Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
HTTP POST from within VFP 8 application? 1
- Thread starter banswara
- Start date
Mike Gagnon
Programmer
banswara
Here is a start:
Mike Gagnon
If you want to get the best response to a question, please check out FAQ184-2483 first.
Here is a start:
Mike Gagnon
If you want to get the best response to a question, please check out FAQ184-2483 first.
Here's another example:
Code:
DEFINE CLASS SocketWrapper As Custom
* Based on Anatoliy Mogylevets SMTP code at [URL unfurl="true"]http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail[/URL]
#DEFINE SMTP_PORT 25
#DEFINE HTTP_PORT 80
#DEFINE AF_INET 2
#DEFINE SOCK_STREAM 1
#DEFINE IPPROTO_TCP 6
#DEFINE SOCKET_ERROR -1
#DEFINE FD_READ 1
host = ""
IP = ""
Port = 80
hSocket = 0
cIn = ''
WaitForRead = 0
PROCEDURE Init()
THIS.decl
IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
* unable to initialize Winsock on this computer
RETURN .F.
ENDIF
RETURN .T.
ENDPROC
PROCEDURE Destroy
= WSACleanup()
ENDPROC
PROCEDURE Host_Assign( vNewVal )
if empty(vNewVal)
THIS.IP = ''
else
THIS.IP = THIS.GetIP(vNewVal)
endif
if not empty(THIS.IP)
THIS.Host = vNewVal
else
THIS.Host = ''
endif
ENDPROC
PROTECTED FUNCTION GetIP( pcHost )
#DEFINE HOSTENT_SIZE 16
LOCAL nStruct, nSize, cBuffer, nAddr, cIP
nStruct = gethostbyname(pcHost)
IF nStruct = 0
RETURN ""
ENDIF
cBuffer = Repli(Chr(0), HOSTENT_SIZE)
cIP = Repli(Chr(0), 4)
= CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
= CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
= CopyMemory(@cIP, THIS.buf2dword(cIP),4)
RETURN inet_ntoa(THIS.buf2dword(cIP))
ENDFUNC
PROTECTED FUNCTION Connect
LOCAL cBuffer, cPort, cHost, lResult
THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
IF THIS.hSocket = SOCKET_ERROR
RETURN .F.
ENDIF
cPort = THIS.num2word(htons(THIS.Port))
nHost = inet_addr(THIS.IP)
cHost = THIS.num2dword(nHost)
cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
RETURN lResult
FUNCTION HttpGet( pcServer, pcUrl )
LOCAL lResult
THIS.Host = pcServer
IF THIS.Connect()
THIS.snd("GET "+pcURL+" HTTP/1.0"+crlf)
THIS.snd("Accept: */*"+crlf)
THIS.snd("Accept-Language: en-us"+crlf)
THIS.snd("Accept-Encoding: gzip, deflate"+crlf)
THIS.snd("User-Agent: Mozilla/4.0"+crlf)
THIS.snd("Host: "+pcServer+crlf)
THIS.snd("Pragma: no-cache"+crlf)
THIS.snd(crlf,.t.) && End of headers
*info=url encoded string
lResult = .T.
ELSE
lResult = .F.
ENDIF
THIS.Disconnect()
ENDFUNC
FUNCTION HttpPost( pcServer, pcUrl, pcData, poFdbk )
LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
THIS.Host = pcServer
IF THIS.Connect()
THIS.snd("POST "+pcURL+" HTTP/1.0"+crlf)
THIS.snd("Content-Type:application/x-[URL unfurl="true"]www-form-urlencoded"+crlf)[/URL]
THIS.snd("Accept: */*"+crlf)
THIS.snd("Accept-Language: en-us"+crlf)
THIS.snd("Accept-Encoding: gzip, deflate"+crlf)
THIS.snd("User-Agent: Mozilla/4.0"+crlf)
THIS.snd("Host: "+pcServer+crlf)
lnLen = len(pcData)
THIS.snd("Content-Length: "+tran(lnLen)+crlf)
THIS.snd("Pragma: no-cache"+crlf)
THIS.snd(crlf) && End of headers
* If we have a valid feedback object, provide feedback
if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
lcRemain = pcData
lnComplete = 0
poFdbk.Feedback( 0 )
do while len(lcRemain)>0
lcSnd = LEFT( lcRemain, 100 )
lcRemain = SUBSTR( lcRemain, 101 )
THIS.snd(lcSnd)
lnComplete = lnComplete+len(lcSnd)
poFdbk.Feedback( lnComplete/lnLen*100 )
enddo
THIS.snd('',.t.) && get a response, too.
else && no feedback object, just send one big chunk.
THIS.snd(pcData,.t.) && get a response, too.
endif
lResult = .T.
ELSE
lResult = .F.
ENDIF
THIS.Disconnect()
ENDFUNC
FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
LOCAL lResult
IF THIS.Connect()
THIS.snd("HELO", .T.)
THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
THIS.snd("DATA", .T.)
THIS.snd("From: " + pcSender)
THIS.snd("To: " + pcRecipient)
THIS.snd("Subject: " + pcSubject)
THIS.snd("")
THIS.snd(pcBody)
THIS.snd(".", .T.)
THIS.snd("QUIT", .T.)
lResult = .T.
ELSE
= MessageB("Unable to connect to [" + THIS.Host +;
"] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
48, " Connection error")
lResult = .F.
ENDIF
THIS.Disconnect()
RETURN lResult
ENDFUNC
Function URLencode
LPARAMETER pcInStr
* ' encode Percent signs
* ' Double Quotes
* ' CarriageReturn / LineFeeds
LOCAL lcOut, lnI
* StrTran is WAY faster than building the string in memory
lcOut = StrTran(pcInStr, [%], '%25' )
lcOut = StrTran(lcOut, [+], '%2B' )
lcOut = StrTran(lcOut, [ ], '+' )
for lnI = 0 to 31
lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
endfor
for lnI = 127 to 255
lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
endfor
RETURN lcOut
*!* LOCAL lcIn, lcOut, lnI, lnCh
*!* lcIn = StrTran(pcInStr, [%], '%25' )
*!* lcIn = StrTran(lcIn, [+], '%2B' )
*!* lcIn = StrTran(lcIn, [ ], '+' )
*!* lcIn = StrTran(lcIn, ["], '%22' )
*!* lcIn = StrTran(lcIn, [,], '%2C' )
*!* lcIn = StrTran(lcIn, ['], '%27' )
*!* lcIn = StrTran(lcIn, [=], '%3D' )
*!* lcIn = StrTran(lcIn, [&], '%26' )
*!* lcIn = StrTran(lcIn, [`], '%60' )
*!* lcOut = ''
*!* for lnI = 1 to len(lcIn)
*!* lcCh = Substr(lcIn,lnI,1)
*!* lnCh = Asc(lcCh)
*!* if not between( lnCh, 33, 126 )
*!* lcCh = '%' + Right( Transform(lnCh,'@0'), 2 )
*!* endif
*!* lcOut = lcOut + lcCh
*!* endfor
*!* RETURN lcOut
ENDFUNC && UrlEncode
FUNCTION Disconnect
if THIS.hSocket<>SOCKET_ERROR
= closesocket(THIS.hSocket)
endif
THIS.hSocket = SOCKET_ERROR
ENDFUNC
FUNCTION snd(cData, lResponse)
LOCAL cBuffer, nResult, cResponse
cBuffer = cData && + CrLf
nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
IF nResult = SOCKET_ERROR
RETURN .F.
ENDIF
IF Not lResponse
RETURN .T.
ENDIF
LOCAL hEventRead, nWait, cRead
DO WHILE .T.
* creating event, linking it to the socket and wait
hEventRead = WSACreateEvent()
= WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
* 1000 milliseconds can be not enough
THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
= WSACloseEvent(hEventRead)
IF THIS.WaitForRead <> 0 && error or timeout
EXIT
ENDIF
* reading data from connected socket
THIS.cIn = THIS.cIn+THIS.Rd()
ENDDO
RETURN .T.
ENDFUNC
PROTECTED FUNCTION Rd
#DEFINE READ_SIZE 16384
LOCAL cRecv, nRecv, nFlags
cRecv = Repli(Chr(0), READ_SIZE)
nFlags = 0
nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
ENDFUNC
PROCEDURE decl
DECLARE INTEGER gethostbyname IN ws2_32 STRING host
DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
DECLARE INTEGER closesocket IN ws2_32 INTEGER s
DECLARE INTEGER WSACreateEvent IN ws2_32
DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
DECLARE INTEGER inet_addr IN ws2_32 STRING cp
DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
DECLARE INTEGER WSACleanup IN ws2_32
DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
INTEGER s, STRING @sname, INTEGER namelen
DECLARE INTEGER send IN ws2_32;
INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
DECLARE INTEGER recv IN ws2_32;
INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
DECLARE INTEGER WSAEventSelect IN ws2_32;
INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
INTEGER dwTimeout, INTEGER fAlertable
DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
STRING @Dest, INTEGER Src, INTEGER nLength
ENDPROC
FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
ENDFUNC
FUNCTION num2dword(lnValue)
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
IF lnValue < 0
lnValue = 0x100000000 + lnValue
ENDIF
LOCAL b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDFUNC
FUNCTION num2word(lnValue)
RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
ENDFUNC
ENDDEFINE-
1
- #4
banswara,
Instead of making direct API calls, as in the posting above, you could also create an "instance" of COM object using VFP's CREATEOBJECT() but make sure that your call matches the version of the DLL on your machine, there are several versions of the dll. The code below uses WinHttp.dll ver 5.1, do a search in RegEdit for "WinHttp.WinHttpRequest" to see what is on your machine, the call will match the string in the registry. If you need to get the dll it's available from Microsoft on their Platform SDK CD, the CD is free but they charge $10 for shipping. If you're not posting to a secure site you can skip the set credentials and client certificate calls. You may want to build a class or functions around the calls to handle errors and check the StatusCode and StatusText properties of the object after the send call.
loHTTP = CREATEOBJECT("WinHttp.WinHttpRequest.5.1"
loHTTP.Open("POST", " , .F.)
loHTTP.SetCredentials("UserName", "Password", 0)
loHTTP.SetClientCertificate("CertficateName"
loHTTP.SetRequestHeader("content-type", "application/x-loHTTP.Send("SendThis"
With the other posts you should have several options now.
Good luck.
Ralph
Instead of making direct API calls, as in the posting above, you could also create an "instance" of COM object using VFP's CREATEOBJECT() but make sure that your call matches the version of the DLL on your machine, there are several versions of the dll. The code below uses WinHttp.dll ver 5.1, do a search in RegEdit for "WinHttp.WinHttpRequest" to see what is on your machine, the call will match the string in the registry. If you need to get the dll it's available from Microsoft on their Platform SDK CD, the CD is free but they charge $10 for shipping. If you're not posting to a secure site you can skip the set credentials and client certificate calls. You may want to build a class or functions around the calls to handle errors and check the StatusCode and StatusText properties of the object after the send call.
loHTTP = CREATEOBJECT("WinHttp.WinHttpRequest.5.1"
loHTTP.Open("POST", " , .F.)
loHTTP.SetCredentials("UserName", "Password", 0)
loHTTP.SetClientCertificate("CertficateName"
loHTTP.SetRequestHeader("content-type", "application/x-loHTTP.Send("SendThis"
With the other posts you should have several options now.
Good luck.
Ralph
- Thread starter
- #5
This looks like just what I wanted! Thanks so much!
Can I simply substitute the name of the file I wish to post in the oHTTP.Send("myfile.jpg" statement?
Also, the SetRequestHeader() statement, where can I find an explanation as to what to set that to for a jpg file?
Can I simply substitute the name of the file I wish to post in the oHTTP.Send("myfile.jpg"
statement?Also, the SetRequestHeader() statement, where can I find an explanation as to what to set that to for a jpg file?
banswara,
Most of the documentation you're going to find is written for C++ and VB programmers so you will have to extrapolate what you need from them. A search of Google groups is of help a lot times and you might try that. The Microsoft support site for WinHttp is: and there are some C++ examples and classes built around the dll in the platform SDK.
Another source of good info is right in VFP. Use the object browser under tools; select COM libraries and scroll until you find Microsoft WinHttp and then check the box. The browser allows you see exposed methods, events, interfaces and
constants (which sometimes can be really helpful).
As for how to "Post" your image file I would try to convert the file to a string using VFP's FileToStr() and send the the string. While I have not posted images this has worked with sending other files and XML streams.
Ralph
Most of the documentation you're going to find is written for C++ and VB programmers so you will have to extrapolate what you need from them. A search of Google groups is of help a lot times and you might try that. The Microsoft support site for WinHttp is: and there are some C++ examples and classes built around the dll in the platform SDK.
Another source of good info is right in VFP. Use the object browser under tools; select COM libraries and scroll until you find Microsoft WinHttp and then check the box. The browser allows you see exposed methods, events, interfaces and
constants (which sometimes can be really helpful).
As for how to "Post" your image file I would try to convert the file to a string using VFP's FileToStr() and send the the string. While I have not posted images this has worked with sending other files and XML streams.
Ralph
- Status
Similar threads
