httpprot.pas

互联网套件

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE
Creation:     November 23, 1997
Version:      1.24
Description:  THttpCli is an implementation for the HTTP protocol
              RFC 1945 (V1.0), RFC 2068 (V1.1)
Credit:       This component was based on a freeware from by Andreas
              Hoerstemeier and used with his permission.
              [e-mail] http://www.westend.de/~hoerstemeier
EMail:        [e-mail]
              [e-mail]             http://www.rtfm.be/fpiette
Support:      Use the mailing list [e-mail] See website for details.
Legal issues: Copyright (C) 1997, 1998, 1999 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Quick Reference:
HTTP component can retrieve documents or files using HTTP protocol; that is
connect to a HTTP server also known as a webserver. It can also trigger a
CGI/ISAPI/NSAPI script and post data using either GET or POST method.
Syntax of an URL: protocol://[user[:password]@]server[:port]/path
Path can include data: question mark followed by URL encoded data.
HTTP component is either asynchonous (non-blocking) or synchonous (blocking).
Highest performance is when using asynchonous operation. This is the
recommended way to use HTTP component.
To request several URL simultaneously, use asynchronous operation and as much
HTTP components as you wants to request URLs. All requests will be executed
simultaneously without using multi-threading and without blocking your app.
Methods:
    GetASync    Asynchronous, non-blocking Get
                Retrieve document or file specified by URL, without blocking.
                OnRequestDone event trigered when finished. Use HTTP GET
                method (data contained in URL)
    PostASync   Asynchronous, non-blocking Post
                Retrieve document or file specified by URL, without blocking.
                OnRequestDone event trigered when finished. Use HTTP POST
                method (data contained in request stream)
    HeadASync   Asynchronous, non-blocking Head
                Retrieve document or file header specified by URL, without
                blocking. OnRequestDone event trigered when finished. Use HTTP
                HEAD method.
    Get         Synchronous, blocking Get. Same as GetAsync, but blocks until
                finished.
    Post        Synchronous, blocking Post. Same as PostAsync, but blocks until
                finished.
    Head        Synchronous, blocking Head. Same as HeadAsync, but blocks until
                finished.
    Abort       Immediately close communication.

Updates:
11/29/97 RcvdStream and SendStream properties moved to public section
11/30/97 Document name bug corrected
12/02/97 Removed bug occuring with terminating slash in docname
12/03/97 Added properties RcvdCount and SentCount to easily add a progress
         bar feature (On receive, the ContentLength is initialized with the
         value from the header. Update the progress bar in the OnDocData event,
         or the OnSendData event).
         Added the OnSendBegin, OnSendData and OnSendEnd events.
12/07/97 Corrected Head function to work as expected. Thanks to
         R. Barry Jones <[e-mail]
29/12/97 V0.96 Added ModifiedSince property as followinf proposition made by
         Aw Kong Koy" <[e-mail]>.
30/12/97 V0.97 Added a Cookie property to send cookies
11/01/98 V0.98 Added WSocket read-only property which enable to access the
         socket component used internally. For example to close it to abort
         a connection.
13/01/98 V0.99 Added MultiThreaaded property to tell the component that it is
         working in a thread and should take care of it.
15/01/98 V1.00 Completely revised internal working to make it work properly
         with winsock 2. The TimeOut property is gone.
         Changed OnAnswerLine event to OnHeaderData to be more consistent.
         Replaced AnswserLine property by readonly LastResponse property.
         Added OnRequestDone event. Added GetAsync, PostAsync, HeadAsync
         asynchronous, non-blocking methods. Added Abort procedure.
16/01/98 V1.01 Corrected a bug which let some data be lost when receiving
         (thanks to  Fulvio J. Castelli <[e-mail]>)
         Added test for HTTP/1.1 response in header.
31/01/98 V1.02 Added an intermediate message posting for the OnRequestDone
         event. Thanks to Ed Hochman <[e-mail]> for his help.
         Added an intermediate PostMessage to set the component to ready state.
04/02/98 V1.03 Added some code to better handle DocName (truncating at the
         first question mark).
05/02/98 V1.04 Deferred login after a relocation, using WM_HTTP_LOGIN message.
         Added workarounf to support faulty webservers which sent only a single
         LF in header lines. Submitted by Alwin Hoogerdijk <[e-mail]>
15/03/98 V1.05 Enlarge buffers from 2048 to 8192 bytes (not for D1)
01/04/98 V1.06 Adapted for BCB V3
13/04/98 V1.07 Made RcvdHeader property readonly and cleared the content at the
         start of a request.
         Protected Abort method from calling when component is ready.
         Ignore any exception triggered by CancelDnsLookup in Abort method.
14/04/98 V1.08 Corrected a relocation bug occuring with relative path
26/04/98 V1.09 Added OnLocationChange event
30/04/98 V1.10 Added ProxyUsername and ProxyPassword. Suggested by
         Myers, Mike <[e-mail]>.
26/05/98 V1.11 Corrected relocation problem when used with ASP webpages
09/07/98 V1.12 Adapted for Delphi 4
         Checked argument length in SendCommand
19/09/98 V1.13 Added support for HTML document without header
         Added OnSessionConnected event, httpConnected state and
         httpDnsLookupDone state.
         Corrected a problem with automatic relocation. The relocation
         message was included in data, resulting in wrong document data.
         Added two new events: OnRequestHeaderBegin and OnRequestHeaderEnd.
         They replace the OnHeaderBegin and OnHeaderEnd events that where
         called for both request header (to web server) and response
         header (from web server)
22/11/98 V1.14 Added a Location property than gives the new location in
         case of page relocation. Suggested by Jon Robertson <[e-mail]>
21/12/98 V1.15 Set ContentLength equal to -1 at start of command.
31/01/99 V1.16 Added HostName property
01/02/99 V1.17 Port was lost in DoRequestAsync when using a proxy.
         Thanks to David Wright <[e-mail]> for his help.
         Report Dns lookup error and session connect error in OnrequestDOne
         event handler as suggested by Jack Olivera <[e-mail]>.
14/03/99 V1.18 Added OnCookie event.
16/03/99 V1.19 Added Accept property.
               Added a default value to Agent property.
               Changed OnCookie event signature (not fully implemented yet !).
07/05/99 V1.20 Added code to support Content Ranges by Jon Robertson
               <[e-mail]>.
24/07/99 V1.21 Yet another change in relocation code.
Aug 20, 1999  V1.22 Changed conditional compilation so that default is same
              as latest compiler (currently Delphi 4, Bcb 4). Should be ok for
              Delphi 5. Added Sleep(0) in sync wait loop to reduce CPU usage.
              Added DnsResult property as suggested by Heedong Lim
              <[e-mail]>. This property is accessible from
              OnStateChange when state is httpDnsLookupDone.
              Triggered OnDocData after writing to the stream.
Sep 25, 1999  V1.23 Yet another change in relocation code when using proxy
              Francois Demers <[e-mail]> found that some webserver
              do not insert a space after colon in header line. Corrected
              code to handle it correctly.
              Cleared ContentType before issuing request.
Oct 02, 1999  V1.24 added AcceptRanges property. Thanks to Werner Lehmann
              <[e-mail]>

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit HttpProt;

interface

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$IFNDEF VER80} { Not for Delphi 1                    }
    {$H+}       { Use long strings                    }
    {$J+}       { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0                    }
    {$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125} { C++ Builder V4.0                    }
    {$ObjExportAll On}
{$ENDIF}

uses
    WinProcs, WinTypes, Messages, SysUtils, Classes, Forms, WSocket;

const
    HttpCliVersion     = 124;
    CopyRight : String = ' THttpCli (c) 97-99 F. Piette V1.24 ';
    DefaultProxyPort   = '80';
{$IFDEF VER80}
    { Delphi 1 has a 255 characters string limitation }
    HTTP_RCV_BUF_SIZE = 255;
    HTTP_SND_BUF_SIZE = 8193;
{$ELSE}
    HTTP_RCV_BUF_SIZE = 8193;
    HTTP_SND_BUF_SIZE = 8193;
{$ENDIF}
    WM_HTTP_REQUEST_DONE = WM_USER + 1;
    WM_HTTP_SET_READY    = WM_USER + 2;
    WM_HTTP_LOGIN        = WM_USER + 3;
    httperrNoError  = 0;
    httperrBusy     = 1;
    httperrNoData   = 2;
    httperrAborted  = 3;
    httperrOverflow = 4;

type
    EHttpException = class(Exception)
        ErrorCode : Word;
        constructor Create(const Msg : String; ErrCode : Word);
    end;

    THttpEncoding    = (encUUEncode, encBase64, encMime);
    THttpRequest     = (httpAbort, httpGET, httpPOST, httpHEAD);
    THttpState       = (httpReady,         httpNotConnected, httpConnected,
                        httpDnsLookup,     httpDnsLookupDone,
                        httpWaitingHeader, httpWaitingBody,  httpAborting);

    TOnCommand       = procedure (Sender : TObject;
                                  const S: String) of object;
    TDocDataEvent    = procedure (Sender : TObject;
                                  Buffer : Pointer;
                                  Len    : Integer) of object;
    TCookieRcvdEvent = procedure (Sender       : TObject;
                                  const Data   : String;
                                  var   Accept : Boolean) of object;
    THttpRequestDone = procedure (Sender : TObject;
                                  RqType : THttpRequest;
                                  Error  : Word) of object;

    THttpCli = class(TComponent)
    protected
        FWSocket          : TWSocket;
        FWindowHandle     : HWND;
        FMultiThreaded    : Boolean;
        FState            : THttpState;
        FHostName         : String;
        FTargetHost       : String;
        FPort             : String;
        FProxy            : String;
        FProxyPort        : String;
        FUsername         : String;
        FPassword         : String;
        FProxyUsername    : String;
        FProxyPassword    : String;
        FLocation         : String;
        FConnected        : Boolean;
        FDnsResult        : String;
        FSendBuffer       : array [0..HTTP_SND_BUF_SIZE - 1] of char;
        FRequestType      : THttpRequest;
        FReceiveBuffer    : array [0..HTTP_RCV_BUF_SIZE - 1] of char;
        FReceiveLen       : Integer;
        FLastResponse     : String;
        FHeaderLineCount  : Integer;
        FBodyLineCount    : Integer;
        FAllowedToSend    : Boolean;
        FURL              : String;
        FPath             : String;
        FDocName          : String;
        FSender           : String;
        FReference        : String;
        FAgent            : String;
        FAccept           : String;
        FModifiedSince    : TDateTime;       { Warning ! Use GMT date/Time }
        FNoCache          : Boolean;
        FStatusCode       : Integer;
        FReasonPhrase     : String;
        FContentLength    : LongInt;
        FContentType      : String;
        FDoAuthor         : TStringList;
        FContentPost      : String;
        FContentRangeBegin: String;   {JMR!! Added this line!!!}
        FContentRangeEnd  : String;   {JMR!! Added this line!!!}
        FAcceptRanges     : String;
        FCookie           : String;
        FLocationFlag     : Boolean;
        FRcvdHeader       : TStrings;
        FRcvdStream       : TStream;   { If assigned, will received the answer }
        FRcvdCount        : LongInt;   { Number of received bytes for the body }
        FSentCount        : LongInt;
        FSendStream       : TStream;   { Contains the data to send }
        FReqStream        : TMemoryStream;
        FRequestDoneError : Integer;
        FNext             : procedure of object;
        FOnStateChange    : TNotifyEvent;
        FOnSessionConnected   : TNotifyEvent;
        FOnRequestHeaderBegin : TNotifyEvent;
        FOnRequestHeaderEnd   : TNotifyEvent;
        FOnHeaderBegin    : TNotifyEvent;
        FOnHeaderEnd      : TNotifyEvent;
        FOnHeaderData     : TNotifyEvent;
        FOnDocBegin       : TNotifyEvent;
        FOnDocEnd         : TNotifyEvent;
        FOnDocData        : TDocDataEvent;
        FOnSendBegin      : TNotifyEvent;
        FOnSendEnd        : TNotifyEvent;
        FOnSendData       : TDocDataEvent;
        FOnTrace          : TNotifyEvent;
        FOnCommand        : TOnCommand;
        FOnCookie         : TCookieRcvdEvent;
        FOnDataAvailable  : TDataAvailable;
        FOnRequestDone    : THttpRequestDone;
        FOnLocationChange : TNotifyEvent;

        procedure SendRequest(const method,Version: String);
        procedure GetHeaderLineNext;
        procedure GetBodyLineNext;
        procedure SendCommand(const Cmd : String); virtual;
        procedure Login; virtual;
        procedure Logout; virtual;
        procedure SocketDNSLookupDone(Sender: TObject; Error: Word);
        procedure SocketSessionClosed(Sender: TObject; Error: Word);
        procedure SocketSessionConnected(Sender : TObject; Error : Word);
        procedure SocketDataSent(Sender : TObject; Error : Word);
        procedure SocketDataAvailable(Sender: TObject; Error: Word);
        procedure LocationSessionClosed(Sender: TObject; Error: Word); virtual;
        procedure DoRequestAsync(Rq : THttpRequest);
        procedure DoRequestSync(Rq : THttpRequest);
        procedure SetMultiThreaded(newValue : Boolean);
        procedure StateChange(NewState : THttpState);
        procedure TriggerStateChange;
        procedure TriggerCookie(const Data : String;
                                var   bAccept : Boolean); virtual;
        procedure TriggerSessionConnected; virtual;
        procedure TriggerRequestHeaderBegin; virtual;
        procedure TriggerRequestHeaderEnd; virtual;
        procedure TriggerHeaderBegin; virtual;
        procedure TriggerHeaderEnd; virtual;
        procedure TriggerDocBegin; virtual;
        procedure TriggerDocData(Data : Pointer; Len : Integer); virtual;
        procedure TriggerDocEnd; virtual;
        procedure TriggerSendBegin; virtual;