sms.bas

Pocket PC 2002发送短信的程序

Attribute VB_Name = "basSMS"
'******************************************************************************
' Implements the SMS module
'******************************************************************************
' FileName:  SMS.bas
' Creator:   Christian Forsberg
' Created:   2002-06-06
'******************************************************************************
' Version   Date   Who Comment
' 00.00.000 020606 CFO Created
'******************************************************************************
Option Explicit

' API declarations
Public Declare Function SmsOpen Lib "SMS" (ByVal ptsMessageProtocol As String, ByVal dwMessageModes As Long, ByRef psmshHandle As Long, ByRef phMessageAvailableEvent As Long) As Long
Public Declare Function SmsSendMessage Lib "SMS" (ByVal smshHandle As Long, ByVal psmsaSMSCAddress As Long, ByVal psmsaDestinationAddress As String, ByVal pstValidityPeriod As Long, ByVal pbData As String, ByVal dwDataSize As Long, ByVal pbProviderSpecificData As String, ByVal dwProviderSpecificDataSize As Long, ByVal smsdeDataEncoding As Long, ByVal dwOptions As Long, ByRef psmsmidMessageID As Long) As Long
Public Declare Function SmsClose Lib "SMS" (ByVal smshHandle As Long) As Long

' API constants
Public Const SMS_MSGTYPE_TEXT = "Microsoft Text SMS Protocol"
Public Const SMS_MODE_SEND = 2             ' Open in send mode
Public Const SMSDE_GSM = 1                 ' Use standard GSM encoding
Public Const SMSAT_INTERNATIONAL = 1       ' International number format
Public Const PS_MESSAGE_OPTION_NONE = 0    ' No message options
Public Const PS_MESSAGE_CLASS0 = 0         ' Send immediately
Public Const PSRO_NONE = 0                 ' No replacements
Public Const SMS_OPTION_DELIVERY_NONE = 0  ' No delivery options
Public Sub SendSMS(ByVal Number As String, ByVal Message As String)

' Send SMS message.
' IN:  Number, number to send to
'      Message, message to send
' Known bugs:
' Version   Date   Who Comment
' 00.00.000 020606 CFO Created
'******************************************************************************
  Dim SMSHandle As Long
  Dim SMSEvent As Long
  Dim SMSAddress As String
  Dim SMSProvider As String
  
  ' Open SMS Messaging Component
  If 0 <> SmsOpen(SMS_MSGTYPE_TEXT, SMS_MODE_SEND, SMSHandle, SMSEvent) Then
    MsgBox "Could not open SMS component!", _
           vbCritical, App.Title
    Exit Sub
  End If

  ' Set Address structure (UDT as string)
MsgBox "Number:" & Number
  SMSAddress = LongToBytes(SMSAT_INTERNATIONAL) & Number
MsgBox "SMSAddress:" & CStr(SMSAddress)
MsgBox "Message:" & Message
  ' Set Provider structure (UDT as string)
  SMSProvider = LongToBytes(PS_MESSAGE_OPTION_NONE) & _
                LongToBytes(PS_MESSAGE_CLASS0) & _
                LongToBytes(PSRO_NONE)
MsgBox "SMSProvider:" & CStr(SMSProvider)
  ' Send message
  If 0 = SmsSendMessage(SMSHandle, 0, SMSAddress, 0, Message, LenB(Message), _
         SMSProvider, 12, SMSDE_GSM, SMS_OPTION_DELIVERY_NONE, 0) Then
    MsgBox "Message sent!", vbInformation, App.Title
  Else
    MsgBox "Could not send message!", vbCritical, App.Title
  End If
  
  ' Close SMS Messaging Component
  If 0 <> SmsClose(SMSHandle) Then
    MsgBox "Could not close SMS component!", vbCritical, App.Title
    Exit Sub
  End If

End Sub