Monday, August 9, 2010

send sms pake pc

Dim mOK
Dim mErr
Dim mResult

Dim doit As Boolean
Dim sdata As String

Private Sub cmdSend_Click()
    Dim n
    ' Setup PictureBox for Scale
    List1.Clear
    List1.AddItem "Starting..."
    ' Fire Rx Event Every Byte
    MSComm1.RThreshold = 1
    ' When Inputting Data, Input All Bytes
    MSComm1.InputLen = 0
    ' 19200 Baud, No Parity, 8 Data Bits, 1 Stop Bit
    MSComm1.Settings = "19200,N,8,1"
    ' Make sure DTR line is low to prevent Stamp reset
    MSComm1.DTREnable = True
    MSComm1.InBufferSize = 32
    MSComm1.OutBufferSize = 0
    ' Open COM1
    MSComm1.CommPort = 5
    MSComm1.RTSEnable = True
    'Me.MSComm1.Handshaking = 2 - comRTS
    MSComm1.PortOpen = True
    List1.AddItem "Port Opened"

    Dim what As Boolean
   
    what = sendIt("AT+CMGF=1", "OK", "ERROR")
    If what = True Then
        what = sendIt("AT+CMGS=" & Chr(34) & Me.txtMNo & Chr(34), ">", "ERROR")
        If what = True Then
            n = Now
            Me.txtMToSend = Me.txtMsg & n
            'MSComm1.Output = Me.txtMsg & n & Chr(26) & Chr(13)
            what = sendIt(Me.txtMToSend & Chr(26), "OK", "ERROR")
        End If
    End If
    Me.MSComm1.PortOpen = False
    List1.AddItem "Done..."
End Sub

Function sendIt(ByVal s, ByVal ok, ByVal eror, Optional ByVal TOut = 5) As Boolean
    mOK = ok
    mErr = eror
    List1.AddItem "Sending.." & s
    MSComm1.Output = s & Chr(13)
    Dim p
    p = 0.0001 * TOut
    doit = False
    sdata = ""
    Dim dt1 As Date, dt2 As Date
    dt1 = Now
    Dim p1
    While doit = False
        dt2 = Now
        p1 = (dt2 - dt1)
        If p1 >= p Then
            List1.AddItem "Timeout..."
            doit = True
            sendIt = False
            Exit Function
        End If
        DoEvents
    Wend
    sendIt = True
End Function


Sub wait()
    Dim p
    p = 0.0005
    doit = False
    Me.List1.AddItem "Waiting..."
    sdata = ""
    Dim dt1 As Date, dt2 As Date
    dt1 = Now
    Dim p1
    While doit = False
        dt2 = Now
        p1 = (dt2 - dt1)
        If p1 >= p Then
            List1.AddItem "Timeout..."
            doit = True
        End If
        DoEvents
    Wend
End Sub

Private Sub MSComm1_OnComm()
    List1.AddItem "In OnComm"
    Dim sdata1
    If MSComm1.CommEvent = comEvReceive Then
        sdata1 = MSComm1.Input
        sdata = sdata & sdata1
        If InStr(sdata, mOK) > 0 Then
            doit = True
            mResult = "OK"
            List1.AddItem "--> " & sdata
        ElseIf InStr(sdata, "ERROR") > 0 Then
            doit = True
            List1.AddItem "Err--->" & sdata
            mResult = "ERR"
        ElseIf InStr(sdata, ">") > 0 Then
            doit = True
            List1.AddItem ">>---> " & sdata
            mResult = sdata
        Else
            List1.AddItem "?---> " & sdata
            mResult = sdata
        End If
    End If
End Sub

No comments: