Skip to main content

AccessTr.neT


Toplu SMS gönderme

Toplu SMS gönderme

Çözüldü #7
Microsoft Access ile dilediğiniz türde gelişmiş tüm veritabanı programlarını , performanslı bir şekilde yazabilirsiniz. Toplu sms , toplu mail , toplu faks programı olarak Access 2007 ile geliştirilmiş bir örneğide ekde yolluyorum. Ekde yolladığım bu programın aynı zamanda microsoft Sql server üzerinde çalışan versiyonuda bulunmakta.

Access veya herhangi bir  programlama dilinde bu tür mesaj sistemlerini kullanmak için , mesaj sistemi için gerekli kütüphaneyi modüller kısmındaki referanslar da eklemeniz ve bir iki satır kod yazmanız.

Programccılık da önemli olan mesajı göndermek değil , entegrasyonlarını güzel bir şekilde ayarlamak çok önemli.

Program eki :

Kod:
www.akkarinca.com/download/smfkur.exe
Access 2007 ile yazılış. Toplu SMS,Mail,Faks,Etiket Programı. Şu anda 100'ün üzerinde kullanıcısı bulunmakda aralık 2008 de çıkmasına rağmen.

Kod:
www.akkarinca.com/download/dernekkur.exe
Access 2003 ile yazılmış Dernek programı. Türkiye ve Türkiye dışında toplam 1.000 'in üzerinde dernek kullanmakta.

Daha detaylı bilgi almak isterseniz mailleşebiliriz. **************

Saygılarımla.
Cevapla
Çözüldü #8
Serdar abi sizi burada görmek Access kullanıcısı olarak gerçekten büyük bir kazanç. Keşke vaktiniz müsait olsa sitemizde sizi daha sık görebilsek. Sizden öğreneceğimiz çok şey var.
AccessTr.Net teknik konular içeren bir sitedir. Bu tip sitelerde en iyi şekilde yardım alabilmeniz için Site Kurallarını mutlaka okumanız ve buna göre hareket etmeniz lazım.
Cevapla
Çözüldü #9
sms göndermenin 4-5 yolu var

1

Kod:
http://www.codeproject.com/KB/webservices/OrangeSmsApi2.aspx
internet üzerinden bir kayıtlı olduğun bir sms firmasının sayfasından (orange firması)
Kod:
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 sub


2
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 = Nothing

buda başka bir nokia kodu

Kod:
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 Sub

3 hazır activex ile tabii activex paralı


Kod:
http://www.smsco.it/tomcat/en/sms_tutorials/sms_from_access.jsp
bu sitede var

4 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 Function

buda comm port olayının c#  kodu

Kod:
http://www.codeproject.com/KB/cs/SMS.aspx
meşhur çin atasözü  "ACCESS İLE YAPABİLECEKLERİNİZ HAYAL EDEBİLECEKLERİNİZ İLE SINIRLIDIR" siz ne kadar hayal edebiliyorsunuz
Cevapla
Çözüldü #10
(26/01/2009, 12:20)esrefigit yazdı: sms göndermenin 4-5 yolu var

1
http://www.codeproject.com/KB/webservice...sApi2.aspx
internet üzerinden bir kayıtlı olduğun bir sms firmasının sayfasından (orange firması)
Kod:
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 sub


2
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 = Nothing

buda başka bir nokia kodu

Kod:
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 Sub

3 hazır activex ile tabii activex paralı

http://www.smsco.it/tomcat/en/sms_tutori...access.jsp
bu sitede var

4 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 Function

buda comm port olayının c# kodu
http://www.codeproject.com/KB/cs/SMS.aspx

4. yol için yardımcı olabilecek arkadaş varmı acaba
@benbendedeilem
Cevapla
Çözüldü #11
Başka yol derken, nasıl bir yol istiyorsunuz?
™Hiç Birimiz, Hepimiz Kadar Akıllı Olamayız...®

Cevapla
Çözüldü #12
benim istediğim
cep telefonunu bilgisayara takıp Access ile tablodaki numaralara otomatik sms göndermek
@benbendedeilem
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task