做管理資訊系統時用來實現來電顯示的原始碼

做管理資訊系統時用來實現來電顯示的原始碼。

 

Option Explicit
Const DEBFLG = 1

Public COMX, BEEPNO, HANGUP, PNLOC As Integer

Public COMBUF, COMLIN As String
Dim h

Private Sub Command1_Click()
   
    frmWelcome.Visible = False
   
End Sub

Private Sub Option1_Click(Index As Integer)

    COMX = Index + 1

    Call INIT_MODEM

End Sub

Private Sub Form_Load()

    '電話號碼置空
    PhoneNumber = ""   '用來存放從貓中的電話號碼
    getNumber = ""       '存放去掉區號後的號碼
    
    
    With MSComm1
    .InBufferSize = 1024
    .InputLen = 0
    .InputMode = 0
    .RThreshold = 1
    .RTSEnable = True
    .Settings = "9600,N,8,1"
    .SThreshold = 0
    End With
   
  

'檢測串列口

    Dim I, C As Integer

    COMX = 0

    COMBUF = ""

    COMLIN = ""

    BEEPNO = 0

    HANGUP = 0

    On Error GoTo ERROR_FORM_LOAD

'檢測可用串口

    For C = 1 To 4

        If MSComm1.PortOpen Then MSComm1.PortOpen = False
   

        MSComm1.CommPort = C

        If Not MSComm1.PortOpen Then
   
             MSComm1.PortOpen = True
        End If

        If MSComm1.PortOpen Then MSComm1.PortOpen = False
   

        If COMX = 0 Then COMX = C
   

FORM_LOAD_1:

    Next C

    If COMX = 0 Then End

    On Error GoTo 0

    Option1(COMX - 1).Value = True

Exit Sub

ERROR_FORM_LOAD:

    Option1(C - 1).Enabled = False

    Resume FORM_LOAD_1
    Exit Sub
   

Exit Sub
why:
MsgBox Err.Description
End Sub

'檢測串列口

'檢查Modem命令是否完成

Private Sub CHK_MODEM()
On Error GoTo why

Dim T As Single

Dim L As Integer

T = Timer

Do

    COMBUF = COMBUF + MSComm1.Input

    L = InStr(1, COMBUF, "OK")

Loop Until L <> 0 Or Timer - T > 1

    If L = 0 Then
  
        MsgBox "連接埠" & COMX & "上沒有發現Modem,請選擇別的連接埠試試.", vbOKOnly + vbCritical, "測試MODEM"

    Else
        MsgBox "來電顯示已經啟動,確定此按鈕後,如果返回ok,說明電腦與Modem能正常通訊，否則,請重試其它連接埠"

    End If
Exit Sub
why: MsgBox Err.Description
End Sub

'串列口接收事件處理
Private Sub MSComm1_OnComm()
    Dim a
    Dim b
    On Error GoTo why
    Dim inStrData As String, tm As String
    Dim iPos As Integer
    inStrData = MSComm1.Input & MSComm1.Input
    iPos = InStr(inStrData, "NMBR=")
    '記錄程式是否第一次開啟，不是話下次就不顯示貓的返回資訊
    
     If TimeOpen = 0 Then
         MsgBox inStrData
         TimeOpen = 54 '寫成什麼都可以，但0不可以,
         MsgBox "恭喜!來電顯示和Modem都已經成功設定." '成功了，哈哈，我有錢可以賺了
         frmWelcome.Visible = False
         Command2.Visible = False
     End If
    a = InStr(1, inStrData, "NMBR = ", vbTextCompare)
    If a <> 0 Then
        b = InStr(a, inStrData, vbCr, vbTextCompare)
        PhoneNumber = Mid(inStrData, a + 7, b - a - 7)
        frmReg.Show
    Else:
    End If
  Exit Sub
why:
 MsgBox Err.Description
End Sub

Private Sub INIT_MODEM()
On Error GoTo why

    If MSComm1.PortOpen Then MSComm1.PortOpen = False

    MSComm1.CommPort = COMX

    If Not MSComm1.PortOpen Then MSComm1.PortOpen = True

    MSComm1.Output = "AT+VCID=1" + vbCr

    '檢查Modem命令是否完成

    Call CHK_MODEM

    MSComm1.Output = "ATS0=0" + vbCr
    Exit Sub
why:
MsgBox Err.Description

End Sub

 

=2====================================================================================

Option Explicit
Const DEBFLG = 1

Public COMX, BEEPNO, HANGUP, PNLOC As Integer

Public COMBUF, COMLIN As String
Dim h

Private Sub Command1_Click()
   
    frmWelcome.Visible = False
   
End Sub

Private Sub Option1_Click(Index As Integer)

    COMX = Index + 1

    Call INIT_MODEM

End Sub

Private Sub Form_Load()

    '電話號碼置空
    PhoneNumber = ""   '用來存放從貓中的電話號碼
    getNumber = ""       '存放去掉區號後的號碼
   
   
    With MSComm1
    .InBufferSize = 1024
    .InputLen = 0
    .InputMode = 0
    .RThreshold = 1
    .RTSEnable = True
    .Settings = "9600,N,8,1"
    .SThreshold = 0
    End With
   
  

'檢測串列口

    Dim I, C As Integer

    COMX = 0

    COMBUF = ""

    COMLIN = ""

    BEEPNO = 0

    HANGUP = 0

    On Error GoTo ERROR_FORM_LOAD

'檢測可用串口

    For C = 1 To 4

        If MSComm1.PortOpen Then MSComm1.PortOpen = False
   

        MSComm1.CommPort = C

        If Not MSComm1.PortOpen Then
   
             MSComm1.PortOpen = True
        End If

        If MSComm1.PortOpen Then MSComm1.PortOpen = False
   

        If COMX = 0 Then COMX = C
   

FORM_LOAD_1:

    Next C

    If COMX = 0 Then End

    On Error GoTo 0

    Option1(COMX - 1).Value = True

Exit Sub

ERROR_FORM_LOAD:

    Option1(C - 1).Enabled = False

    Resume FORM_LOAD_1
    Exit Sub
   

Exit Sub
why:
MsgBox Err.Description
End Sub

'檢測串列口

'檢查Modem命令是否完成

Private Sub CHK_MODEM()
On Error GoTo why

Dim T As Single

Dim L As Integer

T = Timer

Do

    COMBUF = COMBUF + MSComm1.Input

    L = InStr(1, COMBUF, "OK")

Loop Until L <> 0 Or Timer - T > 1

    If L = 0 Then
  
        MsgBox "連接埠" & COMX & "上沒有發現Modem,請選擇別的連接埠試試.", vbOKOnly + vbCritical, "測試MODEM"

    Else
        MsgBox "來電顯示已經啟動,確定此按鈕後,如果返回ok,說明電腦與Modem能正常通訊，否則,請重試其它連接埠"

    End If
Exit Sub
why: MsgBox Err.Description
End Sub

'串列口接收事件處理
Private Sub MSComm1_OnComm()
    Dim a
    Dim b
    On Error GoTo why
    Dim inStrData As String, tm As String
    Dim iPos As Integer
    inStrData = MSComm1.Input & MSComm1.Input
    iPos = InStr(inStrData, "NMBR=")
    '記錄程式是否第一次開啟，不是話下次就不顯示貓的返回資訊
    
     If TimeOpen = 0 Then
         MsgBox inStrData
         TimeOpen = 54 '寫成什麼都可以，但0不可以,
         MsgBox "恭喜!來電顯示和Modem都已經成功設定." '成功了，哈哈，我有錢可以賺了
         frmWelcome.Visible = False
         Command2.Visible = False
     End If
    a = InStr(1, inStrData, "NMBR = ", vbTextCompare)
    If a <> 0 Then
        b = InStr(a, inStrData, vbCr, vbTextCompare)
        PhoneNumber = Mid(inStrData, a + 7, b - a - 7)
        frmReg.Show
    Else:
    End If
  Exit Sub
why:
 MsgBox Err.Description
End Sub

Private Sub INIT_MODEM()
On Error GoTo why

    If MSComm1.PortOpen Then MSComm1.PortOpen = False

    MSComm1.CommPort = COMX

    If Not MSComm1.PortOpen Then MSComm1.PortOpen = True

    MSComm1.Output = "AT+VCID=1" + vbCr

    '檢查Modem命令是否完成

    Call CHK_MODEM

    MSComm1.Output = "ATS0=0" + vbCr
    Exit Sub
why:
MsgBox Err.Description

End Sub

http://topic.csdn.net/t/20031205/23/2533209.html
http://topic.csdn.net/t/20060802/16/4922488.html
http://topic.csdn.net/t/20040407/23/2938498.html