?? frmzhenting.frm

?? 一本關(guān)于VB串口編程的詳細(xì)參考資料
?? FRM
?? 第 1 頁 / 共 2 頁
字號(hào):
上一頁 12
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   3
         Left            =   4560
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   4
         Left            =   5880
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   5
         Left            =   7200
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   6
         Left            =   8520
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0000FF00&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   7
         Left            =   9960
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
   End
   Begin VB.CommandButton CommandQuit 
      Caption         =   "返回"
      Height          =   375
      Left            =   9720
      TabIndex        =   1
      Top             =   3600
      Width           =   1095
   End
   Begin VB.CommandButton CommandDisable 
      Caption         =   "解除警報(bào)"
      Enabled         =   0   'False
      Height          =   375
      Left            =   8520
      TabIndex        =   0
      Top             =   3600
      Width           =   1095
   End
End
Attribute VB_Name = "Frmzhenting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim no As String                '存儲(chǔ)偵聽到的消息為第幾條消息
Dim rs As New ADODB.Recordset
Dim dbcn As New ADODB.Connection
Dim arr_return(40) As Variant   '存儲(chǔ)帶%%的數(shù)據(jù)信息
Dim mess_index() As Variant     '存儲(chǔ)GSM模塊返回的帶有短消息編號(hào)的確認(rèn)信息
Dim message(100) As Variant     '存儲(chǔ)讀取短消息時(shí)的所有信息
Dim mess(19) As Variant         '存儲(chǔ)arr_return轉(zhuǎn)化后的信息
Dim Value(11) As Variant        '存儲(chǔ)數(shù)據(jù)轉(zhuǎn)化之后的信息，即最后的數(shù)值
Dim zhuanfa_no As Integer       '記錄偵聽到的第幾號(hào)站口,以供轉(zhuǎn)發(fā)時(shí)使用
Dim intall As Integer           '在Timer1控件中指示程序的流程，初始值為0
Dim ifalarm As Boolean          '判斷是否報(bào)警
Dim strsql As String

Private Sub CommandDisable_Click()
On Error Resume Next
ifalarm = False
intall = 0
End Sub

Private Sub CommandQuit_Click()
Unload Me

End Sub

Private Sub Form_Load()
On Error Resume Next
intall = 0
End Sub


'''''''''''''''''''''''''''執(zhí)行傳來的sql語句
Public Function excutesql(strsql As String)
Dim filename As String
filename = App.Path + "\db\db1.mdb"       '指定數(shù)據(jù)庫文件的位置
dbcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filename
dbcn.Open     '連接數(shù)據(jù)庫
  rs.ActiveConnection = dbcn
    rs.Source = strsql
    rs.Open

      
End Function

Private Sub Timer1_Timer()

On Error Resume Next
  If MDIForm1.Comm1.InBufferCount > 0 Then     '檢測(cè)端口緩沖區(qū)是否為空
intall = intall + 1            ' Timer控件的間隔時(shí)間每到一次，IntAll加1，不同的IntAll
                                '  值進(jìn)行不同的操作
If intall = 1 Then
         Call readno            ' IntAll為1，即剛開始運(yùn)行程序，由于緩沖區(qū)端口不為空，調(diào)用
                           'ReadNo函數(shù)，讀取GSM模塊發(fā)給PC機(jī)的確認(rèn)信息中新到短
                       '消息的編號(hào)
End If
If intall = 2 Then
         Call getdata           ' IntAll為2，表明已經(jīng)讀取到短消息的編號(hào)，由于緩沖區(qū)端口不                                  '為空，調(diào)用GetData 函數(shù)，讀取GSM模塊中的指定編號(hào)的短信息
                       ' 對(duì)讀取的短消息進(jìn)行處理，得到有用數(shù)據(jù)，保存入庫，并且刪除
                       ' 該短消息。如果沒有報(bào)警則IntAll＝0，從新開始掃描端口。
Call rectemp           '讀取刪除后GSM模塊發(fā)送給PC機(jī)的確認(rèn)信息。
End If
If intall = 4 Then
          Call zhuanfa  'IntAll為4，表明此時(shí)有報(bào)警現(xiàn)象，轉(zhuǎn)發(fā)報(bào)警給有關(guān)的負(fù)責(zé)人
End If
If intall = 5 Then
         Call sendtxt              'IntAll為5，判斷是否讀取到GSM模塊返回的確認(rèn)信息中的">"，
                                  '如果讀到，則發(fā)送數(shù)據(jù)信息，沒有讀到，重新轉(zhuǎn)發(fā)。
      End If
      If intall = 8 Then
          If MDIForm1.Comm1.InBufferCount > 0 Then
              Call rectemp          '讀取轉(zhuǎn)發(fā)后，GSM模塊返回的確認(rèn)信息
               intall = 7
           End If
      End If
      If intall = 9 Then
           If ifalarm Then             ' 判斷是否報(bào)警，如果報(bào)警，則開始循環(huán)播放報(bào)警聲音。
               MMControl1.filename = App.Path + "\alarm1.wav"  '指定要播放的報(bào)警聲音
               MMControl1.Command = "Open"                '打開
                 MMControl1.Command = "Play"               '播放
                 intall = 8                            'IntAll=8控制循環(huán)播放
            End If
        End If
End If

End Sub
Public Function getdata()       '從串口讀出消息，從%開始存到數(shù)組arr_return中
On Error Resume Next
Dim Count As Integer           '循環(huán)讀取中用到的計(jì)數(shù)器
Dim sum As Integer             '計(jì)算校驗(yàn)和時(shí)用到的變量
Dim Flag As Boolean            '判斷讀取的數(shù)據(jù)是否有效
Dim temp As Variant            '臨時(shí)變量，存放每次讀取的字符
Count = 0

MDIForm1.Comm1.InputLen = 1
While MDIForm1.Comm1.InBufferCount > 0   '按照字節(jié)循環(huán)讀取緩沖區(qū)
temp = MDIForm1.Comm1.Input
Count = Count + 1
If Hex(Asc(temp)) = Hex(Asc("%")) Then    '判斷讀到的字符是否為"%"
      Flag = True                         '如果是，標(biāo)志位為true，表明數(shù)據(jù)有效
End If
 If Flag = True Then
   arr_return(Count - 1) = Asc(temp)      '以%%開頭的數(shù)據(jù)存入數(shù)組中
 End If
Wend
If Flag = True Then
   For Count = 2 To 20
      mess(Count - 2) = arr_return(Count) '把數(shù)組arr_return的有用數(shù)據(jù)存入mess數(shù)組
   Next
   sum = 0
   For Count = 0 To 17                    '循環(huán)取得所有數(shù)據(jù)的和
      sum = sum + mess(Count)
   Next
   sum = sum Mod 128                        '取得校驗(yàn)和
      
   If sum = mess(18) Then                 '判斷校驗(yàn)和與校驗(yàn)位是否相等，如果相等，按照數(shù)據(jù)
                                          '協(xié)議，合并得到最終數(shù)據(jù)
      Value(0) = mess(0)
      Value(1) = mess(1) * 100 + mess(2)
      Value(2) = mess(3) * 100 + mess(4)
      Value(3) = mess(5) * 100 + mess(6)
      Value(4) = mess(7) * 100 + mess(8)
      Value(5) = mess(9) * 100 + mess(10)
      Value(6) = mess(11) * 100 + mess(12)
      Value(7) = mess(13) * 100 + mess(14)
      Value(8) = mess(15) * 100 + mess(16)
      Value(9) = mess(17)
      Value(10) = mess(18)
      Call savedata                     '調(diào)用savedata函數(shù)保存數(shù)據(jù)
    Else
       MsgBox "對(duì)不起，收到信息中的校驗(yàn)和不正確！", vbOKOnly, "通知"
                                        '校驗(yàn)和不正確，提示出錯(cuò)
    End If
Else
    intall = 1                          '數(shù)據(jù)無效，重新讀取
End If
End Function

Public Function savedata()       ''''保存取得的數(shù)據(jù)信息到數(shù)據(jù)庫
On Error Resume Next
Dim state As String            '保存遠(yuǎn)端設(shè)備工作狀態(tài)
Dim tel As String              '遠(yuǎn)端設(shè)備的手機(jī)號(hào)
Dim time As String             '接收到數(shù)據(jù)的時(shí)間
Dim time1 As Date              '把時(shí)間轉(zhuǎn)換成Date類型
Dim id As String               '遠(yuǎn)端設(shè)備的編號(hào)
Dim name As String             '遠(yuǎn)端設(shè)備的名字
Dim j As Integer
strsql = "select * from state where state_no =" & Value(0) & ""
                             '根據(jù)狀態(tài)碼從數(shù)據(jù)庫中取得對(duì)應(yīng)的事件，存在state變量中
excutesql (strsql)
state = rs!state_name
rs.Close
dbcn.Close
                             '根據(jù)GSM模塊返回的確認(rèn)信息，從中取得遠(yuǎn)端設(shè)備的手機(jī)號(hào)和發(fā)送時(shí)間
For j = 0 To UBound(message) - 34
If message(j) = "+" And message(j + 1) = "8" And message(j + 2) = "6" Then
    tel = message(j + 3) + message(j + 4) + message(j + 5) + message(j + 6) + message(j + 7) + message(j + 8) + message(j + 9) + message(j + 10) + message(j + 11) + message(j + 12) + message(j + 13)
     time = message(j + 18) + message(j + 19) + message(j + 20) + message(j + 21) + message(j + 22) + message(j + 23) + message(j + 24) + message(j + 25) + Space(1) + message(j + 27) + message(j + 28) + message(j + 29) + message(j + 30) + message(j + 31) + message(j + 32) + message(j + 33) + message(j + 34)
time1 = CDate(time)
End If
Next

                            '根據(jù)手機(jī)號(hào)從數(shù)據(jù)庫中取得遠(yuǎn)端設(shè)備信息：編號(hào)，名字
strsql = "select * from zhankou where tel= '" & tel & "'"
excutesql (strsql)
id = rs!id
name = rs!name
rs.Close
dbcn.Close
                               '將數(shù)據(jù)存儲(chǔ)到數(shù)據(jù)庫中
Select Case state              '根據(jù)狀態(tài)碼的不同，執(zhí)行不同的操作
 Case "該站點(diǎn)完成初始化，進(jìn)入正常運(yùn)行"
     ifalarm = False
     strsql = "update zhankou set ifactive=1"   '標(biāo)記遠(yuǎn)端設(shè)備為當(dāng)前活動(dòng)的遠(yuǎn)端設(shè)備
     excutesql (strsql)
 Case "校驗(yàn)和錯(cuò)誤"
     ifalarm = True
     MsgBox rs!id & "號(hào)站口電流電壓值設(shè)定失敗！", vbOKOnly, "通知"
 Case "工作正常", "電壓恢復(fù)正常", "A相恢復(fù)正常", "B相恢復(fù)正常", "C相恢復(fù)正常", "1路電流源恢復(fù)正常", "2路電流源恢復(fù)正常", "3路電流源恢復(fù)正常", "4路電流源恢復(fù)正常"
                    '遠(yuǎn)端設(shè)備工作正常
    ifalarm = False
   
    strsql = "INSERT INTO data VALUES(" & CInt(id) & ", '" & name & "', '" & time1 & "', '" & state & "', " & Value(1) & ", " & Value(2) & ", " & Value(3) & ", " & Value(4) & ", " & Value(5) & ", " & Value(6) & ", " & Value(7) & ", " & Value(8) & ");"
    excutesql (strsql)                  '保存數(shù)據(jù)
     Tno.Text = id                      '在窗口中顯示接收到的數(shù)據(jù)
     Ttime.Text = time1
     Tname.Text = name
     Tevent.Text = state
     Tv.Text = Value(1)
     Ta.Text = Value(2)
     Tb.Text = Value(3)
     Tc.Text = Value(4)
     Ta1.Text = Value(5)
     Ta2.Text = Value(6)
     Ta3.Text = Value(7)
     Ta4.Text = Value(8)
     Call ConvertBin                   '調(diào)用十進(jìn)制轉(zhuǎn)換二進(jìn)制的函數(shù)，用來分析I/O的各個(gè)端口狀態(tài)
Case Else
                                '遠(yuǎn)端設(shè)備工作不正常
    ifalarm = True
    strsql = "INSERT INTO data VALUES(" & CInt(id) & ", '" & name & "', '" & time1 & "', '" & state & "', " & Value(1) & ", " & Value(2) & ", " & Value(3) & ", " & Value(4) & ", " & Value(5) & ", " & Value(6) & ", " & Value(7) & ", " & Value(8) & ");"
    excutesql (strsql)                   '保存數(shù)據(jù)
    GurhanButton1.Enabled = True         '激活解除警報(bào)按鈕
     Tno.Text = id                       '顯示數(shù)據(jù)
     Ttime.Text = time1
     Tname.Text = name
     Tevent.Text = state
     Tv.Text = Value(1)
     Ta.Text = Value(2)
     Tb.Text = Value(3)
     Tc.Text = Value(4)
     Ta1.Text = Value(5)
     Ta2.Text = Value(6)
     Ta3.Text = Value(7)
     Ta4.Text = Value(8)
     Call ConvertBin                     '調(diào)用十進(jìn)制轉(zhuǎn)換二進(jìn)制的函數(shù)，用來分析I/O的各個(gè)端口狀態(tài)
End Select
     Set rs = Nothing
     dbcn.Close
     zhuanfa_no = CInt(id)
     MDIForm1.Comm1.Output = "AT+CMGD=" + no + Chr(13) + Chr(10)
If ifalarm = False Then               '沒有報(bào)警，則重新開始掃描端口
  intall = 0
End If
 
Dim m As Integer               '清空數(shù)組內(nèi)容
For m = 0 To 18
mess(m) = 0
Next
For m = 0 To 10
Value(m) = 0
Next

End Function

Public Function sendtxt()
On Error Resume Next
Dim Buf$
Dim ChrErr As String
Dim LastCh As String
If MDIForm1.Comm1.InBufferCount > 0 Then

  MDIForm1.Comm1.InputLen = 0
  Buf = Trim(MDIForm1.Comm1.Input)
  ChrErr = Right(Left(Buf, 5), 1)  '取得緩沖區(qū)的倒數(shù)第四個(gè)字符，存入變量ChrErr中
  LastCh = Right(Buf, 1)           '取得緩沖區(qū)的最后一個(gè)字符，存入變量LastCh中
  If ChrErr = "E" Then             '判斷是否為E，是則代表返回信息為Error,重新發(fā)送AT命令
     strsql = "select * from renyuan "
     excutesql (strsql)
     MDIForm1.Comm1.Output = "AT+CMGS=" + rs!tel + Chr(13) + Chr(13) + Chr(10)
     intall = 4
     Set rs = Nothing
     dbcn.Close
  End If
  If LastCh = ">" Then
      MDIForm1.Comm1.Output = "The no." & zhuanfa_no & " have somthing wrong in the I/O " + Chr(26)
                         '如果最后一個(gè)字符為">",則發(fā)送報(bào)警消息給相關(guān)負(fù)責(zé)人
  End If
End If


End Function


Public Function rectemp()
Dim Buf$
If MDIForm1.Comm1.InBufferCount > 0 Then
MDIForm1.Comm1.InputLen = 0             'Comm1控件的InputLen屬性設(shè)為0，代表把緩沖區(qū)中所
                                   '有內(nèi)容一次全部讀出。
Buf = MDIForm1.Comm1.Input
End If

End Function
Public Function ConvertBin()
On Error Resume Next
    Dim IntIO As Integer           'IO端口的數(shù)據(jù)
    Dim Count As Integer
    Dim BinArray(7) As Integer     '存放對(duì)應(yīng)字節(jié)的數(shù)據(jù)
        IntIO = Value(9)
        BinArray(7) = IntIO Mod 2  '
        IntIO = IntIO \ 2
        BinArray(6) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(5) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(4) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(3) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(2) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(1) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(0) = IntIO Mod 2
        
        For Count = 0 To UBound(BinArray)
            If BinArray(Count) = 1 Then  '端口數(shù)據(jù)為1的端口對(duì)應(yīng)的Shape控件顏色變紅報(bào)警
               Shape1(Count).FillColor = &H8080FF
               Else
               Shape1(Count).FillColor = &H80FF80
               End If
        Next
        
    
End Function

''''''''''''''''''''''讀取偵聽到的短消息的號(hào)碼
Public Function readno()
On Error Resume Next
If MDIForm1.Comm1.InBufferCount > 0 Then
Dim Count As Integer
Count = 0
MDIForm1.Comm1.InputLen = 1                 '按照字節(jié)循環(huán)讀取緩沖區(qū)中的信息
   While MDIForm1.Comm1.InBufferCount > 0
     ReDim Preserve mess_index(Count + 1)   '動(dòng)態(tài)定義數(shù)組的大小
     mess_index(Count) = Hex(Asc(MDIForm1.Comm1.Input))  '把字符型數(shù)據(jù)轉(zhuǎn)換為16進(jìn)制數(shù)
            Count = Count + 1
   Wend
   Count = UBound(mess_index)               '取數(shù)組的上限
     no = Val("&H" + mess_index(Count - 3))  '取短消息的編號(hào)，它位于整個(gè)緩沖區(qū)的倒數(shù)第三個(gè)字符
      MDIForm1.Comm1.Output = "AT+CMGR=" & no & "" + Chr(13) + Chr(10)
                                             '按照編號(hào)發(fā)送命令讀取短消息
 End If
     
       

End Function
Public Function zhuanfa()
'''''''''''''''''''''''''''''''轉(zhuǎn)發(fā)信息
strsql = "select * from renyuan "
excutesql (strsql)
MDIForm1.Comm1.Output = "AT+CMGS=" + rs!tel + Chr(13) + Chr(13) + Chr(10)
Set rs = Nothing
dbcn.Close
End Function
上一頁 12
?? 文件大小 5055 K
?? 上傳用戶 wuqiweipp
?? 所屬分類串口編程
??? 相關(guān)標(biāo)簽

#串口編程 #參考資料
?? 快捷鍵說明

復(fù)制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號(hào) Ctrl + =
減小字號(hào) Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmzhenting.frm

?? 快捷鍵說明
