form1.frm

手机编程

  End If
  MSComm1.Output = "AT+CMGS=" + tPhone.Text + Chr(13)
  ModuleDo.TimeDelay (100)
  If InStr(MSComm1.Input, ">") > 0 Then
     MsgBox "okok1"
  End If
  MSComm1.Output = txtSend.Text + Chr(26) + Chr(13)
  'MSComm1.InBufferCount = 0
  'MSComm1.OutBufferCount = 0
  'MSComm1.Output = txtSend.Text + Chr(13)
  'If MSComm1.Input = "OK" Then
  '   txtRecv.Text = "okok"
  'Else
   '  txtRecv.Text = "nono"
  'End If
  ModuleDo.TimeDelay (1000)
  If InStr(MSComm1.Input, "OK") > 0 Then
     MsgBox "okok2"
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Cancel = True
  Me.Hide
End Sub

Public Sub pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static Rec As Boolean, msg As Long
    msg = X / Screen.TwipsPerPixelX
    If Rec = False Then
        Rec = True
        Select Case msg
            Case WM_LBUTTONDBLCLK:
            Case WM_LBUTTONDOWN:
            Case WM_LBUTTONUP:
                 PopupMenu menufile
            Case WM_RBUTTONDBLCLK:
            Case WM_RBUTTONDOWN:
            Case WM_RBUTTONUP:
                 PopupMenu menufile
        End Select
        Rec = False
    End If
End Sub
Private Sub cancel_Click()
Timer1.Interval = 0
txtSend.Text = ""
txtRecv.Text = ""
tPhone.Text = ""
tCenter.Enabled = True
CSetup.Enabled = True
CRun.Enabled = True
ComPort.Enabled = True
ComBand.Enabled = True
If MSComm1.PortOpen Then
   MSComm1.PortOpen = False
   msg.Caption = ComPort.Text & " 连接断开"
End If
End Sub

Private Sub CRun_Click()
CSetup_Click
If MSComm1.PortOpen = True Then
MSComm1.Output = "AT+CMGF=0" + Chr(13)
TimeDelay (100)
'If InStr(MSComm1.Input, "OK") > 0 Then
    CRun.Enabled = False
    Timer1.Interval = 3000
    msg.Caption = "系统正在运行......"
'Else
 '  MsgBox "手机信号不强", vbOKOnly + vbExclamation, "系统运行"
'End If
Else
   MsgBox "COM设置失败!!!", vbOKOnly + vbExclamation, "系统运行"
End If
End Sub

Private Sub CSend_Click()
Dim encodeTxt As String
Dim strsql As String
Dim timeTxt As String
Dim nRet As Long
If MSComm1.PortOpen Then
   nRet = ModuleDo.GetSendPDU(txtSend.Text, tPhone.Text, encodeTxt, tCenter.Text)
   If nRet > 0 Then
      MSComm1.Output = "AT+CMGF=0" + Chr(13)
      ModuleDo.TimeDelay (100)
      MSComm1.Output = "AT+CMGS=" & nRet & Chr(13)
      ModuleDo.TimeDelay (100)
      If InStr(MSComm1.Input, ">") > 0 Then
            MSComm1.Output = encodeTxt + Chr(26) + Chr(13)
            ModuleDo.TimeDelay (600)
            If InStr(MSComm1.Input, "ERROR") <> 0 Then
               MsgBox "发送失败(Code001)!!!", vbOKOnly + vbExclamation, "发送测试"
            Else
               timeTxt = Format$(Now, "yyyymmdd hh:mm:ss")
               strsql = "insert into sendmsglog (MobileNo,Msg,SendTime,SendUser) values ('" & tPhone.Text & "','" & txtSend.Text & "','" & timeTxt & "','test')"
               ModuleDb.insertRecord (strsql)
               txtRecv.Text = "手机号：" & tPhone.Text & "发送信息成功!!!!"
            End If
       Else
          MsgBox "发送失败(Code000)!!!", vbOKOnly + vbExclamation, "发送测试"
       End If
   Else
      MsgBox "对方号码或发送内容未输或输入错误!!!", vbOKOnly + vbExclamation, "发送测试"
   End If
End If
End Sub

Private Sub CSetup_Click()
tCenter.Enabled = False
CSetup.Enabled = False
ComPort.Enabled = False
ComBand.Enabled = False
If MSComm1.PortOpen Then
   msg.Caption = ComPort.Text & " 已连接!!!"
Else
  With MSComm1
     .CommPort = ComPort.ListIndex + 1
     .RThreshold = 1
     .SThreshold = 0
     .Handshaking = comNone
     .Settings = ComBand.Text & ",N,8,1"
     .PortOpen = True
  End With
  msg.Caption = ComPort.Text & " 连接成功!!!"
  'MSComm1.Output = "ATE0" + Chr(13)
   'MSComm1.Output = "AT" + Chr(13)
   msg.Caption = "初始化GPRS成功!!!"
  'MSComm1.Output = "AT" + Chr(13)
  'msg.Caption = "连接GPRS MODEM成功!!!"
  'MSComm1.Output = "AT+CSCA=" + Chr(34) + tCenter.Text + Chr(34) + Chr(13)
  'msg.Caption = "设置服务中心号码成功!!!"
End If
End Sub

Private Sub exit_Click()
  On Error Resume Next
  Shell_NotifyIcon NIM_DELETE, TheForm
  DoEvents
End
End Sub

Private Sub Form_Load()
   SysTray
   DoEvents
   With ComPort
        .Clear
        .AddItem "COM1"
        .AddItem "COM2"
        .AddItem "COM3"
        .AddItem "COM4"
        .AddItem "COM5"
        .AddItem "COM6"
        .AddItem "COM7"
        .AddItem "COM8"
        .ListIndex = 0
  End With
  
  With ComBand
    .Clear
    .AddItem "4800"
    .AddItem "9600"
    .AddItem "19200"
    .AddItem "38400"
    .AddItem "57600"
    .AddItem "115200"
    .ListIndex = 1
  End With
  If ModuleReg.getLicence(Format$(Now, "yyyy-mm-dd")) = "rqnook" Then
  Unload Me
  End If
  
  'CRun_Click
End Sub

Private Sub open_Click()
   Me.Show
   DoEvents
End Sub

Private Sub Reg_Click()
  frmReg.Show
  DoEvents
End Sub

Private Sub Timer1_Timer()
'txtSend.Text = Format$(Now, "yyyy年mm月dd日 hh:mm:ss") + Chr(13)
GetMsgBuff
End Sub
Private Sub GetMsgBuff()
Dim nrc As ADODB.Recordset
Dim nRet As Long
Dim encodeTxt As String
Dim timeTxt As String
Dim strsql As String
Set nrc = New ADODB.Recordset
strsql = "select * from msgbuff order by MsgStatus,Pri,SendTime limit 0,1"
Set nrc = ExecuteSQL(strsql)
If nrc.EOF = False And MSComm1.PortOpen = True Then
   nrc.MoveFirst
      msg.Caption = "正在发送[" & nrc.Fields(1) & "] [" & nrc.Fields(2) & "]"
      nRet = ModuleDo.GetSendPDU(nrc.Fields(2), nrc.Fields(1), encodeTxt, tCenter.Text)
      If nRet > 0 Then
         ClrComBuffer
         MSComm1.Output = "AT+CMGS=" & nRet & Chr(13)
         ModuleDo.TimeDelay (200)
         If InStr(MSComm1.Input, ">") > 0 Then
            MSComm1.Output = encodeTxt + Chr(26) + Chr(13)
            ModuleDo.TimeDelay (800)
            If InStr(MSComm1.Input, "ERROR") <> 0 Then
               UpdateMsgBuff (nrc.Fields(0))
            Else
               timeTxt = Format$(Now, "yyyymmdd hh:mm:ss")
               strsql = "insert into sendmsglog (MobileNo,Msg,SendTime,SendUser) values ('" & nrc.Fields(1) & "','" & nrc.Fields(2) & "','" & timeTxt & "','" & nrc.Fields(6) & "')"
               ModuleDb.insertRecord (strsql)
               strsql = "delete from msgbuff where MsgIndex=" & nrc.Fields(0)
               ModuleDb.delRecord (strsql)
               msg.Caption = "发送[" & nrc.Fields(1) & "] [" & nrc.Fields(2) & "]成功!!!"
            End If
         Else
            UpdateMsgBuff (nrc.Fields(0))
         End If
      End If
End If
nrc.Close
End Sub
Private Sub ClrComBuffer()
    MSComm1.Output = "AT" & Chr(13)
    ModuleDo.TimeDelay (100)
    Do While MSComm1.InBufferCount <> 0
        MSComm1.InBufferCount = 0
        ModuleDo.TimeDelay (50)
    Loop
    MSComm1.OutBufferCount = 0
End Sub
Private Sub UpdateMsgBuff(idTxt As String)
   Dim nrc As ADODB.Recordset
   Dim strsql As String
   strsql = "select * from msgbuff where MsgIndex=" & idTxt
   Set nrc = ExecuteSQL(strsql)
   nrc.Fields(5) = "0"
   nrc.Update
   If nrc.EOF = True Then
      msg.Caption = "发送[" & nrc.Fields(1) & "] [" & nrc.Fields(2) & "]失败]"
   End If
   nrc.Close
End Sub

Private Sub txtSend_Change()
 If Len(txtSend) < 70 Then
    LenTxt.Caption = "剩余字数：" & 70 - Len(txtSend)
 Else
    MsgBox "测试短信内容不能超过70字", vbOKOnly + vbExclamation, "发送测试"
 End If
End Sub