commstrm.cls

GPS卫星定位系统相关源代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CCommStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Private mdimainform.oworkmode As CWorkMode
Private oComm As Object

Private oTransForm As New CTransform
'Private odelay As New delay

'Private m_bSaveRecord As Boolean


Public Function StartWorking() As Boolean
    Dim Port As Integer
    Dim Baud As String
    Dim parity As String
    Dim DataBit As String
    Dim StopBit As String
      Ini_GetCommSetting "comm" & CStr(i), Port, Baud, parity, DataBit, StopBit 'GlbFunction
      If SetCommSetting(Port, Baud, parity, DataBit, StopBit) Then
        '用SetCommSetting设置串口,如设置成功则表示开始工作
        StartWorking = True
        g_bOpenComm = True
      Else
        StartWorking = False
        g_bOpenComm = False
      End If

    
End Function

Public Sub StopWorking()
    If MDIMainForm.oComm1.PortOpen Then
         MDIMainForm.oComm1.PortOpen = False
    End If
    'If MDIMainForm.oComm2.PortOpen Then
        'MDIMainForm.oComm2.PortOpen = False
    'End If
    
    
    g_bOpenComm = False
End Sub

Private Function SetCommSetting(ByVal Port As Integer, ByVal Baud As String, ByVal parity As String, ByVal DataBit As String, ByVal StopBit As String) As Boolean
    Dim strSetting As String
    
   ' On Error GoTo errhandle
    If MDIMainForm.oComm1.PortOpen Then
        MDIMainForm.oComm1.PortOpen = False
    End If
    
    'If MDIMainForm.oComm2.PortOpen Then
        'MDIMainForm.oComm2.PortOpen = False
    'End If
    
    
    
    'oComm.CommPort = Port
    'oComm.InputLen = 0
    'strSetting = Baud + "," + parity + "," + DataBit + "," + StopBit
    'oComm.Settings = strSetting
    'oComm.PortOpen = True
    
    MDIMainForm.INIT 1
    MDIMainForm.Open_ComX (2)
    'MDIMainForm.Open_ComX (3)
    'MDIMainForm.Open_ComX (4)
    'MDIMainForm.Open_ComX (5)
    'MDIMainForm.Open_ComX (6)
    'MDIMainForm.Open_ComX (7)
    'MDIMainForm.Open_ComX (8)

    SetCommSetting = True
    Exit Function

errhandle:
    SetCommSetting = False
    MsgBox "GPS串口设置失败！", , "设置串口"
    Exit Function
End Function

Public Sub GetInputBuff(ByVal Chuan As Integer)
Dim ch As String
Dim PP(6) As String
Dim P As String         '通讯码解码后存放处,13908694851
Dim Dd As String
Dim SS As String
Dim i, j As Integer
Dim ww As String
Dim qq As String
On Error Resume Next
Dim tttt As String       '串口接收的数据
Dim Temp_weizhi As Long  '
Sleep (251)
Temp_ReceFlag = True
Static X As Integer
'odelay.SleepCom 4
Select Case Chuan

       Case 1
            tttt = Datas
            MDIMainForm.oComm1.InBufferCount = 0
       'Case 2
            'tttt = MDIMainForm.oComm2.Input
            'MDIMainForm.oComm2.InBufferCount = 0
End Select
strBuff1 = ""
txm = ""
'tttt = "&:00112343456781133869"
ch = Trim(tttt)
Form7.Text1.Text = ""
Form7.Text1.Text = Form7.Text1.Text + ch
qq = ch
Datas = ch
            If oTransForm.TransRecord(qq) Then
                X = X + 1
                If X = 4 Then X = 0
                MDIMainForm.Text1.Text = ch & "第" & X & "次"
                WhetherOK = True
                MDIMainForm.oWorkMode.ReceiveData oTransForm.GetRecord()
                'MonitorForm.ReceiveData oTransForm.GetRecord
            Else
                WhetherOK = False
            End If
MDIMainForm.oWorkMode.DisplayCallResult (Mid(ch, 3, 3)) '显示呼叫结果,根据WhetherOK
ch = ""
Datas = ""
Sleep (100)
MDIMainForm.INIT Chuan
Temp_ReceFlag = False
errhandle:
'    MsgBox "读串口错！"
 '   MDIMainForm.oWorkMode.SetModeNone
End Sub

Public Sub SendCommand(ByVal nCmdType As String, ByVal strCommID As String)
    Dim Temp_Back  As String
    Dim DDD1 As String
    Dim PDU As String
    Dim Temp_HEAD As String
    Dim Temp_len As String
    Dim Weinum As Integer
    Static X As Integer
    Temp_SendFlag = True
    
    'Temp_HEAD = "AT+CMGS=140" + Chr(13)?????
    
    'If Len(strCommID) <> 3 Then Exit Sub '?????
    
    'MDIMainForm.oComm1.InBufferCount = 0
    
    Select Case nCmdType
        Case "FB", "FF" '单个查询
        If AlertFlag = True Then DHFLAG = 1
             Select Case DHFLAG
                    Case 1
                         Temp_Back = "]?" & NumberCar '?????单呼,轮询
                         Weinum = 1
                    Case 2
                         PDU = "(CMD,001," + Temp_Start_Date + "," + Temp_End_Date + ")"
                         Weinum = 2
                    Case 3
                         PDU = "(CMD,002," + Temp_Cishu + "," + Temp_JianG + ")"
                         Weinum = 1
                    Case 4
                         PDU = "(CTR,111)"
                         Weinum = 1
                    Case 5
                         '?????
                         Weinum = 2
                    Case 6
                         '?????
                         Weinum = 1
                    Case 7
                         '?????
                         Weinum = 1
                    Case 8
                         PDU = "(CTR,SSS)"
                         Weinum = 1
                    Case 9
                         PDU = "(CMD,005,1)"
                         Weinum = 1
                    Case 10
                         PDU = "(CMD,006,006," + Temp_Lisn_Tel + "," + Temp_Lisn_Tel + ")"
                         Weinum = 4
                    Case 11
                         PDU = "(CMD,007,007," + Temp_Lisn_Tel + "," + Temp_Lisn_Tel + ")"
                         Weinum = 4
                    Case 12
                         PDU = "(CTR,DON)"
                         Weinum = 1
                    Case 13
                         PDU = "(CTR,LON)"
                         Weinum = 1
                    Case 14
                         PDU = "(CTR,DUL)"
                         Weinum = 1
                    Case 15
                         PDU = "(CTR,777)"
                         Weinum = 1
                    Case 16
                         PDU = "(CTR,888)"
                         Weinum = 1
             End Select
        
        'Case "FF" '轮询
        '     PDU = ""
        
        Case "FA" '锁车
             Temp_Back = "]" & Chr(22) & NumberCar '?????锁车门
             Weinum = 1
             
        Case "FE" '解锁
             Temp_Back = "]#" & NumberCar '????? 开车门
             Weinum = 1

        Case "FC" '报警应答
             PDU = "(CTR,999)"
             Weinum = 1
            
        Case "FD" '监听
             
             Temp_Back = "]" & Chr(3) & NumberCar  '?????监听"
             Weinum = 2
    End Select
    'PDU = AsctoPdu(PDU)?????
    
    'Temp_len = Hex(Len(PDU) / 2 + Weinum)?????
    
    'If Len(Temp_len) = 1 Then Temp_len = "0" + Temp_len??????
          
    'PDU = Temp_len + PDU?????
          
    'Temp_Back = "0011000D9168" + Trim(strCommID) + "000000" + PDU + Chr(26) + Chr(13)?????
 
 If Temp_ReceFlag = False Then
 If Series2 = False Then
     Temp_ChuanKou = 1              '/*****************/'
 Else
     Temp_ChuanKou = 2
 End If
     X = X + 1
    If X = 4 Then X = 0
    MDIMainForm.Text2.Text = Temp_Back & " 第" & X & "次" & "s_" & Temp_ChuanKou

 MDIMainForm.oComm1.OutBufferCount = 0
Select Case Temp_ChuanKou
          
           Case "1"
                      MDIMainForm.oComm1.OutBufferCount = 0
                      Sleep (200)
                      MDIMainForm.oComm1.Output = Temp_Back
                      Sleep (200)
                      'MDIMainForm.oComm1.InBufferCount = 0
           
           'Case "2"
                      'MDIMainForm.oComm2.Output = Temp_HEAD    'here is the key?????
                      'MDIMainForm.oComm2.OutBufferCount = 0
                      'Sleep (200)
                      'MDIMainForm.oComm2.Output = Temp_Back
                      'Sleep (200)
                      'MDIMainForm.oComm2.InBufferCount = 0
                      
           
    End Select
End If
Temp_SendFlag = False
End Sub



Public Sub SetComm(ByRef Comm As Object)
    'Set oComm = Comm
End Sub

Private Sub Class_Terminate()
    Set oTransForm = Nothing
End Sub

Public Function AsctoPdu(ByVal ddd As String) As String
Dim i As Integer
Dim temp_info As Integer
Dim temp_string As String
Dim temp_er() As String
Dim temp_string1 As String
Dim temp_info1 As String
Dim j As Integer
Dim X As Integer
ReDim temp_er(Len(ddd))
For i = 1 To Len(ddd)
    temp_info = Asc(Mid(ddd, i, 1))
    For j = 6 To 0 Step -1
        If temp_info >= 2 ^ j Then
           temp_info = temp_info - 2 ^ j
           temp_er(i) = temp_er(i) + "1"
        Else
           temp_er(i) = temp_er(i) + "0"
        End If
    Next
Next
  
For j = Len(ddd) To X Step -1
    temp_string = temp_string + CStr(temp_er(j))
Next
If Len(temp_string) Mod 8 > 0 Then
   For i = 1 To 8 - Len(temp_string) Mod 8
       temp_string = "0" + temp_string
   Next
End If
For j = Len(temp_string) - 7 To 1 Step -8
  temp_info1 = Hex(ErtoShi(Mid(temp_string, j, 8)))
  If Len(temp_info1) = 1 Then
     temp_string1 = temp_string1 + "0" + temp_info1
  Else
     temp_string1 = temp_string1 + temp_info1
  End If
Next
AsctoPdu = temp_string1
End Function

Public Function PdutoAsc(ByVal ddd As String) As String
Dim aa As String
Dim bb As String
Dim cc As Long
Dim i As Integer
Dim j  As Integer
Dim Dd As Long
Dim ff As Long
Dim xx As String
Dim PP As Integer
aa = Trim(ddd) '"A8A7B30893C962B15B7046A3D55CB0D90CE78CC566339B4B66B3E58A3018CD858BDD6431580C0683C16030182D857A3A8B30992C16C30567345ACD059BC172CE586C36B3B964361BAD0883D15CB8D84D1683C56030180C0683D152" 'Text1.Text '"61F1985C369FD1" '"EE3F31"

For i = 1 To Len(aa) Step 2
   bb = Trim(Mid(aa, i, 2))
   If Asc(bb) = 10 Or Asc(bb) = 13 Then Exit Function
   cc = CDec("&H" + bb)
   If j = 7 Then
      j = 0
      ff = 0
   End If
    j = j + 1
             If cc < 2 ^ (8 - j) Then              '小于最小值
                 Dd = cc * 2 ^ (j - 1) + ff
                 ff = 0
             ElseIf cc > 2 ^ (8 - j) * (2 ^ j - 1) Then  '大于最大值
                 Dd = (cc - 2 ^ (8 - j) * (2 ^ j - 1)) * 2 ^ (j - 1) + ff
                 ff = 2 ^ j - 1
             ElseIf cc >= 2 ^ (8 - j) And cc <= 2 ^ (8 - j) * (2 ^ j - 1) Then  '比较中间值
                 For PP = 1 To 2 ^ j
                    If cc > (2 ^ (8 - j) * PP) And cc < (2 ^ (8 - j) * (PP + 1)) Then
                       Dd = (cc - 2 ^ (8 - j) * PP) * 2 ^ (j - 1) + ff
                       ff = PP
                       Exit For
                    ElseIf cc = (2 ^ (8 - j) * PP) Then
                       Dd = ff
                       ff = PP
                       Exit For
                    ElseIf cc = (2 ^ (8 - j) * (PP + 1)) Then
                       Dd = ff
                       ff = PP + 1
                       Exit For
                    End If
                 Next
             End If
 If j = 7 Then
  PdutoAsc = PdutoAsc + Chr(Dd) + Chr(ff)
 Else
  PdutoAsc = PdutoAsc + Chr(Dd)
 End If
Next


End Function

Private Function ErtoShi(ByVal temp_er As String) As Integer
 Dim i As Integer
 Dim temp_num As String
 For i = 1 To 8
     ErtoShi = ErtoShi + Val(Mid(temp_er, i, 1)) * 2 ^ (8 - i)
 Next
End Function