在Delphi调用LibCurl

在Delphi中无法直接使用LibCurl的最新版本，在网上只查到有个CurlPas的调用接口，但已经6年没更新了。

为了解决这个问题，我只有在VC中写LibCurl的实现代码，然后在Delphi调用VC的DLL。

 http.zip   

在这个压缩包中只有一个http.dll，是在VC中实现Http的Get/Head/Post，其实还包括2个下载文件函数，其中一个下载函数是将文件的数据保存到IStream流中的，但在Delphi中不知道怎么写调用参数，所以就没用上。

有了调用接口，就写个简单的类来调用吧！

unit http;

interface

uses
    Windows,
    SysUtils,
    Classes;

type
    TWinHttp = class
    private
        procedure Initializing;
        procedure HttpInfo;

    protected
        FUrl,FCookie,FSavePath,FReferer,FProxy,FHead,FSource,FPostData,
        FLocation:string;
        FStateCode,FProxyPort:Integer;

    public
        constructor Create;overload;
        function Get:string;
        function Head:string;
        function Post:string;
        function StateCode:Integer;

    published
        property Url:string read FUrl write FUrl;
        property Cookie:string read FCookie write FCookie;
        property SavePath:string read FSavePath write FSavePath;
        property PostData:string read FPostData write FPostData;
        property Referer:string read FReferer write FReferer;
        property Proxy:string read FProxy write FProxy;
        property ProxyPort:Integer read FProxyPort write FProxyPort;
        property Location:string read FLocation write FLocation;


    end;



implementation

const BUFSIZ = 204800;

//==============================================================================
// 静态调用http.dll
//==============================================================================


//下载文件
function GetFile( Url:PChar; Cookie:PChar; SavePath:PChar ):Boolean;
    cdecl external 'http.dll' name 'GetFile';

//获取网页源码
function GetUrl( Url:PChar; Referer:PChar; Cookie:PChar;
    Proxy:PChar; ProxyPort:Integer;
    Source:PChar; nSrc:Integer ):Boolean;
    cdecl external 'http.dll' name 'GetUrl';

//获取网页HTTP头
function GetHead( Url:PChar; Referer:PChar; Cookie:PChar;
    Proxy:PChar; ProxyPort:Integer;
    Source:PChar; nSrc:Integer ):Boolean;
    cdecl external 'http.dll' name 'GetHead';

//HTTP提交
function PostUrl( Url:PChar; Referer:PChar; Cookie:PChar;
     PostData:PChar; Proxy:PChar; ProxyPort:Integer;
    Source:PChar; nSrc:Integer ):Boolean;
    cdecl external 'http.dll' name 'PostUrl';



//==============================================================================
// TWinHttp
//==============================================================================

constructor TWinHttp.Create;
begin
    Initializing;
end;

procedure TWinHttp.Initializing;
begin
    FUrl := '';
    FCookie := '';
    FSavePath := '';
    FReferer := '';
    FProxy := '';
    FHead := '';
    FSource := '';
    FPostData := '';
    FStateCode := 0;
    FProxyPort := 0;
end;

procedure TWinHttp.HttpInfo;
var
    i,nPos,nIndex:Integer;
    CookieList:TStringList;
begin
    CookieList := TStringList.Create;

    //提取HTTP头
    nPos := Pos( #13#10#13#10, FSource );
    if nPos <> 0 then
    begin
        FHead := Copy( FSource, 1, nPos );

        //提取状态码
        FStateCode := StrToInt( Copy( FHead, 10, 3 ) );

        //Location
        if FStateCode = 302 then
        begin
            nPos := Pos( 'Location: ', FHead );

            FLocation := Copy( FHead, nPos + Length( 'Location: ' ),
                Length( FHead ) - nPos );
            FLocation := Copy( FLocation, 1, Pos( #13#10, FLocation ) - 1 );
        end;

        //网页内容
        FSource := Copy( FSource, nPos + Length( #13#10#13#10 ),
            Length( FSource ) - nPos );

        if ( Pos( 'charset=utf-8', FSource ) <> 0 ) or
            ( Pos( 'charset=UTF-8', FSource ) <> 0 ) then
        begin
            FSource := Utf8ToAnsi( FSource );
        end;

    end;

    //提取Cookie
    ExtractStrings( [#13], [], PChar( FHead ), CookieList );
    if CookieList.Count > 0 then
    begin
        FCookie := '';
        for i := 0 to CookieList.Count - 1 do
        begin
            nPos := Pos( 'Set-Cookie: ', CookieList[i] );
            if nPos = 1 then
            begin
                FCookie := FCookie +
                    Copy( CookieList[i], Length( 'Set-Cookie: ' ) + 1,
                    Length( CookieList[i] ) - Length( 'Set-Cookie: ' ) + 1 );
                nIndex := Length( FCookie );
                if FCookie[nIndex] <> ';' then
                    FCookie := FCookie + '; ';
            end;
        end;
    end;

    CookieList.Free;
end;

function TWinHttp.Get:string;
var
    pSource:PChar;
begin
    FSource := '';
    FHead := '';
    FLocation := '';
    FStateCode := 0;


    if FUrl <> '' then
    begin
        GetMem( pSource, BUFSIZ );
        ZeroMemory( pSource, BUFSIZ );

        if GetUrl( PChar( FUrl ), PChar( FReferer ), PChar( FCookie ),
            PChar( FProxy ), FProxyPort, pSource, BUFSIZ ) then
        begin
            FSource := StrPas( pSource );
        end;
        FreeMem( pSource );

        //提取Http头中的各项数据
        HttpInfo;
    end;

    Result := FSource;
end;

function TWinHttp.Head:string;
var
    pSource:PChar;
begin
    FSource := '';
    FLocation := '';
    FHead := '';
    FStateCode := 0;

    if FUrl <> '' then
    begin
        GetMem( pSource, BUFSIZ );
        ZeroMemory( pSource, BUFSIZ );

        if GetHead( PChar( FUrl ), PChar( FReferer ), PChar( FCookie ),
            PChar( FProxy ), FProxyPort, pSource, BUFSIZ ) then
        begin
            FSource := StrPas( pSource );
        end;
        FreeMem( pSource );

        FHead := FSource;

        //提取Http头中的各项数据
        HttpInfo;
    end;

    Result := FHead;
end;

function TWinHttp.Post:string;
var
    pSource:PChar;
begin
    FSource := '';
    FLocation := '';
    FHead := '';
    FStateCode := 0;

    if ( FUrl <> '' ) and ( FPostData <> '' ) then
    begin
        GetMem( pSource, BUFSIZ );
        ZeroMemory( pSource, BUFSIZ );

        if PostUrl( PChar( FUrl ), PChar( FReferer ),
             PChar( FPostData ), PChar( FCookie ),
             PChar( FProxy ), FProxyPort,
             pSource, BUFSIZ ) then
        begin
            FSource := StrPas( pSource );
        end;
        FreeMem( pSource );

        //提取Http头中的各项数据
        HttpInfo;
    end;
end;

function TWinHttp.StateCode:Integer;
begin
    Result := FStateCode;
end;

end.