καλησπερα πανο
Νομιζω ότι έχω αυτό που ζητάς.
Option Compare Database
Enum enmSubmitMethod
enmPOST = 1
enmGET = 2
End Enum
Private objXMLHTTP As MSXML2.XMLHTTP
Function sms_apostoli(kinito As String, minima As String) As String
Dim Apostoleas As String
Dim url As String
Dim myarr1
Dim myarr2
Dim reply As String
Dim Sms As String
Dim sender As String
Dim txt_receiver As String
Apostoleas = "" εδω το ονομα του αποστολεα
sender = URLEncode(Apostoleas)
Sms = URLEncode(minima)
txt_receiver = "30" & kinito
url = "http://attenzoservices.com/api_http2/http?"
myarr1 = Array("user", "pass", "from", "text", "to", "text")
myarr2 = Array("εδω το user", "εδω ο κωδικος", sender, Sms, txt_receiver)
reply = send(url, myarr1, myarr2)
'url = "http://www.bulk-sms.gr/messenger/customers/v3/smsc.asp?"
'myarr1 = Array("user", "pass", "action", "from", "to", "text", "typesms")
'myarr2 = Array("", "", "sendsms", sender, txt_receiver, Sms, "sms")
'reply = send(url, myarr1, myarr2)
'MsgBox reply
End Function
Private Function send(Addressurl As String, myarr1, myarr2)
Dim PageResults As String
Set objXMLHTTP = New MSXML2.XMLHTTP
PageResults = SubmitDataAsString(Addressurl, 1, myarr1, myarr2)
send = PageResults
End Function
Private Function SubmitDataAsString(URLString As String, SubmitMethod As enmSubmitMethod, FormInputArray As Variant, FormValueArray As Variant) As String
' URLString is the URL that is to be requested
' FormInputArray are the names of the <INPUT> tags
' FormValueArray are the actual values of the corresponding <INPUT> tags
Dim iCount As Integer
On Error Resume Next
' There are 2 different types of Submit methods, POST and GET
' POST method has the form name/values in the message body whereas
' GET method shows it on the URL
' So we need to manipulate the parameters passed in differently based on the requested
' methods
If SubmitMethod = enmPOST Then
' Set the URL property to the Requested URL
mURL = URLString
' Set the method of request which is POST and the URL,and set the Async parameter to false
objXMLHTTP.Open "POST", URLString, False
' Sets the header so that the web server knows a form is going to be posted
objXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' Construct the message body first before we send, it is a name/value pair,separated by ampersands
' which looks like "username=skeevs&password=aaa"
For iCount = 0 To UBound(FormInputArray)
strBody = strBody & FormInputArray(iCount) & "=" & FormValueArray(iCount) & "&"
Next
' Need to remove the last ampersand which was added in the FOR Loop above, so we use the LEFT function
objXMLHTTP.send Left(strBody, Len(strBody) - 1)
ElseIf SubmitMethod = enmGET Then
Dim strURLParam As String
Dim strURL As String
' Construct the URL first , it is a name/value pair,separated by ampersands
For iCount = 0 To UBound(FormInputArray)
strURLParam = strURLParam & FormInputArray(iCount) & "=" & FormValueArray(iCount) & "&"
Next
' Need to remove the last ampersand which was added in the FOR Loop above, so we use the LEFT function
strURLParam = Left(strURLParam, Len(strURLParam) - 1)
' Construct the URL string for the GET method
strURL = URLString & "?" & strURLParam
' Set the URL property to the Requested URL
mURL = strURL
' Set the method of request which is POST and the URL
objXMLHTTP.Open "GET", strURL, False
' Sets the header so that the web server knows a form is going to be posted
objXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'objxmlhttp.
' Send the constructed URL
objXMLHTTP.send strURL
End If
SubmitDataAsString = objXMLHTTP.responseText
End Function
Private Function URL_Encode(input_text As String) ' auto edo einai gia tin bulk sms
Dim count As Integer
Dim one_char As String
URL_Encode = ""
For count = 1 To Len(input_text)
one_char = Mid(input_text, count, 1)
If InStr("0123456789ABCDEFGHIJKLMNOPRSTUVWXYZ", UCase(one_char)) = 0 Then
one_char = "%" & Right(Hex(Asc(one_char)), 2)
End If
URL_Encode = URL_Encode & one_char
Next
End Function
Public Function URLEncode(ByVal StringToEncode As String) As String ' ÊÁÉ ÁÕÔÏ ÅÉÍÁÉ ÃÉÁ ÔÇÍ attenzoservices
If StringToEncode = "" Then
URLEncode = ""
Exit Function
End If
Dim i As Integer
Dim iAsc As Long
Dim sTemp As String
Dim ByteArrayToEncode() As Byte
ByteArrayToEncode = ADO_EncodeUTF8(StringToEncode)
For i = 0 To UBound(ByteArrayToEncode)
iAsc = ByteArrayToEncode(i)
Select Case iAsc
Case 32 'space
sTemp = "+"
Case 48 To 57, 65 To 90, 97 To 122
sTemp = Chr(ByteArrayToEncode(i))
Case Else
'Debug.Print iAsc
sTemp = "%" & Hex(iAsc)
End Select
URLEncode = URLEncode & sTemp
Next
End Function
Public Function ADO_EncodeUTF8(ByVal strUTF16 As String) As Byte() 'ÊÁÉ ÁÕÔÏ ÅÄÙ ÅÉÍÁÉ ÃÉÁ ÔÇÍ attenzoservices
Const adTypeBinary As Long = 1
Const adTypeText As Long = 2
Const adModeReadWrite As Long = 3
Dim objStream As Object
Dim data() As Byte
If strUTF16 = "" Then
ADO_EncodeUTF8 = data
Exit Function
End If
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeText
objStream.Open
objStream.WriteText strUTF16
objStream.Flush
objStream.Position = 0
objStream.Type = adTypeBinary
objStream.Read 3 ' skip BOM
data = objStream.Read()
objStream.Close
ADO_EncodeUTF8 = data
End Function
Public Function WinHTTPPostRequest(url As String, FormData As String) As String
Dim http As New MSXML2.XMLHTTP
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", url & "?" & FormData, False
http.setRequestHeader "Content-Type", "multipart/form-data;"
http.send FormData
WinHTTPPostRequest = http.responseText
End Function
Ανοιξε μια function και βαλτο μεσα όπως το βλεπεις
είναι κωδικας για 2 εταιρειες με sms
αλεξια
 |