Form Error

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 6810
ClientLeft = 5595
ClientTop = 1200
ClientWidth = 8925
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6810
ScaleWidth = 8925
Begin VB.Timer tmrReadFromSIM
Interval = 5000
Left = 3330
Top = 3210
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
Height = 360
Left = 3315
TabIndex = 10
Top = 2760
Width = 780
End
Begin VB.TextBox txtIdxNo
Height = 330
Left = 1800
TabIndex = 9
Top = 2775
Width = 645
End
Begin VB.CommandButton cmdRead
Caption = "Read"
Height = 360
Left = 2490
TabIndex = 8
Top = 2760
Width = 780
End
Begin VB.Timer Timer5
Interval = 1000
Left = 2070
Top = 2985
End
Begin VB.TextBox txtResponse
Height = 6135
Left = 4200
MultiLine = -1 'True
TabIndex = 7
Top = 450
Width = 4710
End
Begin VB.ListBox lstMessage
Height = 2985
Left = 315
TabIndex = 5
Top = 3585
Width = 3855
End
Begin VB.CommandButton cmdSend
Caption = "Send"
Height = 360
Left = 330
TabIndex = 4
Top = 2760
Width = 1005
End
Begin VB.TextBox txtMsg
Height = 1575
Left = 330
TabIndex = 2
Top = 1125
Width = 3780
End
Begin VB.TextBox txtNumber
Height = 345
Left = 345
TabIndex = 0
Top = 465
Width = 3765
End
Begin MSCommLib.MSComm msCOMMSIM
Left = 3765
Top = 6240
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
Handshaking = 2
BaudRate = 115200
End
Begin VB.Label lblMsgList
Caption = "Message List"
Height = 225
Left = 345
TabIndex = 6
Top = 3285
Width = 1350
End
Begin VB.Label Label2
Caption = "Message"
Height = 270
Left = 330
TabIndex = 3
Top = 885
Width = 1275
End
Begin VB.Label Label1
Caption = "Cell Number"
Height = 270
Left = 345
TabIndex = 1
Top = 165
Width = 1275
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type SMSDataStructure
SMSDS_CallerID As String
SMSDS_Type As String
SMSDS_Request As String
SMSDS_RequestDT As String
SMSDS_Response As String
SMSDS_ResponseDT As String
SMSDS_Status As String
SMSDS_SenderName As String 'Name read from addressbook when
at+cmgr=<sim no.> command is used
End Type


Enum ENUM_RequestType
enmInitialization = 0
enmReadFromSIM = 1
enmSendToSIM = 2
enmDeleteFromSIM = 3
enmHangupLine = 4
End Enum

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim SMSData As SMSDataStructure
Public mstrInputOne As String
Const constWait4Reply = 7
Public blnResponse As Boolean

Private Sub cmdDelete_Click()

fncRequestToCOM msCOMMSIM, enmDeleteFromSIM, CInt(txtIdxNo.Text)

tmpTimer = "": tmpTimer = Timer + constWait4Reply
Do Until Timer > tmpTimer
'If blnGoForRespGen = True Then tmpTimer = "": Exit Do
DoEvents
Loop

'=========================================================
'Get SMS from Sim Card
'=========================================================
Call Timer5_Timer
'=========================================================
End Sub

Private Sub cmdRead_Click()

Dim tmpTimer

fncRequestToCOM msCOMMSIM, enmReadFromSIM, CInt(txtIdxNo.Text)

tmpTimer = "": tmpTimer = Timer + constWait4Reply
Do Until Timer > tmpTimer
'If blnGoForRespGen = True Then tmpTimer = "": Exit Do
DoEvents
Loop

'=========================================================
'Get SMS from Sim Card
'=========================================================
Call Timer5_Timer
'=========================================================

End Sub

Private Sub cmdSend_Click()
Send_SMS_Command txtNumber, txtMsg.Text, "", ""
End Sub

Private Sub Form_Load()

msCOMMSIM.PortOpen = True

fncRequestToCOM msCOMMSIM, enmInitialization, 0

End Sub

Private Sub Form_Unload(Cancel As Integer)
Timer5.Enabled = False
End Sub

Private Sub msCOMMSIM_OnComm()
On Error GoTo ErrH

If ErrorFound() = True Then
'If Len(FrmOnlineStatus.txtFault.Text) > 30000 Then
FrmOnlineStatus.txtFault.Text = Right(FrmOnlineStatus.txtFault.Text,
Len(FrmOnlineStatus.txtFault.Text) - 5000)
'FrmOnlineStatus.txtFault.Text = "Output One -> " &
FrmOnlineStatus.txtFault.Text & mErrorMsg & vbCrLf & "Error corrected." &
" - " & Now & vbCrLf
'FrmOnlineStatus.txtFault.SelStart =
Len(FrmOnlineStatus.txtFault.Text)
Else
Select Case msCOMMSIM.CommEvent
' Events
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 comEvReceive ' Received RThreshold # of chars.
WriteSMDRDataOutPut
Case comEvSend ' There are SThreshold number of characters in
the transmit buffer.
Case comEvEOF ' An EOF charater was found in ' the input
stream
End Select
End If

Exit Sub

ErrH:
'ErrLog "frmSupervisor->msCOMMSIM_OnComm() - Error # : " & Err.Number
& ", Description : " & Err.Description & ", Source : " & Err.Source
End Sub

Private Sub WriteSMDRDataOutPut()
On Error GoTo ErrH

Dim ComString As String
Dim splt
Dim sSlotNo As String
Dim tmpTimer
Dim strCallText As String
Dim arrParseData() As String
Dim varTempData, varTemp
Dim sData As String

ComString = msCOMMSIM.Input

txtResponse.Text = ComString & vbCrLf & txtResponse.Text

mstrInputOne = ""

If ComString Like "*+CMTI: " & Chr(34) & "SM" & Chr(34) & "*" Then

''''' splt = Split(ComString, ",")
'''''
''''' If UBound(splt) > 0 Then
'''''
''''' sSlotNo = splt(UBound(splt))
''''' sSlotNo = Replace(sSlotNo, "", Chr(13))
''''' sSlotNo = Replace(sSlotNo, "", Chr(10))
''''' splt = Split(sSlotNo, Chr(13))
'''''
''''' sSlotNo = splt(0)
'''''
''''' If IsNumeric(sSlotNo) = True Then
'''''
''''' MakeSMSDataEmpty
'''''
''''' 'Request to Read SMS
''''' Call fncRequestToCOM(msCOMMSIM,
enmReadFromSIM, CInt(sSlotNo))
'''''
''''' tmpTimer = "": tmpTimer = Timer +
constWait4Reply
''''' Do Until Timer > tmpTimer
''''' 'If blnGoForRespGen = True Then tmpTimer
= "": Exit Do
''''' DoEvents
''''' Loop
'''''
'''''
'=========================================================
''''' 'Get SMS from Sim Card
'''''
'=========================================================
''''' Call Timer5_Timer
'''''
'=========================================================
'''''
''''' 'Delete SMS
''''' Call fncRequestToCOM(msCOMMSIM,
enmDeleteFromSIM, CInt(sSlotNo))
'''''
''''' '''' Wait for few seconds
''''' tmpTimer = ""
''''' tmpTimer = Timer + constWait4Reply
''''' Do Until Timer > tmpTimer
''''' DoEvents
''''' Loop
'''''
''''' tmpTimer = ""
'''''
''''' End If
'''''
''''' End If
End If

mstrInputOne = mstrInputOne & ComString 'for Live Processing

strCallText = mstrInputOne


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Read SMS

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
arrParseData = Split(strCallText, ",")

If UCase(Right(arrParseData(0), 5)) = UCase("READ") & Chr(34) Then

SMSData.SMSDS_CallerID = Replace(arrParseData(1), Chr(34), "")

''Check for date
arrParseData(3) = Replace(arrParseData(3), Chr(34), "")
SMSData.SMSDS_RequestDT = Format(DateSerial(Mid(arrParseData(3),
1, 2), Mid(arrParseData(3), 4, 2), Mid(arrParseData(3), 7, 2)),
"yyyy-MM-dd")

''check for time
varTempData = Replace(Mid(arrParseData(4), 1, InStr(1,
arrParseData(4), Chr(34))), Chr(34), "")
varTempData = Format(Left(varTempData, 8), "HH:mm:ss")

SMSData.SMSDS_RequestDT = SMSData.SMSDS_RequestDT & " " &
varTempData

''check for Request
varTempData = Mid(arrParseData(4), InStr(1, arrParseData(4),
Chr(34)) + 1, Len(arrParseData(4)))
varTempData = Replace(varTempData, vbCrLf, "")
If UCase(Right(varTempData, 2)) = UCase("OK") Then
varTempData = Mid(varTempData, 1, Len(varTempData) - 2)
End If

If UBound(arrParseData) > 4 Then
Dim i As Byte

For i = 5 To UBound(arrParseData)
'arrParseData (i)
arrParseData(i) = Mid(arrParseData(i), 1,
InStr(arrParseData(i), vbCrLf & vbCrLf & "OK") - 1)
varTemp = Replace(arrParseData(i), vbCrLf, "")

varTempData = varTempData & "," & varTemp
Next i
End If

'sometimes varTempData contains OK+CMTI: "SM",1 - use following
lines to avoid this data
Dim intCnt As Integer
intCnt = InStr(varTempData, "OK+CMTI:")
If intCnt > 0 Then
varTempData = Mid(varTempData, 1, intCnt)
End If

SMSData.SMSDS_Request = varTempData

sData = SMSData.SMSDS_CallerID & "," & SMSData.SMSDS_Request & ","
& SMSData.SMSDS_RequestDT

MakeFile SMSData.SMSDS_CallerID & "#" &
Replace(SMSData.SMSDS_RequestDT, ":", "-") & ".txt", sData

blnResponse = True

End If

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%




Exit Sub
ErrH:
'MsgBox Err.Description
Resume Next
End Sub



Public Function ErrorFound() As Boolean

Dim mErrorMsg As String

'Dim mErrorFound As Boolean
Select Case frmSupervisor.msCOMMSIM.CommEvent
' Errors
Case comEventBreak ' A Break was received.
mErrorMsg = "Communication Break received." & vbCrLf & "Please
check cable connection."
Case comEventCDTO ' CD (RLSD) Timeout.
mErrorMsg = "CD (RLSD) Timeout."
Case comEventCTSTO ' CTS Timeout.
mErrorMsg = "CTS Timeout."
Case comEventDSRTO ' DSR Timeout.
mErrorMsg = "DSR Timeout."
Case comEventFrame ' Framing Error
mErrorMsg = "Framing Error"
Case comEventOverrun ' Data Lost.
mErrorMsg = "Data Overrun: Changing to Overdrive State."
Case comEventRxOver ' Receive buffer overflow.
mErrorMsg = "Data Received: Changing to Overdrive State."
Case comEventRxParity ' Parity Error.
mErrorMsg = "Parity Error."
Case comEventTxFull ' Transmit buffer full.
mErrorMsg = "Transmit buffer full."
Case comEventDCB ' Unexpected error retrieving DCB
mErrorMsg = "Unexpected Communication Error. Corrected!"
Case Else
ErrorFound = False
Exit Function
End Select

ErrorFound = True

End Function


Public Function fncRequestToCOM(msCOM As MSComm, enmRType As
ENUM_RequestType, Optional intIndex As Integer) As Integer
On Error GoTo ErrH

Dim tmpTimer

Select Case enmRType

Case 0 'Initialization

'msCOM.Output = "at+clip=1"
'Sleep 100

msCOM.Output = "ATH" & vbCrLf
Sleep 100

'' tmpTimer = "": tmpTimer = Timer + 2
'' Do Until Timer > tmpTimer
'' 'If blnGoForRespGen = True Then tmpTimer = "": Exit
Do
'' DoEvents
'' Loop

msCOM.Output = "at+cmgf=1"
Sleep 100

'' tmpTimer = "": tmpTimer = Timer + 2
'' Do Until Timer > tmpTimer
'' 'If blnGoForRespGen = True Then tmpTimer = "": Exit
Do
'' DoEvents
'' Loop



'' tmpTimer = "": tmpTimer = Timer + 2
'' Do Until Timer > tmpTimer
'' 'If blnGoForRespGen = True Then tmpTimer = "": Exit
Do
'' DoEvents
'' Loop


Case 1 'ReadFromSIM

''MSCOM control will listen response of SIM
msCOM.Output = "AT+CMGR=" & intIndex & Chr(13)

Case 2 'SendToSIM

''vbCrLf - vbCr(set cursor to next line) + vbLf (insert one
line from current position of cursor)
' msCOM.Output = "AT+CMGS=" & SMSData.SMSDS_CallerID & vbCrLf &
SMSData.SMSDS_Response & Chr(26)

' msCOM.Output = "AT+CMGS=" & SMSData.SMSDS_CallerID & vbcr &
SMSData.SMSDS_Response & Chr(26)

'If GSMModem = VISIONTEK_FCT_ROUTER Then
msCOM.Output = "AT+CMGS=" & SMSData.SMSDS_CallerID &
Chr(13) & SMSData.SMSDS_Response & Chr(26)
'ElseIf GSMModem = MATRIX_GMS_ROUTER Then
' msCOM.Output = "AT+CMGS=" & Chr(34) &
SMSData.SMSDS_CallerID & Chr(34) & Chr(13) & SMSData.SMSDS_Response &
Chr(26)
'End If

Case 3 'DeleteFromSIM
msCOM.Output = "AT+CMGD=" & intIndex & vbCrLf
Sleep 200

Case 4 'Hangup Line
msCOM.Output = "ATH" 'Hangup Line

End Select

Exit Function

ErrH:
ErrLog "fncRequestToCOM() - Error # : " & Err.Number & ", Description
: " & Err.Description & ", Source : " & Err.Source
End Function


'Generate Error Log File
Public Function ErrLog(strLine As String)
On Error Resume Next

Dim AppPath As String, FreeFileNo%
Dim lgFName As String
Dim dDate As Date

dDate = Date - 2

'Check old log files exist or not
If FileExist(App.Path & "\" & "ErrLog-" & Format(dDate, "dd-MM-yyyy")
& ".log") = True Then
'Delete old log files
Kill App.Path & "\" & "ErrLog-" & Format(dDate, "dd-MM-yyyy") &
".log"
End If

lgFName = "ErrLog-" & Format(Now, "dd-MM-yyyy") & ".log"

If Right(App.Path, 1) <> "\" Then AppPath = App.Path & "\" Else
AppPath = App.Path

FreeFileNo = FreeFile

Open AppPath & "\" & lgFName For Append As #FreeFileNo
Print #FreeFileNo, Now, Space(1) & strLine
Close #FreeFileNo

End Function

Public Function FileExist(ByVal szFileName As String) As Boolean
Dim nFileNumber As Integer
On Error Resume Next
nFileNumber = FreeFile
Open szFileName For Input As nFileNumber
If Err.Number <> 0 Then
FileExist = False
Else
FileExist = True
End If
Close nFileNumber
End Function




'Developer : Dt: 11/02/2005
'Purpose : Send SMS Command to GSM Modem

Public Function Send_SMS_Command(StrCallerID As String, strSMS As String,
strUserID As String, strPcID As String) As Boolean

On Error GoTo ErrHandler


SMSData.SMSDS_CallerID = AV(StrCallerID)
SMSData.SMSDS_Response = AV(strSMS)


''Send SMS to SIM
bytLastCmd = enmSendToSIM: mstrInputOne = ""

WriteLog "Sending SMS : CallerID : " & StrCallerID & ", Message :
" & strSMS

Call fncRequestToCOM(msCOMMSIM, enmSendToSIM)

DoEvents

''''Wait for few seconds
TTP5:
'tmpTimer = "": tmpTimer = Timer + constWait4Reply
'Do Until Timer > tmpTimer
' If blnGoForDelete = True Then tmpTimer = "": Exit Do
' DoEvents
'Loop
'tmpTimer = ""
''''''???? Call Timer5_Timer

'Add SMS Request to Database

'''' If Len(Trim(SMSData.SMSDS_RequestDT)) = 0 Then
'''' SMSData.SMSDS_RequestDT = Format(Now, "dd/mm/yyyy
HH:MM:SS")
'''' End If
''''
''''
'''' fncInsertInTo ZDLL.AV(SMSData.SMSDS_RequestDT), 0,
ZDLL.AV(strSMS), 1, ZDLL.AV(StrCallerID), ZDLL.AV(strUserID),
ZDLL.AV(strPcID), IIf(mblnDenyShowOnScreen = True, 1, 0)
''''
''''
'*********************************************************************
'''' 'Added by On Dt : 16/07/2005
'''' 'Getting Last SMS Request ID for sending requested User
''''
'*********************************************************************
'''' rsRequestID.CursorLocation = adUseClient
'''' rsRequestID.Open "Select max(ST_ID) From SMSTransaction Where
ST_Type=0", ZIDLL.cnDb, adOpenDynamic, adLockReadOnly
''''
'''' If rsRequestID.RecordCount > 0 Then
'''' lstRequestID = rsRequestID.Fields(0)
'''' End If
''''
'*********************************************************************
''''
'''' 'Show SMS on Request Screen
'''' ShowOnScreen enmRequest, ZDLL.AV(StrCallerID),
ZDLL.AV(strUserID), ZDLL.AV(strSMS), ZDLL.AV("1"),
ZDLL.AV(SMSData.SMSDS_RequestDT), CDbl(lstRequestID)


Set rsRequestID = Nothing
Send_SMS_Command = True
Exit Function

ErrHandler:

ErrLog "frmSupervisor->Send_SMS_Command() : Err No. : " &
Err.Number & ", Description : " & Err.Description
Send_SMS_Command = False
'========================================================
End Function

Public Function MakeFile(sFileName As String, strLine As String)
On Error Resume Next

Dim AppPath As String, FreeFileNo%
Dim lgFName As String
Dim dDate As Date

dDate = Date - 2

'Check old log files exist or not
'If FileExist(App.Path & "\" & sFileName & ".txt") = True Then
' 'Delete old log files
' Kill App.Path & "\" & Format(dDate, "dd-MM-yyyy") & ".log"
'End If

'lgFName = Format(Now, "dd-MM-yyyy") & ".log"
lgFName = sFileName

If Right(App.Path, 1) <> "\" Then AppPath = App.Path & "\" Else
AppPath = App.Path

FreeFileNo = FreeFile

Open AppPath & "\" & lgFName For Append As #FreeFileNo
Print #FreeFileNo, Now, Space(1) & strLine
Close #FreeFileNo

End Function


'Generate Application Log File
Public Function WriteLog(strLine As String)
On Error Resume Next

Dim AppPath As String, FreeFileNo%
Dim lgFName As String
Dim dDate As Date

dDate = Date - 2

'Check old log files exist or not
If FileExist(App.Path & "\" & Format(dDate, "dd-MM-yyyy") & ".log") =
True Then
'Delete old log files
Kill App.Path & "\" & Format(dDate, "dd-MM-yyyy") & ".log"
End If

lgFName = Format(Now, "dd-MM-yyyy") & ".log"

If Right(App.Path, 1) <> "\" Then AppPath = App.Path & "\" Else
AppPath = App.Path

FreeFileNo = FreeFile

Open AppPath & "\" & lgFName For Append As #FreeFileNo
Print #FreeFileNo, Now, Space(1) & strLine
Close #FreeFileNo

End Function

Function AV(Str As Variant) As String
AV = IIf(IsNull(Str), "", Str)
End Function

Function AI(Str As Variant) As Double
AI = IIf(IsNull(Str), 0, Str)
End Function


Public Sub Timer5_Timer()
On Error GoTo ErrH

Dim INT_STRING_LENGTH As Integer


'For Port One
INT_STRING_LENGTH = msCOMMSIM.RThreshold
With msCOMMSIM
If .InBufferCount > 0 Then 'And .InBufferCount < MAX_REC_LEN And
msCOMMSIM.RThreshold <> 1 Then
.RThreshold = 0
If .InBufferCount Then
.InputLen = .InBufferCount

'Read SMS via Com Port from GSM Modem
'====================================
WriteSMDRDataOutPut
'====================================
End If
.RThreshold = 50
End If
End With
Exit Sub

ErrH:
MsgBox Err.Description
Resume
End Sub


Private Sub MakeSMSDataEmpty()
SMSData.SMSDS_CallerID = ""
SMSData.SMSDS_Request = ""
SMSData.SMSDS_RequestDT = ""
SMSData.SMSDS_Response = ""
SMSData.SMSDS_ResponseDT = ""
SMSData.SMSDS_Status = ""
SMSData.SMSDS_Type = ""
End Sub

Private Sub COMnSIM()
On Error GoTo ErrH

Dim i As Integer
Dim tmpTimer

Dim flds, fld, fls, fl, ts, sFl
Dim fsoFolder As FileSystemObject
Dim strString As String
Dim splt
Dim sCallerID As String
Dim sMsg As String

Set fsoFolder = New FileSystemObject

For i = 1 To 30

MakeSMSDataEmpty

blnResponse = False

'Send AT Commad to GMS Modem for Reading SMS
'=========================================================
Call fncRequestToCOM(msCOMMSIM, enmReadFromSIM, i)
'=========================================================

'=========================================================
'''' Wait for few seconds
'=========================================================
TTP1:
tmpTimer = "": tmpTimer = Timer + constWait4Reply
Do Until Timer > tmpTimer
DoEvents
Loop

tmpTimer = ""

'=========================================================

'Get SMS from Sim Card
'=========================================================
Call Timer5_Timer
'=========================================================


If blnResponse = True Then
'Delete SMS
Call fncRequestToCOM(msCOMMSIM, enmDeleteFromSIM, i)

'''' Wait for few seconds
tmpTimer = ""
tmpTimer = Timer + constWait4Reply
Do Until Timer > tmpTimer
DoEvents
Loop

tmpTimer = ""
End If

'Check Pending Sending Messages

Set fld = fsoFolder.GetFolder(App.Path)

Set fls = fld.Files

For Each fl In fls

Select Case LCase(Right(fl.Name, 3))
Case "req"

Set sFl = fsoFolder.GetFile(fl.Path)
Set ts = sFl.OpenAsTextStream(ForReading,
TristateUseDefault)
strString = ts.ReadLine
ts.Close
Set ts = Nothing

If Len(Trim(strString)) > 0 Then
Name fl.Path As Left(fl.Path, Len(fl.Path) - 4) &
".cmp"

splt = Split(strString, "#")

If UBound(splt) > 0 Then

sCallerID = splt(0)
sMsg = splt(1)

If Len(Trim(sMsg)) > 0 Then

Send_SMS_Command sCallerID, sMsg, "", ""

End If

End If

End If

Debug.Print strString

End Select

Next


Next

Exit Sub
ErrH:
'MsgBox Err.Description
Resume Next
End Sub

Private Sub tmrReadFromSIM_Timer()
COMnSIM
End Sub


.

Loading