form1.frm

GSMSMS调试软件 VB源程序

Senddata(1) = &H1
Senddata(2) = &HF2

Dim Length As Integer
Dim Sendstrings As String
Sendstrings = ""
For i = 0 To 2
a = Hex(Senddata(i))
    If Senddata(i) >= &H10 Then
    Sendstrings = Sendstrings & "[" & a & "]"
    Else
    Sendstrings = Sendstrings & "[" & "0" & a & "]"
    End If
Next i
Form1.Text1.Text = Form1.Text1.Text + Chr$(13) & Chr$(10) + Sendstrings + Chr$(13) & Chr$(10)

Form1.MSComm1.Output = Senddata 'Chr$(&H24) & Chr$(&H1) & Chr$(&HF0)

End Sub

Private Sub Command3_Click()
Dim GSMno_txt As String
GSMno_txt = Text2.Text
'[24][07][F6][XX][XX][XX][XX][XX][XX]
ReDim Senddata(8)
Senddata(0) = &H24
Senddata(1) = &H7
Senddata(2) = &HF6
'***** GSM number  ********
Senddata(3) = Abs("&h" & (Mid(GSMno_txt, 2, 1) & Mid(GSMno_txt, 1, 1)))
Senddata(4) = Abs("&h" & (Mid(GSMno_txt, 4, 1) & Mid(GSMno_txt, 3, 1)))
Senddata(5) = Abs("&h" & (Mid(GSMno_txt, 6, 1) & Mid(GSMno_txt, 5, 1)))
Senddata(6) = Abs("&h" & (Mid(GSMno_txt, 8, 1) & Mid(GSMno_txt, 7, 1)))
Senddata(7) = Abs("&h" & (Mid(GSMno_txt, 10, 1) & Mid(GSMno_txt, 9, 1)))
Senddata(8) = Abs("&hf" & Mid(GSMno_txt, 11, 1))

Dim Length As Integer
Dim Sendstrings As String
Sendstrings = ""
For i = 0 To 8
a = Hex(Senddata(i))
    If Senddata(i) >= &H10 Then
    Sendstrings = Sendstrings & "[" & a & "]"
    Else
    Sendstrings = Sendstrings & "[" & "0" & a & "]"
    End If
Next i
Form1.Text1.Text = Form1.Text1.Text + Chr$(13) & Chr$(10) + Sendstrings + Chr$(13) & Chr$(10)

Form1.MSComm1.Output = Senddata
'显示手机号码状态
With Form1.StatusBar1.Panels
.Item(2).Text = "目标手机： " & Form1.Text2.Text
End With
'记录上次手机号码
SaveSetting App.Title, "属性", "NUMBER", Form1.Text2.Text
End Sub

Private Sub Command4_Click()
'接收状态查询[24][01][F8]
ReDim Senddata(2)
Senddata(0) = &H24
Senddata(1) = &H1
Senddata(2) = &HF8

Dim Length As Integer
Dim Sendstrings As String
Sendstrings = ""
For i = 0 To 2
a = Hex(Senddata(i))
    If Senddata(i) >= &H10 Then
    Sendstrings = Sendstrings & "[" & a & "]"
    Else
    Sendstrings = Sendstrings & "[" & "0" & a & "]"
    End If
Next i
Form1.Text1.Text = Form1.Text1.Text + Chr$(13) & Chr$(10) + Sendstrings + Chr$(13) & Chr$(10)

Form1.MSComm1.Output = Senddata
End Sub

Private Sub Command5_Click()
'接收请求    [24][02][FA][XX]
ReDim Senddata(3)
Senddata(0) = &H24
Senddata(1) = &H2
Senddata(2) = &HFA
Senddata(3) = Readsmsno

Dim Length As Integer
Dim Sendstrings As String
Sendstrings = ""
For i = 0 To 3
a = Hex(Senddata(i))
    If Senddata(i) >= &H10 Then
    Sendstrings = Sendstrings & "[" & a & "]"
    Else
    Sendstrings = Sendstrings & "[" & "0" & a & "]"
    End If
Next i
Form1.Text1.Text = Form1.Text1.Text + Chr$(13) & Chr$(10) + Sendstrings + Chr$(13) & Chr$(10)

Form1.MSComm1.Output = Senddata
End Sub

Private Sub Command6_Click()
'发一条短信息[24][XX][F4][XX][XX][XX][XX][XX]
Dim SMS_MSG As String
Dim SMS_LENGH As Byte
Dim SENDOK As Boolean
Dim K As Byte

If SMSType = 0 Then
'16进制
    If Text3.Text = "" Then
    SMS_MSG = "[41][42][43][44][45]"
    Else
    SMS_MSG = Text3.Text
    End If
    SMS_LENGH = Len(SMS_MSG)
    
    Dim II As Integer
    Dim i As Integer
    i = 0
    Dim HH As String
    Dim HL As String
    Dim BSEND() As Byte
    Dim NUM  As Byte
    NUM = SMS_LENGH / 4 - 1 '小心小数
    ReDim BSEND(NUM)
    
    Dim S As Byte
    
    For II = 1 To SMS_LENGH Step 4
    a = Mid(SMS_MSG, II, 1)
    If a = "[" Then
    HH = Mid(SMS_MSG, II + 1, 1)
    HL = Mid(SMS_MSG, II + 2, 1)
        If ASCNUM(HH) <> 16 And ASCNUM(HL) <> 16 Then
        S = ASCNUM(HH) * 16 + ASCNUM(HL)
            BSEND(i) = ASCNUM(HH) * 16 + ASCNUM(HL)
            i = i + 1
        SENDOK = True
              
                        
        Else
         MsgBox ("无效的16进制数据!"), , "错误..."
         II = SMS_LENGH
        SENDOK = False
        
        End If
    Else
         MsgBox ("无效的16进制数据!"), , "错误..."
         II = SMS_LENGH
        SENDOK = False
    End If
    Next II

    If SENDOK = True Then
    ReDim Senddata(3 + NUM)
    Senddata(0) = &H24
    Senddata(1) = 2 + NUM
    Senddata(2) = &HF4

    For i = 0 To NUM
    Senddata(3 + i) = BSEND(i)
    Next i
    
    SMS_LENGH = NUM + 1
    
    End If

'英文
ElseIf SMSType = 1 Then
    If Text3.Text = "" Then
    SMS_MSG = "www.cetinet.com"
    Else
    SMS_MSG = Text3.Text
    End If
    SMS_LENGH = Len(SMS_MSG)

    ReDim Senddata(2 + SMS_LENGH)
    Senddata(0) = &H24
    Senddata(1) = 1 + SMS_LENGH
    Senddata(2) = &HF4

    For K = 1 To SMS_LENGH
    Senddata(2 + K) = Asc(Mid(SMS_MSG, K, 1))
    Next K
    SENDOK = True
    
'中文
ElseIf SMSType = 2 Then
    If Text3.Text = "" Then
    SMS_MSG = "中国电子技术信息网"
    Else
    SMS_MSG = Text3.Text
    End If
    SMS_LENGH = Len(SMS_MSG)
    
    SMS_LENGH = SMS_LENGH * 2
    ReDim Senddata(2 + SMS_LENGH)
    Senddata(0) = &H24
    Senddata(1) = 1 + SMS_LENGH
    Senddata(2) = &HF4

    For K = 1 To SMS_LENGH Step 2
    Senddata(2 + K) = AscB(MidB(SMS_MSG, K + 1, 1))
    Senddata(2 + K + 1) = AscB(MidB(SMS_MSG, K, 1))
    Next K
    SENDOK = True
End If

If SENDOK = True Then
'显示
Dim Length As Integer
Dim Sendstrings As String
Sendstrings = ""
For i = 0 To 2 + SMS_LENGH
a = Hex(Senddata(i))
    If Senddata(i) >= &H10 Then
    Sendstrings = Sendstrings & "[" & a & "]"
    Else
    Sendstrings = Sendstrings & "[" & "0" & a & "]"
    End If
Next i
Form1.Text1.Text = Form1.Text1.Text + Chr$(13) & Chr$(10) + Sendstrings + Chr$(13) & Chr$(10)

Form1.MSComm1.Output = Senddata
End If
End Sub

Private Sub Form_Load()

'设置串口
    Settings = GetSetting(App.Title, "属性", "设置", "") ' frmTerminal.MSComm1.Settings]\
    If Settings <> "" Then
        MSComm1.Settings = Settings
        If Err Then
            MsgBox Error$, 48
            Exit Sub
        End If
    Else
        MSComm1.Settings = "2400,N,8,1"
    End If
    
    CommPort = GetSetting(App.Title, "属性", "通信端口", "") ' frmTerminal.MSComm1.CommPort
    If CommPort <> "" Then
        MSComm1.CommPort = CommPort
    Else
        MSComm1.CommPort = 1
    End If
    
    Handshaking = GetSetting(App.Title, "属性", "握手", "") 'frmTerminal.MSComm1.Handshaking
    If Handshaking <> "" Then
        MSComm1.Handshaking = Handshaking
        If Err Then
            MsgBox Error$, 48
            Exit Sub
        End If
    Else
        MSComm1.Handshaking = 0
    End If
    
    THESMSTYPE = GetSetting(App.Title, "属性", "SMS", "") ' frmTerminal.MSComm1.CommPort
    If THESMSTYPE <> "" Then
        SMSType = Val(THESMSTYPE)
    Else
        SMSType = 1
    End If
    Option1(SMSType).Value = True
    
    THENUMBER = GetSetting(App.Title, "属性", "NUMBER", "") ' frmTerminal.MSComm1.CommPort
    If THENUMBER <> "" Then
        Form1.Text2.Text = THENUMBER
    Else
        Form1.Text2.Text = "请输入手机号码！"
    End If
    Option1(SMSType).Value = True
'初始化接收缓冲设置
Form1.Combo1.AddItem "缓冲区：1"
Form1.Combo1.AddItem "缓冲区：2"
Form1.Combo1.AddItem "缓冲区：3"
Form1.Combo1.AddItem "缓冲区：4"
Readsmsno = 1
'显示状态栏
With Form1.StatusBar1.Panels
.Item(1).Text = "串口状态：" & "COM" & Form1.MSComm1.CommPort & "  Set=" & Form1.MSComm1.Settings & " " & Form1.MSComm1.PortOpen
.Item(2).Text = "目标手机： " & Form1.Text2.Text
End With
End Sub

Private Sub Label7_Click()
nResult = Shell("start.exe http://www.cetinet.com", vbHide)
End Sub

Private Sub mnuclear_Click()
cleartestnote
End Sub

Private Sub mnuclrdistxt_Click()
Form1.Text1.Text = ""
End Sub

Private Sub mnucommopen_Click()
    MSComm1.PortOpen = Not MSComm1.PortOpen
    mnucommopen.Checked = MSComm1.PortOpen
With Form1.StatusBar1.Panels
.Item(1).Text = "串口状态：" & "COM" & Form1.MSComm1.CommPort & "  Set=" & Form1.MSComm1.Settings & " " & Form1.MSComm1.PortOpen
End With
End Sub

Private Sub mnucommseting_Click()
frmProperties.Show vbModal
End Sub

Private Sub mnuexit_Click()
Unload Me
End Sub

Private Sub mnuCetinet_Click()
nResult = Shell("start.exe http://www.cetinet.com", vbHide)
End Sub

Private Sub mnuopen_Click()
opentestnote
End Sub

Private Sub mnusave_Click()
savetestnote
End Sub

Private Sub MSComm1_OnComm()
Dim buffer() As Byte
Dim Bufferlength As Integer
Select Case MSComm1.CommEvent
   ' Handle each event or error by placing
   ' code below each case statement

' 错误
      Case comEventBreak   ' 收到 Break。
       Case comEventCDTO   ' CD (RLSD) 超时。
      Case comEventCTSTO   ' CTS Timeout。
      Case comEventDSRTO   ' DSR Timeout。
      Case comEventFrame   ' Framing Error
      Case comEventOverrun   '数据丢失。
      Case comEventRxOver '接收缓冲区溢出。
      Case comEventRxParity ' Parity 错误。
      Case comEventTxFull   '传输缓冲区已满。
      Case comEventDCB   '获取 DCB] 时意外错误

   ' 事件
      Case comEvCD   ' CD 线状态变化。
      Case comEvCTS   ' CTS 线状态变化。
      Case comEvDSR   ' DSR 线状态变化。
      Case comEvRing   ' Ring Indicator 变化。
      Case comEvReceive   ' 收到 RThreshold # of chars.
'============================================================
Bufferlength = MSComm1.InBufferCount
While Bufferlength > 0
'**************************************************************
MSComm1.InputLen = Bufferlength
ReDim buffer(Bufferlength)
buffer = MSComm1.Input

For i = 0 To Bufferlength - 1

a = Hex(buffer(i))
    If buffer(i) >= &H10 Then
    Text1.Text = Text1.Text & "(" & a & ")"
    Else
    Text1.Text = Text1.Text & "(" & "0" & a & ")"
    End If
Next i
'**************************************************************
Bufferlength = MSComm1.InBufferCount
Wend

'============================================================
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
      Case Else               '
End Select
End Sub

Private Sub Option1_Click(Index As Integer)
SMSType = Index
Dim typename As String
Select Case Index
Case 0
    typename = "16进制"
Case 1
    typename = "英文"
Case 2
    typename = "中文"
End Select
With Form1.StatusBar1.Panels
.Item(3).Text = "SMS类型：" & typename
End With
SaveSetting App.Title, "属性", "SMS", SMSType
End Sub

Private Sub Text1_Change()
Form1.Text1.SelStart = Len(Form1.Text1.Text)
While Len(Form1.Text1.Text) > 1000
Form1.Text1.Text = ""
Wend
End Sub

Private Sub Text3_Change()
Dim Thelen As Integer
If SMSType = 0 Then
Thelen = Len(Form1.Text3.Text) \ 4
ElseIf SMSType = 1 Then
Thelen = Len(Form1.Text3.Text)
ElseIf SMSType = 2 Then
Thelen = Len(Form1.Text3.Text)
End If
Form1.Label5.Caption = Thelen

End Sub