tranform.cls

gps 源码 vb+access 其他地方很难找到 很详细的说明

                             MDIMainForm.oWorkMode.OndutyInit True
                             'RECEIVED = True
                        Case UNLOCKRESPONSE
                             MDIMainForm.StatusBar1.Panels(2).Text = "解锁[" & oTarget.GetName & "]车成功"
                             If Link_Sever = True Then MDIMainForm.Winsock1.SendData "解锁" + CStr(nID)
                             MDIMainForm.oWorkMode.OndutyInit True
                             
                             'RECEIVED = True
       End Select
    End If
    MDIMainForm.Label7.Caption = temp_info
End Function
Private Sub AddItemList()
Dim i As Integer
Dim dbs As Database
Dim rst As Recordset
Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
Set rst = dbs.OpenRecordset("target")
rst.Index = "CommId"
rst.Seek "=", txm
        For i = 0 To Form1.List1.ListCount - 1
            If Trim(Mid(Form1.List1.List(i), 1, 4)) = rst.Fields("Name") Then
               Form1.List1.RemoveItem i
               If Len(rst.Fields("Name")) = 1 Then
               Form1.List1.AddItem "   " + rst.Fields("Name") + "号车开机" + "               " + str(Time) + "                " + str(Date)
               adddate = True
               ElseIf Len(rst.Fields("Name")) = 2 Then
               Form1.List1.AddItem "  " + rst.Fields("Name") + "号车开机" + "               " + str(Time) + "                " + str(Date)
               adddate = True
               End If
            End If
            'Else
            '   Form1.List1.AddItem rst.Fields("Name") + "号车开机" + "               " + str(Time) + "                " + str(Date)
            'End If
        Next
        If adddate = True Then
           adddate = False
        Else
               If Len(rst.Fields("Name")) = 1 Then
               Form1.List1.AddItem "   " + rst.Fields("Name") + "号车开机" + "               " + str(Time) + "                " + str(Date)
               End If
               If Len(rst.Fields("Name")) = 2 Then
               Form1.List1.AddItem "  " + rst.Fields("Name") + "号车开机" + "               " + str(Time) + "                " + str(Date)
               End If
        End If
'rst.Edit
'rst.Fields("lasttime") = Date
'rst.Update
End Sub
Private Sub RemoveItemlist(ByVal Temp_Openj As Boolean)
Dim i As Integer
Dim dbs As Database
Dim rst As Recordset
Dim infostr As String
Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
Set rst = dbs.OpenRecordset("target")
rst.Index = "CommId"
rst.Seek "=", txm
If Temp_Openj = True Then
    infostr = "号车开机"
Else
    infostr = "号车关机"
End If
   If Form1.List1.ListCount = 0 Then
      Form1.List1.AddItem "   " + rst.Fields("Name") + infostr + "               " + str(Time) + "                " + str(Date)
   Else
        
        For i = 0 To Form1.List1.ListCount - 1
            If Trim(Mid(Form1.List1.List(i), 1, 4)) = rst.Fields("Name") Then
               'Form1.List1.RemoveItem i - 1
               Form1.List1.RemoveItem i
               Form1.List1.AddItem "   " + rst.Fields("Name") + infostr + "               " + str(Time) + "                " + str(Date)
            End If
            'If Trim(Mid(Form1.List1.List(i), 1, 4)) = "" Then
'               Form1.List1.RemoveItem i
            'End If
        Next
   End If
'rst.Edit
'rst.Fields("lasttime") = Date
'rst.Update
End Sub
Private Sub WriteRz(ByVal TEMP_CarID As Integer, ByVal TEMP_Open_Close As Boolean)
Dim filename As String
Dim filenum As Long
filenum = FreeFile
filename = strPath + "rz\" + CStr(Date) + ".TXT"
If Dir(strPath + "rz\", vbDirectory) = "" Then
   MkDir strPath + "rz\"
End If
If TEMP_Open_Close = True Then
    Open strPath + "rz\" + CStr(Date) + ".txt" For Append As #filenum
         Print #filenum, CStr(TEMP_CarID) + "号车" + "        " + CStr(Time) + "       " + CStr(Date) + "开机!"
    Close #filenum
Else
    Open strPath + "rz\" + CStr(Date) + ".txt" For Append As #filenum
         Print #filenum, CStr(TEMP_CarID) + "号车" + "        " + CStr(Time) + "       " + CStr(Date) + "关机!"
    Close #filenum
End If
End Sub

Private Sub Class_Initialize()
    m_bStart = False
End Sub

Private Sub Class_Terminate()
    Set oRecord = Nothing
End Sub

Public Function Hex_num(ByVal Temp_Data_Num As String) As Long
Dim i As Integer
Dim D As String
For i = 0 To 1
   D = Mid(Temp_Data_Num, 2 - i, 1)
   Select Case D
          Case "F"
               Hex_num = Hex_num + 15 * (16 ^ i)
          Case "E"
               Hex_num = Hex_num + 14 * (16 ^ i)
          Case "D"
               Hex_num = Hex_num + 13 * (16 ^ i)
          Case "C"
               Hex_num = Hex_num + 12 * (16 ^ i)
          Case "B"
               Hex_num = Hex_num + 11 * (16 ^ i)
          Case "A"
               Hex_num = Hex_num + 10 * (16 ^ i)
          Case Else
               Hex_num = Hex_num + Val(D) * (16 ^ i)
   End Select
Next

End Function

Public Function Disp_Info(ByVal num As Long, ByVal Room As Integer) As Boolean
Dim i As Integer
For i = 7 To 0 Step -1
    If num >= 2 ^ i Then
       num = num - 2 ^ i
       Info_Data i, Room
    End If
Next
End Function

Private Sub Info_Data(ByVal num As Integer, ByVal Temp_Room As Integer)
If Temp_Room = 1 Then
     
     Select Case num
            Case 4
                 temp_info = temp_info + "紧急报警 "
                 oRecord.bAlert = True
                 AlertFlag = True
            
            Case 1
                 temp_info = temp_info + "盗警 "
                 oRecord.bAlert = True
                 AlertFlag = True
            
            Case 2
                 temp_info = temp_info + "求助服务申请 "
            
            Case 3
                 temp_info = temp_info + "遥控报警 "
            
            Case 0
                 temp_info = temp_info + "医疗服务申请 "
            Case 5
                 temp_info = temp_info + "车辆故障服务申请 "
            Case 6
                 temp_info = temp_info + "车辆电池电压过低 "
            Case 7
                 temp_info = temp_info + "电池被破坏 "
     End Select

ElseIf Temp_Room = 2 Then

     Select Case num
            Case 0
                 temp_info = temp_info + "车辆越界 "
            Case 1
                 temp_info = temp_info + "车辆超速 "
            Case 2
                 temp_info = temp_info + "遥控器电池电压低 "
            Case 3
                 temp_info = temp_info + "GPS接收机故障 "
            Case 4
                 temp_info = temp_info + "通话手柄故障 "
            Case 5
                 temp_info = temp_info + " "
            Case 6
                 temp_info = temp_info + "ACC处于熄火状态 "
            Case 7
                 temp_info = temp_info + "误报警消除 "
     End Select

ElseIf Temp_Room = 3 Then
     
     Select Case num
            Case 0
                 temp_info = temp_info + "车门处于开启状态 "
            Case 1
                 temp_info = temp_info + "车辆处于设防状态 "
     End Select

End If
End Sub
Private Sub Type_Info(ByVal Type_char As String)
    Select Case Type_char
           Case "ONE"
                 temp_info = "定位信息 "
           Case "H"
                 temp_info = "监听成功 "
           Case "LKC"
                 temp_info = "锁车成功 "
                 Temp_Lock_Flag = LOCKRESPONSE
           Case "ULC"
                 temp_info = "解锁成功 "
                 Temp_Lock_Flag = UNLOCKRESPONSE
           Case "DOC"
                 temp_info = "车门开启 "
           Case "DCC"
                 temp_info = "车门上锁 "
           Case "P"
                 temp_info = "报警取消 "
                 AlertFlag = False
                 oRecord.bAlert = False
           Case "R"
                 temp_info = "历史记录 "
    End Select
End Sub

Private Sub printinfo(ByVal ch As String)
    Dim dbs As Database
    Dim rst As Recordset
   ' On Error GoTo ErrorHandler  ' 设置错误处理程序。
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
    Set rst = dbs.OpenRecordset("target")
    rst.Index = "Carid"
    rst.Seek "=", ch   'id
    
    If Not rst.NoMatch Then
    'printer.NewPage
    Printer.FontName = "宋体"
    Printer.FontSize = 24 '13.8
    Printer.Print "报警用户资料"
    Printer.FontSize = 13.8 '9.6
    Printer.Print "----------------------------------"
    
    Printer.Print "报警时间:" + Date$ + "  " + Time$
    Printer.Print
    Printer.Print "车辆名称:" + rst!Name
    Printer.Print
    Printer.Print "通 讯 码:" + rst.Fields("commid")
    Printer.Print
    Printer.Print "车牌号码:" + rst.Fields("no")
    Printer.Print
    Printer.Print "车    型:" + rst.Fields("type")
    Printer.Print
    Printer.Print "车主姓名:" + rst.Fields("owner")
    
    Printer.Print "----------------------------------"
    Printer.Print
    Printer.EndDoc
    End If
'ErrorHandler:
 '   MsgBox "请连好您的打印机！", 48, "警告"
  '  Exit Sub

End Sub