nmhttp.pas

DELPHI里面一些常用的控件

unit NMHttp;
{$X+}
{$R-}

{$IFDEF VER100}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE NMF3}
{$ENDIF}

interface

uses
  SysUtils, Classes, PSock, NMExtstr, NMConst, NMUUE, NMURL, Winsock;
{$IFDEF VER110}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER120}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER125}
{$OBJEXPORTALL On}
{$ENDIF}

//  CompName='NMHTTP';
//  Major_Version='4';
//  Minor_Version='02';
//  Date_Version='012798';

const {Protocol}
  Prt_gopher = 'gopher';
  Prt_ftp = 'ftp';

  Prt_str_http = ' HTTP/1.0';
  Prox_Head_Str = 'Proxy-Connection: Keep-Alive';
  Prox_Host_Str = 'Host: ';
  Host_Accpt_Str1 = 'Accept: www/source, text/html, video/mpeg, image/jpeg, image/x-tiff';
  Host_Accpt_Str2 = 'Accept: image/x-rgb, image/x-xbm, image/gif, */*, application/postscript';
  Host_UserAgent = 'User-Agent';
  Head_From = 'From';
  Head_Host = 'Host';
  Head_Cookie = 'Cookie';
  Head_Referer = 'Referer';
  Head_Content = 'Content-type: application/x-www-form-urlencoded';
  Head_Link = 'Link: ';
  Head_URI = 'URI-header: ';
  Head_ContentLength = 'Content-Length: ';
  Head_SetCookie = 'SET-COOKIE:';
  Head_CL2 = 'CONTENT-LENGTH:';
  Head_length = 'ENGTH:';
  Head_Location = 'LOCATION:';

  Cmd_Get = 'GET ';
  Cmd_Options = 'OPTIONS ';
  Cmd_Post = 'POST ';
  Cmd_Put = 'PUT ';
  Cmd_Head = 'HEAD ';
  Cmd_Patch = 'PATCH ';
  Cmd_Copy = 'COPY ';
  Cmd_Move = 'MOVE ';
  Cmd_Link = 'LINK ';
  Cmd_Unlink = 'UNLINK ';
  Cmd_Delete = 'DELETE ';
  Cmd_Trace = 'TRACE ';

type
  {HTTP Transaction Type Options}
  CmdType = (CmdGET, CmdOPTIONS, CmdHEAD, CmdPOST, CmdPUT, CmdPATCH, CmdCOPY,
    CmdMOVE, CmdDELETE, CmdLINK, CmdUNLINK, CmdTRACE, CmdWRAPPED, cmdPOSTS);

  HTTPException = class(Exception);
  TResultEvent = procedure(Cmd: CmdType) of object;

  THeaderInfo = class(TPersistent)
  private
    FLocalAddress: string;
    FLocalProgram: string;
    FCookie: string;
    FReferer: string;
    FUserId: string;
    FPassword: string;
    FProxyUserId: string;
    FProxyPassword: string;
  published
    property LocalMailAddress: string read FLocalAddress write FLocalAddress;
    property LocalProgram: string read FLocalProgram write FLocalProgram;
    property Cookie: string read FCookie write FCookie;
    property Referer: string read FReferer write FReferer;
    property UserId: string read FUserId write FUserId;
    property Password: string read FPassword write FPassword;
    property ProxyUserId: string read FProxyUserId write FProxyUserId;
    property ProxyPassword: string read FProxyPassword write FProxyPassword;
  end;

  {*******************************************************************************************
  HTTP Class definition
  ********************************************************************************************}
  TNMHTTP = class(TPowersock)
  private
    FBody: string; {File Name for received file}
    FHeader: string; {File Name for saving Header}
    FSelector: string; {The Selector or Directory string}
    FSendHeader: TexStringList;
    FLocation: string;

    FHeaderInfo: THeaderInfo; {Header Information}

    FCookieIn: string; {Cookie - string}
    FInputFileMode: boolean; {Inputs - File Mode}
    FOutPutFileMode: boolean; {Output - File Mode}
    FEncodePosts: boolean;
    TheSendFile: string;
    FSendStream: TStream; {The name of File to send}
    TheDestURL: string; {The Destination URL in MOVE and COPY commands}
    URL_Holder: string; {Temporary holder for URL}
    ConnType: CmdType; {The Transaction type}

    // URL specifics
    FScheme: string;
    FUser: string;
    FPassword: string;
    FNetworkLocation: string;
    FPort: string;
    FQuery: string;
    FResource: string;
    FParameters: string;
    FPath: string;
    FFragment: string;

    FOnSuccess: TResultEvent; {Pointer to handler of function to execute after all bytes received}
    FOnFailure: TResultEvent;
    FOnAboutToSend: TNotifyEvent;
    FOnRedirect: THandlerEvent;
    FOnAuthenticationNeeded: TNotifyEvent;
//    FOnProxyAuthenticationNeeded: TNotifyEvent;

  protected
    procedure HTTPConnect; virtual;
//    procedure ParsetheURL; virtual;
    procedure AssembleHTTPHeader; virtual;
    procedure RemoveHeader; virtual;
    procedure SendHTTP; virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Options(URL: string); virtual;
    procedure Get(URL: string); virtual;
    procedure Post(URL, PostData: string); virtual;
    procedure Put(URL, PutData: string); virtual;
    procedure Head(URL: string); virtual;
    procedure Patch(URL, PatchData: string); virtual;
    procedure Delete(URL: string); virtual;
    procedure Trace(URL, TraceData: string); virtual;
    procedure Copy(URL1, URL2: string); virtual;
    procedure Move(URL1, URL2: string); virtual;
    procedure Link(URL, link: string); virtual;
    procedure UnLink(URL, link: string); virtual;
    procedure Wrapped(URL, WrappedData: string); virtual;
    procedure Abort; override;
    procedure PostStream(URL: string; Stream: TStream); virtual;

    property SendHeader: TExStringList read FSendHeader write FSendHeader;
    property CookieIn: string read FCookieIn;

  published
    property OnPacketRecvd;
    property OnPacketSent;
    property Body: string read FBody write FBody;
    property Header: string read FHeader write FHeader;
    property HeaderInfo: THeaderInfo read FHeaderInfo write FHeaderInfo;
    property InputFileMode: boolean read FInputFileMode write FInputFileMode;
    property OutputFileMode: boolean read FOutputFileMode write FOutputFileMode;

    property Proxy;
    property ProxyPort;

    property OnAboutToSend: TNotifyEvent read FOnAboutToSend write FOnAboutToSend;
    property OnSuccess: TResultEvent read FOnSuccess write FOnSuccess;
    property OnFailure: TResultEvent read FOnFailure write FOnFailure;
    property OnRedirect: THandlerEvent read FOnRedirect write FOnRedirect;
    property OnAuthenticationNeeded: TNotifyEvent read FOnAuthenticationNeeded write FOnAuthenticationNeeded;
  end;

  implementation

uses
  URLParse;

{*******************************************************************************************
Create HTTP component
********************************************************************************************}

constructor TNMHTTP.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FHeaderInfo := THeaderInfo.create;
  FSendHeader := TExStringList.create;
  FEncodePosts := TRUE;
  FHeader := sHTTP_Head_File; {Default Header File}
  FBody := sHTTP_Body_File;
  FInputFileMode := FALSE; {Inputs - File Mode}
  FOutPutFileMode := FALSE; {Output - File Mode}
  ProxyPort := 8080;
end;

destructor TNMHTTP.Destroy;
begin
  FHeaderInfo.free;
  FSendHeader.free;
  inherited destroy;
end;

{*******************************************************************************************
Get Page given by URL
********************************************************************************************}

procedure TNMHTTP.Get(URL: string);
begin
  ConnType := CmdGET; {Set transaction type to Get}
  URL_Holder := URL; {Set Locator to URL for later}
  HTTPConnect; {Get Page}
end;

{*******************************************************************************************
Get Option given by URL
********************************************************************************************}

procedure TNMHTTP.Options(URL: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  ConnType := CmdOPTIONS; {Set Connection type to get Options}
  HTTPConnect; {Connect to web and get Options}
end;

{*******************************************************************************************
Post File in FileName to given URL
********************************************************************************************}

procedure TNMHTTP.Post(URL, PostData: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  (*
    if FEncodePosts then
      begin
        NMURL1 := TNMURL.create(self);
        try
          if OutPutFileMode then
            begin
            end
          else
            begin
              NMURL1.InputString := postData;
              Postdata := NMURL1.Encode;
            end;
        finally
          NMURL1.Free;
        end;
      end;
  *)
  TheSendFile := PostData; {Set the file to send to filename}
  ConnType := CmdPOST; {Set Connection type to Post}
  HTTPConnect; {Connect to web and post}
end;

{*******************************************************************************************
Put File in FileName to given URL
********************************************************************************************}

procedure TNMHTTP.Put(URL, PutData: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheSendFile := PutData; {Set the file to send to filename}
  ConnType := CmdPUT; {Set Connection type to Put}
  HTTPConnect; {Connect to web and put}
end;

{*******************************************************************************************
Get Heading of given URL
********************************************************************************************}

procedure TNMHTTP.Head(URL: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  ConnType := CmdHEAD; {Set Connection type to Head}
  HTTPConnect; {Connect to web and get heading}
end;

{*******************************************************************************************
Patch given URL with given file
********************************************************************************************}

procedure TNMHTTP.Patch(URL, PatchData: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheSendFile := Patchdata; {Set the file to send to filename}
  ConnType := CmdPATCH; {Set Connection type to Patch}
  HTTPConnect; {Connect to web and patch}
end;

{*******************************************************************************************
Copy URL1 to URL2
********************************************************************************************}

procedure TNMHTTP.Copy(URL1, URL2: string);
begin
  URL_Holder := URL1; {Set Locator to URL for later}
  TheDestURL := URL2; {Set theDestURL to be used later}
  ConnType := CmdCOPY; {Set Connection type to COPY}
  HTTPConnect; {Connect to web and copy}
end;

{*******************************************************************************************
Move URL1 to URL2
********************************************************************************************}

procedure TNMHTTP.Move(URL1, URL2: string);
begin
  URL_Holder := URL1; {Set Locator to URL for later}
  TheDestURL := URL2; {Set theDestURL to be used later}
  ConnType := CmdMOVE; {Set Connection type to MOVE}
  HTTPConnect; {Connect to web and move}
end;

{*******************************************************************************************
Link URL to Link
********************************************************************************************}

procedure TNMHTTP.Link(URL, Link: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheDestURL := Link; {Set theDestURL to link later}
  TheSendFile := sHTTP_Data_File; {Set the file to send to entity.stf}
  ConnType := CmdLINK; {Set Connection type to LINK}
  HTTPConnect; {Connect to web and link}
end;

{*******************************************************************************************
UnLink URL from Link
********************************************************************************************}

procedure TNMHTTP.UnLink(URL, Link: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheDestURL := Link; {Set theDestURL to link later}
  TheSendFile := sHTTP_Data_File; {Set the file to send to entity.stf}
  ConnType := CmdUNLINK; {Set Connection type to UNLINK}
  HTTPConnect; {Connect to web and Unlink}
end;

{*******************************************************************************************
Delete URL
********************************************************************************************}

procedure TNMHTTP.Delete(URL: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  ConnType := CmdDELETE; {Set Connection type to DELETE}
  HTTPConnect; {Connect to web and Delete}
end;

{*******************************************************************************************
Request a trace from URL
********************************************************************************************}

procedure TNMHTTP.Trace(URL, TraceData: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheSendFile := TraceData; {Set the file to send to entity.stf}
  ConnType := CmdTRACE; {Set Connection type to TRACE}
  HTTPConnect; {Connect to web and TRACE}
end;

{*******************************************************************************************
Send Wrapped command to URL
********************************************************************************************}

procedure TNMHTTP.Wrapped(URL, WrappedData: string);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  TheSendFile := WrappedData; {Set the file to send to entity.stf}
  ConnType := CmdWRAPPED; {Set Connection type to TRACE}
  HTTPConnect; {Connect to web and send WRAPPED}
end;

{*******************************************************************************************
Abort transaction
********************************************************************************************}

procedure TNMHTTP.Abort;
begin
  Wait_Flag := TRUE; {Force fetch to come out of wait loop}
  cancel; {Set Flag to cancel present transaction}
end;

procedure TNMHTTP.PostStream(URL: string; Stream: TStream);
begin
  URL_Holder := URL; {Set Locator to URL for later}
  FSendStream := Stream; {Set the file to send to filename}
  ConnType := CmdPOSTS; {Set Connection type to Post}
  HTTPConnect; {Connect to web and post}
end;

{*******************************************************************************************
Carry out HTTP transaction
********************************************************************************************}

procedure TNMHTTP.HTTPConnect;
var
  Handled: boolean;
  LkHead: string;
  tmp: string;
begin
  repeat
    //ParsetheURL;                                   {Parse the URL to get Host, Port and Selector}
    ParseURL(URL_Holder, FScheme, FUser, FPassword, FNetworkLocation, FPort, FPath, FResource, FParameters, FQuery, FFragment);
    if (FUser <> '') or (FPassword <> '') then
      HeaderInfo.FUserId := FUser;
    HeaderInfo.FPassword := FPassword;
    Port := StrToInt(DefaultPort(FScheme));
    Host := FNetworkLocation;