djmain.bas

VB与欧姆龙PLC通过RS-232串口通讯 的上位机程序

Attribute VB_Name = "djmain"
Option Explicit
Public ws As Workspace
Public dbrpt As Database
Public glrpt As Recordset
Public lqrpt As Recordset
Public lfrpt As Recordset
Public Glcxconcent As String
Public Lqcxconcent As String
Public txrst As Recordset
Public delrst As Recordset
'Public benci  As Boolean
Public bcgl As Recordset
Public bclq As Recordset

Public glcx As String
'Public Lqws As Workspace
'Public dbrpt As Database

Public lqcx As String

'Public lfws As Workspace
'Public dbrpt As Database
'Public lfrpt As Recordset
Public baocun As Boolean
Public glstr1 As String
Public glstr2 As String
Public tbl As Integer
Public dkh As String
Public btl As String
Sub main()
Set ws = DBEngine.Workspaces(0)
Set dbrpt = ws.OpenDatabase(App.Path & "\Report\report.mdb")
Set glrpt = dbrpt.OpenRecordset("Glreport", dbOpenDynaset)
Set bcgl = dbrpt.OpenRecordset("glthis", dbOpenDynaset)

'Set Lqws = DBEngine.Workspaces(0)
'Set dbrpt = Lqws.OpenDatabase(App.Path & "\Report\report.mdb")
Set lqrpt = dbrpt.OpenRecordset("Lqreport", dbOpenDynaset)
Set bclq = dbrpt.OpenRecordset("lqthis", dbOpenDynaset)

Set txrst = dbrpt.OpenRecordset("txb", dbOpenDynaset)

'Set lfws = DBEngine.Workspaces(0)
'Set dbrpt = lfws.OpenDatabase(App.Path & "\Report\lfset.mdb")


'rst.Open "select * from txb where dft = 'Y'", conn, adOpenStatic, adLockOptimistic
If txrst.RecordCount > 0 Then
dkh = txrst(0)
btl = txrst(1)
Else
txrst.AddNew
txrst.Fields(0) = "1"
txrst.Fields(1) = "4800,e,7,2"
txrst.Fields(2) = "Y"
txrst.Update
End If
txrst.Close
'Set txrst = Nothing

'Lqreport.Show



djgc.Show
End Sub
Public Function fscset(ts As String) As String
Dim le As Integer
Dim a As Byte
Dim j As Integer
Dim tj As String
a = 0
le = Len(ts)
For j = 1 To le
 tj = Mid(ts, j, 1)
 a = Asc(tj) Xor a
Next j
fscset = Hex(a)
If Len(fscset) = 1 Then
fscset = "0" + fscset
End If
End Function
Public Function fsccheck(ts As String) As Boolean
Dim le As Integer
Dim a As Byte
Dim j As Integer
Dim fcsd As String
Dim tj As String
On Error GoTo checkerror
a = 0
le = Len(ts) - 4
fcsd = Mid(ts, le + 1, 2)
For j = 1 To le
 a = Asc(Mid(ts, j, 1)) Xor a
Next j
tj = Hex(a)
If Len(tj) = 1 Then
 tj = "0" + tj
End If
If fcsd <> tj Then
  fsccheck = False
Else: fsccheck = True
End If
Exit Function
checkerror: fsccheck = False
End Function