L1 Listing Program Modul Server
Dim counter As Integer Dim StatusData As Integer Dim DataPilahWinsock(0 To 5) As String Dim temp As Variant Dim SendData_Winsock As String Dim MSCOMMBuffer As String Dim UserArray(1 To 41) As Boolean Dim GlobalIndex As Integer
'...iniialisasi variabel status pesan = 0... Private Sub initvar() StatusPesan = 0 End Sub
'...mengambil dan menjalankan perintah yang dituliskan oleh user... Private Sub Command3_Click() MSComm1.Output = Text3.Text + Chr(13) End Sub '...melakukan perintah reset... Private Sub Command4_Click() MSComm1.Output = "RS" + Chr(13) End Sub
L2 '...meload form saat menjalankan program... Private Sub Form_Load() Winsock(0).Protocol = sckTCPProtocol '.. menseting protocol dimana klien dapet melakukan koneksi dengan server... Winsock(0).LocalPort = 555 '...mensetting port yang akan di dengarkan, dimana client akan menggunakan port ini untuk terhubung dengan server... Winsock(0).Listen '...winsock siap menerima input... initSerial '...memanggil fungsi serial... '...bila port serial terbuka maka timer untuk cek eror akan aktif... If MSComm1.PortOpen = True Then Timercheckerror.Enabled = True End If End Sub
'...melakukan koneksi dengan serial... Private Sub MSComm1_OnComm() Dim MSCOMMInputData As String '...server mengambil input data dari serial... If MSComm1.InBufferCount <> 0 Then '...jika buffer pada serial terdapat data... MSCOMMInputData = MSComm1.Input '...maka variabel MSCOMMInputData akan berisi data2 yang berasal dari serial... Text4 = Text4 + MSCOMMInputData '...text 4 akan menampilkan data pada MSCOMMInputData...
L3 If Left(MSCOMMInputData, 3) = "0" + Chr(13) + Chr(10) Then '...jika pada MSCOMMInputData datanya berupa nila 0 dengan karak ter Enter dan ganti baris, 'maka yang akan diambil adalah karakter ketiga dari sebelah kiri... MSCOMMInputData = "" '..MSCOMMInputData akan dikosongkan... MSCOMMBuffer = "" 'MSCOMMBufer juga akan dikosongkan... Exit Sub End If '...jika data pada MSCOMMinput data adalah berupa nilai 2, karakter enter dan ganti baris maka akan diambil karakter ketiga dari sebelah kiri.... If Left(MSCOMMInputData, 3) = "2" + Chr(13) + Chr(10) Then MSComm1.Output = "RS" + Chr(13) '...MSCOmm1 akan menjalankan perintah reset... MSCOMMInputData = "" '...MSCommInputData akan dikosongkan... MSCOMMBuffer = "" '...MSCOMMBuffer juga akan dikosongkan... Exit Sub End If '...bila data pada MSCOMMinput bukan '0' dan '2'... If MSCOMMInputData <> "0" + Chr(13) + Chr(10) And MSCOMMInputData <> "2" + Chr(13) + Chr(10) Then MSCOMMBuffer = MSCOMMBuffer + MSCOMMInputData '...data pada MSCOMMBuffer adalah data yang ada pada MSCOMInputData... End If '...jika terdapat data pada MSCOMMbufer yg besarnya dari nilai 5...
L4 If Right(MSCOMMBuffer, 2) = Chr(13) + Chr(10) And Len(MSCOMMBuffer) >= 5 Then SendData_Winsock = "Koordinat|" & MSCOMMBuffer & "|" '... winsock mengirimkan data koordinat ke client... delaying (0.8) '..delay... TimerExecuted.Enabled = True '...timer execute aktif... Timercheckerror.Enabled = True '....timer cek aktif.... MSCOMMBuffer = "" '...bufer dikosongkan.... End If End If End Sub
'..perubahan pada Text1... Private Sub Text1_Change() Text1.SelStart = Len(Text1) '...bila ada perubahan pada teks1 maka akan tetap ditampilkan perintah yg sebelumnya juga... End Sub
'... jika pada text terjadi perubahan... Private Sub Text3_Change() If Right(Text3.Text, 1) = Chr(10) Then '...ambil data sebelah kanan sebanyak 1 karakter dari text3.text yaitu ganti baris... MSComm1.Output = Text3.Text '...MSComm1 akan mengeluarkan Output sesuai dengan yang ditulis oleh user...
L5 Text3.Text = "" '...Lalu text3 akan kembali kosong... End If End Sub
Private Sub Text4_Change() Text4.SelStart = Len(Text4) End Sub
'...cek error time... Private Sub Timercheckerror_Timer() MSComm1.Output = "ER" + Chr(13) End Sub
'...timer executed... Private Sub TimerExecuted_Timer() Winsock(GlobalIndex).SendData SendData_Winsock '...mengirimkan data ke client... SendData_Winsock = "" '..winsock dokosongkan... TimerExecuted.Enabled = False '...matikan timer executed... End Sub
'...menutup koneksi... Private Sub Winsock_Close(index As Integer) LabelConnect.Caption = "No One Connected" '...menampilkan pesan tentang koneksi... UserArray(index) = False '...menutup request koneksi..'
L6 Winsock(index).Close '...menutup winsock... Unload Winsock(index) '...menutup semua koneksi... End Sub
'...meminta koneksi winsock... Private Sub Winsock_ConnectionRequest(index As Integer, ByVal requestID As Long) Dim user As Integer Dim Count As Integer 'menetapkan user sebanyak 40... For Count = 1 To 40 If UserArray(Count) = False Then '...jika tidak ada permintaan koneksi... user = Count '...jumlah user = jumlah index count... UserArray(Count) = True ' ...jika ada permintaan koneksi... GoTo accepted '...lompat ke accepted... End If Next Count user = 0 accepted: If user <> 0 Then '...jika usernya tidak =0... If index = 0 Then '...index masih = 0... Load Winsock(user) '...melakukan koneksi winsok client... Winsock(user).LocalPort = 0 '...menentukan port yang akan digunakan... Winsock(user).Accept requestID '...menerima koneksi... LabelConnect.Caption = "Connected" '....menampilkan pesan terkoneksi...
L7 End If End If End Sub
'...data masuk ke winsock..... Private Sub Winsock_DataArrival(index As Integer, ByVal bytesTotal As Long) Dim WinsockData As String Dim titik As Integer Dim PointerData As Integer titik = 1 Winsock(index).GetData WinsockData '...mengambil data dari client... Text1 = Text1 + WinsockData '...data tersebut akan ditampilkan di text1... '...Memisahkan data... For titiklokasi = 1 To Len(WinsockData) Step 1 If Mid(WinsockData, titiklokasi, 1) = "|" Then '...menaruh pointer titik lokasi pada karakter"|"'... '..data yang terdapat pada DataPilahData adalah data yang diambil dari karakter tengah yang dikirim winsok yang di batasi oleh karakter "|"... DataPilahWinsock(PointerData) = Mid(WinsockData, titik, titiklokasi - titik) titik = titiklokasi + 1 '...penambahan tempat untuk pointer titik... PointerData = PointerData + 1 '...penambahan tempat untuk pointer PointerData... '...pengembalian pointer PointerData pada titik awal... If PointerData >= 5 Then PointerData = 1
L8 End If End If Next titiklokasi '...memilah header data... If DataPilahWinsock(0) = "Directly" Then '...bila header data directly... If DataPilahWinsock(1) = "WH" + Chr(13) Then '...bila perintah yang dituliskan adalah WH... Timercheckerror.Enabled = False '...timer cek tidak aktif... End If Winsock(index).SendData "aCk|" '...winsok mengirimkan ack... MSComm1.Output = DataPilahWinsock(1) '...server akan mengirimkan perintah ke serial... delaying (0.8) '...delay... Winsock(index).SendData "eXecuted|" '...mengirimkan perintah executed ke client... GlobalIndex = index Exit Sub End If If DataPilahWinsock(0) = "fIle" Then '...jika header data adalah file(listing program).... loncatfile: '...server akan megirimkan perintah DL(delete Line) dari line 1-2048 + karakter Enter... MSComm1.Output = "DL 1,2048" + Chr(13) delaying (0.8) '..delay... TimerExecuted.Enabled = True '..timer executed aktif... For CountKirimSerial = 1 To 2048 Step 1 '....menuliskan perintah dari line 1-2048
L9 Next CountKirimSerial '...Output serial berupa perintah di DataPilah(1) dan perintah rn(untuk menjalankan semua perintah yang diminta dan enter... MSComm1.Output = DataPilahWinsock(1) + "rn" + Chr(13) MSComm1.Output = "rn" + Chr(13) SendData_Winsock = "aCk|" '...mengirimkan ack ke client... GlobalIndex = index TimerExecuted.Enabled = True '...timer executed aktif... Text4 = Text4 + DataPilahWinsock(1) '...menampilkan perintah yang ditulis ke text4... Exit Sub End If '...data yang ada di DataPilahData(0)-(5) dikosongkan.... DataPilahWinsock(0) = "" DataPilahWinsock(1) = "" DataPilahWinsock(2) = "" DataPilahWinsock(3) = "" DataPilahWinsock(4) = "" DataPilahWinsock(5) = "" End Sub
'...memanggil serial... Private Sub initSerial() On Error GoTo error MSComm1.PortOpen = True
L10 Exit Sub error: temp = MsgBox("Port Serial sedang digunakan atau tidak ada", vbCritical) End Sub
'....delay.... Private Sub delaying(lama As Integer) Dim Tampung As Long Tampung = Timer + lama Do While (Timer <= Tampung) DoEvents Loop End Sub
'...menghapus tulisan yang ada di text1... Private Sub Command5_Click() Text1 = "" End Sub
'...menghapus tulisan yang ada di text4... Private Sub Command6_Click() Text4 = "" End Sub
L11 Listing Program Modul Client
Dim KoneksitoData As New Connection Dim GetValue As New Recordset Dim WinsockDataSend As String Dim temp As Variant Dim FlagChangeListing As Boolean Dim FlagCheckError As Boolean
'...memanggil fungsi winsock... Private Sub initWinsock() Winsock.RemoteHost = TextHostname '...mengeset host sesuai dengan yang dituliskan pada TextHostName... Winsock.RemotePort = TextPort ' mengeset port yang akan digunakan untuk menghubungkan ke server... End Sub
'...menyalakan timer... Private Sub KirimData(Perintah As String) TimeOut.Enabled = True End Sub
L12 '...membersihkan form pesan kesalahan pada TextMessaggeListing... Private Sub Command10_Click() TextMessageListing = "" End Sub
'...menggerakan lengan robot ke posisi Origin.... Private Sub Command11_Click() WinsockDataSend = "Directly|OG" & Chr(13) & "|" TimerWinsockSend.Enabled = True '...timer diaktifkan... End Sub
'...untuk menyimpan posisi... Private Sub Command3_Click() WinsockDataSend = "Directly|HE " & Val(TextSavePosition) & Chr(13) & "|" TimerWinsockSend.Enabled = True '...timer diaktifkan... End Sub
'...memberikan variabel speed pada directly... Private Sub Command4_Click() WinsockDataSend = "Directly|SP " & Val(TextRobotSpeed) & Chr(13) & "|" TimerWinsockSend.Enabled = True '...timer diaktifkan... End Sub
L13 '...menggerakan lengan robot ke posisi tertentu yang sudah disimpan sebelumnya... Private Sub Command5_Click() If OptionMoveOpenGrip Then '..jika robot bergerak dengan grip terbuka... WinsockDataSend = "Directly|MO " & Val(TextMovetoPosition) & ",o" & Chr(13) & "|" TimerWinsockSend.Enabled = True '...timer diaktifkan... Else '...jika bergerak dengan grip tertutup... WinsockDataSend = "Directly|MO " & Val(TextMovetoPosition) & ",c" & Chr(13) & "|" TimerWinsockSend.Enabled = True End If End Sub
'...menghapus form get robot info... Private Sub Command6_Click() TextRobotInfo = "" '...mengosongkan form textrobotinfo... End Sub
'...menggerakan lengan robot ke posisi nested... Private Sub Command9_Click() WinsockDataSend = "Directly|NT" & Chr(13) & "|" TimerWinsockSend.Enabled = True '...timer diaktifkan... End Sub
L14 '...menghapuskan Listing program.... Private Sub CommandClearListing_Click() TextListing.Text = "" '...menghapuskan tulisan pada TextListing.... End Sub
'...menghapus Line program yang disimpan dari line 1 sampai 2048... Private Sub CommandClearRobot_Click() WinsockDataSend = "Directly|DL 1,2048" + Chr(13) + "|" TimerDoButtonSend.Enabled = True '...timer diaktifkan... End Sub
'...penekanan mouse dalam menggerakan lengan robot pada control pad... Private Sub CommandControlPad_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) Dim distance As Integer Dim degrees As Integer distance = Val(TextMoveDistance) '...mengeset jarak pergerakan.. degrees = Val(TextScrollDegrees) '...mengeset sudut pergerakan joint... '...pergerakan lengan robot dengan menggunakan control pad... Select Case Index Case 0: WinsockDataSend = "Directly|DW " & distance & ",0,0" + Chr(13) + "|" Case 1: WinsockDataSend = "Directly|DW -" & distance & ",0,0" + Chr(13) + "|"
L15 Case 2: WinsockDataSend = "Directly|DW 0," & distance & ",0" + Chr(13) + "|" Case 3: WinsockDataSend = "Directly|DW 0,-" & distance & ",0" + Chr(13) + "|" Case 4: WinsockDataSend = "Directly|DW 0,0," & distance & Chr(13) + "|" Case 5: WinsockDataSend = "Directly|DW 0,0,-" & distance & Chr(13) + "|" Case 6: WinsockDataSend = "Directly|GO" + Chr(13) + "|" Case 7: WinsockDataSend = "Directly|GC" + Chr(13) + "|" Case 8: WinsockDataSend = "Directly|MJ 0,0,0," & degrees & ",0" + Chr(13) + "|" Case 9: WinsockDataSend = "Directly|MJ 0,0,0,-" & degrees & ",0" + Chr(13) + "|" Case 10: WinsockDataSend = "Directly|MJ 0,0,0,0," & degrees & Chr(13) + "|" Case 11: WinsockDataSend = "Directly|MJ 0,0,0,0,-" & degrees & Chr(13) + "|" Case 12: WinsockDataSend = "Directly|MJ " & degrees & ",0,0,0,0" + Chr(13) + "|" Case 13: WinsockDataSend = "Directly|MJ -" & degrees & ",0,0,0,0" + Chr(13) + "|"
L16 Case 14: WinsockDataSend = "Directly|MJ 0," & degrees & ",0,0,0" + Chr(13) + "|" Case 15: WinsockDataSend = "Directly|MJ 0,-" & degrees & ",0,0,0" + Chr(13) + "|" Case 16: WinsockDataSend = "Directly|MJ 0,0," & degrees & ",0,0" + Chr(13) + "|" Case 17: WinsockDataSend = "Directly|MJ 0,0,-" & degrees & ",0,0" + Chr(13) + "|" End Select TimerDoButtonSend.Enabled = True '...timer diaktifkan... End Sub
'...menghentikan pergerakan bila mouse tidak ditekan... Private Sub CommandControlPad_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) TimerDoButtonSend.Enabled = False '...timer tidak aktif... WinsockDataSend = "" '...winsock dihapuskan... End Sub
'...menjalankan perintah yang dituliskan user dalam listing program... Private Sub CommandDo_Click() If CheckErrorListing.Value = 1 Then '...memanggil fungsi cek listing untuk pengecekan error... CheckListing
L17 End If '...jika tidak terdapat error If CheckSendRunListing.Value = 1 Then If FlagCheckError Then GrepAndSendListing Else 'jika terjadi error... MsgBox ("Any error on listing program. Please repair the error first.") End If End If End Sub
Private Sub CheckError() FlagChangeListing = True End Sub
'...pengecekan errro pada listing program.... Private Sub CheckListing() Dim DataSyntax As New Recordset Dim startPoint As Long Dim lastPoint As Long Dim startSpacePoint As Long Dim lastSpacePoint As Long Dim charCounter As Long
L18 Dim lineCounter As Long Dim lineWords As String Dim Words(1 To 9) As String Dim pointerOffset As Long Dim charLineCounter As Long Dim CheckMsgError As String startPoint = 1 lastPoint = 1 TextMessageListing = "" '...Form TextMssageListing kosong... 'jika data dari kanan karakter ke 2 pada TextListing tidak terdapat karakter Enter + new Line If Right(TextListing, 2) <> vbCrLf Then TextListing = TextListing + vbCrLf 'maka ditambahkan karakter Enter dan New Line... End If For charCounter = 1 To Len(TextListing) '...inisialisasi variabel... pointerOffset = 1 startSpacePoint = 1 lastSpacePoint = 1 If Mid(TextListing, charCounter, 1) = Chr(10) Then '..validasi perintah... temp = TextListing '..data pada TextListing dimasukan dalam variabel temp... lastPoint = charCounter + 1
L19 lineWords = Mid(TextListing, startPoint, lastPoint - startPoint) '...Data yang ada dimasukan ke dalam variabel adalah data yang ada pada variabel TextListing dari star sampai lastpoin berupa karakter ganti baris... '...inisialisai baris... For charLineCounter = 1 To Len(lineWords) Step 1 '..variable charlinecounter increase hingga line words(menunjukan baris)... If Mid(lineWords, charLineCounter, 1) = " " Or Mid(lineWords, charLineCounter, 1) = Chr(13) Then 'mengecek apakah line tersebut adalah " "(spasi) atau enter... lastSpacePoint = charLineCounter '...nilai charlinecounter akan slalu increase dan sama dengan LastspacePoint... Words(pointerOffset) = Mid(lineWords, startSpacePoint, lastSpacePoint startSpacePoint) temp = Mid(lineWords, startSpacePoint, lastSpacePoint - startSpacePoint) pointerOffset = pointerOffset + 1 startSpacePoint = lastSpacePoint End If DoEvents Next charLineCounter lineCounter = lineCounter + 1 If Words(1) <> "" Then If Left(Words(1), 1) = "'" Then GoTo No_Check End If
L20 '...untuk menampilkan display kesalahan pada line yang ke berapa... If Val(Words(1)) <= 0 Or Val(Words(1)) >= 2047 Then CheckMsgError = "Error number on line: " & lineCounter & vbCrLf TextMessageListing = TextMessageListing + CheckMsgError End If '...untuk mengecek kesalahan penulisan perintah yang di berikan seperti mo menjadi mov dengan melihat data base yang tersimpan degan nama datasynRVM1... If Words(2) <> "" Then DataSyntax.Open "select * from datasynRVM1 where syntax='" & LTrim(LCase(Words(2))) & "'", KoneksitoData, 1, 3 If DataSyntax.RecordCount = 0 Then CheckMsgError = "Syntax Error on line: " & lineCounter & vbCrLf '...menampilkan kesalahan penulisan sintak pada baris ke berapa... TextMessageListing = TextMessageListing + CheckMsgError End If DataSyntax.Close '...menutup database... End If If Words(3) <> "" Then '...jika jumlah karakter perintah >3 maka tidak akan dijalankan... End If If Words(4) <> "" Then End If If Words(5) <> "" Then End If
L21 If Words(6) <> "" Then End If If Words(7) <> "" Then End If If Words(8) <> "" Then End If If Words(9) <> "" Then End If End If '...jika tidak dicek... No_Check: startPoint = lastPoint End If DoEvents Next charCounter If TextMessageListing = "" Then FlagCheckError = True TextMessageListing = "***** No error found *****" '...menampilkan pesan ke user jikalau tidak ada kesalahan... Else FlagCheckError = False End If End Sub
L22 Private Sub GrepAndSendListing() Dim startPoint As Integer Dim lastPoint As Integer Dim charCounter As Integer Dim lineCounter As Integer If TextListing <> vbCrLf Then WinsockDataSend = "fIle|" & TextListing & "|" TimerWinsockSend.Enabled = True End If
End Sub '...mendapatkan koordinat pada posisi tertentu... Private Sub CommandGetCurrentCoordinate_Click() WinsockDataSend = "Directly|WH" + Chr(13) + "|" '...winsock mengirimkan data ke server dengan perintah wh... TimerWinsockSend.Enabled = True '...aktifkan timer winsock send... End Sub
'...menuju ke posisi tertentu... Private Sub CommandGotoCoordinate_Click() 'winsock mengirimkan data dengan perintah MP dan posisi yang dituliskan oleh user... WinsockDataSend = "Directly|MP " + TextCoordinate(0) + "," + TextCoordinate(1) + "," + TextCoordinate(2) + "," + TextCoordinate(3) + "," + TextCoordinate(4) + Chr(13) + "|"
L23 TimerWinsockSend.Enabled = True '...aktifkan timer winsock... End Sub
'...membuka file listing program yang telah disimpan... Private Sub CommandOpen_Click() On Error GoTo Error: CommonDialog1.filename = "" CommonDialog1.ShowOpen If CommonDialog1.filename = "" Then Exit Sub End If TextListing = ReadFile(CommonDialog1.filename) Error: End Sub
‘...menyimpan file listing program... Private Sub CommandSaveListing_Click() Dim filename As String Dim flagExist As Integer On Error GoTo Error CommonDialog1.filename = "" CommonDialog1.ShowSave filename = CommonDialog1.filename
L24 If CommonDialog1.filename = "" Then Exit Sub End If
Open filename For Input As #1 Close #1 flagExist = MsgBox("File Already Exist, Overwrite?", vbOKCancel) If flagExist = 1 Then '...mengecek apakah nama file yang ingin disimpan sudah ada... GoTo Overwrite Else Exit Sub End If Overwrite: temp = SavekeFile(TextListing, filename) Label1 = "Write Program Here" Exit Sub Error: If Err = 53 Then Close #1 CreateFile (filename) GoTo Overwrite End If End Sub
L25 '...menyimpan setingan pergerakan lengan robot... Private Sub CommandSaveSettings_Click() temp = SavekeFile(TextHostname & "|" & TextPort & "|" & TextMoveDistance & "|" & TextScrollDegrees & "|", App.Path & "\settings.hs") '...menyimpan setingan yang di tuliskan user ke dalam file setting.hs... MsgBox ("Settings Recorded") End Sub
'...meload form saat program di jalankan... Private Sub Form_Load() LoadSettings initvalue initWinsock initSyntaxdb End Sub
'...menutup form saat program keluar... Private Sub Form_Unload(Cancel As Integer) Winsock.Close Unload Me End Sub
L26 Private Sub initvalue() FlagCheckError = False End Sub
'...menjalankan lengan robot dengan grip tertutup... Private Sub OptionMoveCloseGrip_Click() If OptionMoveCloseGrip.Value Then OptionMoveOpenGrip.Value = False End If End Sub
'...menjalankan lengan robot dengan grip terbuka... Private Sub OptionMoveOpenGrip_Click() If OptionMoveOpenGrip.Value Then OptionMoveCloseGrip.Value = False End If End Sub
'...menuliskan program yang baru... Private Sub TextListing_Change() Dim charCounter As Long Dim lineCounter As Long lineCounter = 1
L27 For charCounter = 1 To Len(TextListing) Step 1 If Mid(TextListing, charCounter, 1) = Chr(10) Then lineCounter = lineCounter + 1 End If DoEvents Next charCounter LabelcounterLine = "Line Counter: " & lineCounter FlagChangeListing = False FlagCheckError = False Label1 = "Write Program Here*" End Sub
Private Sub TextRobotInfo_Change() TextRobotInfo.SelStart = Len(TextRobotInfo) End Sub
'mengaktifkan timer timeout.... Private Sub TimeOut_Timer() LabelStatusPerintah = "Status: Command Execution Failed" TimeOut.Enabled = False End Sub
'timer buat mengirimkan perintah directly... Private Sub TimerDoButtonSend_Timer()
L28 On Error GoTo Keluar '...mengecek error... Winsock.SendData WinsockDataSend '...winsock mengirimkan data.... Exit Sub Keluar: TimerDoButtonSend.Enabled = False temp = MsgBox("Lakukan koneksi terlebih dahulu", vbCritical) End Sub
'...timercheck Winsock.... Private Sub TimerCheckWinsock_Timer() If Winsock.State = 0 Then LabelStatusPerintah = "Status: No Connection to Server" TimerCheckWinsock.Enabled = False DoDisconnection End If End Sub
'...timerSaat winsock mengirimkan data... Private Sub TimerWinsockSend_Timer() On Error GoTo Keluar Winsock.SendData WinsockDataSend TimerWinsockSend.Enabled = False WinsockDataSend = "" Exit Sub
L29 Keluar: TimerWinsockSend.Enabled = False temp = MsgBox("Lakukan koneksi terlebih dahulu", vbCritical) End Sub
'...Winsock menutup koneksi... Private Sub Winsock_Close() DoDisconnection End Sub
'...Winsock melakukan koneksi... Private Sub Winsock_Connect() LabelStatusPerintah = "Status: Connected" TimerCheckWinsock.Enabled = True End Sub
'...Winsock menampung data.... Private Sub Winsock_DataArrival(ByVal bytesTotal As Long) Dim titiklokasi As Integer Dim datamasuk As String Dim WindockData As String Dim DataPilahWinsock(0 To 5) As String Dim titik As Integer Dim PointerData As Integer
L30 titik = 1 Winsock.GetData datamasuk TextDebug = datamasuk '...debug Reason '...menginisialissikan variabel(data) yang masuk ke winsock... For titiklokasi = 1 To Len(datamasuk) Step 1 test = Mid(datamasuk, titiklokasi, 1) If Mid(datamasuk, titiklokasi, 1) = "|" Then DataPilahWinsock(PointerData) = Mid(datamasuk, titik, titiklokasi - titik) titik = titiklokasi + 1 PointerData = PointerData + 1 If PointerData >= 5 Then PointerData = 5 End If End If Next titiklokasi '...Jika data yang masuk berupa ack... If DataPilahWinsock(0) = "aCk" Then TimeOut.Enabled = False LabelStatusPerintah = "Status: Command Executed" End If '...Jika data yang masuk dengan header koordinat... If DataPilahWinsock(0) = "Koordinat" Then TextRobotInfo.Text = TextRobotInfo + DataPilahWinsock(1) LabelStatusPerintah = "Status: Command Executed"
L31 End If End Sub
'...mengganti frame... Private Function GantiFrame(pilih As Integer) Select Case pilih Case 0: Frame(0).Visible = True Frame(1).Visible = False Frame(2).Visible = False Frame(3).Visible = False Frame(4).Visible = False Case 1: Frame(0).Visible = False Frame(1).Visible = True Frame(2).Visible = False Frame(3).Visible = False Frame(4).Visible = False Case 2: Frame(0).Visible = False Frame(1).Visible = False Frame(2).Visible = True Frame(3).Visible = False Frame(4).Visible = False
L32 Case 3: Frame(0).Visible = False Frame(1).Visible = False Frame(2).Visible = False Frame(3).Visible = True Frame(4).Visible = False Case 4: Frame(0).Visible = False Frame(1).Visible = False Frame(2).Visible = False Frame(3).Visible = False Frame(4).Visible = True End Select End Function '...pemilihan Option pada toolBars... Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key Case Is = "connect": If Toolbar1.Buttons(1).Value = tbrPressed Then DoConnection Else DoDisconnection End If Case Is = "writeprogram": GantiFrame (1)
L33 Case Is = "directcontrol": GantiFrame (2) Case Is = "options": GantiFrame (3) Case Is = "about": GantiFrame (4) Case Is = "exit": Unload Me End Select End Sub
'....melakukan koneksi dengan server... Private Sub DoConnection() Toolbar1.Buttons(1).Image = 2 Toolbar1.Buttons(1).Value = tbrPressed Toolbar1.Buttons(1).ToolTipText = "Connected, for disconnect click here" Winsock.Connect End Sub
'...melakukan disconect dengan server... Private Sub DoDisconnection() Toolbar1.Buttons(1).Image = 1 Toolbar1.Buttons(1).Value = tbrUnpressed Toolbar1.Buttons(1).ToolTipText = "Click here for Connecting the server" Winsock.Close End Sub
L34 ' memanggil data base pada file data hesa.hs... Sub initSyntaxdb() On Error GoTo INIT_FAIL strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.hs;Persist Security Info=False" KoneksitoData.ConnectionString = strcon KoneksitoData.Open Exit Sub INIT_FAIL: temp = MsgBox("Data Initial failed. Make sure file 'data.hs' exist on current directory", vbCritical) End Sub
'... mengeset pergerakan robot sesuai dengan yang ditentukan user... Private Sub LoadSettings() Dim DataPilah As String Dim terusCounting As Integer Dim awal As Integer Dim akhir As Integer Dim part(1 To 4) As String Dim offset As Integer Dim panjangDataPilah As Integer offset = 1 awal = 1
L35 DataPilah = ReadFile(App.Path & "\settings.hs") panjangDataPilah = Len(DataPilah) For terusCounting = 1 To panjangDataPilah Step 1 If Mid(DataPilah, terusCounting, 1) = "|" Then akhir = terusCounting part(offset) = Mid(DataPilah, awal, akhir - awal) offset = offset + 1 awal = akhir + 1 End If TextHostname = part(1) TextPort = part(2) TextMoveDistance = part(3) TextScrollDegrees = part(4) Next terusCounting End Sub
'...delay... Private Sub delaying(lama As Integer) Dim Tampung As Long Tampung = Timer + lama Do While (Timer <= Tampung) DoEvents Loop End Sub