httpprot.pas

BaiduMp3 search baidu mp3

Jul 12, 2004 Just this warning: The component now doesn't consider 401 status
             as a fatal error (no exception is triggered). This required a
             change in the application code if it was using the exception that
             is no more triggered for status 401.
Jul 18, 2004 V1.63 Use CompareText to check for http string is relocation
             header. Thanks to Roger Tinembart <[e-mail]>
Jul 23, 2004 V1.64 Fixed a line too long exception when requesting HEAD or URL
             http://de.news.yahoo.com:80/. The server was sending a document
             even after we requested just the header. The fix make the
             component ignore data and abort the connection. This is really an
             error at server side !
Aug 08, 2004 V1.65 Moved utility function related to URL handling into IcsUrl
             unit for easy reuse outside of the component.
Aug 20, 2004 V1.66 Use MsgWaitForMultipleObjects in DoRequestSync to avoid
             consumming 100% CPU while waiting.
Sep 04, 2004 V1.67 Csonka Tibor <[e-mail]> worked a lot on my NTLM code,
             fixing it and making it work properly.
             I removed NTLM specific usercode and password properties to use
             FUsername and FPassword which are extracted from the URL.
             Define symbol UseNTLMAuthentication for Delphi 5 and up.
Sep 13, 2004 V1.68 Added option httpoNoNTLMAuth by Csonka Tibor
             Fixed TriggerRequestDone for NTLM authentication
             Moved NTLM code out of DoBeforeConnect which was intended for
             socket setup and not for protocol handling.
Oct 02, 2004 V1.69 Removed second copy of IntToStrDef.
Oct 06, 2004 V1.70 Miha Remec fixed THttpCli.GetHeaderLineNext to add
             status check for 301 and 302 values.
Oct 15, 2004 V1.71 [e-mail] enhanced basic and NTLM
             authentifications methods. Event OnNTLMAuthStep has been
             removed. Now basic authentication is not automatically sent with
             a request. It is only sent when the server request it by replying
             with a 401 or 407 response. Sending basic authentication in the
             first request was a kind of security threat for NTLM:
             usercode/password is sent unencrypted while NTLM is made to send
             it encrypted (DES). This has the side effect of requiring two
             request where one was needed. This could be a problem when posting
             data: data has to be posted twice ! This is transparent to the user
             except for performance :-( A future enhancement could be a new
             option to always send basic authentication.
Oct 30, 2004 V1.72 Made SendRequest virtual.
Nov 07, 2004 V1.73 Added CleanupRcvdStream. [e-mail] found that
             document must be cleaned if received in intermediate authentication
             steps.
Nov 09, 2004 V1.74 Cleared FDoAuthor from InternalClear. Thanks Maurizio.
Nov 11, 2004 V1.75 Added CleanupRcvdStream when starting relocation.
             Thanks Maurizio.
             Removed second TriggerHeaderEnd in GetHeaderLineNext.
             Thanks Ronny Karl for finding this one.
Nov 20, 2004 V1.76 Angus Robertson found a problem with SendStream because of
             authentication (post restarted because authentication need to be
             done).
             Maurizio fixed the issue above an a fix others:
             - added a CleanupSendStream procedure, and added a call to it in
               every place where the CleanupRcvdStream is called.
             - changed the Content-Length calculation: if the position of the
               stream is not 0 then the length was wrong
             - changed the the test in DoRequestAsync: if the position of the
               stream is at the end then it will send nothing
Nov 22, 2004 V1.77 Only a single error code for httperrInvalidAuthState.
Dec 14, 2004 V1.78 Excluded code 407 and added code 400 in DoRequestSync
Dec 19, 2004 V1.79 Revised CleanupRcvdStream to make it compatible with D1.
Dec 22, 2004 V1.80 Changed SocketDataAvailable so that header lines that are
             too long to fit into the receive buffer (8K) are simply truncated
             instead of triggering an exception.
Jan 05, 2005 V1.81 Maurizio Lotauro <[e-mail]> optimized NTLM
             authentication by not sending content in the first step.
Jan 29, 2005 V1.82 Fixed socks properties propagation to control socket.
Feb 05, 2005 V1.83 Fixed GetHeaderLineNext in the case Abort is called from
             OnHeaderEnd event (Bug reported by Csonka Tibor).
             Fixed relocation to https destination when USE_SSL is not
             defined. It is handled as a non implemented protocol.
Mar 19, 2005 V1.84 Changed CleanupRcvdStream to check for COMPILER3_UP instead
             of checking DELPHI3_UP (BCB compatibility issue).
             Changed StrToIntDef to check for COMPILER5_UP instead of
             DELPHI5_UP (BCB compatibility issue). Thanks to Albert Wiersch.
Mar 21, 2005 V1.85 Added port in "host:" header line as suggested by Sulimov
             Valery <[e-mail]>.
             In DoRequestAsync, allow to continue even with no data to be sent.
Apr 14, 2005 V1.86 Fixed PrepareBasicAuth to ignore charcase when checking for
             'basic' keyword in header line. Thanks to [e-mail] for
             finding this bug which affected use thru iPlanet Web Proxy Server.


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

interface

{$B-}                  { Enable partial boolean evaluation   }
{$T-}                  { Untyped pointers                    }
{$X+}                  { Enable extended syntax              }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFDEF COMPILER2_UP}  { Not for Delphi 1                    }
    {$H+}              { Use long strings                    }
    {$J+}              { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
    {$ObjExportAll On}
{$ENDIF}
{$IFDEF COMPILER5_UP}
    {$DEFINE UseNTLMAuthentication}
{$ENDIF}

uses
    Messages,
{$IFDEF USEWINDOWS}
    Windows,
{$ELSE}
    WinTypes, WinProcs,
{$ENDIF}
    SysUtils, Classes,
    {$IFNDEF NOFORMS}
    Forms, Controls,
    {$ENDIF}
{ You must define USE_SSL so that SSL code is included in the component.    }
{ To be able to compile the component, you must have the SSL related files  }
{ which are _NOT_ freeware. See http://www.overbyte.be for details.         }
{$IFDEF USE_SSL}
    IcsSSLEAY, IcsLIBEAY,
{$ENDIF}
{$IFDEF UseNTLMAuthentication}
    IcsNtlmMsgs,
{$ENDIF}
    IcsUrl, WinSock, WSocket;

const
    HttpCliVersion       = 186;
    CopyRight : String   = ' THttpCli (c) 1997-2005 F. Piette V1.86 ';
    DefaultProxyPort     = '80';
{$IFDEF DELPHI1}
    { 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;

    { EHttpException error code }
    httperrNoError                  = 0;
    httperrBusy                     = 1;
    httperrNoData                   = 2;
    httperrAborted                  = 3;
    httperrOverflow                 = 4;
    httperrVersion                  = 5;
    httperrInvalidAuthState         = 6;

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

    THttpEncoding    = (encUUEncode, encBase64, encMime);
    THttpRequest     = (httpABORT, httpGET, httpPOST, httpPUT,
                        httpHEAD,  httpCLOSE);
    THttpState       = (httpReady,         httpNotConnected, httpConnected,
                        httpDnsLookup,     httpDnsLookupDone,
                        httpWaitingHeader, httpWaitingBody,  httpBodyReceived,
                        httpWaitingProxyConnect,
                        httpClosing,       httpAborting);
    THttpChunkState  = (httpChunkGetSize, httpChunkGetExt, httpChunkGetData,
                        httpChunkSkipDataEnd, httpChunkDone);
{$IFDEF UseNTLMAuthentication}
    THttpNTLMState   = (ntlmNone, ntlmMsg1, ntlmMsg2, ntlmMsg3, ntlmDone);
    TNTLMAuthType    = (ntlmAuthProxy, ntlmAuthNormal);
{$ENDIF}
    THttpBasicState  = (basicNone, basicMsg1, basicDone);
    TBasicAuthType   = (basicAuthProxy, basicAuthNormal);

    TOnCommand       = procedure (Sender : TObject;
                                  var 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;
                                  ErrCode : Word) of object;
    TBeforeHeaderSendEvent = procedure (Sender       : TObject;
                                        const Method : String;
                                        Headers      : TStrings) of object;
    THttpCliOption = (httpoNoBasicAuth, httpoNoNTLMAuth);
    THttpCliOptions = set of THttpCliOption;

    THttpCli = class(TComponent)
    protected
        FCtrlSocket           : TWSocket;
        FWindowHandle         : HWND;
        FMultiThreaded        : Boolean;
        FState                : THttpState;
        FLocalAddr            : String;
        FHostName             : String;
        FTargetHost           : String;
        FTargetPort           : String;
        FPort                 : String;
        FProtocol             : String;
        FProxy                : String;
        FProxyPort            : String;
        FUsername             : String;
        FPassword             : String;
        FProxyUsername        : String;
        FProxyPassword        : String;
        FProxyConnected       : Boolean;
        FLocation             : String;
        FCurrentHost          : String;
        FCurrentPort          : String;
        FCurrentProtocol      : 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;
        FConnection           : String;         { for Keep-alive }
        FProxyConnection      : String;         { for proxy keep-alive }
        FAgent                : String;
        FAccept               : String;
        FAcceptLanguage       : String;
        FModifiedSince        : TDateTime;      { Warning ! Use GMT date/Time }
        FNoCache              : Boolean;
        FStatusCode           : Integer;
        FReasonPhrase         : String;
        FResponseVer          : String;
        FRequestVer           : String;
        FContentLength        : LongInt;
        FContentType          : String;
        FTransferEncoding     : String;
        FChunkLength          : Integer;
        FChunkRcvd            : Integer;
        FChunkState           : THttpChunkState;
        FDoAuthor             : TStringList;
        FContentPost          : String;         { Also used for PUT }
        FContentRangeBegin    : String;
        FContentRangeEnd      : String;
        FAcceptRanges         : String;
        FCookie               : String;
        FLocationFlag         : Boolean;
        FFollowRelocation     : Boolean;    {TED}
        FHeaderEndFlag        : Boolean;
        FRcvdHeader           : TStrings;
        FRcvdStream           : TStream; { If assigned, will recv the answer }
        FRcvdCount            : LongInt; { Number of rcvd bytes for the body }
        FSentCount            : LongInt;
        FSendStream           : TStream; { Contains the data to send         }
        FReqStream            : TMemoryStream;
        FRequestDoneError     : Integer;
        FNext                 : procedure of object;
        FBodyData             : PChar;
        FBodyDataLen          : Integer;
        FOptions              : THttpCliOptions;
        FSocksServer          : String;
        FSocksLevel           : String;
        FSocksPort            : String;