Autor: Matthias Griesbach (---.customers.d1-online.com)
Datum: 17.06.14 22:40
Um weitere Funktionen wie HttpQueryHeaders und ReadCSV nutzen zu können, gibt es eine neue WinHttp.inc
Die neuste Version befinden sich immer am Ende dieses Threads.
'Eine Struktur aus der Vorlage, noch nicht Profan angepasst
'Wird vermutlich nötig, wenn User und Passwort für den Zugriff benötigt werden.
'Structure WinHTTP_ParametersStruc
'URL.s
'RequestType.s
'ReturnHeader.i
' UserName.s
' Password.s
' HeaderData.s
'OptionalData.s
'UserAgent.s
' CallbackID.i
' *CallbackStart
' *CallbackProgress
' *CallbackEnd
' *Memory
' FilePath.s
' FileBufferSize.i
'EndStructure
'Ein paar Variablen
Declare WinHttp&,hInternet&, hSession&, hConnect&, hRequest&, bResults&
'Init Prozedur. "P" mit "*" ersetzen, und Zeile Listbox entkommentieren, um alle Funktionen anzusehen
Proc WinHttpInit
WinHttp&=ImportDLL("winhttp.dll", "P")
'ListBox$("Funktionen",1)
EndProc
'Exit Prozedur
Proc WinHttpEnd
FreeDll WinHttp&
EndProc
'Prozedur zum Starten einer Session
Proc HttpOpen
Parameters name$
Declare ansistring#,widestring#,size&,wsize&,i&,return$
Return$="Session established"
size&=Len(name$)+1
Dim ansistring#,size&
String ansistring#,0=name$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
hSession& = PWinHttpOpen(Addr(widestring#),~WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,~WINHTTP_NO_PROXY_NAME,~WINHTTP_NO_PROXY_BYPASS,0)
CaseNot hSession& :Return$="Session: "+str$(~GetLastError())+" - "+WinError$(%WinError)
Dispose ansistring#
Dispose widestring#
Return Return$
EndProc
'Prozedur um eine Verbundung zum Webserver (Domain) herzustellen
Proc HttpConnect
Parameters name$
Declare ansistring#,widestring#,size&,wsize&,i&,Return$
Return$="Connection established"
size&=Len(name$)+1
Dim ansistring#,size&
String ansistring#,0=name$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)+1
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
hConnect& = PWinHttpConnect(hSession&,addr(widestring#),~INTERNET_DEFAULT_HTTP_PORT, 0)
CaseNot hConnect& :Return$="Connect: "+str$(~GetLastError())+" - "+WinError$(%WinError)
Dispose ansistring#
Dispose widestring#
Return Return$
EndProc
'Prozedur um einen Request zu erstellen.
Proc HttpRequest
Parameters verb$, objekt$, types$, Return$
Declare ansistring#,widestring#,widestring2#,size&,wsize&,wsize2&,i&
Return$="Request opened"
size&=Len(objekt$)+1
Dim ansistring#,size&
String ansistring#,0=objekt$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)+1
Dim widestring2#,len(verb$)+1
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
Clear ansistring#
size&=Len(verb$)+1
Dim ansistring#,size&
String ansistring#,0=verb$
MultiByteToWideChar(1,1,ansistring#,size&,widestring2#,wsize&)
hRequest& = PWinHttpOpenRequest( hConnect&, addr(widestring2#) ,addr(widestring#),0,~WINHTTP_NO_REFERER,~WINHTTP_DEFAULT_ACCEPT_TYPES,~WINHTTP_FLAG_BYPASS_PROXY_CACHE) '~NULL objekt$ addr(widestring#) addr(widestring2#)
CaseNot hRequest& :Return$= "Request: "+str$(~GetLastError())+" - "+WinError$(%WinError)
Dispose ansistring#
Dispose widestring#
Dispose widestring2#
Return Return$
EndProc
'Prozedur um dem Request Header Informationen hinzuzufügen
Proc HttpAddHeader
Parameters text$
Declare ansistring#,widestring#,size&,wsize&,i&, Return$
Return$= "Add Header "+text$
text$=text$+chr$(13)+chr$(10)
size&=Len(text$)+1
Dim ansistring#,size&
String ansistring#,0=text$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)'+1
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
CaseNot PWinHttpAddRequestHeaders(hRequest&, addr(widestring#),-1,~WINHTTP_ADDREQ_FLAG_ADD):Return$="AddHeader: "+str$(~GetLastError())+WinError$(%WinError)
Dispose ansistring#
Dispose widestring#
Return Return$
EndProc
Proc HttpQueryHeaders
Declare Size&,Downloaded&,Buff#,Return$,i&
PWinHttpQueryHeaders(hRequest&,~WINHTTP_QUERY_RAW_HEADERS_CRLF,~WINHTTP_HEADER_NAME_BY_INDEX, 0,addr(Size&),~WINHTTP_NO_HEADER_INDEX)
Dim Buff#, Size&*2
Print "Get Header -> Size="+str$(Size&)
bResults& = PWinHttpQueryHeaders(hRequest&,~WINHTTP_QUERY_RAW_HEADERS_CRLF,~WINHTTP_HEADER_NAME_BY_INDEX, Addr(Buff#),addr(Size&),~WINHTTP_NO_HEADER_INDEX)
CaseNot bResults& :Return "Headers: "+str$(~GetLastError())+WinError$(%WinError)
WhileNot i&=Size&*2
Return$=Return$+Char$(Buff#,i&,1)
inc i&
EndWhile
Dispose Buff#
Return Return$
EndProc
'Prozedur um den Request zu senden
'Der Body Text wird hier mit übergeben.
Proc HttpSend
Parameters Text$
Declare ansistring#,widestring#,size&,wsize&,i&,Return$
size&=Len(text$)+1
Dim ansistring#,size&
String ansistring#,0=text$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)
Return$="Send Request "+format$("0",wsize&)+" Byte"
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
bResults& = PWinHttpSendRequest( hRequest&,~WINHTTP_NO_ADDITIONAL_HEADERS,0,addr(widestring#), wsize&,wsize&, 0) '~WINHTTP_NO_REQUEST_DATA addr(widestring#)
CaseNot bResults& :Return$="Send: "+str$(~GetLastError())+WinError$(%WinError)
Dispose ansistring#
Dispose widestring#
Return Return$
EndProc
'Prozedur um den Request separat mit WinHttpWriteData zu senden
'Der Body Text wird hier mit WinHttpWriteData übergeben.
Proc HttpSendAndWrite
Parameters Text$
Declare ansistring#,widestring#,size&,wsize&,i&,BytesWritten&,Return$
size&=Len(text$)+1
Dim ansistring#,size&
String ansistring#,0=text$
i&=size&*2
Dim widestring#,i&
wsize&=(size&*2)
MultiByteToWideChar(1,1,ansistring#,size&,widestring#,wsize&)
buffer#=widestring#
bResults& = PWinHttpSendRequest( hRequest&,~WINHTTP_NO_ADDITIONAL_HEADERS,0,~WINHTTP_NO_REQUEST_DATA, 0,wsize&, 0) '~WINHTTP_NO_REQUEST_DATA addr(widestring#)
Dispose ansistring#
Dispose widestring#
if bResults&
bResults& = PWinHttpWriteData( hRequest&, addr(buffer#), wsize&, addr(BytesWritten&))
Return$="Send Request "+format$("0",BytesWritten&)+" Byte"
CaseNot bResults& :Return$="Write: "+str$(~GetLastError())+WinError$(%WinError)
else
Return$="Send: "+str$(~GetLastError())+WinError$(%WinError)
EndIf
Dispose ansistring#
Dispose widestring#
Return Return$
EndProc
'Prozedur um Darten auf den Webserver zu schreiben
Proc HttpWriteData
Parameters file$
Declare BytesWritten&, Size&, Buff#,Return$
Size&= FileSize(file$)
Dim Buff#, Size&
BlockRead(file$, Buff#, 0, Size&)
bResults& = PWinHttpWriteData( hRequest&, addr(Buff#), Size&, addr(BytesWritten&))
CaseNot bResults& :Return "Write: "+str$(~GetLastError())+WinError$(%WinError)
Return$= str$(Size&)+" Bytes written"
Dispose Buff#
Return Return$
EndProc
'Prozedur, um eine CSV-Datei einzulesen, und dem Body hinzuzufügen
Proc ReadCSV
Parameters file$
Declare BytesWritten&, Size&, Buff#, Return$
Size&= FileSize(file$)
Dim Buff#, Size&
BlockRead(file$, Buff#, 0, Size&)
Return$=String$(Buff#,0)
Dispose Buff#
Return Return$
EndProc
'Prozedur um die Antwort des Servers zu verarbeiten
'Die Größe des Buffers beruht nur auf einer Annahme.
Proc HttpReceiveResponse
Declare Size&,Downloaded&,Buff#,Return$,Ansi#,wsize&
bResults& = PWinHttpReceiveResponse( hRequest&, 0)
CaseNot bResults& :Return "Receive: "+str$(~GetLastError())'+WinError$(%WinError)
PWinHttpQueryDataAvailable( hRequest&, addr(size&))
print "ReadSize:";format$("0",size&);"Byte"
Dim Buff#,Size&
PWinHttpReadData( hRequest&, Buff#, Size&, addr(Downloaded&))
print "DownloadedSize:";format$("0",Downloaded&);"Byte"
Return$=String$(Buff#,0)
print "Return: "+str$(len(Return$))
Dispose Buff#
Assign #1,"C:\\Kylt PCR\\outfile.txt"
Rewrite #1
Print #1, Return$
Close #1
Return Return$
EndProc
'Prozedur um alle HInternet Handels freizugeben.
Proc HttpClose
Case hRequest& : PWinHttpCloseHandle(hRequest&)
Case hConnect& : PWinHttpCloseHandle(hConnect&)
Case hSession& : PWinHttpCloseHandle(hSession&)
EndProc
XProfan X2, Windows 7
|
|
