*========================================================================================
* HTTP Client
*========================================================================================
Define Class cHTTPClient as Custom

	#include incl\httpclient.h
	#include acodey.h

	*--------------------------------------------------------------------------------------
	* interne Eigenschaften 
	*--------------------------------------------------------------------------------------
	Protected hInternet, hSession
	hInternet = 0
	hSession = 0	
	
	nBytesTotal = 0
	nFileSize = 0
	
	*--------------------------------------------------------------------------------------
	* Interneteinstellungen von Windows (Start > Einstellungen > Systemsteuerung > 
	* Internet) bernehmen. Dies gilt insbesondere fr die Konfiguration eines Proxy-
	* Servers.
	*--------------------------------------------------------------------------------------
	nOpenType = INTERNET_OPEN_TYPE_PRECONFIG
	
	*--------------------------------------------------------------------------------------
	* Daten immer neu vom Server laden (keinen Cache benutzen).
	*--------------------------------------------------------------------------------------
	nRequestFlags = INTERNET_FLAG_RELOAD + INTERNET_FLAG_KEEP_CONNECTION 
	nOpenFlags = 0
	
	*--------------------------------------------------------------------------------------
	* URL, auf die zugegriffen werden soll. Es kann hier auch ein expliziter Port angegeben
	* werden:
	* 
	*  HTTP   80
	*  HTTPS  443
	*--------------------------------------------------------------------------------------
	cServer = ""
	nPort = INTERNET_INVALID_PORT_NUMBER
	cPath = ""
	
	*--------------------------------------------------------------------------------------
	* Letzter API Fehler, wenn eine Funktion .F. zurckgibt.
	*--------------------------------------------------------------------------------------
	nLastError = 0
	
	*--------------------------------------------------------------------------------------
	* Standard HTTP Header
	*--------------------------------------------------------------------------------------
	cHTTPVersion = Alltrim(NULL)
	cReferer = Alltrim(Null)
	cAcceptTypes = Alltrim(NULL)
	cAgent = Version()
	
	*--------------------------------------------------------------------------------------
	* Eigene HTTP Header
	*--------------------------------------------------------------------------------------
	cHeaders = ""
	
	*--------------------------------------------------------------------------------------
	* Benutzername und Kennwort fr geschtzte Webseiten
	*--------------------------------------------------------------------------------------
	cUsername = ""
	cPassword = ""


*========================================================================================
* Baut die Verbindung auf. 
*========================================================================================
Function Connect
Lparameters tcServer

	*--------------------------------------------------------------------------------------
	* Rckgabe .T. bei Erfolg
	*--------------------------------------------------------------------------------------
	Local llOK
	llOK = .T.
	
	*--------------------------------------------------------------------------------------
	* API Deklarationen
	*--------------------------------------------------------------------------------------
	DECLARE INTEGER InternetOpen IN wininet;
	    STRING  sAgent, INTEGER lAccessType,;
	    STRING sProxyName, STRING sProxyBypass,;
	    Long Flags

	DECLARE INTEGER InternetConnect IN wininet;
	    INTEGER hInternetSession, STRING sServerName,;
	    INTEGER nServerPort, STRING sUsername,;
	    STRING sPassword, INTEGER lService,;
	    INTEGER lFlags, INTEGER lContext

	DECLARE INTEGER GetLastError IN kernel32
	
	*--------------------------------------------------------------------------------------
	* 
	*--------------------------------------------------------------------------------------
	If m.llOK and Vartype(m.tcServer) == "C"
		This.cServer = m.tcServer
	EndIf
	
	*--------------------------------------------------------------------------------------
	* Eine eventuell bestehende Session wird geschlossen.
	*--------------------------------------------------------------------------------------
	If m.llOK
		This.Disconnect()
	EndIf 

	*--------------------------------------------------------------------------------------
	* Internetverbindung herstellen
	*--------------------------------------------------------------------------------------
	If m.llOK
		This.hInternet = InternetOpen(This.cAgent,This.nOpenType,NULL,NULL,0)
		If This.hInternet == 0
			This.nLastError = GetLastError()
			llOK = .F.
		EndIf
	EndIf
	
	*--------------------------------------------------------------------------------------
	* Sitzung starten
	*--------------------------------------------------------------------------------------
	If m.llOK
		This.hSession = InternetConnect( ;
			This.hInternet, ;
			This.cServer, This.nPort, ;
			This.cUsername, This.cPassword, INTERNET_SERVICE_HTTP, This.nOpenFlags, 0 ;
		)
		If This.hSession == 0
			This.nLastError = GetLastError()
			llOK = .F.
		EndIf
	EndIf 
	
	*--------------------------------------------------------------------------------------
	* Im Fehlerfall die Verbindung abbrechen
	*--------------------------------------------------------------------------------------
	If not m.llOK
		This.Disconnect()
	EndIf

Return m.llOK


*========================================================================================
* Trennt die Verbindung
*========================================================================================
Procedure Disconnect
	
	*--------------------------------------------------------------------------------------
	* API Deklarationen
	*--------------------------------------------------------------------------------------
	DECLARE INTEGER InternetCloseHandle IN wininet INTEGER hInet

	*--------------------------------------------------------------------------------------
	* Session beenden
	*--------------------------------------------------------------------------------------
	If This.hSession # 0
		InternetCloseHandle( This.hSession )
		This.hSession = 0
	EndIf
		
	*--------------------------------------------------------------------------------------
	* Internetverbindung beenden
	*--------------------------------------------------------------------------------------
	If This.hInternet # 0
		InternetCloseHandle( This.hInternet )
		This.hInternet = 0
	EndIf
	
EndProc


*========================================================================================
* Beim Freigeben des Objektes die Internetverbindung anbauen
*========================================================================================
Procedure Destroy
	This.Disconnect()
EndProc


*========================================================================================
* HTTPS aktvieren
*========================================================================================
PROCEDURE UseSSL
	This.nRequestFlags = BITOR(This.nRequestFlags, INTERNET_FLAG_SECURE)
	This.nRequestFlags = BITOR(This.nRequestFlags, INTERNET_FLAG_IGNORE_CERT_CN_INVALID)
	This.nRequestFlags = BITOR(This.nRequestFlags, INTERNET_FLAG_KEEP_CONNECTION)
	This.nPort = 443
	This.nOpenFlags = Bitor(This.nOpenFlags,INTERNET_FLAG_SECURE)
ENDPROC

*========================================================================================
* Zerlegt eine URL und trgt diese in die Eigenschaften ein.
*========================================================================================
Procedure SplitURL
LParameter tcURL

	*--------------------------------------------------------------------------------------
	* Bei Verwendung einer https-Adresse mssen wir den SSL Modus aktivieren
	*--------------------------------------------------------------------------------------
	If Lower (Left (m.tcURL, 8)) == "https://"
		This.UseSsl()
	EndIf	

	*--------------------------------------------------------------------------------------
	* Wurde das Protokoll bergeben? Wenn nicht verwenden wir http://...
	*--------------------------------------------------------------------------------------
	Local lcURl
	If "://" $ m.tcURL
		lcURl = m.tcURL 
	Else
		lcURl = "http://"+m.tcURL
	EndIf 
	
	*--------------------------------------------------------------------------------------
	* Der Server kann eine Portnummer haben. Anderenfalls verwenden wir den Standardport
	* fr das gewhlte Protokoll.
	*--------------------------------------------------------------------------------------
	Local lcServer
	lcServer = STREXTRACT( m.lcURL, "://", "/", 1, 3 )
	If ":" $ m.lcServer
		This.cServer = StrExtract(m.lcServer,"",":")
		This.nPort = Val(StrExtract(m.lcServer,":",""))
	Else
		This.cServer = m.lcServer
		This.nPort = INTERNET_INVALID_PORT_NUMBER
	EndIf 
	
	*--------------------------------------------------------------------------------------
	* Ist noch ein Pfad angegeben?
	*--------------------------------------------------------------------------------------
	If AT("/",m.lcURL,3) > 0
		This.cPath = SUBSTR( m.lcURL, AT("/",m.lcURL,3) )
	Else
		This.cPath = ""
	EndIf 

EndProc

*========================================================================================
* Liest eine URL aus und liefert deren Inhalt zurck. Im Fehlerfall wird NULL zurckge-
* geben. In diesem Fall enthlt nLastError die Fehlerursache.
*========================================================================================
Function Get
LParameter tcURL

	Local lcReturn
	If This.IsConnected()
		This.SplitUrl( m.tcURL )
		lcReturn = This.Request("GET")
	Else
		lcReturn = NULL
	EndIf
	
Return m.lcReturn 


*========================================================================================
* Sendet Daten zum Server
*========================================================================================
Function Post
LParameter tcURL, tcData

	Local lcReturn
	If This.IsConnected()
		This.SplitUrl( m.tcURL )
		lcReturn = This.Request("POST",m.tcData)
	Else
		lcReturn = NULL
	EndIf
	
Return m.lcReturn 


*========================================================================================
* Sendet einen Request zum Server. Es mu bereits eine Verbindung bestehen.
*========================================================================================
Function Request
Lparameter tcVerb, tcData

	*--------------------------------------------------------------------------------------
	* Bei Mierfolg wird NULL zurckgegeben
	*--------------------------------------------------------------------------------------
	Local llOK, lcReturn
	llOK = .T.
	lcReturn = NULL
	this.nBytesTotal = 0
	
	*--------------------------------------------------------------------------------------
	* API Deklaration
	*--------------------------------------------------------------------------------------
	DECLARE INTEGER InternetReadFile IN wininet;
	    INTEGER hFile, STRING @lpBuffer,;
	    INTEGER dwBytesToRead, INTEGER @lpdwBytesRead

	DECLARE INTEGER HttpSendRequest IN wininet;
	    INTEGER hRequest, String lpszHeaders,;
	    INTEGER dwHeadersLength, String lpOptional,;
	    INTEGER dwOptionalLength

	DECLARE INTEGER HttpOpenRequest IN wininet;
	    INTEGER hConnect, STRING lpszVerb,;
	    STRING lpszObjectName, STRING lpszVersion,;
	    STRING lpszReferer, String lpszAcceptTypes,;
	    INTEGER dwFlags, INTEGER dwContext

	DECLARE INTEGER InternetQueryDataAvailable IN wininet;
	    INTEGER hFile, INTEGER @lpdwBytesAvailable,;
	    INTEGER dwFlags, INTEGER dwContext
	
	DECLARE INTEGER GetLastError IN kernel32

	*--------------------------------------------------------------------------------------
	* Einen Request erstellen
	*--------------------------------------------------------------------------------------
	Local lnRequest
	If m.llOK
		lnRequest = HttpOpenRequest( ;
			This.hSession, ;
			m.tcVerb, ;
			This.cPath, ;
			This.cHTTPVersion, ;
			This.cReferer, ;
			This.cAcceptTypes, ;
			This.nRequestFlags, ;
			0 ;
		)
		If m.lnRequest == 0
			llOK = .F.
			This.nLastError = GetLastError()
		EndIf 
	Else
		lnRequest = 0
	EndIf
	
	*--------------------------------------------------------------------------------------
	* Request an den Server bertragen
	*--------------------------------------------------------------------------------------
	Local lnSend
	If m.llOK
		If Vartype(m.tcData) == "C"
			lnSend = HttpSendRequest( ;
				m.lnRequest, ;
				This.cHeaders+Chr(0)+Chr(0), -1, ;
				tcData, Len(m.tcData) ;
			)
		Else 
			lnSend = HttpSendRequest( m.lnRequest, This.cHeaders+Chr(0)+Chr(0),-1,NULL,0)
		EndIf 
		IF m.lnSend == 0
			llOK = .F.
			This.nLastError = GetLastError()
		EndIf
	EndIf	

	this.nBytesTotal = 0
	*--------------------------------------------------------------------------------------
	* Die Antwort vom Server holen
	*--------------------------------------------------------------------------------------
	LOCAL lnTotalBt, lnAvailBt, lnReadBt, lcBuffer
	If m.llOK
		lcReturn = ""
		DO WHILE .T.
			lnAvailBt = 0
			InternetQueryDataAvailable (lnRequest, @lnAvailBt, 0,0)
			IF lnAvailBt = 0
				Exit
			Else
				lcBuffer = REPLICATE( Chr(0), lnAvailBt)
				lnReadBt = 0
				This.eventRead( m.lnAvailBt )
				If InternetReadFile(m.lnRequest,@lcBuffer,lnAvailBt,@lnReadBt) == FALSE
					llOK = .F.
					This.nLastError = GetLastError()
					Exit
				EndIf 
	    ENDIF
			lcReturn = m.lcReturn + Left(m.lcBuffer,m.lnReadBt)
		EndDo
		This.eventDownloadComplete()
	EndIf 		

	*--------------------------------------------------------------------------------------
	* Den Handle schlieen
	*--------------------------------------------------------------------------------------
	If m.lnRequest > 0
		DECLARE INTEGER InternetCloseHandle IN wininet INTEGER hInet
		InternetCloseHandle( m.lnRequest )
	EndIf
	
	*--------------------------------------------------------------------------------------
	* Im Fehlerfall NULL zurckgeben
	*--------------------------------------------------------------------------------------
	If not m.llOK
		lcReturn = NULL
	EndIf 

RETURN m.lcReturn


*========================================================================================
* Wird ausgelst, bevor Daten gelesen werden
*========================================================================================
Procedure eventRead
LParameter tnReadByte

	this.nBytesTotal = this.nBytesTotal + tnReadByte 
	
EndProc


*========================================================================================
* Wird ausgelst, wenn der Download abgeschlossen wurde
*========================================================================================
Procedure eventDownloadComplete
EndProc



*========================================================================================
* Liefert die Fehlermeldung im Klartext zurck
*========================================================================================
Procedure GetErrorMsg
	
	*--------------------------------------------------------------------------------------
	* Konstanten
	*--------------------------------------------------------------------------------------
	#DEFINE FORMAT_MESSAGE_ALLOCATE_BUFFER 0x100
	#DEFINE FORMAT_MESSAGE_ARGUMENT_ARRAY 0x2000
	#DEFINE FORMAT_MESSAGE_FROM_STRING 0x400
	#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 0x1000
	#DEFINE FORMAT_MESSAGE_IGNORE_INSERTS 0x200
	#DEFINE FORMAT_MESSAGE_MAX_WIDTH_MASK 0xFF

	*--------------------------------------------------------------------------------------
	* API Deklarationen
	*--------------------------------------------------------------------------------------
	DECLARE INTEGER FormatMessage IN kernel32;
	    INTEGER   dwFlags,;
	    INTEGER   lpSource,;
	    INTEGER   dwMessageId,;
	    INTEGER   dwLanguageId,;
	    INTEGER @ lpBuffer,;
	    INTEGER   nSize,;
	    INTEGER   Arguments 

  DECLARE INTEGER LocalFree IN kernel32 INTEGER hMem

  DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
      STRING @dst, INTEGER src, INTEGER nLen

    LOCAL nFlags, hBuffer, nLen, cBuffer
    cBuffer=""

    * specify format parameters
    nFlags = FORMAT_MESSAGE_ALLOCATE_BUFFER +;
        FORMAT_MESSAGE_FROM_SYSTEM +;
        FORMAT_MESSAGE_IGNORE_INSERTS

    hBuffer = 0
    nLen = FormatMessage(nFlags, 0,;
        This.nLastError, 0, @hBuffer, 0, 0)

    IF nLen <> 0
        cBuffer = REPLICATE(Chr(0), 500)
        = CopyMemory(@cBuffer, hBuffer, nLen)
        = LocalFree(hBuffer)
        RETURN STRTRAN(LEFT(cBuffer, nLen), Chr(13)+Chr(10), "")
    ELSE
        RETURN "unbekannte Meldung"
    ENDIF

EndProc


*========================================================================================
* Gibt .T. zurck, wenn eine Verbindung aufgebaut wurde
*========================================================================================
Function IsConnected
Return This.hSession # 0

EndDefine


*========================================================================================
* Bietet Kodierungsdienste rund um 
*========================================================================================
Define Class CHttpEncoding as Custom

*========================================================================================
* Kodiert einen string im Format das in Urls verwendet wird.
*========================================================================================
Procedure UrlEncode( tcString )

	*--------------------------------------------------------------------------------------
	* Assertion
	*--------------------------------------------------------------------------------------
	#IF __DEBUGLEVEL >= __DEBUG_REGULAR
		Assert Vartype(m.tcString) == T_CHARACTER
	#ENDIF

	*--------------------------------------------------------------------------------------
	* Kodieren
	*--------------------------------------------------------------------------------------
	Local lnChar, lcEncoded, lcChar
	lcEncoded = ""
	For lnChar = 1 to Len(m.tcString)
		lcChar = Substr(m.tcString,m.lnChar,1)
		Do case
		Case IsAlpha(m.lcChar) or IsDigit(m.lcChar)
			lcEncoded = m.lcEncoded + m.lcChar
		Case InList(m.lcChar,"=","?","/","#","&")
			lcEncoded = m.lcEncoded + m.lcChar
		Otherwise 
			lcEncoded = m.lcEncoded + "%" + Right(Transform(Asc(m.lcChar),"@0"),2)
		EndCase
	EndFor 

Return m.lcEncoded

EndDefine 
