unit Curl;
{
******* NOTE ************ NOTE ************ NOTE *************
This file is a modified version of curl_h.pp
curl_h.pp was a part of the CurlPas project
Curlpas offers two possible licenses MIT X or MPL
The one choosed for this modified version is the MPL.
More infos at http://www.tekool.com/opcurl
See below for infos about copyright and licensing
******* NOTE ************ NOTE ************ NOTE *************
}
{
* The contents of this file are subject to the Mozilla Public
* License Version 1.1 (the "License"); you may not use this file
* except in compliance with the License. You may obtain a copy of
* the License at http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
* implied. See the License for the specific language governing
* rights and limitations under the License.
*
* The Original Code is curl_h.pp, a file from Curlpas, a Free Pascal wrapper for Curl.
*
* More infos about CurlPas at http://curl.haxx.se
* Contact Jeffrey Pohlmeyer <yetanothergeek@yahoo.com>
*
* The Initial Developer of the Original Code is Jeffrey Pohlmeyer
* Portions created by Jeffrey Pohlmeyer are Copyright (C) 2001-2002 Jeffrey Pohlmeyer
*
* Contributors:
* Christophe Espern - cespern@free.fr
*
* History :
*
* 27/03/02 : Christophe Espern
* - First public release of of this file in OP Curl - Version 0.3
*
* 24/03/02 : Christophe Espern
* - This file has been renamed Curl.pas
* - Add a note to indicate the fact that this file is a modified version
* - Add the header for the MPL license
*
* 20/03/02 : Christophe Espern
* - Reorganize the whole file in sections
* - Remove the link to the C libray in order to allow multi-platforms compilation
* - Remove all the overloaded easy_cur_opt functions.
* - Remove the $OBJFPC directive - This will allow to switch with Delphi
* - Add curl_global_init and curl_global_cleanup declarations from curl.h
* - Add flags constants from curl.h. They are used in global_init
}
interface
const
{$IFDEF LINUX}
LIB_CURL = 'libcurl.so';
{$ENDIF}
{$IFDEF WIN32}
LIB_CURL='libcurl.dll';
{$ENDIF}
{Global_init flags constants}
CURL_GLOBAL_SSL= (1 shl 0);
CURL_GLOBAL_WIN32= (1 shl 1);
CURL_GLOBAL_ALL =(CURL_GLOBAL_SSL or CURL_GLOBAL_WIN32);
CURL_GLOBAL_NOTHING=0;
CURL_GLOBAL_DEFAULT= CURL_GLOBAL_ALL;
{Return codes for curl_easy_ functions}
type TCurlCode = (
CURLE_OK, CURLE_UNSUPPORTED_PROTOCOL, CURLE_FAILED_INIT, CURLE_URL_MALFORMAT, CURLE_URL_MALFORMAT_USER,
CURLE_COULDNT_RESOLVE_PROXY, CURLE_COULDNT_RESOLVE_HOST, CURLE_COULDNT_CONNECT, CURLE_FTP_WEIRD_SERVER_REPLY,
CURLE_FTP_ACCESS_DENIED, CURLE_FTP_USER_PASSWORD_INCORRECT, CURLE_FTP_WEIRD_PASS_REPLY, CURLE_FTP_WEIRD_USER_REPLY,
CURLE_FTP_WEIRD_PASV_REPLY, CURLE_FTP_WEIRD_227_FORMAT, CURLE_FTP_CANT_GET_HOST, CURLE_FTP_CANT_RECONNECT,
CURLE_FTP_COULDNT_SET_BINARY, CURLE_PARTIAL_FILE, CURLE_FTP_COULDNT_RETR_FILE, CURLE_FTP_WRITE_ERROR,
CURLE_FTP_QUOTE_ERROR, CURLE_HTTP_NOT_FOUND, CURLE_WRITE_ERROR, CURLE_MALFORMAT_USER, CURLE_FTP_COULDNT_STOR_FILE,
CURLE_READ_ERROR, CURLE_OUT_OF_MEMORY, CURLE_OPERATION_TIMEOUTED, CURLE_FTP_COULDNT_SET_ASCII, CURLE_FTP_PORT_FAILED,
CURLE_FTP_COULDNT_USE_REST, CURLE_FTP_COULDNT_GET_SIZE, CURLE_HTTP_RANGE_ERROR, CURLE_HTTP_POST_ERROR,
CURLE_SSL_CONNECT_ERROR, CURLE_FTP_BAD_DOWNLOAD_RESUME, CURLE_FILE_COULDNT_READ_FILE, CURLE_LDAP_CANNOT_BIND,
CURLE_LDAP_SEARCH_FAILED, CURLE_LIBRARY_NOT_FOUND, CURLE_FUNCTION_NOT_FOUND, CURLE_ABORTED_BY_CALLBACK,
CURLE_BAD_FUNCTION_ARGUMENT, CURLE_BAD_CALLING_ORDER, CURLE_HTTP_PORT_FAILED, CURLE_BAD_PASSWORD_ENTERED,
CURLE_TOO_MANY_REDIRECTS, CURLE_UNKNOWN_TELNET_OPTION, CURLE_TELNET_OPTION_SYNTAX, CURLE_OBSOLETE,
CURLE_SSL_PEER_CERTIFICATE, CURLE_GOT_NOTHING, CURLE_SSL_ENGINE_NOTFOUND, CURLE_SSL_ENGINE_SETFAILED, CURL_LAST
);
{ CurlCODE's as strings ... }
const CurlCodeStrings : array[CURLE_OK..CURL_LAST] of string[33] = (
'CURLE_OK', 'CURLE_UNSUPPORTED_PROTOCOL', 'CURLE_FAILED_INIT', 'CURLE_URL_MALFORMAT', 'CURLE_URL_MALFORMAT_USER',
'CURLE_COULDNT_RESOLVE_PROXY', 'CURLE_COULDNT_RESOLVE_HOST', 'CURLE_COULDNT_CONNECT', 'CURLE_FTP_WEIRD_SERVER_REPLY',
'CURLE_FTP_ACCESS_DENIED', 'CURLE_FTP_USER_PASSWORD_INCORRECT', 'CURLE_FTP_WEIRD_PASS_REPLY', 'CURLE_FTP_WEIRD_USER_REPLY',
'CURLE_FTP_WEIRD_PASV_REPLY', 'CURLE_FTP_WEIRD_227_FORMAT', 'CURLE_FTP_CANT_GET_HOST', 'CURLE_FTP_CANT_RECONNECT',
'CURLE_FTP_COULDNT_SET_BINARY', 'CURLE_PARTIAL_FILE', 'CURLE_FTP_COULDNT_RETR_FILE', 'CURLE_FTP_WRITE_ERROR',
'CURLE_FTP_QUOTE_ERROR', 'CURLE_HTTP_NOT_FOUND', 'CURLE_WRITE_ERROR', 'CURLE_MALFORMAT_USER', 'CURLE_FTP_COULDNT_STOR_FILE',
'CURLE_READ_ERROR', 'CURLE_OUT_OF_MEMORY', 'CURLE_OPERATION_TIMEOUTED', 'CURLE_FTP_COULDNT_SET_ASCII', 'CURLE_FTP_PORT_FAILED',
'CURLE_FTP_COULDNT_USE_REST', 'CURLE_FTP_COULDNT_GET_SIZE', 'CURLE_HTTP_RANGE_ERROR', 'CURLE_HTTP_POST_ERROR',
'CURLE_SSL_CONNECT_ERROR', 'CURLE_FTP_BAD_DOWNLOAD_RESUME', 'CURLE_FILE_COULDNT_READ_FILE', 'CURLE_LDAP_CANNOT_BIND',
'CURLE_LDAP_SEARCH_FAILED', 'CURLE_LIBRARY_NOT_FOUND', 'CURLE_FUNCTION_NOT_FOUND', 'CURLE_ABORTED_BY_CALLBACK',
'CURLE_BAD_FUNCTION_ARGUMENT', 'CURLE_BAD_CALLING_ORDER', 'CURLE_HTTP_PORT_FAILED', 'CURLE_BAD_PASSWORD_ENTERED',
'CURLE_TOO_MANY_REDIRECTS', 'CURLE_UNKNOWN_TELNET_OPTION', 'CURLE_TELNET_OPTION_SYNTAX', 'CURLE_OBSOLETE',
'CURLE_SSL_PEER_CERTIFICATE', 'CURLE_GOT_NOTHING', 'CURLE_SSL_ENGINE_NOTFOUND', 'CURLE_SSL_ENGINE_SETFAILED', 'CURL_LAST'
);
type
{ List type used by some curl functions ... }
pcurl_slist = ^tcurl_slist;
tcurl_slist = record
data : PChar;
next : pcurl_slist;
end;
{Curl Base Functions}
function curl_version: PChar; cdecl; external LIB_CURL;
procedure curl_global_cleanup;stdcall; cdecl; external LIB_CURL name 'curl_global_cleanup';
procedure curl_global_init(flag:longint);stdcall; cdecl; external LIB_CURL name 'curl_global_init';
{Curl Easy Functions}
function curl_easy_init:LongInt; cdecl; external LIB_CURL;
procedure curl_easy_cleanup(handle:LongInt);cdecl; external LIB_CURL;
function curl_easy_perform(handle:LongInt):TCurlCode;stdcall; cdecl; external LIB_CURL;
function curl_easy_getinfo(handle:LongInt; request:LongInt; return:pointer):TCurlCode;stdcall; cdecl; external LIB_CURL;
function curl_easy_set_integer(handle:LongInt; option:integer; value:LongInt):TCurlCode;stdcall; cdecl; external LIB_CURL name 'curl_easy_setopt';
function curl_easy_set_pointer(handle:LongInt; option:integer; value:pointer):TCurlCode;stdcall; cdecl; external LIB_CURL name 'curl_easy_setopt';
function curl_easy_set_pchar(handle:LongInt; option:integer; value:PChar):TCurlCode;stdcall; cdecl; external LIB_CURL name 'curl_easy_setopt';
{Curl List Functions}
function curl_slist_append(aList:pcurl_slist; aData:PChar):pcurl_slist; cdecl; external LIB_CURL;
procedure curl_slist_free_all(aList:pcurl_slist); cdecl; external LIB_CURL;
const
CURL_ERROR_SIZE = 256; { -- Maximum size of error strings returned by libcurl }
CURLCLOSEPOLICY_OLDEST = 1;
CURLCLOSEPOLICY_LEAST_RECENTLY_USED = 2;
CURL_HTTP_VERSION_NONE = 0;
CURL_HTTP_VERSION_1_0 = 1;
CURL_HTTP_VERSION_1_1 = 2;
{Curl Options}
{boolean options}
CURLOPT_NOTHING = 0;
CURLOPT_CRLF = 27;
CURLOPT_VERBOSE = 41;
CURLOPT_HEADER = 42;
CURLOPT_NOPROGRESS = 43;
CURLOPT_NOBODY = 44;
CURLOPT_FAILONERROR = 45;
CURLOPT_UPLOAD = 46;
CURLOPT_POST = 47;
CURLOPT_FTPLISTONLY = 48;
CURLOPT_FTPAPPEND = 50;
CURLOPT_NETRC = 51;
CURLOPT_FOLLOWLOCATION = 52;
CURLOPT_TRANSFERTEXT = 53;
CURLOPT_PUT = 54;
CURLOPT_HTTPPROXYTUNNEL = 61;
CURLOPT_SSL_VERIFYPEER = 64;
CURLOPT_FRESH_CONNECT = 74;
CURLOPT_FORBID_REUSE = 75;
CURLOPT_HTTPGET = 80;
CURLOPT_FTP_USE_EPSV = 85;
CURLOPT_AUTOREFERER = 58;
{ integer Options }
CURLOPT_PORT = 3;
CURLOPT_TIMEOUT =13;
CURLOPT_LOW_SPEED_LIMIT = 19;
CURLOPT_LOW_SPEED_TIME = 20;
CURLOPT_RESUME_FROM = 21;
CURLOPT_SSLVERSION = 32;
CURLOPT_TIMECONDITION = 33;
CURLOPT_TIMEVALUE = 34;
CURLOPT_PROXYPORT = 59;
CURLOPT_POSTFIELDSIZE = 60;
CURLOPT_MAXREDIRS = 68;
CURLOPT_MAXCONNECTS = 71;
CURLOPT_CONNECTTIMEOUT = 78;
{ integer constants ... }
CURLOPT_CLOSEPOLICY = 72; { CURLCLOSEPOLICY_LEAST_RECENTLY_USED; CURLCLOSEPOLICY_OLDEST }
CURLOPT_SSL_VERIFYHOST = 81; { 1:check existence; 2:ensure match }
CURLOPT_HTTP_VERSION = 84; { CURL_HTTP_VERSION_NONE; CURL_HTTP_VERSION_1_0; CURL_HTTP_VERSION_1_1 }
{ PChar parameters ... }
CURLOPT_URL = 10002;
CURLOPT_PROXY = 10004;
CURLOPT_USERPWD = 10005;
CURLOPT_PROXYUSERPWD = 10006;
CURLOPT_RANGE = 10007;
CURLOPT_ERRORBUFFER = 10010;
CURLOPT_POSTFIELDS = 10015;
CURLOPT_REFERER = 10016;
CURLOPT_FTPPORT = 10017;
CURLOPT_USERAGENT = 10018;
CURLOPT_COOKIE = 10022;
CURLOPT_SSLCERT = 10025;
CURLOPT_SSLCERTPASSWD = 10026;
CURLOPT_COOKIEFILE = 10031;
CURLOPT_CUSTOMREQUEST = 10036;
CURLOPT_INTERFACE = 10062;
CURLOPT_KRB4LEVEL = 10063;
CURLOPT_CAINFO = 10065;
CURLOPT_RANDOM_FILE = 10076;
CURLOPT_EGDSOCKET = 10077;
CURLOPT_COOKIEJAR = 10082;
CURLOPT_SSL_CIPHER_LIST = 10083;
{ linked-lists ... }
CURLOPT_HTTPHEADER = 10023;
CURLOPT_QUOTE = 10028;
CURLOPT_POSTQUOTE = 10039;
CURLOPT_TELNETOPTIONS = 10070;
CURLOPT_HTTPPOST = 10024; {linked-list of tHttpPost records}
CURLOPT_HTTPREQUEST = 10035; { -- Obsolete}
{ Files (100nn) and callbacks (200nn) ... }
CURLOPT_FILE = 10001;
CURLOPT_WRITEFUNCTION = 20011;
CURLOPT_INFILE = 10009;
CURLOPT_INFILESIZE = 14; { -- this one is actually a LongInt, but it wants to be here }
CURLOPT_READFUNCTION = 20012;
CURLOPT_WRITEHEADER = 10029;
CURLOPT_HEADERFUNCTION = 20079;
CURLOPT_PROGRESSDATA = 10057;
CURLOPT_PROGRESSFUNCTION = 20056;
CURLOPT_PASSWDDATA = 10067;
CURLOPT_PASSWDFUNCTION = 20066;
CURLOPT_CLOSEFUNCTION = 20073;
{
These are documented on the curl website, but not defined in my copy of curl.h:
- Maybe because I do not have an ssl engine installed ?
CURLOPT_SSLCERT
CURLOPT_SSLCERTTYPE
CURLOPT_SSLCERTPASSWD
CURLOPT_SSLKEY
CURLOPT_SSLKEYTYPE
CURLOPT_SSLKEYASSWD
CURLOPT_SSL_ENGINE
CURLOPT_SSL_ENGINEDEFAULT
}
{ "var" style parameters - these get modified}
{ CURLOPT_STDERR: Buffer to receive error messages in, must be at least CURL_ERROR_SIZE
bytes big. If this is not used, error messages go to stderr instead: }
CURLOPT_STDERR = 10037;
{ CURLOPT_FILETIME: Pass a pointer to a time_t to get a possible date of the requested
document! Pass a NULL to shut it off. }
CURLOPT_FILETIME = 10069;
{Other strange things...}
{ CURLOPT_FTPASCII: same value as CURLOPT_TRANSFERTEXT - is this one obsolete? }
CURLOPT_FTPASCII = 53;
{ CURLOPT_MUTE: obsolete option, removed in 7.8 }
CURLOPT_MUTE = 55;
{ CURLOPT_WRITEINFO:
curl.h says: "Pass a pointer to string of the output using full variable-replacement as described elsewhere."
jeff.p says: "huh?" :-}
CURLOPT_WRITEINFO = 10040;
{ constants passed to curl_easy_getinfo }
CURLINFO_EFFECTIVE_URL = 1048577;
CURLINFO_CONTENT_TYPE = 1048594; { - added in 7.9.4, bug-fixed in 7.9.5 }
CURLINFO_HTTP_CODE = 2097154;
CURLINFO_HEADER_SIZE = 2097163;
CURLINFO_REQUEST_SIZE = 2097164;
CURLINFO_SSL_VERIFYRESULT = 2097165;
CURLINFO_FILETIME = 2097166;
CURLINFO_TOTAL_TIME = 3145731;
CURLINFO_NAMELOOKUP_TIME = 3145732;
CURLINFO_CONNECT_TIME = 3145733;
CURLINFO_PRETRANSFER_TIME = 3145734;
CURLINFO_SIZE_UPLOAD = 3145735;
CURLINFO_SIZE_DOWNLOAD = 3145736;
CURLINFO_SPEED_DOWNLOAD = 3145737;
CURLINFO_SPEED_UPLOAD = 3145738;
CURLINFO_CONTENT_LENGTH_DOWNLOAD = 3145743;
CURLINFO_CONTENT_LENGTH_UPLOAD = 3145744;
CURLINFO_STARTTRANSFER_TIME = 3145745;
CURLINFO_LASTONE = 18;
{ curl.h defines "true" and "false" as integers, so I renamed them ( for obvious reasons ) }
CURL_TRUE = 1;
CURL_FALSE = 0;
{ Http post data structure and constants ... }
type
ppHttpPost = ^pHttpPost;
pHttpPost = ^tHttpPost;
THttpPost = record
next : pHttpPost; { next entry in the list }
name : PChar; { pointer to allocated name }
namelength : LongInt; { length of name length }
contents : PChar; { pointer to allocated data contents }
contentslength : LongInt; { length of contents field }
contenttype : PChar; { Content-Type }
contentheader : pcurl_slist; { list of extra headers for this form }
more : pHttpPost; { if one field name has more than one file, this should link to following files }
flags : LongInt; { as defined below }
end;
const
HTTPPOST_FILENAME = 1; { specified content is a file name, sent as an "attachment" }
HTTPPOST_READFILE = 2; { specified content is a file name, sent as raw data }
HTTPPOST_PTRNAME = 4; { name is only stored pointer do not free in formfree }
HTTPPOST_PTRCONTENTS = 8; { contents is only stored pointer do not free in formfree }
type tCURLformoption = (
CURLFORM_NOTHING,
CURLFORM_COPYNAME,
CURLFORM_PTRNAME,
CURLFORM_NAMELENGTH,
CURLFORM_COPYCONTENTS,
CURLFORM_PTRCONTENTS,
CURLFORM_CONTENTSLENGTH,
CURLFORM_FILECONTENT,
CURLFORM_ARRAY,
CURLFORM_ARRAY_START,
CURLFORM_FILE,
CURLFORM_CONTENTTYPE,
CURLFORM_CONTENTHEADER,
CURLFORM_END,
CURLFORM_ARRAY_END,
CURLFORM_LASTENTRY
);
procedure curl_formfree( form: pHttpPost ); cdecl; external LIB_CURL;
{
"curl_formadd" wants a "va_list" as its third parameter,
but FPC does not support this type of function call.
It appears that *usually* the number of arguments is an odd number between 5 and 13.
So this VERY_UGLY workaround should work in most cases ...
}
function curl_formadd_5( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Option_End: tCURLformoption
): LongInt; cdecl; external LIB_CURL name 'curl_formadd';
function curl_formadd_7( httppost: ppHttpPost; last_post:ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
OptN: tCURLformoption
): LongInt; cdecl; external LIB_CURL name 'curl_formadd';
function curl_formadd_9( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
OptN: tCURLformoption
): LongInt; cdecl; external LIB_CURL name 'curl_formadd';
function curl_formadd_11( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Option_End: tCURLformoption
): LongInt; cdecl; external LIB_CURL name 'curl_formadd';
function curl_formadd_13( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Opt5: tCURLformoption; Val5: LongInt;
Option_End: tCURLformoption
): LongInt; cdecl; external LIB_CURL name 'curl_formadd';
{ Now we can declare overloaded "aliases" for the "real" curl_formadd ... }
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Option_End: tCURLformoption
): LongInt;overload; {5}
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Option_End: tCURLformoption
): LongInt;overload; {7}
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Option_End: tCURLformoption
): LongInt;overload; {9}
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Option_End: tCURLformoption
): LongInt;overload; {11}
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Opt5: tCURLformoption; Val5: LongInt;
Option_End: tCURLformoption
): LongInt;overload; {13}
implementation
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Option_End: tCURLformoption
): LongInt;
begin
curl_formadd:=curl_formadd_5(httppost, last_post, Opt1, Val1, Option_End);
end;
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Option_End: tCURLformoption
): LongInt;
begin
curl_formadd:=curl_formadd_7( httppost, last_post, Opt1, Val1, Opt2, Val2, Option_End );
end;
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Option_End: tCURLformoption
): LongInt;
begin
curl_formadd:=curl_formadd_9( httppost, last_post, Opt1, Val1, Opt2, Val2, Opt3, Val3, Option_End );
end;
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Option_End: tCURLformoption
): LongInt;
begin
curl_formadd:=curl_formadd_11(
httppost, last_post, Opt1, Val1, Opt2, Val2, Opt3, Val3, Opt4, Val4, Option_End );
end;
function curl_formadd( httppost: ppHttpPost; last_post: ppHttpPost;
Opt1: tCURLformoption; Val1: LongInt;
Opt2: tCURLformoption; Val2: LongInt;
Opt3: tCURLformoption; Val3: LongInt;
Opt4: tCURLformoption; Val4: LongInt;
Opt5: tCURLformoption; Val5: LongInt;
Option_End: tCURLformoption
): LongInt;
begin
curl_formadd:=curl_formadd_13(
httppost, last_post, Opt1, Val1, Opt2, Val2, Opt3, Val3, Opt4, Val4, Opt5, Val5, Option_End );
end;
end.unit curlengine;
{/*
* The contents of this file are subject to the Mozilla Public
* License Version 1.1 (the "License"); you may not use this file
* except in compliance with the License. You may obtain a copy of
* the License at http://www.mozilla.org/MPL
*
* Software distributed under the License is distributed on an "AS
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
* implied. See the License for the specific language governing
* rights and limitations under the License.
*
* The Original Code is the OP-Curl : an Object-Pascal wrapper for Curl.
*
* More infos at http://www.tekool.com/opcurl - Contact : cespern@free.fr
*
* The Initial Developer of the Original Code is Christophe ESPERN
* Portions created by Christophe ESPERN are Copyright (C) 2001-2002 Christophe
* ESPERN. All Rights Reserved.
*
* Contributor(s): None
*
* Known bugs : None
*
}
interface
uses SysUtils,Curl,Classes;
type
TCurlEngine = class (TComponent)
private
FStream:TStream;
FUserName: string;
FLastError: string;
FPassword: string;
FResultString: string;
protected
function DoDownload(Url,OutputFile:string): boolean;virtual;
function DoUpload(URL:string): boolean;virtual;
public
constructor Create(Aowner:TComponent);override;
destructor Destroy;override;
function UploadFile(InputFile,URL:string):boolean;
function UploadString(Data,URL:string):boolean;
function Download(Url,OutputFile:string):boolean;
procedure FreeResultString;
property LastError:string read FLastError;
property ResultString:string read FResultString;
published
property UserName:string read FUserName write FUserName;
property Password:string read FPassword write FPassword;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Tekool', [TCurlEngine]);
end;
function WriteFunc(ptr:pointer;size,nmemb:longint;stream:TStream):longint; cdecl;
begin
try
Result:=stream.Write(ptr^,size*nmemb)
except
raise Exception.create('TCurlEngine : WriteFunc error');
end;
end;
function ReadFunc(ptr:pointer;size,nmemb:longint;stream:TStream):longint; cdecl;
begin
try
if size*nmemb>stream.size then
Result:=stream.Read(ptr^,stream.size)
else
Result:=stream.Read(ptr^,size*nmemb);
except
raise Exception.create('TCurlEngine : ReadFunc error');
end;
end;
{ TCurlEngine }
constructor TCurlEngine.Create(Aowner: TComponent);
begin
inherited;
end;
destructor TCurlEngine.Destroy;
begin
inherited;
end;
function TCurlEngine.DoDownload(Url,OutputFile:string): boolean;
var
HCurl:longint;
rc:TCurlCode;
s:string;
begin
FResultString:='';
Result:=false;
try
if OutputFile<>'' then
FStream:=TFileStream.Create(OutputFile,fmCreate)
else
{$IFDEF FPC}
FStream:=TFileStream.Create(inttostr(integer(self)),fmCreate) ;
{$ELSE}
FStream:=TStringStream.Create('');
{$ENDIF}
hCurl:= curl_easy_init;
if UserName<>'' then
curl_easy_set_pchar(hCurl, CURLOPT_USERPWD,Pchar(UserName+':'+PassWord));
curl_easy_set_integer(HCurl,CURLOPT_TIMEOUT,1);
curl_easy_set_pchar(HCurl, CURLOPT_URL, Pchar(URL));
curl_easy_set_integer(HCurl,CURLOPT_FILE,integer(FStream));
curl_easy_set_pointer(HCurl,CURLOPT_WRITEFUNCTION,@WriteFunc);
rc:= curl_easy_perform(HCurl);
if rc<>CURLE_OK then
FLastError:=CurlCodeStrings[rc]
else begin
FLastError:='';
Result:=true;
end;
curl_easy_cleanup(HCurl);
if OutPutFile='' then begin
FStream.Position := 0;
SetLength(FResultString, FStream.size);
FStream.ReadBuffer(Pointer(FResultString)^, FStream.size);
DeleteFile(inttostr(integer(self)));
end;
finally
DeleteFile(inttostr(integer(self)));
FStream.free;
end;
end;
function TCurlEngine.DoUpload(URL:string): boolean;
var
HCurl:LongInt;
begin
Result:=false;
try
if FStream=nil then
raise EXception.create('TCurlEngine.DoUpload : FStream = nil !');
hCurl:= curl_easy_init;
if UserName<>'' then
curl_easy_set_pchar(hCurl, CURLOPT_USERPWD,Pchar(UserName+':'+PassWord));
if hCurl <> 0 then begin
curl_easy_set_pchar(hCurl, CURLOPT_URL, PChar(URL));
curl_easy_set_integer(hCurl,CURLOPT_UPLOAD, 1);
curl_easy_set_pointer(hCurl,CURLOPT_READFUNCTION,@ReadFunc);
curl_easy_set_pointer(hCurl, CURLOPT_INFILE, FStream);
curl_easy_set_integer(hCurl, CURLOPT_INFILESIZE, longint(FStream.size));
curl_easy_perform(hCurl);
curl_easy_cleanup(hCurl);
end;
except
raise;
end;
end;
function TCurlEngine.UploadString(Data, URL: string): boolean;
begin
FStream:= TStringStream. create(data);
Result:=DoUpload(URL);
FStream.Free;
end;
function TCurlEngine.Download(Url, OutputFile: string): boolean;
begin
Result:=DoDownload(URL,OutputFile);
end;
procedure TCurlEngine.FreeResultString;
begin
FResultString:='';
end;
function TCurlEngine.UploadFile(InputFile, URL: string): boolean;
begin
FStream:=TFileStream.Create(InputFile,fmOpenWrite);
Result:=DoUpload(URL);
FStream.free;
end;
initialization
curl_global_init(CURL_GLOBAL_ALL);
finalization
curl_global_cleanup;
end.
