identifier.frm

some thing about vb 6 for net

                        .Status(iLineNum).Text = "Outgoing Call"
                End Select

            Case IDENT_EVENTS.WATCHDOG                          'Serial Number or Watchdog Event
                Exit Sub                                        'Do not process

          '----------------------------------------------------------------------------------------------
          'Serial numbers are in response to the ATSN command which also puts the Identifier
          'in Event Mode.  Its a good idea to use the ATSN instead of the AT command to put
          'the Identifer into Event Mode so you can use the returned serial number event to verify
          'communications from and to the Identifer
          '
          'When this program is run you should see the serial number event (3,2,XXXXXXXX,01) on the first
          'line of the Events Received List Box
          '----------------------------------------------------------------------------------------------
            Case IDENT_EVENTS.INVALID_CALLER_ID                 'Caller ID Event - Out of Area or Private

                If stArray(1) = "P" Then                        'Private Caller ID, blocked by caller
                    .CallName(iLineNum).Text = "Private"
                Else
                    .CallName(iLineNum).Text = "Out of Area"    'Caller ID data not available to telco
                End If

                .Number(iLineNum).Text = stArray(1)
                AddRecord iLineNum

            Case IDENT_EVENTS.DTMF                              'DTMF event

                If .Status(iLineNum) = "Outgoing Call" Then     'Make sure it's an outgoing call otherwise the
                    .Number(iLineNum).Text = .Number(iLineNum).Text + stArray(1)
                End If                                          'The MLM-2X can receive digits on incoming calls

            Case IDENT_EVENTS.SIGNAL_ERROR                      ' Caller ID Signal Error Event
              ' The most common error is answering the line while the Caller ID data is being received
                .CallName(iLineNum).Text = "Error"
        End Select

    End With

End Sub


Private Sub ClearEvents_Click()
    IdentifierEvents.Clear
End Sub


Private Sub cmdExit_Click()
    Unload Me
End Sub


Private Sub comm1_OnComm()
    Static stEvent             As String                       'storage for an Identifier event
    Dim stComChar               As String * 1                   'temporary storage for received comm port data
    

    Select Case Comm1.CommEvent

        Case comEvReceive                                       ' Received RThreshold # of chars.

          '----------------------------------------------------------------------------------------------
          'The following illustrates how the Identifier is designed
          'to make authoring software easy as '123' for developers:
          '1) Look for a "+" character which indicates the beginning of an event
          '2) Save subsequent characters until you detect a carriage return
          '3) Process the Event
          '----------------------------------------------------------------------------------------------
            Do
                stComChar = Comm1.Input                         'read 1 character .Inputlen = 1

                Select Case stComChar

                    Case chEventStart                           'Beginning of Identifier event
                        stEvent = ""

                    Case vbLf                                   'Ignore linefeeds

                    Case vbCr                                   'The CR indicates the end of the Identifier Event
                        ProcessEvent stEvent                    'Process the Identifier event

                    Case Else
                        stEvent = stEvent + stComChar           'Save everything between the + and CR
                End Select

            Loop While Comm1.InBufferCount                      'Loop until all characters in receive buffer are processed
        '----------------------------------------------------------------------------------------------
        'The following communication events are ignored.
        'In normal Identifier operation they will never fire.
        '----------------------------------------------------------------------------------------------
        'Case comBreak                                           ' A Break was received.
        'Case comCDTO                                            ' CD (RLSD) Timeout.
        'Case comCTSTO                                           ' CTS Timeout.
        'Case comDSRTO                                           ' DSR Timeout.
        'Case comFrame                                           ' Framing Error
        'Case comOverrun                                         ' Data Lost.
        'Case comRxOver                                          ' Receive buffer overflow.
        'Case comRxParity                                        ' Parity Error.
        'Case comTxFull                                          ' Transmit buffer full.
        'Case comEvCD                                            ' Change in the CD line.
        'Case comEvCTS                                           ' Change in the CTS line.
        'Case comEvDSR                                           ' Change in the DSR line.
        'Case comEvRing                                          ' Change in the Ring Indicator.
        'Case comEvSend                                          ' chars in send buffer
        '----------------------------------------------------------------------------------------------
    End Select

End Sub


Private Sub Connect_Click()

    If (Connect.Caption = "&Connect") Then                      ' This menu item will open or close the com port

        If Not Comm1.PortOpen Then                              ' Open the comm port if not already open
            Comm1.PortOpen = True
        End If

        If Not Comm1.PortOpen Then                              ' if there is a problem opening the port
            MsgBox "Cannot open comm port " & Comm1.CommPort    ' display an error first
            End                                                 ' bail out of the program
        End If

      ' Initialize communications and update app UI
        Comm1.RThreshold = 1                                    ' Generate a receive event on every character received
        Comm1.InputLen = 1                                      ' Read the receive buffer 1 char at a time
        Comm1.Output = vbCr + "ATSN" + vbCr                     ' Send command to put Identifier in event mode and receive serial number
        Initialize_Click                                        ' Initialize the Identifer to match form checkboxes
        Connect.Caption = "Dis&connect"                         ' Change the menu to reflect opposite of port status
        Initialize.Enabled = True                               ' Enable the re-intialize button
    
    Else
        Comm1.PortOpen = False                                  ' Close the port and update app UI
        Connect.Caption = "&Connect"                            ' Change the menu to reflect opposite of port status
        Initialize.Enabled = False                              ' Disable the re-intialize button
    End If

End Sub


Private Sub Exit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim iLineNum                As Integer
    
    'retrieve last window location
    Me.Top = GetSetting(App.Title, "Window", "Top", Me.Top)
    Me.Left = GetSetting(App.Title, "Window", "Left", Me.Left)
    
    
    'retrieve last port settings
    Comm1.Settings = GetSetting(App.Title, "Properties", "Settings", Comm1.Settings)
    Comm1.CommPort = GetSetting(App.Title, "Properties", "CommPort", Comm1.CommPort)
    Comm1.Handshaking = GetSetting(App.Title, "Properties", "Handshaking", Comm1.Handshaking)
    bEcho = GetSetting(App.Title, "Properties", "Echo", False)
    m_stDataPath = GetSetting(App.Title, "Properties", "DataPath", DefDataPath)

    For iLineNum = 1 To 8                                       ' Initialize Line Status Screen
        frmLineInfo.CallName(iLineNum).Text = ""
        frmLineInfo.Number(iLineNum).Text = ""
        frmLineInfo.Status(iLineNum).Text = "Idle"
    Next
    OpenDataBase
End Sub


Private Sub Form_Unload(Cancel As Integer)

    If Comm1.PortOpen Then
        Comm1.PortOpen = False
        Initialize.Enabled = False
    End If
    If (Me.WindowState = vbNormal) Then
        SaveSetting App.Title, "Window", "Top", Me.Top
        SaveSetting App.Title, "Window", "Left", Me.Left
    End If
    SaveSetting App.Title, "Properties", "DataPath", m_stDataPath
    
    CloseDatabase

End Sub


Private Sub Initialize_Click()
    Dim intFeatures             As Integer
    
    intFeatures = 0

    If CBool(chkWatchdog.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.WATCHDOG
    End If

    If CBool(chkDTMF.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.DTMFDIGITS
    End If

    If CBool(chkHook.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.HOOKSTATUS
    End If

    If CBool(chkRingStop.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.RINGSTOP
    End If

    If CBool(chkRingStart.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.RINGSTART
    End If

    If CBool(chkCallerID.Value) Then
        intFeatures = intFeatures + IDENT_FEATURES.CALLERID
    End If

    Comm1.Output = "ATF" + Str(intFeatures) + vbCr              'Turn on selected events

    If Not CBool(chkDialing) Then                               'Not in North America?
        Comm1.Output = "ATD0" + vbCr                            'Turn off North American Dialing
        Comm1.Output = "ATX,5,65535" + vbCr                     'Set DTMF timeout to infinite
    Else
        Comm1.Output = "ATD1" + vbCr                            'Turn on North American Dialing
        Comm1.Output = "ATX,5,7500" + vbCr                      'Set DTMF timeout to 7.5 seconds
    End If

End Sub


Private Sub Properties_Click()
    Load frmProperties
    frmProperties.Show
End Sub



Private Sub OpenDataBase()
    Set fo = New FileSystemObject
    
    Set wrk = CreateWorkspace("", "admin", "", dbUseJet)
    
    If Not fo.FileExists(m_stDataPath & "phonedb.mdb") Then
        Set db = wrk.CreateDatabase(m_stDataPath & "phonedb.mdb", dbLangGeneral)
        CreatePhoneDB
    Else
        Set db = wrk.OpenDataBase(m_stDataPath & "phonedb.mdb")
    End If
    Set rs = db.OpenRecordset("PhoneCalls", dbOpenTable)
    
End Sub

Private Sub CloseDatabase()
    db.Close
    wrk.Close
    Set db = Nothing
    Set wrk = Nothing
    Set fo = Nothing
End Sub


Private Sub AddRecord(iLine As Integer)
    Dim lID As Long
    With rs
        If (.RecordCount > 0) Then
            .MoveLast
            lID = .Fields("id") + 1
        Else
            lID = 1
        End If
        .AddNew
        .Fields("id") = lID
        .Fields("datetime") = Now
        .Fields("status") = Mid(frmLineInfo.Status(iLine).Text, 1, 1)
        .Fields("line") = iLine
        .Fields("number") = frmLineInfo.Number(iLine).Text
        .Fields("name") = frmLineInfo.CallName(iLine).Text
        .Update
    End With

End Sub

Private Function CreatePhoneDB() As Recordset
    Dim tbl As TableDef
    Set tbl = db.CreateTableDef("PhoneCalls")
    With tbl
        .Fields.Append .CreateField("id", dbLong, 4)
        .Fields.Append .CreateField("datetime", dbDate, 4)
        .Fields.Append .CreateField("status", dbText, 1)
        .Fields.Append .CreateField("line", dbInteger, 2)
        .Fields.Append .CreateField("number", dbText, 50)
        .Fields.Append .CreateField("name", dbText, 125)
    End With
    db.TableDefs.Append tbl
    Set tbl = Nothing
    
End Function