VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form2 
   BackColor       =   &H00FFFFFF&
   Caption         =   "مركز كنترل خطوط - 1-2010"
   ClientHeight    =   4212
   ClientLeft      =   60
   ClientTop       =   456
   ClientWidth     =   6228
   Icon            =   "Form2.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   RightToLeft     =   -1  'True
   ScaleHeight     =   4212
   ScaleWidth      =   6228
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command4 
      Caption         =   "Sample Code divide String"
      Height          =   396
      Left            =   144
      RightToLeft     =   -1  'True
      TabIndex        =   5
      Top             =   3168
      Width           =   5868
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   1215
      Top             =   90
   End
   Begin VB.Timer Timer1 
      Interval        =   200
      Left            =   675
      Top             =   60
   End
   Begin VB.TextBox Tport 
      Alignment       =   1  'Right Justify
      BackColor       =   &H0080C0FF&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9.6
         Charset         =   178
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   3390
      RightToLeft     =   -1  'True
      TabIndex        =   4
      Text            =   "1"
      Top             =   3735
      Width           =   495
   End
   Begin VB.CommandButton Command1 
      Caption         =   "پاك كردن ليست"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.4
         Charset         =   178
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      RightToLeft     =   -1  'True
      TabIndex        =   2
      Top             =   3720
      Width           =   1455
   End
   Begin VB.ListBox TelList 
      BackColor       =   &H003F7533&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.4
         Charset         =   178
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   2496
      ItemData        =   "Form2.frx":17D2A
      Left            =   60
      List            =   "Form2.frx":17D31
      RightToLeft     =   -1  'True
      TabIndex        =   0
      Top             =   528
      Width           =   6012
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   75
      Top             =   15
      _ExtentX        =   995
      _ExtentY        =   995
      _Version        =   393216
      DTREnable       =   -1  'True
      BaudRate        =   57600
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "شماره پورت دستگاه كالرآيدي:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.4
         Charset         =   178
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3945
      RightToLeft     =   -1  'True
      TabIndex        =   3
      Top             =   3765
      Width           =   2040
   End
   Begin VB.Label L1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Caption         =   " اطلاعات دريافتي از خط تلفن..."
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.4
         Charset         =   178
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3990
      RightToLeft     =   -1  'True
      TabIndex        =   1
      Top             =   210
      Width           =   2145
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CallerIdPort As String
Dim Flash As Byte
Dim divider_string As String
Dim Timer_Counter As Byte
Dim main_string, recieve_string
Dim s, Number As String

Private Sub Command1_Click()
TelList.Clear
End Sub
Private Sub Command4_Click()
'Call divide_string("L1:Ring=1@")
Call divide_string("L1:05118429624@ L1:Ring:1@")
End Sub

Private Sub Form_Load()
divider_string = "*"
TelList.Clear
MSComm1.CommPort = 6
MSComm1.Settings = "57600,N,8,1"
MSComm1.RThreshold = 1
MSComm1.InputLen = 0
MSComm1.Handshaking = comNone
MSComm1.InputMode = comInputModeText
On Error GoTo porterror
MSComm1.PortOpen = True
Exit Sub
porterror:
Call MsgBox("كاربر گرامي، شماره پورت دستگاه كالرآيدي اشتباه تنظيم شده است و يا دستگاه به سيستم متصل نيست. لطفا شماره پورت را اصلاح كنيد", vbCritical, "توجه")
Timer1.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call MsgBox("با بسته شدن اين پنجره کالرآيدي از کار خواهد افتاد", vbInformation, "توجه")
If Form2.MSComm1.PortOpen = True Then Form2.MSComm1.PortOpen = False
End
End Sub
Public Sub divide_string(ByRef recieve_string)
Dim end_string_flag, recieve_text, at_position
Dim current_text, number_string
end_string_flag = True
number_string = 0
While end_string_flag
        at_position = InStr(recieve_string, divider_string)
        current_text = Mid$(recieve_string, 1, at_position)
         If current_text <> "" Then Call Get_CallerID(current_text)
         recieve_string = Mid$(recieve_string, at_position + 1)
      If (InStr(recieve_string, divider_string) <> 0) Then
                end_string_flag = True
            Else
                end_string_flag = False
       End If
Wend
End Sub

Private Sub MSComm1_OnComm()
InputStr = InputStr & MSComm1.Input
TelList.AddItem InputStr
End Sub

Private Sub Timer1_Timer()
Exit Sub
   ' recieve_string = Text2.Text
    recieve_string = MSComm1.Input
    If (recieve_string <> "") Then
        Timer_Counter = 0
        main_string = main_string & recieve_string
        recieve_string = ""
        Timer2.Enabled = True
        Flash = 0
    Else
        If main_string <> "" Then '(read_flag) Then
                Timer_Counter = Timer_Counter + 1
                Call divide_string(main_string)
                If Timer_Counter > 10 Then
                    main_string = ""
                    Timer_Counter = 0
                End If
         End If
    End If
End Sub
Public Sub RemoveZero(ByRef Str As String)
If Len(Str) = 0 Then Exit Sub
Do While (Asc(Left(Str, 1)) < 48)
    Str = Right(Str, Len(Str) - 1)
    If (Len(Str) = 0) Then Exit Do
Loop
While Left(Str, 1) = "0"
    Str = Right(Str, Len(Str) - 1)
Wend

End Sub

Public Sub Get_CallerID(ByVal strin As String)
Dim CallerID As String
CallerID = strin
If InStr(strin, ":") = 0 Then
    ProtecolType = 1
Else
    ProtecolType = 2
End If
If InStr(1, CallerID, "T") > 0 Then Exit Sub
If InStr(1, CallerID, "P") > 0 Then Exit Sub

Dim num1 As String
Dim num2 As String
Dim Start_Line As Byte
Dim Line As Byte
If Len(CallerID) < 7 Then Exit Sub
Call RemoveZero(CallerID)
Line = Val(Mid(CallerID, 2, 1))
LineNumber = Line
If divider_string = "@" Then
    If ProtecolType = 1 Then
        CallerID = Right(CallerID, Len(CallerID) - 2) ' 2 or 3
    Else
        CallerID = Right(CallerID, Len(CallerID) - 3) ' 2 or 3
    End If
Else
    CallerID = Right(CallerID, Len(CallerID) - 2)
End If
Call RemoveZero(CallerID)
If m_OnlyCallerIDDetect = False Then
    If InStr(strin, "Ring") > 0 Then
          Ring1 = InStr(strin, ":")
          Ring1 = Ring1 + 1
          Ring2 = InStr(strin, "@")
          TelList.AddItem LineNumber & " - " & Mid(strin, Ring1, Ring2 - Ring1)
         
          Exit Sub
    End If
    If InStr(strin, "Offhook") > 0 Then
          TelList.AddItem LineNumber & " - " & "Offhook"
          Exit Sub
    End If
    If InStr(strin, "Onhook") > 0 Then
          TelList.AddItem LineNumber & " - " & "Onhook"
          Exit Sub
    End If
     If InStr(strin, "Dialed") > 0 Then
          TelList.AddItem LineNumber & " - " & Left(CallerID, Len(CallerID) - 1)
          Exit Sub
    End If
End If
'--- CallerId Number Detect ----
Do While (Asc(Left(CallerID, 1)) > 47) And (Asc(Left(CallerID, 1)) < 58)
    num1 = num1 & Left(CallerID, 1)
    CallerID = Right(CallerID, Len(CallerID) - 1)
    If Len(CallerID) = 0 Then Exit Do
Loop
Call RemoveZero(num1)
If Len(num1) < 9 Then Exit Sub
TelList.AddItem LineNumber & " - " & num1
End Sub

Public Function ProccessNumber(ByVal strin As String) As String
If Left(strin, 2) = "98" Then strin = Right(strin, Len(strin) - 2)
Call RemoveZero(strin)
'--- Detect Mobile Call ----
If Left(strin, 1) = "9" Then
    ProccessNumber = "0" & strin
Else
    If Left(strin, 3) = "511" Then
        strin = Right(strin, Len(strin) - 3)
    ElseIf Left(strin, 3) = "21" Then
        strin = Right(strin, Len(strin) - 2)
    End If
    ProccessNumber = strin
End If
End Function

Private Sub Timer2_Timer()
If Flash = 3 Then Timer2.Enabled = False
Flash = Flash + 1
If L1.BackColor = &HFFFFFF Then
    L1.BackColor = &H80FF80
Else
    L1.BackColor = &HFFFFFF
End If
End Sub
