1
Kod:
http://www.codeproject.com/KB/webservices/OrangeSmsApi2.aspxKod:
Option explicit
Const ACCESS_KEY = "568d6a389aa"
Dim stNumDest,stMessage
stNumDest = "33612345678"
stMessage = "Hello Word"
EnvoiSms stNumDest,ACCESS_KEY,stMessage
Sub EnvoiSms(stNum, stACCESS_KEY, stMessage)
Dim xmlDoc,stUrl
stUrl = "http://sms.alpha.orange-api.net/sms/sendSMS.xml?id=" & _
stACCESS_KEY &"&to=" & stNum & "&content=" & Escape(stMessage)
Set xmlDoc=CreateObject("Microsoft.XMLDOM")
xmlDoc.Async="false"
if xmlDoc.Load(stUrl) and not xmldOC.selectSingleNode("/response/status/status_code") is Nothing Then
Msgbox "Status_code = " & xmldOC.selectSingleNode("/response/status/status_code").text
else
MsgBox "Error sender", vbCritical
End if
End sub2
nokia tipi telefonların hazır kodları var nokia sitesinde önce nokianın programını kuruyorsun o sana bir adet activex yüklüyor
her modelin activex kod u farklı olduğu için ben sana n6210 kodunu veriyorum
Kod:
Dim ShortMsg As SMS3ASuiteLib.ShortMessage
Set SMSSend = New SMS3ASuiteLib.SMS_SuiteAdapter
Set ShortMsg = SMSSend.CreateShortMsg
ShortMsg.UserDataText = SMSmessage
If Not IsNull(SMSNumber) Then
ShortMsg.OtherEndAddress = SMSNumber
Else
SMSNumber = InputBox("Kinek küldjük az üzenetet? (+OOkkSSSSSSS)", "Telefonszám is kellene...", "+36")
ShortMsg.OtherEndAddress = SMSNumber
End If
ShortMsg.SCAddress = "+36209300099"
ShortMsg.StatusReportRequest = 1
Call SMSSend.Send(ShortMsg)
pSMS = ShortMsg
SMSNotify_ShortMsgSent (pSMS)
SMSSend.Terminate
Set SMSSend = NothingKod:
Option Compare Database
Private SMSSend As SMS3ASuiteLib.SMS_SuiteAdapter
Private WithEvents SMSNotify As SMS3ASuiteLib.SMS_SuiteAdapter
Public puSMS_SuiteAdapter As SMS3ASuiteLib.SMS_SuiteAdapter
Private Sub Form_Load()
Set puSMS_SuiteAdapter = New S3ASuiteLib.SMS_SuiteAdapter
Call puSMS_SuiteAdapter.StartListeningEvents
End Sub
Private Sub CreateMessageButton_Click()
Dim ShortMsg As SMS3ASuiteLib.ShortMessage
Set SMSSend = New SMS3ASuiteLib.SMS_SuiteAdapter
Set ShortMsg = SMSSend.CreateShortMsg
ShortMsg.UserDataText = SMSmessage
ShortMsg.OtherEndAddress = SMSNumber
ShortMsg.SCAddress = "+36209300099" 'replace w/ your SMS centre number
ShortMsg.StatusReportRequest = 1 'if you want a delivery report
Call SMSSend.Send(ShortMsg)
pSMS = ShortMsg
SMSNotify_ShortMsgSent (pSMS) 'if you want a notification
SMSSend.Terminate
Set SMSSend = Nothing
DoCmd.Close
End Sub
Private Sub SMSNotify_ShortMsgSent(ByVal pSMS As SMS3ASuiteLib.ShortMessage)
Dim msbo
msbo = MsgBox("Msg sent to" & pSMS.OtherEndAddress, vbInformation, "SMS")
End SubKod:
http://www.smsco.it/tomcat/en/sms_tutorials/sms_from_access.jsp4 modem özellikli bir cep telefonundan comm port üzerinden form üzerine ekleyeceğin mscomm.ocx active x ile yapabilirsin lakin 2003 de lisans problemi var 2000 office lisans istemiyor ancak 2003 de kullanmak için daha önceden eklenmiş bir form bulabilirsen ofrmu al ver olayı ile kendi programına geçirerek kullanabilirsin
Kod:
Option Explicit
Public Function RemoveInternationalDiallingCode(ByVal tTelNumber As String) As String
RemoveInternationalDiallingCode = "0" & Mid(tTelNumber, 4)
End Function
Public Function GetSMSNum(ByVal tSMSNotification As String) As String
Dim lCRPos As Long
lCRPos = InStrRev(tSMSNotification, vbCr)
If lCRPos > 0 Then GetSMSNum = Mid(tSMSNotification, lCRPos - 2, 2)
If Left(GetSMSNum, 1) = "," Then GetSMSNum = Right(GetSMSNum, 1)
End Function
Public Function ReadSMS(comms As MSComm, ByVal tSMSNum As String, tMessage As String, tSender As String, tDate As String, tTime As String, bRead As Boolean) As Boolean
Dim tChar As String * 1
Dim i As Long
Dim tRead As String
Dim lQuoteNum As Long
Dim tDateTime As String
Dim tData As String
Const TIMEOUT = 10000
On Error GoTo ErrHandler
tData = "AT+CMGR=" & tSMSNum & vbCr
comms.InBufferCount = 0
comms.Output = tData
tData = ""
i = timeGetTime
Do While timeGetTime - i <= TIMEOUT And InStr(tData, "OK" & vbCrLf) = 0 And InStr(tData, "ERROR" & vbCrLf) = 0
DoEvents
If comms.InBufferCount > 0 Then
tChar = comms.Input
tData = tData & tChar
End If
Loop
If InStr(tData, "ERROR") = 0 And tData <> "" Then
For i = 1 To Len(tData)
tChar = Mid(tData, i, 1)
If tChar = """" Then lQuoteNum = lQuoteNum + 1
If lQuoteNum = 1 And tChar <> """" Then tRead = tRead & tChar
If lQuoteNum = 3 And tChar <> """" Then tSender = tSender & tChar
If lQuoteNum = 5 And tChar <> """" Then tDateTime = tDateTime & tChar
If lQuoteNum = 6 And tChar <> """" Then tMessage = tMessage & tChar
Next i
bRead = (tRead = "REC READ")
tDate = Left(tDateTime, 8)
tTime = Mid(tDateTime, 10, 8)
tMessage = Mid(tMessage, 3)
tMessage = Mid(tMessage, 1, InStr(tMessage, vbCr) - 1)
ReadSMS = True
End If
Exit Function
ErrHandler:
ReadSMS = False
End Function
Public Function DeleteAllSMSes(comms As MSComm) As Boolean
Dim i As Long
For i = 1 To 15
DeleteAllSMSes = InStr(TransmitAndReceiveData(comms, "AT+CMGD=" & i & vbCr), "OK")
Next i
End Function
Public Function DeleteSMS(comms As MSComm, ByVal lSMSNum As Long) As Boolean
DeleteSMS = InStr(TransmitAndReceiveData(comms, "AT+CMGD=" & lSMSNum & vbCr), "OK")
End Function
Public Function SendSMS(comms As MSComm, ByVal tSMSNum As String, ByVal tMessage As String) As Boolean
SendSMS = InStr(TransmitAndReceiveData(comms, "AT+CMGS=" & """" & tSMSNum & """" & vbCr & tMessage & Chr(26)), "OK")
End Function
Public Function TestModem(comms As MSComm) As String
TestModem = TransmitAndReceiveData(comms, "AT")
End Function
Public Function ManufacturerInfo(comms As MSComm) As String
ManufacturerInfo = TransmitAndReceiveData(comms, "AT+CGMI")
End Function
Public Function ModelInfo(comms As MSComm) As String
ModelInfo = TransmitAndReceiveData(comms, "AT+CGMM")
End Function
Public Function FirmwareInfo(comms As MSComm) As String
FirmwareInfo = TransmitAndReceiveData(comms, "AT+CGMR")
End Function
Public Function IMEIInfo(comms As MSComm) As String
IMEIInfo = TransmitAndReceiveData(comms, "AT+CGSN")
End Function
Public Function IMSIInfo(comms As MSComm) As String
IMSIInfo = TransmitAndReceiveData(comms, "AT+CIMI")
End Function
Public Function EF_CCIDInfo(comms As MSComm) As String
EF_CCIDInfo = TransmitAndReceiveData(comms, "AT+CCID")
End Function
Public Function NetworkRegStatus(comms As MSComm) As String
NetworkRegStatus = TransmitAndReceiveData(comms, "AT+CREG?")
End Function
Public Function AvailablePLMNs(comms As MSComm) As String
AvailablePLMNs = TransmitAndReceiveData(comms, "AT+COPS?")
End Function
Public Function NetworkFieldStrength(comms As MSComm) As String
NetworkFieldStrength = TransmitAndReceiveData(comms, "AT+CSQ")
End Function
Public Function MainCellMainParams(comms As MSComm) As String
MainCellMainParams = TransmitAndReceiveData(comms, "AT+CCED=0")
End Function
Public Function TransmitAndReceiveData(comms As MSComm, ByVal tData As String) As String
Dim lTime As Long
Const TIMEOUT = 10000
tData = tData & vbCr
With comms
.InBufferCount = 0
.Output = tData
tData = ""
lTime = timeGetTime
tData = ""
Do While timeGetTime - lTime <= TIMEOUT And InStr(tData, "OK") = 0 And InStr(tData, "ERROR" & vbCrLf) = 0
DoEvents
If .InBufferCount > 0 Then tData = tData & .Input
Loop
End With
TransmitAndReceiveData = tData
End FunctionKod:
http://www.codeproject.com/KB/cs/SMS.aspx