I have code visual basic convert to b4a. unfortunately i still confuse how to convert my program(vb6) to b4a. here my code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim responseText As String
Private Sub Command1_Click()
txt_kirim = "00KSCIO 000000" 'set address 00.00
Sending
End Sub
Private Sub Command2_Click()
txt_kirim = "00KRCIO 000000" 'reset address 00.00
Sending
End Sub
Private Sub Form_Load()
portChoice.ListIndex = 0
baudChoice.ListIndex = 3
dataBitChoice.ListIndex = 0
stopBitChoice.ListIndex = 1
parityChoice.ListIndex = 1
enableChoice (False)
End Sub
Private Sub openPort()
Dim sformat As String
If MSComm1.PortOpen = True Then Exit Sub
sformat = baudChoice.List(baudChoice.ListIndex) + "," _
+ Mid(parityChoice.List(parityChoice.ListIndex), 1, 1) + "," _
+ dataBitChoice.List(dataBitChoice.ListIndex) + "," _
+ stopBitChoice.List(stopBitChoice.ListIndex)
MSComm1.Settings = sformat
MSComm1.CommPort = portChoice.ListIndex + 1
MSComm1.PortOpen = True
'appendlnResponse ("COM" + Str(MSComm1.CommPort) + _
' ": Open at " + MSComm1.Settings)
enableChoice (False)
End Sub
Private Sub closePort()
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
enableChoice (True)
End If
End Sub
Private Sub enableChoice(state As Boolean)
portChoice.Enabled = state
baudChoice.Enabled = state
dataBitChoice.Enabled = state
stopBitChoice.Enabled = state
parityChoice.Enabled = state
timeOutBox.Enabled = state
End Sub
Private Sub cmd_Prog_Click()
txt_kirim = "00SC00"
Sending
End Sub
Private Sub cmd_Mon_Click()
txt_kirim = "00SC02"
Sending
End Sub
Private Sub Cmd_run_Click()
txt_kirim = "00SC03"
Sending
End Sub
Private Sub cmd_setup_com_Click()
enableChoice (True)
Call closePort
End Sub
Private Sub Cmd_write_Click()
txt_kirim = "00WD" + Txt_addwr + txt_valwr
Sending
End Sub
Private Sub Cmd_read_Click()
txt_kirim = "00RD" + txt_addrd + "0001"
Sending
txt_valrd = Mid(Txt_terima, 8, 4)
End Sub
Private Sub Sending()
Dim rstr As String
Call computeFCS
rstr = sendCommand(CommandString.Text)
If rstr = "" Then
Beep
Txt_terima = "No Response from PLC"
'appendlnResponse ("(Warning: No Response from PLC)")
Else
appendlnResponse (rstr)
End If
End Sub
Private Sub computeFCS()
Dim result As String
Dim length As String
Dim I As Integer
Dim type_PLC As String
type_PLC = txt_kirim
length = Len(type_PLC)
result = Asc("@")
For I = 1 To length
result = result Xor Asc(Mid(type_PLC, I, 1))
Next
result = Hex(result)
CommandString.Text = "@" + type_PLC + result + "*" + Chr(13)
End Sub
Private Sub ExitButton_Click()
Call closePort
End
End Sub
Private Sub Clear()
End Sub
Private Sub appendlnResponse(s As String)
Txt_terima = responseText
End Sub
Public Function sendCommand(cmd As String)
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
Call openPort
If Mid(cmd, 1, 1) <> "@" Then
MSComm1.Output = Chr(5) ' send ctrl-E
If getCtrlE() = False Then ' should get a Ctrl-E in return
responseText = ""
Exit Function
End If
End If
MSComm1.Output = cmd + Chr(13)
Call getResponse ' get a response within timeout.
sendCommand = responseText ' returned received string.
End Function
Private Function getCtrlE()
Dim inbuff As String
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If inbuff = Chr(5) Then
getCtrlE = True
Exit Function
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
getCtrlE = False
End Function
Private Sub getResponse()
Static responseBuffer As String
Dim inbuff As String
Dim length As Integer
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 500
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If Len(inbuff) > 0 Then
responseBuffer = responseBuffer + inbuff
length = Len(responseBuffer)
If Mid(responseBuffer, length, 1) = Chr(13) Then
responseText = Mid(responseBuffer, 1, length - 1) ' received a complete response string
responseBuffer = ""
Exit Sub
Else
End If
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
responseText = ""
End Sub
problems:
1. how to convert gettichkcount in b4a
2. how to convert command str , hex, xor
3. how to convert call
4. how to convert end function
thanks.
to Erel:
give me a clue for solving this problem. thanks:sign0085:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim responseText As String
Private Sub Command1_Click()
txt_kirim = "00KSCIO 000000" 'set address 00.00
Sending
End Sub
Private Sub Command2_Click()
txt_kirim = "00KRCIO 000000" 'reset address 00.00
Sending
End Sub
Private Sub Form_Load()
portChoice.ListIndex = 0
baudChoice.ListIndex = 3
dataBitChoice.ListIndex = 0
stopBitChoice.ListIndex = 1
parityChoice.ListIndex = 1
enableChoice (False)
End Sub
Private Sub openPort()
Dim sformat As String
If MSComm1.PortOpen = True Then Exit Sub
sformat = baudChoice.List(baudChoice.ListIndex) + "," _
+ Mid(parityChoice.List(parityChoice.ListIndex), 1, 1) + "," _
+ dataBitChoice.List(dataBitChoice.ListIndex) + "," _
+ stopBitChoice.List(stopBitChoice.ListIndex)
MSComm1.Settings = sformat
MSComm1.CommPort = portChoice.ListIndex + 1
MSComm1.PortOpen = True
'appendlnResponse ("COM" + Str(MSComm1.CommPort) + _
' ": Open at " + MSComm1.Settings)
enableChoice (False)
End Sub
Private Sub closePort()
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
enableChoice (True)
End If
End Sub
Private Sub enableChoice(state As Boolean)
portChoice.Enabled = state
baudChoice.Enabled = state
dataBitChoice.Enabled = state
stopBitChoice.Enabled = state
parityChoice.Enabled = state
timeOutBox.Enabled = state
End Sub
Private Sub cmd_Prog_Click()
txt_kirim = "00SC00"
Sending
End Sub
Private Sub cmd_Mon_Click()
txt_kirim = "00SC02"
Sending
End Sub
Private Sub Cmd_run_Click()
txt_kirim = "00SC03"
Sending
End Sub
Private Sub cmd_setup_com_Click()
enableChoice (True)
Call closePort
End Sub
Private Sub Cmd_write_Click()
txt_kirim = "00WD" + Txt_addwr + txt_valwr
Sending
End Sub
Private Sub Cmd_read_Click()
txt_kirim = "00RD" + txt_addrd + "0001"
Sending
txt_valrd = Mid(Txt_terima, 8, 4)
End Sub
Private Sub Sending()
Dim rstr As String
Call computeFCS
rstr = sendCommand(CommandString.Text)
If rstr = "" Then
Beep
Txt_terima = "No Response from PLC"
'appendlnResponse ("(Warning: No Response from PLC)")
Else
appendlnResponse (rstr)
End If
End Sub
Private Sub computeFCS()
Dim result As String
Dim length As String
Dim I As Integer
Dim type_PLC As String
type_PLC = txt_kirim
length = Len(type_PLC)
result = Asc("@")
For I = 1 To length
result = result Xor Asc(Mid(type_PLC, I, 1))
Next
result = Hex(result)
CommandString.Text = "@" + type_PLC + result + "*" + Chr(13)
End Sub
Private Sub ExitButton_Click()
Call closePort
End
End Sub
Private Sub Clear()
End Sub
Private Sub appendlnResponse(s As String)
Txt_terima = responseText
End Sub
Public Function sendCommand(cmd As String)
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
Call openPort
If Mid(cmd, 1, 1) <> "@" Then
MSComm1.Output = Chr(5) ' send ctrl-E
If getCtrlE() = False Then ' should get a Ctrl-E in return
responseText = ""
Exit Function
End If
End If
MSComm1.Output = cmd + Chr(13)
Call getResponse ' get a response within timeout.
sendCommand = responseText ' returned received string.
End Function
Private Function getCtrlE()
Dim inbuff As String
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If inbuff = Chr(5) Then
getCtrlE = True
Exit Function
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
getCtrlE = False
End Function
Private Sub getResponse()
Static responseBuffer As String
Dim inbuff As String
Dim length As Integer
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 500
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If Len(inbuff) > 0 Then
responseBuffer = responseBuffer + inbuff
length = Len(responseBuffer)
If Mid(responseBuffer, length, 1) = Chr(13) Then
responseText = Mid(responseBuffer, 1, length - 1) ' received a complete response string
responseBuffer = ""
Exit Sub
Else
End If
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
responseText = ""
End Sub
problems:
1. how to convert gettichkcount in b4a
2. how to convert command str , hex, xor
3. how to convert call
4. how to convert end function
thanks.
to Erel:
give me a clue for solving this problem. thanks:sign0085: