I've always used the following with good results:
If (False)
`
`Project method: UTIL_HTTP_Download
`Date created: 10/12/06 4:23 PM
`
`Description:
` $result= UTIL_HTTP_Download
($art;$resultpointer;$URL;$referer;$cookie;$post;$
` needs 4D 2004.1 or newer and 4D Internet Commands
` allows HTTP Download, as blob (raw), text (first 32k), or picture
(Mac picture)
` example for usage
`
$result:=UTIL_HTTP_Download("Picture";->[Logos]Bildfeld;"http://www.test.com/m
`
$result:=UTIL_HTTP_Download("blob";->$myblob;"http://www.test.com/song.mp3";)
` BLOB TO DOCUMENT("mysong.mp3";$myblob) ` Note: original name of
file is conta
`
$result:=UTIL_HTTP_Download("text";->$mytext;"127.0.0.1:8080/4DAction/test")
` $result contains by correct calls the HTTP Header in form
` "HTTP/1.x 200 OK....."
` or "HTTP/1.x 404....." = page not found. Look for "@200 OK@"
` the HTTP Header contains other useable info like Cookies
` in addition to a HTTP header it may contain error messages with
these text:
` UTIL_HTTP_Download - Error: URL required ` 3 Parameter are
minimum, wron
` UTIL_HTTP_Download - Error: Wrong result type, blob expected
` Call with P
` UTIL_HTTP_Download - Error: Wrong result type, picture expected
` Call wit
` UTIL_HTTP_Download - Error: Wrong result type, text expected
` Call with P
` UTIL_HTTP_Download - Error: HTTP Request not sent, please check
the URL `
` UTIL_HTTP_Download - Error: Connection failed ` TCP Open not
possible
` the first parameter defines the return type (Text, Picture or Blob)
` Parameter 2 is a pointer to a variable of these typ, it can be a
local variable
` Parameter 3 is the URL, should start with http:// or https://,
http:// is auto
`the other parameters are optional
` Parameter 4 is referer, which is required from some web page.
Usualy the previo
` Parameter 5 contains cookies. Only send if # ""
` Example: "Cookie: 4D-font=sizemediumtext; ID=5"
` or "4D-font=sizemediumtext; ID=5" - in this case the routine
automatically add
` Cookies are automatically handled for HTTP Redirects, like needed
for Amazon. I
` next URL request. The final cookie can be read from the HTTP Header
` Parameter 6 contains values for Post. If passed the HTTP Download
is send as PO
` if value starts with "Content-Type" the whole content is passed
through without
` Parameter 7 allows to set a timeout, maximal wait for an answer.
Default value
` Parameter 8 (Boolean) allows to disable the automatic following
from redirects
` außer Wert beginnt direkt mit "Content-Type", dann wird der
gesamte Inhalt einf
` Usage in 4D versions older than 2004.1 not possible, this method
use pointer on
` the method does not use any global variables or other methods, it
works recursi
` single methods as this are complex and difficult to debug -
creating such compl
` in this case it contains well debugged code and allows easy
installation
` a simple copy&paste allows to add the full functionality.
` Thomas Maul, 4D Deutschland, 5.7.05 - code based on TN 2002-05,
Julien Feasson
End if
C_TEXT($art;$1;$url;$3;$referer;$4;$cookie;$5;$post;$6;$0;$err)
C_POINTER($2;$resultpointer)
C_LONGINT($7;$timeout)
C_BOOLEAN($8;$Followredirect)
$referer:=""
$cookie:=""
$post:=""
$timeout:=30
$Followredirect:=True
` internal variables
C_TEXT($WSPI_MyString;$result)
C_LONGINT($WSPI_parser;$WSPI_n;$WSPI_ascii)
C_STRING(1;$WSPI_MyChar;$C_CR;$C_LF)
C_TEXT($domainname;$domainport;$domainfolder)
C_LONGINT($shift;$FollowNB;$ssl;$lerr;$mysessionID;$state;$srcpos;$dstpos;$pos;$pos2;$teil;$viLen;$viPos;$viChar)
C_BOOLEAN($Follow)
C_TEXT($HTTP_Response;$HTTP_Request;$Response;$ErrorCode;$header;$title;$cookie2;$urlnew;$domainname2)
C_TIME($timer)
C_TEXT($char)
C_LONGINT($i;$j)
C_TEXT($ChunkSizeB16)
C_LONGINT($ChunkSize)
C_BLOB($helpblob;$Blob_All;$Blob_Received)
C_PICTURE($helpict)
C_LONGINT($offset;$offset2)
If (Count parameters<3) ` 3 parameter is minimum
$err:="UTIL_HTTP_Download - Error: URL required"
Else
$art:=$1
$resultpointer:=$2
$url:=$3
If (Count parameters>3)
$referer:=$4
End if
If (Count parameters>4)
$cookie:=$5
End if
If (Count parameters>5)
$post:=$6
End if
If (Count parameters>6)
$timeout:=$7
End if
If (Count parameters>7)
$Followredirect:=$8
End if
$err:=""
Case of
: ($art="Blob")
If (Type($resultpointer->)=Is BLOB )
$domainname:=""
$domainport:=""
$domainfolder:=""
$err:=UTIL_HTTP_Download
("URL_SendRequest";$resultpointer;$url;$referer;$cookie;$post;$timeout;$Followredirect)
Else
$err:="UTIL_HTTP_Download - Error: Wrong result
type, blob expected"
End if
: ($art="Text")
If (Type($resultpointer->)=Is Text )
$err:=UTIL_HTTP_Download
("Blob";->$helpblob;$url;$referer;$cookie;$post;$timeout;$Followredirect)
$resultpointer->:=BLOB to text($helpblob;Text
without length )
Else
$err:="UTIL_HTTP_Download - Error: Wrong result
type, text expected"
End if
: ($art="Picture")
$resultpointer->:=$helpict
If (Type($resultpointer->)=Is Picture )
$err:=UTIL_HTTP_Download
("Blob";->$helpblob;$url;$referer;$cookie;$post;$timeout;$Followredirect)
If ($err="HTTP@")
BLOB TO
PICTURE($helpblob;$resultpointer->)
End if
Else
$err:="UTIL_HTTP_Download - Error: Wrong result
type, picture expected"
End if
` ****** the following routine may be useful if
you need to
encode your URL
` example: "www.test.com/my method" contains a
blank, so needs
to be converted
` call it like
UTIL_HTTP_Download("URL_Encoder";->$encodedurl;$url)
: ($art="URL_Encoder") ` encodes umlauts, blanks and other
special
chars in an URL
$result:=""
$WSPI_MyString:=$url
` If the charset is different than Latin-1 please add
your
translation below
` Parse the string and translate the special
characters
For ($WSPI_parser;1;Length($WSPI_MyString))
$WSPI_MyChar:=Substring($WSPI_MyString;$WSPI_parser;1)
$WSPI_ascii:=Ascii($WSPI_MyChar)
If
((($WSPI_ascii>=Ascii("a'")) & ($WSPI_ascii<=Ascii("z'"))) |
(($WSPI_ascii>=Ascii("A")) & ($WSPI_ascii<=Ascii("Z"))) |
(($WSPI_ascii>=Ascii("0")) & ($WSPI_ascii<=Ascii("9"))) |
($WSPI_MyChar="*") | ($WSPI_MyChar="-") | ($WSPI_MyChar=".") |
($WSPI_MyChar="_") | ($WSPI_MyChar="/"))
$result:=$result+$WSPI_MyChar
Else
$result:=$result+"%"
$WSPI_n:=Ascii($WSPI_MyChar)\16
If ($WSPI_n<10)
$result:=$result+String($WSPI_n)
Else
$result:=$result+Char(Ascii("A")+$WSPI_n-10)
End if
$WSPI_n:=Ascii($WSPI_MyChar)%16
If ($WSPI_n<10)
$result:=$result+String($WSPI_n)
Else
$result:=$result+Char(Ascii("A")+$WSPI_n-10)
End if
End if
End for
$resultpointer->:=$result
` ****** the following routine may be useful if
you need to
extract the cookie
` call it like HTTPHeader:=UTIL_HTTP_Download
("text";->TextResult;"http://www.am
` $result:=UTIL_HTTP_Download
("Get_Cookie";->HTTPCookies;HTTPHeader;char(13))
` Use Parameter 4 to delimit the cookies. Use
char(13) if you
want to read it - o
: ($art="Get_Cookie")
If ($referer="")
$referer:=", "
End if
$cookie:=""
$header:=$url
$title:="Set-Cookie: "
$pos:=Position($title;$header)
While ($pos>0)
$header:=Substring($header;$pos+Length($title))
$pos2:=Position(Char(13)+Char(10);$header)
If ($pos2>0)
$cookie2:=Substring($header;1;$pos2-1)
$header:=Substring($header;$pos2+2)
$pos:=Position($title;$header)
Else
$cookie2:=$header
$pos:=0
End if
If ($cookie="")
$cookie:=$cookie2
Else
$cookie:=$cookie+$referer+$cookie2
End if
End while
$resultpointer->:=$cookie
` ****** the following routine may be useful if
you need to
extract the name o
` sometimes the HTTP Header contains a useable file
name
` if not we can use at least the end of the URL,
which should be
the file name
` call it like this
` $url:="http://www.test.com/song.mp3";
`
$HTTPHeader:=UTIL_HTTP_Download("blob";->$myblob;$url)
` $Filename:=UTIL_HTTP_Download
("Filename";->$HTTPHeader;$url)
` note that you need to pass both HTTPHeader and used
URL.
Routine tries to find
: ($art="File_name")
$pos:=Position("name=\\";$resultpointer->)
If ($pos>0)
$result:=Substring($resultpointer->;$pos)
$pos:=Position(Char(13);$result)
If ($pos>0)
$err:=Substring($result;1;$pos) `
$err is returned as $0
Else
$err:=$result
End if
Else
` find last /
$viLen:=Length($url)
$viPos:=0
For ($viChar;$viLen;1;-1)
If ($url[[$viChar]]="/")
$viPos:=$viChar
$viChar:=0
End if
End for
If ($viPos>0)
$err:=Substring($url;$viPos+1)
Else
$err:=$url
End if
End if
` ****** the following parts are internal
commands. The method
calls itself to
` this makes it easier to install the method, only
one is needed
` long methods are no problem anymore (starting with
2003),
modern computers have
: ($art="URL_Parse_@") ` parses the URL and returns the Domain
name, Port or Folder as target
$domainname:=""
$domainport:=""
$domainfolder:=""
`Check if the user specified the protocol http
Case of
: (Substring($URL;0;7)="http://";)
$shift:=8
: (Substring($URL;0;8)="https://";)
$shift:=9
Else
$shift:=1
End case
`Retrieve the domainname and the portnumber
If ((Position(":";Substring($URL;$shift))#0) &
(Position(":";Substring($URL;$shift))<Position("/";Substring($URL;$shift))))
$domainname:=Substring($URL;$shift;Position(":";Substring($URL;$shift))-1)
If (Position("/";Substring($URL;$shift))#0)
$domainport:=String(Num(Substring($URL;Position(":";Substring($URL;$shift))+$shift;Position("/";Substring($URL;$shift))-Position(":";Substring($URL;$shift))-1)))
Else
$domainport:=String(Num(Substring($URL;Position(":";Substring($URL;$shift))+$shift;$shift-Position(":";Substring($URL;$shift))-1)))
End if
Else
If (Position("/";Substring($URL;$shift))#0)
$domainname:=Substring($URL;$shift;Position("/";Substring($URL;$shift))-1)
Else
$domainname:=Substring($URL;$shift)
End if
If ($url="https@")
$domainport:="443"
Else
$domainport:="80"
End if
End if
If (Position("/";$URL)#0)
$url:=Substring($URL;$shift)
$domainfolder:=Substring($URL;Position("/";$URL))
Else
$domainfolder:="/"
End if
Case of
: ($art="URL_Parse_Domain")
$resultpointer->:=$domainname
: ($art="URL_Parse_Port")
$resultpointer->:=$domainport
: ($art="URL_Parse_Folder")
$resultpointer->:=$domainfolder
Else
$resultpointer->:="error"
End case
: ($art="URL_SendRequest") ` does the real job - finally...
$C_CR:=Char(Carriage return )
$C_LF:=Char(Line feed )
$Follow:=True
$FollowNB:=0
$HTTP_Response:=""
UTIL_HTTP_Download
("URL_Parse_Domain";->$domainname;$url) ` it is
not nice to call it 3 times, but this avoids that we need more methods
or
UTIL_HTTP_Download ("URL_Parse_Port";->$domainport;$url)
UTIL_HTTP_Download
("URL_Parse_Folder";->$domainfolder;$url)
While (($Follow) & ($FollowNB<4))
$Follow:=False
$FollowNB:=$FollowNB+1
If ($post="")
$HTTP_Request:="GET "
Else
$HTTP_Request:="POST "
End if
$HTTP_Request:=$HTTP_Request+$domainfolder
$HTTP_Request:=$HTTP_Request+"
HTTP/1.1"+$C_CR+$C_LF
$HTTP_Request:=$HTTP_Request+"User-Agent:
"+"4D_HTTP-Client"+$C_CR+$C_LF
$HTTP_Request:=$HTTP_Request+"Host:
"+$domainname
If (Num($domainport)#80)
$HTTP_Request:=$HTTP_Request+":"+$domainport
End if
$HTTP_Request:=$HTTP_Request+$C_CR+$C_LF
$HTTP_Request:=$HTTP_Request+"Connection:
"+"Close"+$C_CR+$C_LF
If ($cookie#"")
If ($cookie="Cookie@") ` Post contains
already header and
prepared data, simply pass it through
$HTTP_Request:=$HTTP_Request+$cookie+$C_CR+$C_LF
Else
$HTTP_Request:=$HTTP_Request+"Cookie: "+$cookie+$C_CR+$C_LF
End if
End if
If ($post#"")
If ($post="Content-Type@") ` Post
contains already header and
prepared data, simply pass it through
$HTTP_Request:=$HTTP_Request+$post
Else
$HTTP_Request:=$HTTP_Request+"Content-type:
application/x-www-form-urlencoded"+$C_CR+$C_LF
$HTTP_Request:=$HTTP_Request+"Content-length: "+String(Length($post))
$HTTP_Request:=$HTTP_Request+$C_CR+$C_LF+$C_CR+$C_LF
$HTTP_Request:=$HTTP_Request+$post
End if
End if
$HTTP_Request:=$HTTP_Request+$C_CR+$C_LF
If ($domainport="443")
$ssl:=2
Else
$ssl:=0
End if
$lerr:=TCP_Open
($domainname;Num($domainport);$MySessionID;$ssl)
If ($lerr=0)
SET BLOB SIZE($Blob_Send;0)
TEXT TO
BLOB($HTTP_Request;$Blob_Send;Text without length ;*)
$lerr:=TCP_SendBLOB
($MySessionID;$Blob_Send) ` Send the request
SET BLOB SIZE($Blob_All;0)
If ($lerr=0)
$timer:=Current time+$timeout
Repeat ` Loop to retrieve the
answer
$lerr:=TCP_ReceiveBLOB
($MySessionID;$Blob_Received)
$lerr:=TCP_State
($MySessionID;$State)
$srcpos:=0
If (BLOB
size($Blob_Received)#0)
$timer:=Current
time+$timeout ` reset timer
End if
$dstpos:=BLOB
size($Blob_All)
`Concatenating
received Blobs
COPY
BLOB($Blob_Received;$Blob_All;$srcpos;$dstpos;BLOB
size($Blob_Received))
Until
(($State=0) | ($lerr#0) | (Current time>$timer))
` Blob received
$lerr:=TCP_Close ($MySessionID)
$Response:=BLOB to
text($Blob_All;Text without length )
$ErrorCode:=Substring($Response;Position("HTTP/1.";$Response)+9;3)
If
((($ErrorCode="302") | ($ErrorCode="301") |
($ErrorCode="307")) & $Followredirect) ` forwarding
` Cookie Management
$cookie:=""
$pos:=Position(Char(13)+Char(10)+Char(13)+Char(10);$response)
If ($pos>0)
$header:=Substring($response;1;$pos)
$result:=UTIL_HTTP_Download ("Get_Cookie";->$cookie;$header;", ")
End if
$Follow:=True
$urlNew:=Substring($Response;Position("Location:
";$Response)+10;Position($C_CR;Substring($Response;Position("Location:
";$Response)+10))-1)
UTIL_HTTP_Download
("URL_Parse_Domain";->$domainname2;$urlNew)
` it is not nice to call it 3 times, but this avoids that we need more
methods or
UTIL_HTTP_Download
("URL_Parse_Port";->$domainport;$urlNew)
UTIL_HTTP_Download
("URL_Parse_Folder";->$domainfolder;$urlNew)
If ($domainname2#"")
$domainname:=$domainname2
End if
End if
Else
$err:="UTIL_HTTP_Download -
Error: HTTP Request not sent, please
check the URL"
End if
Else
$err:="UTIL_HTTP_Download - Error:
Connection failed"
End if
End while
$resultpointer->:=$Blob_All
$pos:=Position(Char(13)+Char(10)+Char(13)+Char(10);$response)
If ($pos>0)
If ($err="")
$err:=Substring($response;1;$pos)
DELETE FROM
BLOB($resultpointer->;0;$pos+3)
If (Position("Transfer-Encoding:
chunked";$err)>0)
If (False)
BLOB TO
DOCUMENT("resultblob.txt";$resultpointer->)
End if
UTIL_HTTP_Download
("Chunk";$resultpointer;"")
End if
End if
End if
: ($art="Chunk") ` remove chunk
$C_CR:=Char(Carriage return )
$C_LF:=Char(Line feed )
If (Type($resultpointer->)=Is BLOB )
SET BLOB SIZE($helpblob;0)
$offset2:=0
$HTTP_Response:=BLOB to
text($resultpointer->;Text without length
;$offset2;25000)
$ChunkSizeB16:="-1"
$result:=""
While
((($ChunkSizeB16#"0") & ($ChunkSizeB16#($C_LF+"0"))) &
($ChunkSizeB16#""))
$pos:=Position($C_CR+$C_LF;$HTTP_Response)
$ChunkSizeB16:=Substring($HTTP_Response;1;$pos-1)
$err:=UTIL_HTTP_Download
("HexToDec";->$Response;$ChunkSizeB16)
$ChunkSize:=Num($Response)
$HTTP_Response:=Substring($HTTP_Response;$pos+2)
$ChunkSize:=$ChunkSize+$pos+2
While ($ChunkSize>0)
$teil:=Length($HTTP_Response)
$result:=$result+$HTTP_Response
TEXT TO
BLOB($result;$helpblob;Text without length ;*)
If (False) ` debug
BLOB TO
DOCUMENT("debugdoc.txt";$helpblob)
End if
$result:=""
$max:=25000
If (($ChunkSize-$offset2)<$max)
$max:=$ChunkSize-$teil
End if
If ($max>0)
$HTTP_Response:=BLOB to
text($resultpointer->;Text without
length ;$offset2;$max)
Else
$HTTP_Response:=""
End if
$ChunkSize:=$ChunkSize-$teil
If
((Length($HTTP_Response)=0) | ($ChunkSize<0))
$ChunkSize:=0
End if
End while
$result:=$result+Substring($HTTP_Response;Position($C_CR+$C_LF;$HTTP_Response)+1;$ChunkSize)
$offset:=$ChunkSize+2
$HTTP_Response:=Substring($HTTP_Response;$offset)
If
((Length($HTTP_Response)<6000) & ($offset2<BLOB size($resultpointer->)))
$HTTP_Response:=$HTTP_Response+BLOB to
text($resultpointer->;Text without length ;$offset2;25000)
TEXT TO
BLOB($result;$helpblob;Text without length ;*)
$result:=""
End if
End while
If ($result#"")
If (Ascii($result[[1]])=10)
$result:=Substring($result;2)
End if
End if
TEXT TO BLOB($result;$helpblob;Text without
length ;*)
$resultpointer->:=$helpblob
Else ` response = Text
$HTTP_Response:=$url
$ChunkSizeB16:="-1"
$result:=""
While
((($ChunkSizeB16#"0") & ($ChunkSizeB16#($C_LF+"0"))) &
($ChunkSizeB16#""))
$ChunkSizeB16:=Substring($HTTP_Response;1;Position($C_CR+$C_LF;$HTTP_Response)-1)
$err:=UTIL_HTTP_Download
("HexToDec";->$Response;$ChunkSizeB16)
$ChunkSize:=Num($Response)
$result:=$result+Substring($HTTP_Response;Position($C_CR+$C_LF;$HTTP_Response)+1;$ChunkSize)
$offset:=$ChunkSize+2+Length($ChunkSizeB16)+2
$HTTP_Response:=Substring($HTTP_Response;$offset)
End while
If ($result#"")
If (Ascii($result[[1]])=10)
$result:=Substring($result;2)
End if
End if
$resultpointer->:=$result
End if
: ($art="HexToDec") ` needed for Chunk
$i:=1
$j:=1
$shift:=0
While ($i<=Length($url))
$char:=Substring($url;Length($url)-$i+1;1)
Case of
: ($char="a")
$shift:=$shift+((16^($j-1))*10)
: ($char="b")
$shift:=$shift+((16^($j-1))*11)
: ($char="c")
$shift:=$shift+((16^($j-1))*12)
: ($char="d")
$shift:=$shift+((16^($j-1))*13)
: ($char="e")
$shift:=$shift+((16^($j-1))*14)
: ($char="f")
$shift:=$shift+((16^($j-1))*15)
: (($char>="0") & ($char<="9"))
$shift:=$shift+((16^($j-1))*Num($char))
Else
$j:=$j-1
End case
$i:=$i+1
$j:=$j+1
End while
$resultpointer->:=String($shift)
Else
$err:="UTIL_HTTP_Download - Error: Unknown parameter #1"
End case
End if
$0:=$err
_______________________________________________
Active4D-dev mailing list
[email protected]
http://mailman.aparajitaworld.com/mailman/listinfo/active4d-dev
Archives: http://mailman.aparajitaworld.com/archive/active4d-dev/
