Hi All,
Need help on below coding. I have a program which will receive data from RS232.
But seems like cant display the output correctly as i needed. Pls refer to the pic.
Indeed urgent please help to point out my error.
Need help on below coding. I have a program which will receive data from RS232.
But seems like cant display the output correctly as i needed. Pls refer to the pic.
Indeed urgent please help to point out my error.
Code:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPrivateProfileInt Lib "kernel32" _
Alias "GetPrivateProfileIntA" _
(ByVal sSectionName As String, _
ByVal sKeyName As String, _
ByVal lDefault As Long, _
ByVal sFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal sSectionName As String, _
ByVal sKeyName As String, _
ByVal sDefault As String, _
ByVal sReturnedString As String, _
ByVal lSize As Long, _
ByVal sFileName As String) As Long
'Scanner data settings
Private nTotalLengthReceive As Integer
Private nDataLength As Integer
'Comm port settings
Private sSettings As String 'Settings: Baurate,parity,data bit,stop bit; example: Settings=9600,n,8,1
Private nCommport As Integer
Private nHandshaking As Integer 'Handshaking: 0:None, 1:XOnXOff, 2:RTS, 3:RTSXOnXOff
Private nInputMode As Integer 'InputMode: 0:Text, 1:Binary
Private nInputLen As Integer
Private nRThreshold As Integer
Private nSThreshold As Integer
Private bDTREnable As Boolean
Private bEOREnable As Boolean
Private bRTSEnable As Boolean
Private iTimeOut As Integer
Private nAutoSaveData As Integer 'Auto save data after how many scan
Private lCounter As Long
Private nRetry As Integer
Private Sub Command1_Click()
List1.Clear
lCounter = 0
Label5.Caption = 0
End Sub
Private Sub Command2_Click()
Dim strTemp As String
Dim strDirExists As String
Dim strTodayFile As String
Dim intFB As Integer
Dim intCount As Integer
intFB = FreeFile
If (List1.ListCount <= 0) Then Exit Sub
strTemp = App.Path & "\Data"
strDirExists = Dir(strTemp, vbDirectory)
If strDirExists = "" Then
MkDir strTemp
End If
strTodayFile = Format(Now, "YYYY_MM_DD") & ".txt"
strTemp = App.Path & "\Data\" & strTodayFile
Open strTemp For Append As #intFB
For intCount = (List1.ListCount - 1) To 0 Step -1
Print #intFB, List1.List(intCount)
Next intCount
Close #intFB
List1.Clear
End Sub
Private Sub Form_Load()
Call LoadSettings
lCounter = 0
MSComm1.CommPort = nCommport
MSComm1.Settings = sSettings
MSComm1.Handshaking = nHandshaking
MSComm1.InputMode = nInputMode
MSComm1.InputLen = nInputLen
MSComm1.RThreshold = nRThreshold
MSComm1.SThreshold = nSThreshold
MSComm1.DTREnable = bDTREnable
MSComm1.EOFEnable = bEOREnable
MSComm1.RTSEnable = bRTSEnable
If (MSComm1.PortOpen = True) Then MSComm1.PortOpen = False
DoEvents
Sleep (300)
MSComm1.PortOpen = True
End Sub
Private Sub Form_Terminate()
If (MSComm1.PortOpen = True) Then MSComm1.PortOpen = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If (MSComm1.PortOpen = True) Then MSComm1.PortOpen = False
End Sub
Private Sub MSComm1_OnComm()
Dim i As Long
Dim strInput As String
Dim strEnd As String
Dim strNow As String
i = 0
strInput = ""
strNow = ""
Label7.Caption = ""
Label7.BackColor = vbYellow
Do
strInput = strInput & MSComm1.Input
'DoEvents
i = i + 1
'strEnd = Right(strInput, 2) 'Incase want to check Terminal Characters
Text3.Text = i
Loop Until (Len(strInput) >= nTotalLengthReceive) Or (i > iTimeOut)
If i >= iTimeOut Then
MSComm1.PortOpen = False
Text1.Text = strInput
Label7.BackColor = vbRed
nRetry = nRetry + 1
Text4.Text = nRetry
Else
If (List1.ListCount >= nAutoSaveData) Then Call Command2_Click 'Auto save data after how many scan
Text1.Text = Left(strInput, nDataLength)
Label7.Caption = Left(strInput, nDataLength)
If Check1.Value = 1 Then
Clipboard.Clear
Clipboard.SetText (Label7.Caption)
End If
strNow = Format(Now, "YYYY-MM-DD")
strNow = strNow & " " & Format(Now, "HH:MM:SS") 'Get current Date and Time
List1.AddItem (strNow & " , " & Text1.Text), 0 'Add data in List Box
lCounter = lCounter + 1
Label5.Caption = lCounter
Label7.BackColor = vbGreen
nRetry = 0
Text4.Text = nRetry
End If
Text2.Text = Len(strInput)
DoEvents
Sleep (200)
If (MSComm1.PortOpen = False) Then
MSComm1.PortOpen = True
Sleep (200)
End If
End Sub
Private Sub LoadSettings()
Dim sString As String
Dim lSize As Long
Dim iReturn As Integer
Dim sNull As String
Dim sFile As String
Dim strDirExists As String
sFile = App.Path & "\" & "Settings.ini"
sNull = Chr$(0)
'Commport settings
sString = String$(30, "*")
lSize = Len(sString)
iReturn = GetPrivateProfileString("COMM", "Settings", "", sString, lSize, sFile)
sSettings = Left(sString, (InStr(sString, "*") - 2))
iReturn = GetPrivateProfileInt("COMM", "Commport", 2, sFile)
nCommport = iReturn
'Handshaking: 0:None, 1:XOnXOff, 2:RTS, 3:RTSXOnXOff
iReturn = GetPrivateProfileInt("COMM", "Handshaking", 2, sFile)
nHandshaking = iReturn
'InputMode: 0:Text, 1:Binary
iReturn = GetPrivateProfileInt("COMM", "InputMode", 0, sFile)
nInputMode = iReturn
iReturn = GetPrivateProfileInt("COMM", "InputLen", 2, sFile)
nInputLen = iReturn
iReturn = GetPrivateProfileInt("COMM", "RThreshold", 2, sFile)
nRThreshold = iReturn
iReturn = GetPrivateProfileInt("COMM", "SThreshold", 2, sFile)
nSThreshold = iReturn
iReturn = GetPrivateProfileInt("COMM", "DTREnable", 0, sFile)
bDTREnable = iReturn
iReturn = GetPrivateProfileInt("COMM", "EOREnable", 0, sFile)
bEOREnable = iReturn
iReturn = GetPrivateProfileInt("COMM", "RTSEnable", 1, sFile)
bRTSEnable = iReturn
iReturn = GetPrivateProfileInt("COMM", "TimeOut", 5000, sFile)
iTimeOut = iReturn
iReturn = GetPrivateProfileInt("COMM", "AutoSaveData", 20, sFile)
nAutoSaveData = iReturn
'Scanner Settings
iReturn = GetPrivateProfileInt("SCANNER", "TotalLengthReceive", 12, sFile)
nTotalLengthReceive = iReturn
iReturn = GetPrivateProfileInt("SCANNER", "DataLength", 8, sFile)
nDataLength = iReturn
strDirExists = Dir(App.Path & "\Data", vbDirectory)
If strDirExists = "" Then MkDir App.Path & "\Data"
End Sub
