Llamadas telefonicas con mi programa en VB6

Este es el código que tengo reservado para analizar las llamadas telefónicas.
Ojealo y dime si te sirve.
En cualquier caso, cualquier duda intentare resolvertela.
El código hace llamadas, las detecta y genera un log con ellas. Un saludo
(Los comentarios estan en ingles, eso si. Lo siento)
#####################################################
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form DIALER
Caption = "MSComm Phone Dialer"
ClientHeight = 1545
ClientLeft = 4005
ClientTop = 3270
ClientWidth = 4275
LinkTopic = "Form2"
PaletteMode = 1 'UseZOrder
ScaleHeight = 1545
ScaleWidth = 4275
WhatsThisHelp = -1 'True
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton CancelButton
Caption = "Cancel"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 348
Left = 1680
TabIndex = 3
Top = 885
Width = 852
End
Begin VB.CommandButton QuitButton
Cancel = -1 'True
Caption = "Quit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 348
Left = 2640
TabIndex = 1
Top = 885
Width = 852
End
Begin VB.CommandButton DialButton
Caption = "Dial"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 348
Left = 720
TabIndex = 0
Top = 885
Width = 852
End
Begin VB.Label Status
BorderStyle = 1 'Fixed Single
Caption = "To dial a number, click the Dial button"
Height = 255
Left = 720
TabIndex = 2
Top = 360
Width = 2775
End
End
Attribute VB_Name = "DIALER"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' by Carl Franklin
'
' Updated by Anton de Jong
'
' Demonstrates how to dial phone numbers with a modem.
'
' For this program to work, your telephone and
' modem must be connected to the same phone line.
'--------------------------------------------------------
Option Explicit
DefInt A-Z
' This flag is set when the user chooses Cancel.
Dim CancelFlag
Private Sub CancelButton_Click()
' CancelFlag tells the Dial procedure to exit.
CancelFlag = True
CancelButton.Enabled = False
End Sub
Private Sub Dial(Number$)
Dim DialString$, FromModem$, dummy
' AT is the Hayes compatible ATTENTION command and is required to send commands to the modem.
' DT means "Dial Tone." The Dial command uses touch tones, as opposed to pulse (DP = Dial Pulse).
' Numbers$ is the phone number being dialed.
' A semicolon tells the modem to return to command mode after dialing (important).
' A carriage return, vbCr, is required when sending commands to the modem.
DialString$ = "ATDT" + Number$ + ";" + vbCr
' Communications port settings.
' Assuming that a mouse is attached to COM1, CommPort is set to 2
MSComm1.CommPort = 2
MSComm1.Settings = "9600,N,8,1"
' Open the communications port.
On Error Resume Next
MSComm1.PortOpen = True
If Err Then
MsgBox "COM2: not available. Change the CommPort property to another port."
Exit Sub
End If
' Flush the input buffer.
MSComm1.InBufferCount = 0
' Dial the number.
MSComm1.Output = DialString$
' Wait for "OK" to come back from the modem.
Do
dummy = DoEvents()
' If there is data in the buffer, then read it.
If MSComm1.InBufferCount Then
FromModem$ = FromModem$ + MSComm1.Input
' Check for "OK".
If InStr(FromModem$, "OK") Then
' Notify the user to pick up the phone.
Beep
MsgBox "Please pick up the phone and either press Enter or click OK"
Exit Do
End If
End If
' Did the user choose Cancel?
If CancelFlag Then
CancelFlag = False
Exit Do
End If
Loop
' Disconnect the modem.
MSComm1.Output = "ATH" + vbCr
' Close the port.
MSComm1.PortOpen = False
End Sub
Private Sub DialButton_Click()
Dim Number$, Temp$
DialButton.Enabled = False
QuitButton.Enabled = False
CancelButton.Enabled = True
' Get the number to dial.
Number$ = InputBox$("Enter phone number:", Number$)
If Number$ = "" Then Exit Sub
Temp$ = Status
Status = "Dialing - " + Number$
' Dial the selected phone number.
Dial Number$
DialButton.Enabled = True
QuitButton.Enabled = True
CancelButton.Enabled = False
Status = Temp$
End Sub
Private Sub Form_Load()
' Setting InputLen to 0 tells MSComm to read the entire
' contents of the input buffer when the Input property
' is used.
MSComm1.InputLen = 0
End Sub
Private Sub QuitButton_Click()
End
End Sub
#################################################
VERSION 5.00
Begin VB.Form frmCancelSend
BorderStyle = 3 'Fixed Dialog
Caption = "Visual Basic Terminal"
ClientHeight = 1290
ClientLeft = 1455
ClientTop = 3795
ClientWidth = 5220
ControlBox = 0 'False
Height = 1695
Left = 1395
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1290
ScaleWidth = 5220
Top = 3450
Width = 5340
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "Cancel"
Height = 372
Left = 2160
TabIndex = 1
Top = 840
Width = 972
End
Begin VB.Label Label1
Height = 492
Left = 120
TabIndex = 0
Top = 120
Width = 4932
End
End
Attribute VB_Name = "frmCancelSend"
Attribute VB_Base = "0{C058BDBE-BD78-11CF-9BF3-00AA002FFD8F}"
Attribute VB_Creatable = False
Attribute VB_TemplateDerived = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_Customizable = False
'*************************************************
' CANSEND.FRM is a dialog box that allows the user
' to cancel a "Transmit Text File" operation. This
' is a modeless form that acts modal while allowing
' other processes to continue.
'*************************************************
DefInt A-Z
Option Explicit
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Private Sub Command1_Click()
CancelSend = True
End Sub
Private Sub Form_Activate()
' Make this form a floating window that is always on top.
SetWindowPos hWnd, -1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub Form_Deactivate()
If Not CancelSend Then
frmCancelSend.Show
End If
End Sub
##################################################
Object = "{831FDD16-0C5C-11d2-A9FC-0000F8754DA1}#1.0#0"; "comctl32.ocx"
Begin VB.Form frmProperties
VERSION 5.00
BorderStyle = 3 'Fixed Dialog
Caption = "CommPort Properties"
ClientHeight = 4260
ClientLeft = 4140
ClientTop = 1665
ClientWidth = 6015
Icon = "frmProps.frx":0000
LinkTopic = "Form3"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4260
ScaleWidth = 6015
ShowInTaskbar = 0 'False
Begin VB.Frame fraSettings
BorderStyle = 0 'None
Height = 3495
Left = 255
TabIndex = 1
Top = 570
Width = 5445
Begin VB.CommandButton cmdCancel
Caption = "Cancel"
Height = 300
Left = 4335
TabIndex = 22
Top = 1065
Width = 1080
End
Begin VB.Frame Frame1
Caption = "Maximum Speed"
Height = 870
Left = 180
TabIndex = 20
Top = 630
Width = 2340
Begin VB.ComboBox cboSpeed
Height = 315
Left = 375
Style = 2 'Dropdown List
TabIndex = 21
Top = 330
Width = 1695
End
End
Begin VB.Frame fraConnection
Caption = "Connection Preferences"
Height = 1770
Left = 180
TabIndex = 12
Top = 1635
Width = 2325
Begin VB.ComboBox cboStopBits
Height = 315
Left = 1050
Style = 2 'Dropdown List
TabIndex = 16
Top = 1260
Width = 1140
End
Begin VB.ComboBox cboParity
Height = 315
Left = 1050
Style = 2 'Dropdown List
TabIndex = 15
Top = 810
Width = 1140
End
Begin VB.ComboBox cboDataBits
Height = 315
Left = 1050
Style = 2 'Dropdown List
TabIndex = 14
Top = 330
Width = 1140
End
Begin VB.Label Label5
Caption = "Stop Bits:"
Height = 285
Left = 180
TabIndex = 19
Top = 1320
Width = 885
End
Begin VB.Label Label4
Caption = "Parity:"
Height = 285
Left = 180
TabIndex = 18
Top = 855
Width = 615
End
Begin VB.Label Label3
Caption = "Data Bits:"
Height = 285
Left = 180
TabIndex = 17
Top = 375
Width = 825
End
End
Begin VB.ComboBox cboPort
Height = 315
Left = 900
Style = 2 'Dropdown List
TabIndex = 11
Top = 150
Width = 1425
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Default = -1 'True
Height = 300
Left = 4335
MaskColor = &H00000000&
TabIndex = 10
Top = 705
Width = 1080
End
Begin VB.Frame Frame7
Caption = "&Echo"
Height = 870
Left = 2595
TabIndex = 7
Top = 630
Width = 1590
Begin VB.OptionButton optEcho
Caption = "Off"
Height = 315
Index = 0
Left = 135
MaskColor = &H00000000&
TabIndex = 9
Top = 360
Width = 615
End
Begin VB.OptionButton optEcho
Caption = "On"
Height = 195
Index = 1
Left = 795
MaskColor = &H00000000&
TabIndex = 8
Top = 420
Width = 555
End
End
Begin VB.Frame Frame5
Caption = "&Flow Control"
Height = 1770
Left = 2595
TabIndex = 2
Top = 1635
Width = 1620
Begin VB.OptionButton optFlow
Caption = "None"
Height = 255
Index = 0
Left = 180
MaskColor = &H00000000&
TabIndex = 6
Top = 345
Width = 855
End
Begin VB.OptionButton optFlow
Caption = "Xon/Xoff"
Height = 255
Index = 1
Left = 180
MaskColor = &H00000000&
TabIndex = 5
Top = 645
Width = 1095
End
Begin VB.OptionButton optFlow
Caption = "RTS"
Height = 255
Index = 2
Left = 180
MaskColor = &H00000000&
TabIndex = 4
Top = 945
Width = 735
End
Begin VB.OptionButton optFlow
Caption = "Xon/RTS"
Height = 255
Index = 3
Left = 180
MaskColor = &H00000000&
TabIndex = 3
Top = 1245
Width = 1155
End
End
Begin VB.Label Label1
Caption = "Port:"
Height = 315
Left = 330
TabIndex = 13
Top = 180
Width = 495
End
End
Begin MSComCtlLib.TabStrip tabSettings
Height = 4065
Left = 90
TabIndex = 0
Top = 105
Width = 5820
_ExtentX = 10266
_ExtentY = 7170
BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7}
NumTabs = 1
BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "Properties"
ImageVarType = 2
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmProperties"
Attribute VB_Base = "0{7B2E0C91-D502-11CF-9BF3-00AA002FFD8F}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_TemplateDerived = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private iFlow As Integer, iTempEcho As Boolean
Sub LoadPropertySettings()
Dim i As Integer, Settings As String, Offset As Integer
' Load Port Settings
For i = 1 To 16
cboPort.AddItem "Com" & Trim$(Str$(i))
Next i
' Load Speed Settings
CboSpeed. AddItem "110"
CboSpeed. AddItem "300"
CboSpeed. AddItem "600"
CboSpeed. AddItem "1200"
CboSpeed. AddItem "2400"
CboSpeed. AddItem "4800"
CboSpeed. AddItem "9600"
CboSpeed. AddItem "14400"
CboSpeed. AddItem "19200"
CboSpeed. AddItem "28800"
CboSpeed. AddItem "38400"
CboSpeed. AddItem "56000"
CboSpeed. AddItem "57600"
CboSpeed. AddItem "115200"
CboSpeed. AddItem "128000"
CboSpeed. AddItem "256000"
' Load Data Bit Settings
CboDataBits. AddItem "4"
CboDataBits. AddItem "5"
CboDataBits. AddItem "6"
CboDataBits. AddItem "7"
CboDataBits. AddItem "8"
' Load Parity Settings
CboParity. AddItem "Even"
CboParity. AddItem "Odd"
CboParity. AddItem "None"
CboParity. AddItem "Mark"
CboParity. AddItem "Space"
' Load Stop Bit Settings
CboStopBits. AddItem "1"
CboStopBits.AddItem "1.5"
CboStopBits. AddItem "2"
' Set Default Settings
Settings = frmTerminal.MSComm1.Settings
' In all cases the right most part of Settings will be 1 character
' except when there are 1.5 stop bits.
If InStr(Settings, ".") > 0 Then
Offset = 2
Else
Offset = 0
End If
cboSpeed.Text = Left$(Settings, Len(Settings) - 6 - Offset)
Select Case Mid$(Settings, Len(Settings) - 4 - Offset, 1)
Case "e"
cboParity.ListIndex = 0
Case "m"
cboParity.ListIndex = 1
Case "n"
cboParity.ListIndex = 2
Case "o"
cboParity.ListIndex = 3
Case "s"
cboParity.ListIndex = 4
End Select
cboDataBits.Text = Mid$(Settings, Len(Settings) - 2 - Offset, 1)
cboStopBits.Text = Right$(Settings, 1 + Offset)
cboPort.ListIndex = frmTerminal.MSComm1.CommPort - 1
optFlow(frmTerminal.MSComm1.Handshaking).Value = True
If Echo Then
optEcho(1).Value = True
Else
optEcho(0).Value = True
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim OldPort As Integer, ReOpen As Boolean
On Error Resume Next
Echo = iTempEcho
OldPort = frmTerminal.MSComm1.CommPort
NewPort = cboPort.ListIndex + 1
If NewPort <> OldPort Then ' If the port number changes, close the old port.
If frmTerminal.MSComm1.PortOpen Then
frmTerminal.MSComm1.PortOpen = False
ReOpen = True
End If
frmTerminal.MSComm1.CommPort = NewPort ' Set the new port number.
If Err = 0 Then
If ReOpen Then
frmTerminal.MSComm1.PortOpen = True
frmTerminal.mnuOpen.Checked = frmTerminal.MSComm1.PortOpen
frmTerminal.mnuSendText.Enabled = frmTerminal.MSComm1.PortOpen
frmTerminal.tbrToolBar.Buttons("TransmitTextFile").Enabled = frmTerminal.MSComm1.PortOpen
End If
End If
If Err Then
MsgBox Error$, 48
frmTerminal.MSComm1.CommPort = OldPort
Exit Sub
End If
End If
frmTerminal.MSComm1.Settings = Trim$(cboSpeed.Text) & "," & Left$(cboParity.Text, 1) _
& "," & Trim$(cboDataBits.Text) & "," & Trim$(cboStopBits.Text)
If Err Then
MsgBox Error$, 48
Exit Sub
End If
frmTerminal.MSComm1.Handshaking = iFlow
If Err Then
MsgBox Error$, 48
Exit Sub
End If
SaveSetting App. Title, "Properties", "Settings", frmTerminal. MSComm1. Settings
SaveSetting App. Title, "Properties", "CommPort", frmTerminal. MSComm1. CommPort
SaveSetting App. Title, "Properties", "Handshaking", frmTerminal. MSComm1. Handshaking
SaveSetting App. Title, "Properties", "Echo", Echo
Unload Me
End Sub
Private Sub Form_Load()
' Set the form's size
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
' Size the frame to fit in the tabstrip control
fraSettings.Move tabSettings.ClientLeft, tabSettings.ClientTop
' Make sure the frame is the top most control
fraSettings.ZOrder
' Load current property settings
LoadPropertySettings
End Sub
Private Sub optEcho_Click(Index As Integer)
If Index = 1 Then
iTempEcho = True
Else
iTempEcho = False
End If
End Sub
Private Sub optFlow_Click(Index As Integer)
iFlow = Index
End Sub
##################################################
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTerminal
Caption = "Visual Basic Terminal"
ClientHeight = 4935
ClientLeft = 2940
ClientTop = 2055
ClientWidth = 7155
ForeColor = &H00000000&
Icon = "vbterm.frx":0000
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4935
ScaleWidth = 7155
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 2000
Left = 210
Top = 3645
End
Begin VB.TextBox txtTerm
Height = 3690
Left = 1245
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 3
Top = 1140
Width = 5790
End
Begin MSComctlLib.Toolbar tbrToolBar
Align = 1 'Align Top
Height = 390
Left = 0
TabIndex = 1
Top = 0
Width = 7155
_ExtentX = 12621
_ExtentY = 688
ButtonWidth = 609
ButtonHeight = 582
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 10
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
Value = 1
MixedState = -1 'True
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "OpenLogFile"
Description = "Open Log File..."
Object.ToolTipText = "Open Log File..."
ImageIndex = 1
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "CloseLogFile"
Description = "Close Log File"
Object.ToolTipText = "Close Log File"
ImageIndex = 2
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
Value = 1
MixedState = -1 'True
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "DialPhoneNumber"
Description = "Dial Phone Number..."
Object.ToolTipText = "Dial Phone Number..."
ImageIndex = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "HangUpPhone"
Description = "Hang Up Phone"
Object.ToolTipText = "Hang Up Phone"
ImageIndex = 4
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
Value = 1
MixedState = -1 'True
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Properties"
Description = "Properties..."
Object.ToolTipText = "Properties..."
ImageIndex = 5
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
Value = 1
MixedState = -1 'True
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Key = "TransmitTextFile"
Description = "Transmit Text File..."
Object.ToolTipText = "Transmit Text File..."
ImageIndex = 6
EndProperty
EndProperty
Begin VB.Frame Frame1
BorderStyle = 0 'None
Caption = "Frame1"
Height = 240
Left = 4000
TabIndex = 2
Top = 75
Width = 240
Begin VB.Image imgConnected
Height = 240
Left = 0
Picture = "vbterm.frx":030A
Stretch = -1 'True
ToolTipText = "Toggles Port"
Top = 0
Width = 240
End
Begin VB.Image imgNotConnected
Height = 240
Left = 0
Picture = "vbterm.frx":0454
Stretch = -1 'True
ToolTipText = "Toggles Port"
Top = 0
Width = 240
End
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 165
Top = 1815
End
Begin MSCommLib.MSComm MSComm1
Left = 45
Top = 510
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
NullDiscard = -1 'True
RThreshold = 1
RTSEnable = -1 'True
SThreshold = 1
InputMode = 1
End
Begin MSComDlg.CommonDialog OpenLog
Left = 105
Top = 1170
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "LOG"
FileName = "Open Communications Log File"
Filter = "Log File (*.log)|*.log;"
FilterIndex = 501
FontSize = 9.02458e-38
End
Begin MSComctlLib.StatusBar sbrStatus
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 0
Top = 4620
Width = 7155
_ExtentX = 12621
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 2
Text = "Status:"
TextSave = "Status:"
Key = "Status"
Object.ToolTipText = "Communications Port Status"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 8310
MinWidth = 2
Text = "Settings:"
TextSave = "Settings:"
Key = "Settings"
Object.ToolTipText = "Communications Port Settings"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 2
Object.Width = 1244
MinWidth = 1244
Key = "ConnectTime"
Object.ToolTipText = "Connect Time"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 165
Top = 2445
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":059E
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":08B8
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":0BD2
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":0EEC
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":1206
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "vbterm.frx":1520
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuOpenLog
Caption = "&Open Log File..."
End
Begin VB.Menu mnuCloseLog
Caption = "&Close Log File"
Enabled = 0 'False
End
Begin VB.Menu M3
Caption = "-"
End
Begin VB.Menu mnuSendText
Caption = "&Transmit Text File..."
Enabled = 0 'False
End
Begin VB.Menu Bar2
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuPort
Caption = "&CommPort"
Begin VB.Menu mnuOpen
Caption = "Port &Open"
End
Begin VB.Menu MBar1
Caption = "-"
End
Begin VB.Menu mnuProperties
Caption = "Properties..."
End
End
Begin VB.Menu mnuMSComm
Caption = "&MSComm"
Begin VB.Menu mnuInputLen
Caption = "&InputLen..."
End
Begin VB.Menu mnuRThreshold
Caption = "&RThreshold..."
End
Begin VB.Menu mnuSThreshold
Caption = "&SThreshold..."
End
Begin VB.Menu mnuParRep
Caption = "P&arityReplace..."
End
Begin VB.Menu mnuDTREnable
Caption = "&DTREnable"
End
Begin VB.Menu Bar3
Caption = "-"
End
Begin VB.Menu mnuHCD
Caption = "&CDHolding..."
End
Begin VB.Menu mnuHCTS
Caption = "CTSH&olding..."
End
Begin VB.Menu mnuHDSR
Caption = "DSRHo&lding..."
End
End
Begin VB.Menu mnuCall
Caption = "C&all"
Begin VB.Menu mnuDial
Caption = "&Dial Phone Number..."
End
Begin VB.Menu mnuHangUp
Caption = "&Hang Up Phone"
Enabled = 0 'False
End
End
End
Attribute VB_Name = "frmTerminal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' by Don Malin and Carl Franklin.
'
' Updated by Mike Maddox
'--------------------------------------------------
Option Explicit
Dim Ret As Integer ' Scratch integer.
Dim Temp As String ' Scratch string.
Dim hLogFile As Integer ' Handle of open log file.
Dim StartTime As Date ' Stores starting time for port timer
Private Sub Form_Load()
Dim CommPort As String, Handshaking As String, Settings As String
On Error Resume Next
' Set the default color for the terminal
txtTerm.SelLength = Len(txtTerm)
txtTerm.SelText = ""
txtTerm.ForeColor = vbBlue
' Set Title
App.Title = "Visual Basic Terminal"
' Set up status indicator light
imgNotConnected.ZOrder
' Center Form
frmTerminal.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
' Load Registry Settings
Settings = GetSetting(App.Title, "Properties", "Settings", "") ' frmTerminal.MSComm1.Settings]\
If Settings <> "" Then
MSComm1.Settings = Settings
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
CommPort = GetSetting(App.Title, "Properties", "CommPort", "") ' frmTerminal.MSComm1.CommPort
If CommPort <> "" Then MSComm1.CommPort = CommPort
Handshaking = GetSetting(App.Title, "Properties", "Handshaking", "") 'frmTerminal.MSComm1.Handshaking
If Handshaking <> "" Then
MSComm1.Handshaking = Handshaking
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
Echo = GetSetting(App.Title, "Properties", "Echo", "") ' Echo
On Error GoTo 0
End Sub
Private Sub Form_Resize()
' Resize the Term (display) control
TxtTerm. Move 0, tbrToolBar. Height, frmTerminal. ScaleWidth, frmTerminal. ScaleHeight - sbrStatus. Height - tbrToolBar. Height
' Position the status indicator light
Frame1.Left = ScaleWidth - Frame1.Width * 1.5
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim Counter As Long
If MSComm1.PortOpen Then
' Wait 10 seconds for data to be transmitted.
Counter = Timer + 10
Do While MSComm1.OutBufferCount
Ret = DoEvents()
If Timer > Counter Then
Select Case MsgBox("Data cannot be sent", 34)
' Cancel.
Case 3
Cancel = True
Exit Sub
' Retry.
Case 4
Counter = Timer + 10
' Ignore.
Case 5
Exit Do
End Select
End If
Loop
MSComm1.PortOpen = 0
End If
' If the log file is open, flush and close it.
If hLogFile Then mnuCloseLog_Click
End
End Sub
Private Sub imgConnected_Click()
' Call the mnuOpen_Click routine to toggle connect and disconnect
Call mnuOpen_Click
End Sub
Private Sub imgNotConnected_Click()
' Call the mnuOpen_Click routine to toggle connect and disconnect
Call mnuOpen_Click
End Sub
Private Sub mnuCloseLog_Click()
' Close the log file.
Close hLogFile
hLogFile = 0
mnuOpenLog.Enabled = True
tbrToolBar.Buttons("OpenLogFile").Enabled = True
mnuCloseLog.Enabled = False
tbrToolBar.Buttons("CloseLogFile").Enabled = False
frmTerminal.Caption = "Visual Basic Terminal"
End Sub
Private Sub mnuDial_Click()
On Local Error Resume Next
Static Num As String
Num = "0091-124-635308" ' This is the MSDN phone number
' Get a number from the user.
Num = InputBox$("Enter Phone Number:", "Dial Number", Num)
If Num = "" Then Exit Sub
' Open the port if it isn't already open.
If Not MSComm1.PortOpen Then
mnuOpen_Click
If Err Then Exit Sub
End If
' Enable hang up button and menu item
mnuHangUp.Enabled = True
tbrToolBar.Buttons("HangUpPhone").Enabled = True
' Dial the number.
MSComm1.Output = "ATDT" & Num & vbCrLf
' Start the port timer
StartTiming
End Sub
' Toggle the DTREnabled property.
Private Sub mnuDTREnable_Click()
' Toggle DTREnable property
MSComm1.DTREnable = Not MSComm1.DTREnable
mnuDTREnable.Checked = MSComm1.DTREnable
End Sub
Private Sub mnuFileExit_Click()
' Use Form_Unload since it has code to check for unsent data and an open log file.
Form_Unload Ret
End Sub
' Toggle the DTREnable property to hang up the line.
Private Sub mnuHangup_Click()
On Error Resume Next
MSComm1.Output = "ATH" ' Send hangup string
Ret = MSComm1.DTREnable ' Save the current setting.
MSComm1.DTREnable = True ' Turn DTR on.
MSComm1.DTREnable = False ' Turn DTR off.
MSComm1.DTREnable = Ret ' Restore the old setting.
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
' If port is actually still open, then close it
If MSComm1.PortOpen Then MSComm1.PortOpen = False
' Notify user of error
If Err Then MsgBox Error$, 48
mnuSendText.Enabled = False
tbrToolBar.Buttons("TransmitTextFile").Enabled = False
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
sbrStatus.Panels("Settings").Text = "Settings: "
' Turn off indicator light and uncheck open menu
mnuOpen.Checked = False
imgNotConnected.ZOrder
' Stop the port timer
StopTiming
sbrStatus.Panels("Status").Text = "Status: "
On Error GoTo 0
End Sub
' Display the value of the CDHolding property.
Private Sub mnuHCD_Click()
If MSComm1.CDHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "CDHolding = " + Temp
End Sub
' Display the value of the CTSHolding property.
Private Sub mnuHCTS_Click()
If MSComm1.CTSHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "CTSHolding = " + Temp
End Sub
' Display the value of the DSRHolding property.
Private Sub mnuHDSR_Click()
If MSComm1.DSRHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "DSRHolding = " + Temp
End Sub
' This procedure sets the InputLen property, which determines how
' many bytes of data are read each time Input is used
' to retreive data from the input buffer.
' Setting InputLen to 0 specifies that
' the entire contents of the buffer should be read.
Private Sub mnuInputLen_Click()
On Error Resume Next
Temp = InputBox$("Enter New InputLen:", "InputLen", Str$(MSComm1.InputLen))
If Len(Temp) Then
MSComm1.InputLen = Val(Temp)
If Err Then MsgBox Error$, 48
End If
End Sub
Private Sub mnuProperties_Click()
' Show the CommPort properties form
frmProperties.Show vbModal
End Sub
' Toggles the state of the port (open or closed).
Private Sub mnuOpen_Click()
On Error Resume Next
Dim OpenFlag
MSComm1.PortOpen = Not MSComm1.PortOpen
If Err Then MsgBox Error$, 48
OpenFlag = MSComm1.PortOpen
mnuOpen.Checked = OpenFlag
mnuSendText.Enabled = OpenFlag
tbrToolBar.Buttons("TransmitTextFile").Enabled = OpenFlag
If MSComm1.PortOpen Then
' Enable dial button and menu item
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
' Enable hang up button and menu item
mnuHangUp.Enabled = True
tbrToolBar.Buttons("HangUpPhone").Enabled = True
imgConnected.ZOrder
sbrStatus.Panels("Settings").Text = "Settings: " & MSComm1.Settings
StartTiming
Else
' Enable dial button and menu item
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
' Disable hang up button and menu item
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
imgNotConnected.ZOrder
sbrStatus.Panels("Settings").Text = "Settings: "
StopTiming
End If
End Sub
Private Sub mnuOpenLog_Click()
Dim replace
On Error Resume Next
OpenLog.Flags = cdlOFNHideReadOnly Or cdlOFNExplorer
OpenLog.CancelError = True
' Get the log filename from the user.
OpenLog.DialogTitle = "Open Communications Log File"
OpenLog.Filter = "Log Files (*.LOG)|*.log|All Files (*.*)|*.*"
Do
OpenLog.FileName = ""
OpenLog.ShowOpen
If Err = cdlCancel Then Exit Sub
Temp = OpenLog.FileName
' If the file already exists, ask if the user wants to overwrite the file or add to it.
Ret = Len(Dir$(Temp))
If Err Then
MsgBox Error$, 48
Exit Sub
End If
If Ret Then
replace = MsgBox("Replace existing file - " + Temp + "?", 35)
Else
replace = 0
End If
Loop While replace = 2
' User clicked the Yes button, so delete the file.
If replace = 6 Then
Kill Temp
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
' Open the log file.
hLogFile = FreeFile
Open Temp For Binary Access Write As hLogFile
If Err Then
MsgBox Error$, 48
Close hLogFile
hLogFile = 0
Exit Sub
Else
' Go to the end of the file so that new data can be appended.
Seek hLogFile, LOF(hLogFile) + 1
End If
frmTerminal.Caption = "Visual Basic Terminal - " + OpenLog.FileTitle
mnuOpenLog.Enabled = False
tbrToolBar.Buttons("OpenLogFile").Enabled = False
mnuCloseLog.Enabled = True
tbrToolBar.Buttons("CloseLogFile").Enabled = True
End Sub
' This procedure sets the ParityReplace property, which holds the
' character that will replace any incorrect characters
' that are received because of a parity error.
Private Sub mnuParRep_Click()
On Error Resume Next
Temp = InputBox$("Enter Replace Character", "ParityReplace", frmTerminal.MSComm1.ParityReplace)
frmTerminal.MSComm1.ParityReplace = Left$(Temp, 1)
If Err Then MsgBox Error$, 48
End Sub
' This procedure sets the RThreshold property, which determines
' how many bytes can arrive at the receive buffer before the OnComm
' event is triggered and the CommEvent property is set to comEvReceive.
Private Sub mnuRThreshold_Click()
On Error Resume Next
Temp = InputBox$("Enter New RThreshold:", "RThreshold", Str$(MSComm1.RThreshold))
If Len(Temp) Then
MSComm1.RThreshold = Val(Temp)
If Err Then MsgBox Error$, 48
End If
End Sub
Comment from bpouydog Date: 03/25/2001 03:55AM PST
Here I've provided the complete vb code for a program that logs the incoming and outgoing phone calls chronologically into an access database. Before executing the code do the following to test ur modem.
To test your modem using HyperTerminal (which comes with
Windows) follow this procedure:
Using HyperTerminal, (Found under Programs, Accessories,
HyperTerminal in
Windows 95 or Programs, Accessories, Communications,
HyperTerminal in
Windows 98), follow these instructions:
1. Open the Hyper Terminal Group
2. Double click the Hyperterm.exe icon
3. For name enter CALLER ID
4. Choose OK
5. From the Connect Using drop down box, pick your modem or
the "direct to
the Com port X" which your external modem is connected and
Click OK
6. Choose OK on the Com Port Settings Screen
7. Enter ATZ followed by the ENTER key You should get an OK (If
you do not
receive an OK, check to see that your modem is not in use by
another program
and verify that you selected the correct modem/COM Port for
your modem.)
8. Then enter AT#CID=1 followed by ENTER key. You should receive
an OK. If you
do not receive an OK your modem will not work with this
application.
Then call your modem and you should get caller id data something
like this:
RING
RING
DATE = 0331
TIME = 1245
NMBR = 9543447665
NAME = YES TELECOM
##################################################
VB detecting outgoing phone calls using modem?
VB Caller ID Source Code
Option Explicit
'Private Variables
Public fo As FileSystemObject
Public db As Database
Public wrk As Workspace
Public rs As Recordset
Public idx As Index
Public m_stDataPath As String
Public bEcho As Boolean 'public echo flag for com
Public bOK As Boolean
Public bRing As Boolean
Public bError As Boolean
Public iRingTime As Single
'Private Constants
Private Const DefDataPath = "C:\"
Private Sub Form_Load()
'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)
frmLineInfo.CallName.Text = ""
frmLineInfo.Number.Text = ""
frmLineInfo.DateTime.Text = ""
OpenDataBase
End Sub
Private Sub Connect_Click()
If (Connect.Caption = "&Connect") Then ' This menu item will open or close the com port
On Error GoTo 0
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.DTREnable = True
Comm1.RTSEnable = True
Comm1. RThreshold = 1 ' Generate a receive event on every character received
Comm1.InputLen = 1 ' Read the receive buffer 1 char at a time
bOK = False
bError = False
Comm1.Output = vbCr + "ATZ" + vbCr ' Reset modem
Wait
If bOK Then
bOK = False
bError = False
Comm1.Output = "AT#CID=1" + vbCr 'Turn on caller id events
Wait
If bError Then
MsgBox "Port " + Comm1.CommPort + ": Modem not Caller ID enabled"
Comm1.PortOpen = False ' Close the port and update app UI
Connect.Caption = "&Connect" ' Change the menu to reflect opposite of port status
ElseIf bOK Then
Connect.Caption = "Dis&connect" ' Change the menu to reflect opposite of port status
End If
Else
MsgBox "Port " + Str(Comm1.CommPort) + " not responding"
Comm1.DTREnable = False
Comm1.RTSEnable = False
Comm1.PortOpen = False ' Close the port and update app UI
Connect.Caption = "&Connect" ' Change the menu to reflect opposite of port status
End If
Else
Comm1.DTREnable = False
Comm1.RTSEnable = False
Comm1.PortOpen = False ' Close the port and update app UI
Connect.Caption = "&Connect" ' Change the menu to reflect opposite of port status
End If
End Sub
Private Sub ProcessEvent(stEvent As String)
Dim stNumber As String
ModemEvents.AddItem stEvent 'Add Modem event to event listbox
Select Case stEvent
Case "OK"
bOK = True
Case "ERROR"
bError = True
Case "RING"
If bRing = False Then
frmLineInfo.DateTime.Text = Now
bRing = True
End If
iRingTime = Timer
Case Else
Select Case Left(stEvent, 4)
Case "TIME"
Case "DATE"
Case "NMBR"
stNumber = Mid(stEvent, 8)
If Len(stNumber) = 10 Then
frmLineInfo.Number.Text = "(" + Left(stNumber, 3) + ") " + Mid(stNumber, 4, 3) + "-" + Right(stNumber, 4)
Else
frmLineInfo.Number.Text = stNumber
End If
Case "NAME"
frmLineInfo.CallName.Text = Mid(stEvent, 8)
End Select
End Select
End Sub
Private Sub ClearEvents_Click()
ModemEvents.Clear
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub comm1_OnComm()
Static stEvent As String 'storage for an Modem event
Dim stComChar As String * 1 'temporary storage for received comm port data
Select Case Comm1.CommEvent
Case comEvReceive ' Received RThreshold # of chars.
Do
stComChar = Comm1.Input 'read 1 character .Inputlen = 1
Select Case stComChar
Case vbLf 'Ignore linefeeds
Case vbCr 'The CR indicates the end of the Receive String
If Len(stEvent) > 0 Then
ProcessEvent stEvent 'Process the Modem event
stEvent = ""
End If
Case Else
stEvent = stEvent + stComChar 'Save everything between CR's
End Select
Loop While Comm1.InBufferCount 'Loop until all characters in receive buffer are processed
'----------------------------------------------------------------------------------------------
'The following communication events are ignored.
'In normal 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 Wait()
Dim Start
Start = Timer
Do While Timer < Start + 2
DoEvents
If bOK Then
Exit Sub
End If
If bError Then
Exit Sub
End If
Loop
End Sub
Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Comm1.PortOpen Then
Comm1.PortOpen = 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 Properties_Click()
Load frmProperties
frmProperties.Show
End Sub
Private Sub OpenDataBase()
Set fo = New...