auhttp.int

利用AutoUpgrader可在delphi环境下快速开发自动更新程式

{*******************************************************************************

  AutoUpgrader Professional
  FILE: auHTTP.pas - auHTTP component. Used as base class for acAutoUpgrader
          in the AppControls v2.3 and later

  Copyright (c) 1998-2004 UtilMind Solutions
  All rights reserved.
  E-Mail: [e-mail]
  WWW: http://www.utilmind.com, http://www.appcontrols.com

  The entire contents of this file is protected by International Copyright
Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
or any portion of the code contained in this file is strictly prohibited and
may result in severe civil and criminal penalties and will be prosecuted to
the maximum extent possible under the law.

*******************************************************************************}
{$I auDefines.inc}

unit auHTTP;

interface

uses
  Windows, Classes, Graphics, WinInet,
  auThread, auUtils;

const
  auDefaultProxyPort = 8080;
  auDefaultProxyBypass = '127.0.0.1;';
  DEF_TRANSFERBUFFERSIZE = 4096;
  TEXTHTML = 'text/html';
  DEF_ACCEPT_TYPES = TEXTHTML + ', */*';
{$IFDEF D4}
  S_PIC = 'pic';
{$ELSE}
{  HTTP Response Status Codes: }
  HTTP_STATUS_CONTINUE            = 100;    { OK to continue with request }
  HTTP_STATUS_SWITCH_PROTOCOLS    = 101;    { server has switched protocols in upgrade header }
  HTTP_STATUS_OK                  = 200;    { request completed }
  HTTP_STATUS_CREATED             = 201;    { object created, reason = new URI }
  HTTP_STATUS_ACCEPTED            = 202;    { async completion (TBS) }
  HTTP_STATUS_PARTIAL             = 203;    { partial completion }
  HTTP_STATUS_NO_CONTENT          = 204;    { no info to return }
  HTTP_STATUS_RESET_CONTENT       = 205;    { request completed, but clear form }
  HTTP_STATUS_PARTIAL_CONTENT     = 206;    { partial GET furfilled }
  HTTP_STATUS_AMBIGUOUS           = 300;    { server couldn't decide what to return }
  HTTP_STATUS_MOVED               = 301;    { object permanently moved }
  HTTP_STATUS_REDIRECT            = 302;    { object temporarily moved }
  HTTP_STATUS_REDIRECT_METHOD     = 303;    { redirection w/ new access method }
  HTTP_STATUS_NOT_MODIFIED        = 304;    { if-modified-since was not modified }
  HTTP_STATUS_USE_PROXY           = 305;    { redirection to proxy, location header specifies proxy to use }
  HTTP_STATUS_REDIRECT_KEEP_VERB  = 307;    { HTTP/1.1: keep same verb }
  HTTP_STATUS_BAD_REQUEST         = 400;    { invalid syntax }
  HTTP_STATUS_DENIED              = 401;    { access denied }
  HTTP_STATUS_PAYMENT_REQ         = 402;    { payment required }
  HTTP_STATUS_FORBIDDEN           = 403;    { request forbidden }
  HTTP_STATUS_NOT_FOUND           = 404;    { object not found }
  HTTP_STATUS_BAD_METHOD          = 405;    { method is not allowed }
  HTTP_STATUS_NONE_ACCEPTABLE     = 406;    { no response acceptable to client found }
  HTTP_STATUS_PROXY_AUTH_REQ      = 407;    { proxy authentication required }
  HTTP_STATUS_REQUEST_TIMEOUT     = 408;    { server timed out waiting for request }
  HTTP_STATUS_CONFLICT            = 409;    { user should resubmit with more info }
  HTTP_STATUS_GONE                = 410;    { the resource is no longer available }
  HTTP_STATUS_AUTH_REFUSED        = 411;    { couldn't authorize client }
  HTTP_STATUS_PRECOND_FAILED      = 412;    { precondition given in request failed }
  HTTP_STATUS_REQUEST_TOO_LARGE   = 413;    { request entity was too large }
  HTTP_STATUS_URI_TOO_LONG        = 414;    { request URI too long }
  HTTP_STATUS_UNSUPPORTED_MEDIA   = 415;    { unsupported media type }
  HTTP_STATUS_SERVER_ERROR        = 500;    { internal server error }
  HTTP_STATUS_NOT_SUPPORTED       = 501;    { required not supported }
  HTTP_STATUS_BAD_GATEWAY         = 502;    { error response received from gateway }
  HTTP_STATUS_SERVICE_UNAVAIL     = 503;    { temporarily overloaded }
  HTTP_STATUS_GATEWAY_TIMEOUT     = 504;    { timed out waiting for gateway }
  HTTP_STATUS_VERSION_NOT_SUP     = 505;    { HTTP version not supported }
  HTTP_STATUS_FIRST               = HTTP_STATUS_CONTINUE;
  HTTP_STATUS_LAST                = HTTP_STATUS_VERSION_NOT_SUP;
{$ENDIF}
  HTTP_STATUS_RANGE_NOT_SATISFIABLE = 416;
  // misc strings (for use in application )
  STR_DownloadError   = 'Download Error';
  STR_HostUnreachable = 'Host Unreachable';
  STR_ConnectionLost  = 'Connection Lost';

type
  SetOfChar = set of Char;

  { TauLoginComponent }
  TauLoginComponent = class(TComponent)
  private
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    FLoginUsername, FLoginPassword: String;
      
    procedure DefineProperties(Filer: TFiler); override;
  end;

  { TauHTTP }
  TauHTTPProgressEvent = procedure(Sender: TObject; const ContentType: String;
                                   DataSize, BytesRead,
                                   ElapsedTime, EstimatedTimeLeft: Integer;
                                   PercentsDone: Byte; TransferRate: Single;
                                   Stream: TStream) of object;
{$IFNDEF IE3}
  TauHTTPUploadProgressEvent  = procedure(Sender: TObject;
                                   DataSize, BytesTransferred,
                                   ElapsedTime, EstimatedTimeLeft: Integer;
                                   PercentsDone: Byte; TransferRate: Single) of object;
  TauHTTPUploadFieldRequest   = procedure(Sender: TObject; FileIndex: Word; UploadStream: TMemoryStream; var FieldName, FileName: String) of object;
{$ENDIF}
  TauHTTPHeaderInfoEvent      = procedure(Sender: TObject; ErrorCode: Integer; const RawHeadersCRLF, ContentType, ContentLanguage, ContentEncoding: String;
                                   ContentLength: Integer; const Location: String; const Date, LastModified, Expires: TDateTime; const ETag: String; var ContinueDownload: Boolean) of object;
  TauHTTPStatusChanged        = procedure(Sender: TObject; StatusID: Cardinal; const StatusStr: String) of object;
  TauHTTPRedirected           = procedure(Sender: TObject; const NewURL: String) of object;
  TauHTTPDoneEvent            = procedure(Sender: TObject; const ContentType: String; FileSize: Integer; Stream: TStream) of object;
  TauHTTPConnLostEvent        = procedure(Sender: TObject; const ContentType: String; FileSize, BytesRead: Integer; Stream: TStream) of object;
  TauHTTPErrorEvent           = procedure(Sender: TObject; ErrorCode: Integer; Stream: TStream) of object;
  TauHTTPPasswordRequestEvent = procedure(Sender: TObject; const Realm: String; var TryAgain: Boolean) of object;
  TauHTTPProxyAuthenticationEvent = procedure(Sender: TObject; var ProxyUsername, ProxyPassword: String; var TryAgain: Boolean) of object;
  TauHTTPBeforeSendRequest = procedure(Sender: TObject; hRequest: hInternet) of object;

{$IFNDEF IE3}
  TauHTTPPOSTMethod = (pmFormURLEncoded, pmMultipartFormData);
{$ENDIF}
  TauHTTPRequestMethod = (rmAutoDetect, rmGET, rmPOST);
  TauHTTPAccessType = (atPreconfig, atDirect, atUseProxy);
  TauHTTPProxy = class(TPersistent)
  private
    FAccessType: TauHTTPAccessType;
    FProxyPort: Integer;
    FProxyServer: String;
    FProxyBypass: String;
    FProxyUsername: String;
    FProxyPassword: String;

    function IsUseProxy: Boolean;
  public
    constructor Create;

    procedure Assign(Source: TPersistent); override;
  published
    property AccessType: TauHTTPAccessType read FAccessType write FAccessType default atPreconfig;
    property ProxyPort: Integer read FProxyPort write FProxyPort default auDefaultProxyPort;
    property ProxyServer: String read FProxyServer write FProxyServer stored IsUseProxy;
    property ProxyBypass: String read FProxyBypass write FProxyBypass stored IsUseProxy;
    property ProxyUsername: String read FProxyUsername write FProxyUsername;
    property ProxyPassword: String read FProxyPassword write FProxyPassword;
  end;

  TauHTTPRange = class(TPersistent)
  private
    FStartRange, FEndRange: Cardinal;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property StartRange: Cardinal read FStartRange write FStartRange default 0;
    property EndRange: Cardinal read FEndRange write FEndRange default 0;
  end;

  TauHTTPTimeouts = class(TPersistent)
  private
    FConnectTimeout, FReceiveTimeout, FSendTimeout: DWord;
  public
    procedure Assign(Source: TPersistent); override;  
  published
    property ConnectTimeout: DWord read FConnectTimeout write FConnectTimeout default 0;
    property ReceiveTimeout: DWord read FReceiveTimeout write FReceiveTimeout default 0;
    property SendTimeout: DWord read FSendTimeout write FSendTimeout default 0;
  end;

  TauOutputFileAttributes = class(TPersistent)
  private
    FComplete, FIncomplete: TauFileAttributes;

    procedure SetComplete(const Value: TauFileAttributes);
    procedure SetIncomplete(const Value: TauFileAttributes);
  protected
    procedure AttributesChanged; dynamic;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property Complete: TauFileAttributes read FComplete write SetComplete default [atrArchive];
    property Incomplete: TauFileAttributes read FIncomplete write SetIncomplete default [atrArchive, atrTemporary];
  end;

  { TauFileStream - FileStream able to write to opened file (no read lock) }
  TauFileStream = class(THandleStream)
  public
    constructor Create(const FileName: String; CreateNew: Boolean; TestFileAttributes: Boolean {$IFDEF D4} = True {$ENDIF});
    destructor Destroy; override;
  end;

  TauBufferSize = 255..MaxInt;
  TauInternetOption = (ioIgnoreCertificateInvalid, ioIgnoreCertificateDateInvalid,
                       ioIgnoreUnknownCertificateAuthority,
                       ioIgnoreRedirectToHTTP, ioIgnoreRedirectToHTTPS,
                       ioKeepConnection, ioNoAuthentication,
                       ioNoAutoRedirect, ioNoCookies);
  TauInternetOptions = set of TauInternetOption;
  TauCacheOption   = (coAlwaysReload, coReloadIfNoExpireInformation,
                      coReloadUpdatedObjects, coPragmaNoCache,
                      coNoCacheWrite, coCreateTempFilesIfCantCache,
                      coUseCacheIfNetFail);
  TauCacheOptions  = set of TauCacheOption;
  TauCustomHTTP = class(TauLoginComponent)
  private
    FAddHeaders: TStrings;
    FAcceptTypes, FAgent,
    FOutputFileName: String;
    FOutputFileAttributes: TauOutputFileAttributes;
    FURL, FPostData, FReferer: String;
    FCacheOptions: TauCacheOptions;
    FInternetOptions: TauInternetOptions;
    FRange: TauHTTPRange;
    FTimeouts: TauHTTPTimeouts;
    FTransferBufferSize: TauBufferSize;
{$IFNDEF IE3}
    FPOSTMethod: TauHTTPPOSTMethod;
{$ENDIF}
    FRequestMethod: TauHTTPRequestMethod;
    FProxy: TauHTTPProxy;
    FShowGoOnlineMessage: Boolean;
    FWorkOffline: Boolean;
    FData: Pointer;

    // success events
    FOnBeforeSendRequest: TauHTTPBeforeSendRequest;
    FOnHeaderInfo: TauHTTPHeaderInfoEvent;
    FOnDone: TauHTTPDoneEvent;
    FOnDoneInterrupted: TNotifyEvent;
    FOnProgress: TauHTTPProgressEvent;
    FOnStatusChanged: TauHTTPStatusChanged;
    FOnRedirected: TauHTTPRedirected;
{$IFNDEF IE3}
    FOnUploadProgress: TauHTTPUploadProgressEvent;
    FOnUploadFieldRequest: TauHTTPUploadFieldRequest;
{$ENDIF}
    // error events
    FOnAnyError: TNotifyEvent;
    FOnAborted: TNotifyEvent;
    FOnConnLost: TauHTTPConnLostEvent;
    FOnHostUnreachable: TNotifyEvent;      // no connection
    FOnHTTPError: TauHTTPErrorEvent;       // read error
    FOnOutputFileError: TNotifyEvent;    
    FOnPasswordRequest: TauHTTPPasswordRequestEvent;
    FOnProxyAuthenticationRequest: TauHTTPProxyAuthenticationEvent;
    FOnWaitTimeoutExpired: TauThreadWaitTimeoutExpired;

    // internal events
{$IFDEF USEINTERNAL}