form1.frm

演示用VB怎样取电话来电显示号码

      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'此demo程序为话录通的示例程序，版权所有！有问题请联系：网址：http://www.lutongrj.com
'QQ: 718473996[不在线,请留言] 联系电话： [phone] email: [e-mail]

Option Explicit
Dim fid As Long

Private Sub Check1_Click(Index As Integer)
    Dim DID As String
    Dim DIDN As Long
    
    Dim ct As Long
    
    Dim i As Integer
    
    DID = Combo2.Text & "               "
    DIDN = Val(DID)
    
    ct = 0
    For i = 0 To 7
        If Check1(i).Value > 0 Then
            ct = ct + 2 ^ i
        End If
    Next
    ct = ct + (((((Not ct) And &HFF)) * 256) And &HFF00)
    'CT = 65280
    '----------------------------------------------
    LT_SetChannelNumber DIDN - 64, 16, ct
    '----------------------------------------------
End Sub

Private Sub Check2_Click()
    On Error Resume Next
    If Check2.Value = 1 Then
        If fid = 0 Then
             MsgBox "c:\jilu.txt"
             fid = FreeFile
       
             Open "c:\jilu.txt" For Append As #fid
             
        End If
    Else
        Close #fid
        fid = 0
    End If
    
End Sub

Private Sub CK_Click()
'LT_CheckSerialNo     验证ID  可以对程序进行简单加密
    Dim DID As String
    Dim DIDN As Long
    Dim n As String
    Dim Result As Long
    Dim id As Long
    
    DID = Trim(List1.Text)
    
    DIDN = Val(DID)
    '---------------------------------------------
    On Error Resume Next
    
    id = Val(InputBox(" = ()H" & vbCrLf & _
                      "         = ()B" & vbCrLf & _
                      "请输入ID", "", ""))
    
    If DIDN < 64 Then CK.Enabled = False
    
    Result = LT_CheckSerialNo(DIDN - 64, id)
    If Result <> 0 Then
        MsgBox "通过" & Result
    Else
        MsgBox "错误"
    End If
    '---------------------------------------------
End Sub

Private Sub Command1_Click() '开机

'开机，LT_InitializeSystem     开启“话录通”

    Dim DID As String
    Dim DIDN As Long
    
    DID = Combo2.Text & "               "
    DIDN = Val(DID)
    
    '----------------------------------------------
    If LT_InitializeSystem(DIDN, 2) = 1 Then
        List1.AddItem DIDN
    Else
        MsgBox "no"
    End If
    '----------------------------------------------
    Timer3.Enabled = True   '同时查询状态开始（如果采用查询方式）
End Sub

Private Sub Command10_Click()
 Dim DID As String
    Dim DIDN As Long
    
    DID = Combo2.Text & "               "
    DIDN = Val(DID)
    
    '----------------------------------------------
    If LT_TelHookOnOff(64, 1) = 1 Then
        List1.AddItem " ok"
    Else
        MsgBox "no"
    End If
End Sub

Private Sub Command2_Click() '关机
'关机，LT_CloseSystem       关闭“话录通”
    Dim DID As String
    Dim DIDN As Integer
    
    DID = List1.Text
    
    DIDN = Val(DID)
    
    Timer3.Enabled = False  '*******没有考虑多虑查询情况
    '---------------------------------------------
    MsgBox DIDN
    If LT_CloseSystem(DIDN) = 1 Then
        If List1.ListIndex <> -1 Then
            List1.RemoveItem List1.ListIndex
        End If
    End If
    '---------------------------------------------
End Sub

Private Sub Command3_Click()
''拨号，LT_DialNumber      拨打电话 影响摘挂机
    Dim DID As String
    Dim DIDN As Integer
    Dim n As String
    
    DID = List1.Text
    
    DIDN = Val(DID)
    
    n = Trim(Text1)
    Text1 = "正在拨号。。。" & n
    DoEvents
    '---------------------------------------------
    If LT_DialNumber(DIDN, n) <> 1 Then
        MsgBox "拨号失败！"
    End If
    '---------------------------------------------
    Text1 = n
    Command5.Caption = "挂机"
End Sub


Private Sub Command4_Click(Index As Integer)
    If Index <> 0 Then
        Me.Command4(0).SetFocus
        Timer2.Enabled = True
    End If
End Sub

Private Sub Command4_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'DialOneDTMF               单健拨号
    Dim DID As String
    Dim DIDN As Integer
    
    Dim ct As Long
    
    Dim i As Integer
    
    DID = Combo2.Text & "               "
    DIDN = Val(DID)
    
    ct = Index
    If ct = 0 Then
        ct = &HFF
    'Else
    '    CT = Index + 128
    End If
    
    If DIDN < 64 Then
        For i = Command4.LBound To Command4.UBound
            Command4(i).Enabled = False
        Next
        Exit Sub
    End If
    
    '----------------------------------------------
    DiaDTMF DIDN - 64, ct
    '----------------------------------------------
    Timer1.Enabled = True

End Sub

Private Sub Command5_Click()
'摘挂机
    Dim DID As String
    Dim DIDN As Long
    Dim n As String
    Dim Result As Long
    
    DID = List1.Text
    
    DIDN = Val(DID)
    
    
    If DIDN < 64 Then
        Command5.Enabled = False
        Exit Sub
    End If
    
    If Command5.Caption = "摘机" Then
    '----------------------------------------------
        Result = HookUp_Tel(DIDN, &O1)
    '----------------------------------------------
    Else
    '----------------------------------------------
        Result = HookUp_Tel(DIDN, &O0)
    '----------------------------------------------
    End If
    
    If Result Then
        Command5.Caption = IIf(Command5.Caption = "摘机", "挂机", "摘机")
    Else
        MsgBox "摘挂机失败！"
    End If
End Sub

Private Sub Command6_Click()
'回调，LT_SetCallbackFun     设定回调函数
    '----------------------------------------------
    LT_SetCallbackFun AddressOf Module1.Post2User, 0
    '----------------------------------------------
End Sub

Private Sub Command8_Click()
'回调，LT_SetCallbackFun     设定回调函数
    '----------------------------------------------
    LT_SetCallbackFun 0, 0
    '----------------------------------------------
End Sub

Private Sub Command9_Click()
'参数，在SetFsk函数中 用到了SetChannelNumber 来设定控制字
    Dim DID As String
    Dim DIDN As Integer
    
    Dim PY As String
    Dim PYN As Long
    
    DID = Combo2.Text & "               "
    DIDN = Val(DID)
    
    PY = Combo3.Text & "               "
    PYN = Val(PY)
    
    PYN = PYN + (((((Not PYN) And &HFF)) * 256) And &HFF00)
    '----------------------------------------------
    If SetFsk(DIDN, PYN) Then
        MsgBox "ok"
    Else
        MsgBox "no"
    End If
    '----------------------------------------------

End Sub

Private Sub Form_Load()
    If VB.App.PrevInstance Then End
    Combo2.ListIndex = 0
    Combo3.ListIndex = 2
    
    fid = 0
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim i As Integer
    
    If fid <> 0 Then Close #fid
    
    For i = 1 To List1.ListCount
        List1.Selected(0) = True
        Command2_Click
    Next
End Sub

Private Sub List2_Click() '清除电话列表
    List2.Clear

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    Debug.Print KeyAscii
    If Len(Text1) = 30 And KeyAscii <> 8 Then KeyAscii = 0
    Select Case KeyAscii
    Case Asc("0") To Asc("9")
    Case Asc("*")
    Case Asc("#")
    Case Asc("(")
    Case Asc(")")
    Case Asc(",")
    Case Asc(" ")
    Case Asc("-")
    Case Asc("~")
    Case 8
    Case Else
        KeyAscii = 0
    End Select
End Sub

Private Sub Text2_DblClick()
    Text2 = ""

End Sub

Private Function GetState() As Long
    GetState = &HFFFF
    
    If (pointStart = pointEnd) Then Exit Function
    If (pointEnd >= 1000) Then pointEnd = 0: pointStart = 0: Exit Function
    
    pointStart = pointStart + 1
    If pointStart >= 1000 Then pointStart = 0
    
    GetState = Module1.D_P(pointStart)
End Function

Private Sub Text3_Change()
    Text3.SetFocus
    Text3.SelStart = Len(Text3)     '滚动
    Text3.SelLength = 0
    Me.List1.SetFocus
End Sub

Private Sub Timer1_Timer()
    Dim port As Byte
    Dim n As Byte
    Dim telnmb As String
    Dim teldial As String * 1
    Dim D_P As Long
    
    
    D_P = GetState And &HFFFF
    If D_P < 0 Then D_P = D_P + 65536
    
    Debug.Print D_P;
    
    port = D_P Mod 256 And &H7F
    n = (D_P \ 256) And &HFF
    
    Select Case n
    Case 0 '来电
        'telnmb = LT_GetCallerID(port)
        GetNumber_VB port, telnmb
        'If Len(telnmb) > 2 Then
            telnmb = telnmb & "LEN=" & Len(telnmb)
            Form1.List2.AddItem telnmb
            If fid <> 0 Then Write #fid, "port=" & port & " " & telnmb
            
        'End If
        'MsgBox telnmb
    Case 1 To 16 '数字
        teldial = Trim(Str(n))
        If n = 10 Then teldial = "0"
        If n = 11 Then teldial = "*"
        If n = 12 Then teldial = "#"
        If n > 12 Then teldial = Trim(Hex(n))
    Case &HFD
        teldial = "空闲" '取消
    Case &HFC
        teldial = "错误"
    Case &HFE
        teldial = "震铃"
    Case Else
        Exit Sub
        'Timer1.Enabled = False
        'teldial = "其他" '取消
    End Select
    
    Form1.Text2 = Form1.Text2 & "|" & teldial & "(" & Hex(port) & ")" '& "n=" & Hex(n) '& "dp=" & Hex(D_P)
    
    
End Sub

Private Sub Timer2_Timer()
    Command4_MouseDown 0, 0, 0, 0, 0
    Timer2.Enabled = False
End Sub
'typedef struct _state_now{
'    unsigned char ifTel:1;
'    unsigned char ifRing:1;
'    unsigned char ifError:1;
'    unsigned char ifDtmf:1;
'    unsigned char dtmf:4;
'    unsigned char hd;
'} STATE_NOW;

Private Sub Timer3_Timer()
    Dim port As Long
    Dim state As Integer
    
    For port = 0 To 7
        
        GetKHTState port, state
        If state And &HF Then
            'Text3 = Right(Text3, 200) & "port" & port & "=" & Hex(state) & vbCrLf
            
            Text3 = Right(Text3, 500) & " port=" & port _
                    & "->来电=" & IIf(state And &H1, "1", "0") _
                    & " 振铃=" & IIf(state And &H2, "1", "0") _
                    & " 错误=" & IIf(state And &H4, "1", "0") _
                    & " dtmf=" & IIf(state And &H8, "1", "0") _
                    & " Dtmf=" & ((state And &HF0) / 16) & vbCrLf _
                    & "------------------" & vbCrLf
        End If
        If Val(List1.Text) - 64 = port Then
            Text5 = Hex(state)
            Text4 = IIf(state And &H1000, "摘机", "挂机")
        End If

    Next
    
End Sub