frmmain.frm

为方便一些朋友开发GSM通讯,特提供一套西门子AT指令,有详细说明.

    LblATCommand.Caption = "AT+Command For : ME45"
    LblInfoPonsel.Caption = "ME45"
    ImgLoadSShot.Picture = LoadPicture(App.Path & "\Picture\ME45.gif")
Case "G400m系列"
    RtbListATC.Text = ""
    sFile = App.Path + "\AT+Command\StatusAT.avc"
    RtbTemp.LoadFile sFile
    Colorize RtbListATC, RtbTemp.Text
    RtbTemp.Text = ""
    LblATCommand.Caption = "AT+Command For : G400m"
    LblInfoPonsel.Caption = "G400m"
    ImgLoadSShot.Picture = LoadPicture(App.Path & "\Picture\G400m.gif")
Case "M55C系列"
    RtbListATC.Text = ""
    sFile = App.Path + "\AT+Command\M55C.avc"
    RtbTemp.LoadFile sFile
    Colorize RtbListATC, RtbTemp.Text
    RtbTemp.Text = ""
    LblATCommand.Caption = "AT+Command For : M55C"
    LblInfoPonsel.Caption = "M55C"
    ImgLoadSShot.Picture = LoadPicture(App.Path & "\Picture\M55.GIF")

Case "说明"
    RtbListATC.Text = ""
    sFile = App.Path + "\AT+Command\Readme.avc"
    RtbTemp.LoadFile sFile
    Colorize RtbListATC, RtbTemp.Text
    RtbTemp.Text = ""
    LblATCommand.Caption = "说明"
    LblInfoPonsel.Caption = "说明"
    ImgLoadSShot.Picture = LoadPicture(App.Path & "\Picture\unknown.gif")
End Select
Exit Sub
ErrHandler:
    MsgBox "错误 ! " & err.Description, vbCritical, "错误 !!"
    Exit Sub
End Sub

Sub Load_Com_port()
For i = 1 To 10
CmbCom.AddItem "COM" + Str$(i)
Next i
CmbCom.ListIndex = 0
CmbSetings.AddItem "19200,n,8,1"
CmbSetings.AddItem "38400,n,8,1"
CmbSetings.AddItem "57600,n,8,1"
End Sub

Private Sub SetComPort()
On Error GoTo ErrHandler
iLoadComPort = InStr(1, CmbCom.Text, "COM", vbTextCompare)
iGetComPort = Mid$(CmbCom.Text, iLoadComPort + 4, 1)
If iLoadComPort = 0 Then iGetComPort = "0"
    iGetDevice = Mid$(CmbCom.Text, iLoadComPort + 4, Len(CmbCom.Text))
    With MSCTestCom
         .Settings = CmbSetings.Text
         .PortOpen = True
    End With
Exit Sub
ErrHandler:
    MsgBox "Error !" & err.Description, vbCritical, "Error !!"
    Exit Sub
End Sub

Private Sub MSCTestCom_OnComm()
    Select Case MSCTestCom.CommEvent
        Case comOverrun
            ErrorMessage$ = " Overrun Error"
        Case comRxOver
            ErrorMessage$ = " Receive Buffer Overflow"
        Case comRxParity
            ErrorMessage$ = " Parity Error"
        Case comCDTO
            ErrorMessage$ = " Carrier Detect Timeout"
        Case comCTSTO
            ErrorMessage$ = " CTS Timeout"
        Case comDCB
            ErrorMessage$ = " Error retrieving DCB"
        Case comDSRTO
            ErrorMessage$ = " DSR Timeout"
        Case comFrame
            ErrorMessage$ = " Framing Error"
        Case comBreak
            ErrorMessage$ = " Break Received"
            MSCTestCom.Break = False
            ErrorMessage$ = ""
        Case comTxFull
            MSCTestCom.OutBufferCount = 0
            ErrorMessage$ = ""
        Case comEvRing
            EventMessage$ = " The Phone is Ringing"
        Case comEvEOF
            EventMessage$ = " End of File Detected"
        Case comEvReceive
        Case comEvSend
        Case comEvCTS
            EventMessage$ = " Clear to send"
        Case comEvDSR
            EventMessage$ = " Change in DSR Detected"
        Case comEvCD
            EventMessage$ = " Carrier Status Toggled"
        Case Else
            ErrorMessage$ = " Unknown error or event"
    End Select
    If Len(EventMessage$) Then
        Status.Caption = "状态或者错误信息 : " & EventMessage$ & vbCr
    End If
End Sub

'======================================================================================
Private Sub LblPOpen_Click()
LblPOpen.Visible = False
LblPClose.Visible = True
    If MSCTestCom.PortOpen = False Then
       Call SetComPort
    End If
End Sub

Private Sub LblPClose_Click()
On Error GoTo ErrHandler
    If MSCTestCom.PortOpen = True Then
       MSCTestCom.PortOpen = False
    End If
LblPClose.Visible = False
LblPOpen.Visible = True
Exit Sub
ErrHandler:
    MsgBox "错误 ! " & err.Description, vbCritical, "错误 !!"
    Exit Sub
End Sub

Private Sub LblSend_Click()
On Error GoTo ErrHandler
TxtTestATC.Text = ""
StringCommand$ = CmbATC.Text + vbCr
  
    MSCTestCom.InBufferCount = 0
    MSCTestCom.Output = StringCommand$
    Do
        DoEv = DoEvents()
        If bCancelFlag Then
           bCancelFlag = False
           Exit Do
       End If
       On Error GoTo ErrRepair:
       TxtTestATC.Text = TxtTestATC.Text + MSCTestCom.Input
       
      'If MSCTestCom.InBufferCount > 0 Then
      '   Debug.Print TxtTestATC.Text
      '   Exit Do
      'End If
    Loop
Exit Sub
ErrHandler:
  MsgBox "错误 ! " & err.Description, vbCritical, "错误 !!"
Exit Sub
ErrRepair:
Exit Sub
End Sub

Private Sub LblExit_Click()
Unload Me
End Sub

Private Sub LblAbout_Click()
RtbListATC.Visible = False
Picture2.Visible = True
Picture3.Visible = False
LblATCommand.Caption = "关于"
End Sub

Private Sub LblATCSupport_Click()
RtbListATC.Visible = True
Picture2.Visible = False
Picture3.Visible = False
LblATCommand.Caption = "AT指令集"
If RtbListATC.Text = "" Then
LblATCommand.Caption = "AT指令集"
RtbListATC.Text = "<-- 请选择所支持的AT指令集"
End If
End Sub

Private Sub LblMinimize_Click()
Me.WindowState = vbMinimized
End Sub

'=======================================================================================

Private Sub scrolllabel2_Timer()
LblInfoPonsel.Left = LblInfoPonsel.Left - 40
If LblInfoPonsel.Left <= Shape15.Left + 50 Then
scrolllabel2.Enabled = False
scrolllabel1.Enabled = True
End If
End Sub

Private Sub scrolllabel1_Timer()
LblInfoPonsel.Left = LblInfoPonsel.Left + 40
If LblInfoPonsel.Left >= Shape15.Left + Shape15.Width - 50 - LblInfoPonsel.Width Then
scrolllabel1.Enabled = False
scrolllabel2.Enabled = True
End If
End Sub

'=======================================================================================

Private Sub Font_bold_False()
LblHome.FontBold = False
Me.LblAbout.FontBold = False
Me.LblATCSupport.FontBold = False
Me.LblMinimize.FontBold = False
Me.LblExit.FontBold = False
Me.LblSend.FontBold = False
Me.LblPClose.FontBold = False
Me.LblPOpen.FontBold = False
End Sub

'======================================================================================
Private Sub LblAbout_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblAbout.FontBold = True
LblHome.FontBold = False
Me.LblATCSupport.FontBold = False
Me.LblMinimize.FontBold = False
Me.LblExit.FontBold = False
End Sub

Private Sub LblATCSupport_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblATCSupport.FontBold = True
LblHome.FontBold = False
Me.LblAbout.FontBold = False
Me.LblMinimize.FontBold = False
Me.LblExit.FontBold = False
End Sub
Private Sub LblMinimize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblMinimize.FontBold = True
LblHome.FontBold = False
Me.LblAbout.FontBold = False
Me.LblATCSupport.FontBold = False
Me.LblExit.FontBold = False
End Sub

Private Sub LblExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblExit.FontBold = True
LblHome.FontBold = False
Me.LblAbout.FontBold = False
Me.LblATCSupport.FontBold = False
Me.LblMinimize.FontBold = False
End Sub

Private Sub LblHome_Click()
RtbListATC.Visible = False
Picture2.Visible = False
Picture3.Visible = True
LblATCommand.Caption = "主界面"
End Sub

Private Sub LblHome_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblHome.FontBold = True
Me.LblAbout.FontBold = False
Me.LblATCSupport.FontBold = False
Me.LblMinimize.FontBold = False
Me.LblExit.FontBold = False
End Sub

Private Sub TxtTestATC_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Font_bold_False
End Sub

Private Sub LblPClose_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblPClose.FontBold = True
End Sub

Private Sub LblSend_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblSend.FontBold = True
End Sub

Private Sub LblPOpen_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblPOpen.FontBold = True
End Sub

Private Sub Picmenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Font_bold_False
End Sub

Private Sub Picture4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Font_bold_False
End Sub

Private Sub RtbListATC_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu FrmPopup.Menu
End Sub

Private Sub RtbListATC_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub ImgAvaco_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub LblDesc_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub LblLogo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Picmenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub LblDesc_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Font_bold_False
End Sub

Private Sub LblAvacoOL_Click()
  ShellExecute Me.hWnd, _
        vbNullString, _
        "http://Avaco-Software.tripod.com", _
        vbNullString, _
        "c:\", _
        SW_SHOWNORMAL
End Sub

Private Sub LblMail_Click()
 ShellExecute Me.hWnd, _
        vbNullString, _
        "mailto:[e-mail]", _
        vbNullString, _
        "c:\", _
        SW_SHOWNORMAL
End Sub