mmmcorpsvit/KOLHTTPDownload.pas

## KOLHTTPDownload.pas
{$IFDEF FPC}
 {$mode delphi}
{$ENDIF}
unit KOLHTTPDownload;
{

  ("`-''-/").___..--''"`-._
 `6_ 6  )   `-.  (     ).`-.__.`)
 (_Y_.)'  ._   )  `._ `. ``-..-'
  _..`--'_..-_/  /--'_.' ,'
(il).-''  (li).'  ((!.-'

  Download with HTTP-protocol

  Copyright © 2007-2008 Denis Fateyev (Danger)
  Website: <http://www.fateyev.com>
  E-Mail: <denis@fateyev.com>

  'ParseURL' and 'Posn' functions are copyright (C) 1997-2001 by Francois Piette
  "Permission is granted to anyone to use this software for any purpose, including
  commercial applications, and to alter it and redistribute it freely."  }

  {* TKOLHTTPDownload is the non-visual component that provides a downloading resources with HTTP-protocol. Now uses WinInet routines.
  |<pre>
  |Copyright (C) 2007-2008 Denis Fateyev (Danger) (<a href="mailto:denis@fateyev.com">denis@fateyev.com</a>).
  |</pre>
  |TKOLHTTPDownload coming under the form of a KOL library unit, it can be simply used
  by creating object at runtime, setting the necessary properties:
  !uses Windows, Messages, KOL, ..., KOLHTTPDownload;
  ! //...
  !var DL : PHTTPDownload;
  ! //...
  !DL := NewHTTPDownload;
  !DL.OnDownload:= MyDownload_Proc;
  !DL.GetResource( 'http://example.com/foo/bar.zip' );
  !DL. ...
  !DL.Free;
  |<p>Certainly you can use the 'MCK mirror' provided with component to manage control properties at design time. }

interface

// This conditional define allows some manupulations with HTTP-headers,
// you can disable it (if you really don't need it) by commenting the following line.
{$DEFINE USE_CUSTOMHEADERS}

//-----------------------------------------------------
uses
 Windows, WinInet, KOL, err, UrlMon;

type
  TArrOptions = array[0..11] of Integer;

//-----------------------------------------------------
const
 // Internet_options_consts
 // http://msdn.microsoft.com/en-us/library/windows/desktop/aa385328%28v=vs.85%29.aspx
 INTERNET_OPTION_FROM_CACHE_TIMEOUT = 63; // omg...

 // key, value in msec, set after InternetOpen
 DefInternet_Options : TArrOptions = (
   INTERNET_OPTION_CONNECT_TIMEOUT     , 5000,
   INTERNET_OPTION_DATA_RECEIVE_TIMEOUT, 5000,
   INTERNET_OPTION_DATA_SEND_TIMEOUT   , 5000,
   INTERNET_OPTION_FROM_CACHE_TIMEOUT  , 5000,
   INTERNET_OPTION_RECEIVE_TIMEOUT     , 5000,
   INTERNET_OPTION_SEND_TIMEOUT        , 5000
   );

//INTERNET_FLAG_NO_COOKIES or // mmm_corp, manual Cookies work
iHttpOpenRequestFlagDefault=INTERNET_FLAG_NO_UI or
                            INTERNET_FLAG_PRAGMA_NOCACHE or
                            INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
                            INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
 iDefProxyPort = 3128;
 iTimeOutValue = 200;  // 0.2 sec

 // iDataBufSize must be > 256 !!!!!
 //iDataBufSize  = 4096; // 4 KByte buffer
 iDataBufSize  = 4096*10; // 40 KByte buffer
 // mmm_corp, Content-Disposition must be this or other IE user agent, cyrilic fix
 strUserAgentDefault  = 'Mozilla/5.0 (Windows; U; MSIE 7.0; Windows NT 6.0; en-US)';
// strUserAgentDefault  = 'Mozilla/5.0 (Windows NT 6.3; Trident/7.0; rv 11.0)';

 strConnectType = 'Connection: close';
 strProxyConnectType = 'Proxy-Connection: close';

 // mmm_corp, add some const
   ole32    = 'ole32.dll';
  {$EXTERNALSYM FMFD_DEFAULT}
  FMFD_DEFAULT             = $00000000;
  {$EXTERNALSYM FMFD_URLASFILENAME}
  FMFD_URLASFILENAME       = $00000001;
  {$EXTERNALSYM FMFD_ENABLEMIMESNIFFING}
  FMFD_ENABLEMIMESNIFFING  = $00000002;
  {$EXTERNALSYM FMFD_IGNOREMIMETEXTPLAIN}
  FMFD_IGNOREMIMETEXTPLAIN  = $00000004;
  {FMFD_SERVERMIME (0x00000008)
    Internet Explorer 8. Use the authoritative MIME type specified in pwzMimeProposed. Unless FMFD_IGNOREMIMETEXTPLAIN is specified, no data sniffing is performed.
  FMFD_RESPECTTEXTPLAIN (0x00000010)
    Internet Explorer 9. Do not perform detection if "text/plain" is specified in pwzMimeProposed.
  FMFD_RETURNUPDATEDIMGMIMES (0x00000020)
    Internet Explorer 9. Returns image/png and image/jpeg instead of image/x-png and image/pjpeg.}


 strUnknownError      = 'Unknown error';

 strMethodNameGET     = 'GET';
 strMethodNameHEAD    = 'HEAD';
 strMethodNameDELETE  = 'DELETE';
 strMethodNamePOST    = 'POST';
 strMethodNamePUT     = 'PUT';
 strDefMethodName     = strMethodNameGET;

 // mmm_corp, for POST data
 strContentTypePost =  'Content-Type: application/x-www-form-urlencoded';


// mmm_corp, some declarations from synacode (synapse)
type
  TSpecials = set of AnsiChar;
const
  URISpecialChar: TSpecials =
  [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
    '`', '/', '?', '&', '+', ':', '@', '#', '=', #$7F..#$FF];
  URLSpecialChar: TSpecials =
  [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
    '`', #$7F..#$FF];
  FileSpecialChar: TSpecials =
   ['\', '/', ':', '*', '?', '"', '<', '>', '|'];


// mmm_corp, use for dwContext, http://msdn.microsoft.com/en-us/library/windows/desktop/aa383976%28v=vs.85%29.aspx
{ http://msdn.microsoft.com/en-us/library/windows/desktop/aa383976%28v=vs.85%29.aspx

typedef struct
    HWND       hWindow;      // Window handle
    int        nStatusList;  // List box control to hold callbacks
    HINTERNET  hResource;    // HINTERNET handle created by InternetOpenUrl
    char       szMemo[512];  // String to store status memo
 REQUEST_CONTEXT;}
type
 PREQUEST_CONTEXT = ^TREQUEST_CONTEXT;
 TREQUEST_CONTEXT = record
    hWindow:      HWND;                   // Window handle
    nStatusList:  integer;                // List box control to hold callbacks
    hResource:    HINTERNET;              // HINTERNET handle created by InternetOpenUrl
    szMemo:       array[1..512] of char;  // String to store status memo
end;

//-----------------------------------------------------
{ THTTPHeader }
type
 PHTTPHeader = ^THTTPHeader;
 THTTPHeader = record
 {* |<p>Most important values that can be extracted from http-servers response
 |(see <a href="thttpdownload.htm#parseheaders">ParseHeaders</a> procedure
 |below for more details).</p> }
  HTTPVersion:  KOLstring;
  StatusCode:   Integer;
  ReasonPhrase: KOLstring;
  ServerDate:   KOLstring;
  ServerStr:    KOLstring;
  LastModified: KOLstring;
  Location:     KOLstring;
  SetCookie:    KOLstring;
  Expires:      KOLstring;
  AcceptRanges: KOLstring;
  ContentLength: Integer;

  // mmm_corp
  Content_Disposition: KOLstring;


  TransferEncoding: KOLstring;
  ContentType:   KOLstring;
 end;

//-----------------------------------------------------
 { THTTPDownload }

 PHTTPDownload = ^THTTPDownload;
 PDownloadWorker = ^TDownloadWorker;
 TKOLHTTPDownload = PHTTPDownload;
 THTTPHdrRecvEvent = procedure( Sender: PHTTPDownload; HeaderList: PStrList ) of object;
 {* |Event to be called when http-headers received from http-server. }

 // mmm_corp, add download speed and remaining time
 THTTPProgressEvent = procedure(Sender: PHTTPDownload;  BytesRecv: Integer; BytesAll: Integer;
                                DownloadSpeed: integer; RemainingTime: Integer) of object;
 {* |Event to be called when download progress is changed. }

 THTTPErrorEvent = procedure( Sender: PHTTPDownload; Error: Word ) of object;
 {* |Event to be called when error occured while download process. }

 //THTTPDownloadEvent = procedure( Sender: PHTTPDownload; Data: PStream ) of object;
 THTTPDownloadEvent = reference to procedure( Sender: PHTTPDownload; Data: PStream );
 {* |Event to be called when resource download completed. }

 // mmm_corp, Internet status, http://msdn.microsoft.com/en-us/library/windows/desktop/aa385121%28v=vs.85%29.aspx
 THTTPStatusEvent = procedure(Sender: PHTTPDownload; hInt: HINTERNET; dwContext: DWORD_PTR;
      dwInternetStatus: DWORD; pvStatusInformation: Pointer;
      dwStatusInformationLength: DWORD) of object;

 THTTPDownload = object( TObj )
 {* |This object implements all functionality of component.<br>
 |Use <i>NewHTTPDownload</i> constuction function for creation of object instance. Here is the prototype:
 ! function NewHTTPDownload: PHTTPDownload; }
  private
   fWorker: PDownloadWorker;
   fHeaderList: PStrList;

   {$IFDEF USE_CUSTOMHEADERS}
   fCHeaderList: PStrList;
//   fCHeaderListEmpty: boolean;  // save fHeaderList pointer for re-use/free
   {$ENDIF}

   fFormFields:PStrList;
   fDataStream: PStream;
   fDataStreamEmpty: Boolean;  // save fDataStream pointer for re-use/free

   fResource: string;
   fBusy: Boolean;
   fPort: Word;
   fHostName: string;
   fPath: string;
   fUserName: string;
   fPassword: string;
   fProxySrv: string;
   fProxyPort: Word;
   fPreConfigProxy: Boolean;

   // mmm_corp, add prop
   fMethodName: String;     // get/head etc....
   fPOSTData: String;   // for POST
   fProgressInterval: Integer;  //  call OnProgress by interval in ms
   fLastOnProgressUpdate: Integer;  // ms from last call fOnProgressInterval
   fRealResource: string;
   strUserAgent: string;
   fHttpOpenRequestFlag: Cardinal;

   // mmm_corp, add share declare Error, for Except or OnError speed fixes.....
   fOnError: THTTPErrorEvent;

   fOnHeaderReceived: THTTPHdrRecvEvent;
   fOnProgress: THTTPProgressEvent;
   fOnDownload: THTTPDownloadEvent;

   fInternet_Options : TArrOptions;

   // mmm_corp
   fOnHTTPStatus: THTTPStatusEvent;
   procedure SetDataStream(ds: PStream);  // set data stream
//   procedure SetHeaderList(hs: PStrList); // set data stream
  public
    // mmm_corp, add prop
    procedure fOnErrorCall(Sender: PHTTPDownload; ThreadSender: PThread; Error: Word);

    property  RequestMethodName: string read fMethodName  write fMethodName;
    property  POSTData: string read fPOSTData write fPOSTData;
    property  DataFieldsList: PStrList read fFormFields;
    property  DataStream: PStream read fDataStream write SetDataStream;
    property  RealResource: string read fRealResource;
    property  ProgressInterval: Integer read fProgressInterval write fProgressInterval;
    property  OnHTTPStatus: THTTPStatusEvent read fOnHTTPStatus write fOnHTTPStatus;
    property  UserAgent: string read strUserAgent write strUserAgent;
    property  HttpOpenRequestFlag: Cardinal read fHttpOpenRequestFlag write fHttpOpenRequestFlag;

    property  Internet_Options : TArrOptions read fInternet_Options write fInternet_Options;

    procedure FormFieldsClear;
    procedure FormField(name, value: string);

    function CheckConnection( AResourceName: string ): Boolean;
    {* Simple check if a connection to host that provides specified resource can be established,
    and requested resource can be retrieved. By example:
    !     CheckConnection( 'http://www.example.com/foo/bar.zip' );
    Note that this function may give the wrong results if destination host doesn't accept 'ping' requests.
    |Return value: <i>True</i> if a connection is made successfully, or <i>False</i> otherwise. }

    function  GetResource( AResourceName: string ): Boolean;
    {* |Initiate download process for the specified resource.<br>
    |The parameter <i>AResourceName</i> must contains full path of the requested resource
    in such syntax:
    !     protocol://[user[:password]@]server[:port]/path
    |If parameter <i>port</i> not specified, then <i>standard http-port (80)</i> will be used in request.
    Authorization parameters can be omitted too, if isn't needed.
    In simple case can be used, by example:
    !     GetResource( 'http://www.example.com/foo/bar.zip' );
    |Return value: the function returns <i>False</i> if resource request has invalid syntax,
    |otherwise <i>True</i> returned. }

    procedure SetProxySettings( AProxyServer: string; iProxyPort: Integer = iDefProxyPort );
    {* |Proxy settings for the resource request.<br>
    |<i>iProxyPort</i> parameter can be omitted then <i>standard proxy port (3128)</i> will be used. }

    procedure SetAuthInfo( AUserName: string; APassword: string );
    {* Authorization parameters for the resource request. }

    function  ParseHeaders( var Header: PHTTPHeader ): Boolean;
    {* Extract http-headers information and put into the specified HTTPHeader. By example:
    !var
    !  DL: PHTTPDownload;
    !  Header: PHTTPHeader;
    !// ...
    !procedure TForm1.DLHeaderReceived( Sender: PHTTPDownload; HeaderList: PStrList );
    !begin
    !  New( Header );
    !  DL.ParseHeaders( Header );
    !  // ... do something with Header ...
    !  MsgOk( Header.ReasonPhrase );
    !  // ...
    !  Dispose( Header );
    !end;
    |Return value: <i>False</i> if http-headers doesn't exists (nothing to analyze). }

    {$IFDEF USE_CUSTOMHEADERS}
//    procedure AddCustomHeader( AHeader: string );
    {* |Add custom line to requests http-header. By example:
    !var
    !  DL: PHTTPDownload;
    !// ...
    !procedure TForm1.Button1Click( Sender: PObj );
    !begin
    !  DL.AddCustomHeader( 'Cookie: PHPSESSID=abcdef' );
    !  DL.GetResource( 'http://www.example.com/foo/bar.zip' );
    !end;
    Once assigned these headers will be added automatically to each request sent to http-server
    (while the current THTTPDownload object is in use). Custom headers are not assigned by default.
    |To clear user defined http-headers list, call <i>ClearCustomHeaders</i> procedure.
    |Note that <i>'Connection: close'</i> or <i>'Proxy-Connection: close'</i> (depends on connection type)
    |will be included in the request headers anyway.<br>
    |You must add <b>USE_CUSTOMHEADERS</b> conditional symbol into the project options list. }

    procedure SetCustomHeaders( AHeaderList: PStrList );
    {* |Assign the custom http-headers list from another one. By example:
    !var
    !  DL: PHTTPDownload;
    !  CList: PStrList;
    !// ...
    !procedure TForm1.Button1Click( Sender: PObj );
    !begin
    !  CList:= NewStrList;
    !  CList.Add( 'Cookie: PHPSESSID=abcdef' );
    !  DL.SetCustomHeaders( CList );
    !  DL.GetResource( 'http://www.example.com/foo/bar.zip' );
    !  CList.Free;
    !end;
    |You must add <b>USE_CUSTOMHEADERS</b> conditional symbol into the project options list. }

//    procedure ClearCustomHeaders;
    {* |Clear user defined http-headers list (restore to defaults).
    |You must add <b>USE_CUSTOMHEADERS</b> conditional symbol into the project options list. }
    {$ENDIF}

    procedure CancelDownload;
    {* |Drop current download process immediately. }

    property Resource: string read fResource;
    {* |Currently requested resource. By default: <i>None.</i> }

    property  ProxyServer: string read fProxySrv write fProxySrv;
    {* |IP-address or hostname of http-proxy server. By default: <i>None.</i> }

    property  ProxyPort: Word read fProxyPort write fProxyPort;
    {* |TCP Port of http-proxy server. By default: <i>3128.</i> }

    property  UserName: string read fUserName write fUserName;
    {* |HTTP Autorization parameters: username. By default: <i>None.</i> }

    property  Password: string read fPassword write fPassword;
    {* |HTTP Autorization parameters: password. By default: <i>None.</i> }

    property  UsePreconfigProxy: Boolean read fPreConfigProxy write fPreConfigProxy;
    {*|Parameter that allows to use connection settings stored in Internet Explorer.
     Retrieves the proxy or direct configuration from the Windows registry.
     |By default: <i>False.</i> }

    property  HeaderList: PStrList read fHeaderList;
    {*|Retrieves all received http-headers in raw format (as is).
    Most important parameters can be retrieved with ParseHeaders procedure. }

    {$IFDEF USE_CUSTOMHEADERS}
    property  CustomHeaderList: PStrList read fCHeaderList;
    {*|Retrieves custom http-header list assigned by user.
    See SetCustomHeaders procedure for more details. }
    {$ENDIF}

    property  ReceivedData: PStream read fDataStream;
    {*|Retrieves downloaded resource if present. }

    property  Busy: Boolean read fBusy;
    {*| If <i>True</i>, the object is busy and resource download is in progress at the moment.
    If you wish, you can terminate download process at any moment with CancelDownload procedure. }

    property  OnError: THTTPErrorEvent read fOnError write fOnError;
    {* |Event to be called when error occured while download process. }

    property  OnHeaderReceived: THTTPHdrRecvEvent read fOnHeaderReceived write fOnHeaderReceived;
    {* |Event to be called when http-headers received from http-server. }

    property  OnProgress: THTTPProgressEvent read fOnProgress write fOnProgress;
    {* |Event to be called when download progress is changed.
    Note that there's no way to automatically determine the whole size of requested resource
    |if <i>'Content-Length'</i> field is missing in the http-header (i.e. if <i>Transfer-Encoding</i>
    |header field (rfc-2068 section 14.40) is present and indicates that the <i>"chunked"</i> transfer
    |coding has been applied). Therefore, if <i>'Content-Length'</i> is present, <i>BytesAll</i>
    |parameter indicates the requested resource size, otherwise it's equal to <i>'-1'</i>. }

    property  OnDownload: THTTPDownloadEvent read fOnDownload write fOnDownload;
    {* |Event to be called when resource download completed. }

   destructor Destroy; virtual;
 end;


//-----------------------------------------------------
 { TDownloadWorker }

 TDownloadWorker = object (TObj )
  private
   // Contains parent object's pointer (or NIL if download terminated)
   fOwner: PHTTPDownload;
   fWThread: PThread;
   fDLThread: PThread;
   fCritSection: TRTLCriticalSection;
   fDataBuf: PChar;
   fPort: Word;
   fHostName: string;
   fPath: string;
   fUserName: string;
   fPassword: string;
   fProxySrv: string;
   fProxyPort:  Word;
   fPreConfigProxy: Boolean;
   iContentLen: Integer;
   iReadCount: Integer;

   // mmm_corp, add prop
   fRequestMethodName: String;
   fPOSTData: string;
   fRealURL: String;
   iStartTickCounter: Integer;
   fDownloadSpeed: integer;
   fRemainingTime: Integer;


   function On_DownloadExecute( Sender: PThread ): Integer;
   function On_WatchExecute( Sender: PThread ): Integer;
   procedure On_UpdateProgress;

  public
   procedure StartDownload;
   function StopDownload: Integer;
   destructor Destroy; virtual;
 end;

  // from ActiveX
  {$EXTERNALSYM CoTaskMemFree}
  procedure CoTaskMemFree(pv: Pointer); stdcall;
  procedure CoTaskMemFree;  external ole32 name 'CoTaskMemFree';

//-----------------------------------------------------
function NewHTTPDownload: PHTTPDownload;
function NewDownloadWorker( AOwner: PHTTPDownload ): PDownloadWorker;

//-----------------------------------------------------
// mmm_corp, some aroud function
function EncodeURL(const Value: string): string;
function EncodeURI(const Value: String): String;
function EncodeURIAnsi(const Value: AnsiString): AnsiString;
function DecodeURL(const Value: AnsiString): AnsiString;

function GetWinInetError(ErrorCode:Cardinal): string;
function HttpGetText(const URL: string; Response: PStrList; method: String=strDefMethodName; PostData: string=''; Headers: PStrList=nil): Boolean; overload;
function HttpGetText(const http: PHTTPDownload; const URL: string; Response: PStrList; method: String=strDefMethodName; PostData: string=''): Boolean; overload;
function HttpGetStream(const URL: string; Response: PStream; method: String=strDefMethodName; PostData: string=''): Boolean; overload;
function HttpGetStream(const http: PHTTPDownload; const URL: string; Response: PStream; method: String=strDefMethodName; PostData: string=''): Boolean; overload;

function GetMimeTypeExtension(MimeType: string):string;
function GetMimeTypeFromData(strContentType: string; pstrData: PStream):string;
function GetURLFileName(http: TKOLHTTPDownload; sMimeType: string; DefFileName: string = ''):string;
procedure WaitUntilTrue(bTrueValue: boolean; iSleep: integer=10); inline; // inline; - must be!

procedure ParseURL(const url : String; var Proto, User, Pass, Host, Port, Path : String);
//-----------------------------------------------------

// mmm_corp, fake class
type
   TEventHandlers = class // create a dummy class
   public
   private
    procedure onDownload(Sender: PHTTPDownload; Data: PStream);
    procedure onError(Sender: PHTTPDownload; Error: Word);
    procedure OnHeaderReceived(Sender: PHTTPDownload; HeaderList: PStrList);
   end;

var
  EvHandler: TEventHandlers;

implementation

procedure WaitUntilTrue(bTrueValue: boolean; iSleep: integer=10); inline; // inline; - must be!
var
  IsMainThread: Boolean;
begin
  IsMainThread := MainThreadID = GetCurrentThreadId;
  while bTrueValue do
     begin
     {$IFNDEF NO_APPLET}
     if IsMainThread then
      Applet.ProcessMessages;
     {$ENDIF}
     Sleep(iSleep);
     end;
end;

// get file extension from mimetype
function GetMimeTypeExtension(MimeType: string):string;
var
  r:HKEY;
  val: string;
begin
  val:='';
  Result := '';
  r := 0;
  try
    r := RegKeyOpenRead(HKEY_CLASSES_ROOT,'MIME\Database\Content Type\'+MimeType);
    if r<>0 then
      val := RegKeyGetStr(r,'Extension');
  except
    val := '';
  end;
  if r<>0 then
    RegCloseKey(r);
  Result := val;
end;

// get filename from url
function GetURLFileName(http: TKOLHTTPDownload; sMimeType: string; DefFileName: string = ''):string;
  function RightFileName(const FileName: string): string;
  var
    I: integer;
  begin
    result:='';
    for I := 0 to Length(FileName) do
        if CharIn(FileName[i], FileSpecialChar)=False then
           Result:=Result+FileName[i];
  end;

const
  strDefHTMLExt             = 'html';
  strDefaultFileName        = 'default.'+strDefHTMLExt;
  strContentDisposeFilename = 'filename';
var
  Header: PHTTPHeader;
  s,ext: string;
  j: Integer;
  strProto, fUserName, fPassword, fHostName, strPort, fPath: string;
begin
  // dont use title tag in HTML how do browsers !
  Result:='';
  // set from 'Content-Disposition' header
  New(Header);
  if http.ParseHeaders(Header) then
     begin
     s:=header.Content_Disposition;
     j:=Pos(strContentDisposeFilename, s);
     if j>0 then
        begin
        s:=Copy(s, j+length(strContentDisposeFilename)+1, Length(s)-j);
        j:=Pos(';', s);
        if j>0 then
           s:=Copy(s, 0, j-1);
        Result:=s;
        end;
     end;
  Dispose(Header);

  // set from file name url
  if Result='' then
     begin
     ParseURL(http.RealResource, strProto, fUserName, fPassword, fHostName, strPort, fPath );
     s:=fPath;
     {$WARNINGS OFF}
     s:=DecodeURL(s);
     {$WARNINGS ON}
     // '/images/brain.gif?fsdfsdf=1'
     j:=Pos('?', s);
     if j>0 then
        s:=Copy(s, 0, j-1);
     // '/images/brain.gif'
     j:=DelimiterLast(s, '/');
     if j>0 then
        Delete(s, 1, j);

     // set 'html' if not present '.'
     j:=Pos('.', s);
     if j=0 then
     begin
        if DefFileName<>'' then
          s := DefFileName;
        ext:=GetMimeTypeExtension(sMimeType);
        if ext <> '' then
          s:=s+ext
        else
          s:=s+'.'+strDefHTMLExt;
        //MsgOK(s);
     end;

     // change ext to HTML if text/htm
     if sMimeType=UrlMon.CFSTR_MIME_HTML then
        s:=ChangeFileExt(s, '.'+strDefHTMLExt);
     Result:=s;
     end;

  // set default
  if Result='.'+strDefHTMLExt then
     Result:=strDefaultFileName;

  Result:=Trim(RightFileName(Result));
end;

// get MimeType from pstr
function GetMimeTypeFromData(strContentType: string; pstrData: PStream):string;
var
  pMimeTypeOut, pwzMimeProposed: PWideChar;
  dwMimeFlags: Cardinal;
begin
  // http://msdn.microsoft.com/en-us/library/ms775147%28v=vs.85%29.aspx#Known_MimeTypes
  // can to help
  // GetClassFileOrMime
  // http://msdn.microsoft.com/en-us/library/ms775108%28v=vs.85%29.aspx


  Result:=strUnknownError;
  // http://msdn.microsoft.com/en-us/library/ie/ms775107%28v=vs.85%29.aspx
  dwMimeFlags:=FMFD_DEFAULT;

  {pwzMimeProposed (strContentType)
    A pointer to a string value that contains the proposed MIME type.
    This value is authoritative if type cannot be determined from the data.
    If the proposed type contains a semi-colon (;) it is removed.
    This parameter can be set to NULL.}
  if Pos(';', strContentType)>0 then
     strContentType:=Copy(strContentType, 0, Pos(';', strContentType)-1);

  // zero size string <> nil !, fix it, but why??? 0_o...
  pwzMimeProposed:=PWideChar(strContentType);
  if Trim(strContentType)=''
     then pwzMimeProposed:=nil;


  pstrData.Position:=0;
  try
    case UrlMon.FindMimeFromData(
                  nil,                        // bind context - can be nil
                  nil,                        // url - can be nil
                  pstrData,                   // buffer with data to sniff - can be nil (pwzUrl must be valid)
                  pstrData.Size,              // size of buffer
                  pwzMimeProposed,            // proposed mime if - can be nil
                  dwMimeFlags,                // will be defined
                  pMimeTypeOut,               // the suggested mime
                  0) of                       // must be 0

    S_OK:           SetString(Result, pMimeTypeOut, length(pMimeTypeOut));
    E_FAIL:         Result:='E_FAIL';
    E_INVALIDARG:   Result:='E_INVALIDARG';
    E_OUTOFMEMORY:  Result:='E_OUTOFMEMORY';
    end;
  {finally} except on E: err.Exception do OnExcept(E); end; begin
    CoTaskMemFree(pMimeTypeOut); // ActiveX
  end;
end;

function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
var
  x, l, lv: Integer;
  c: AnsiChar;
  b: Byte;
  bad: Boolean;
begin
  lv := Length(Value);
  SetLength(Result, lv);
  x := 1;
  l := 1;
  while x <= lv do
  begin
    c := Value[x];
    Inc(x);
    if c <> Delimiter then
    begin
      Result[l] := c;
      Inc(l);
    end
    else
      if x < lv then
      begin
        Case Value[x] Of
          #13:
            if (Value[x + 1] = #10) then
              Inc(x, 2)
            else
              Inc(x);
          #10:
            if (Value[x + 1] = #13) then
              Inc(x, 2)
            else
              Inc(x);
        else
          begin
            bad := False;
            Case Value[x] Of
              '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
              'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
            else
              begin
                b := 0;
                bad := True;
              end;
            end;
            Case Value[x + 1] Of
              '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
              'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
            else
              bad := True;
            end;
            if bad then
            begin
              Result[l] := c;
              Inc(l);
            end
            else
            begin
              Inc(x, 2);
              Result[l] := AnsiChar(b);
              Inc(l);
            end;
          end;
        end;
      end
      else
        break;
  end;
  Dec(l);
  SetLength(Result, l);
end;

function DecodeURL(const Value: AnsiString): AnsiString;
begin
  Result := DecodeTriplet(Value, '%');
end;

function chrTrimLeft(const S: KOLString; chr:KOLChar=' '): KOLString;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= chr) do Inc(I);
  Result := Copy(S, I, Maxint);
end;
function chrTrimRight(const S: KOLString; chr:KOLChar=' '): KOLString;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] <= chr) do Dec(I);
  Result := Copy(S, 1, I);
end;
function chrTrim( const S : KOLString; chr:KOLChar=' '): KOLString;
begin
   Result := chrTrimLeft( chrTrimRight( S, chr ), chr );
end;

// mmm_corp, aroud functions in almost synapse style
procedure TEventHandlers.onDownload(Sender: PHTTPDownload; Data: PStream);
begin
  ; // need assign method, because data only create when onDownload assigned
end;

procedure TEventHandlers.onError(Sender: PHTTPDownload; Error: Word);
begin
  Sender.DataStream.Size:=0;  // clear if get error
end;

procedure TEventHandlers.OnHeaderReceived(Sender: PHTTPDownload; HeaderList: PStrList);
begin
  //
end;

function HttpGetText(const URL: string; Response: PStrList; method: String=strDefMethodName; PostData: string=''; Headers: PStrList=nil): Boolean;
const
  DwnldInternet_Options : TArrOptions = (
    INTERNET_OPTION_CONNECT_TIMEOUT     , 20000,
    INTERNET_OPTION_DATA_RECEIVE_TIMEOUT, 20000,
    INTERNET_OPTION_DATA_SEND_TIMEOUT   , 20000,
    INTERNET_OPTION_FROM_CACHE_TIMEOUT  , 20000,
    INTERNET_OPTION_RECEIVE_TIMEOUT     , 20000,
    INTERNET_OPTION_SEND_TIMEOUT        , 20000
  );
var
  http: TKOLHTTPDownload;
  ms: PStream;
begin
  Result := False;

  if Assigned(Response) then
    Response.Clear;

  ms:=NewMemoryStream;
  http:=NewHTTPDownload;

  try
  http.Internet_Options := DwnldInternet_Options;
  http.RequestMethodName:=method;
  http.POSTData:=PostData;
  http.DataStream:=ms;
  http.OnDownload:=EvHandler.onDownload;  // must be!
//  http.UsePreconfigProxy:=true; // proxy settings as in IE
  http.OnError:=EvHandler.onError;
  http.OnHeaderReceived := EvHandler.OnHeaderReceived;

  if Assigned(Headers) then
    begin
      http.SetCustomHeaders(Headers);
    end;

  http.GetResource(URL);
  WaitUntilTrue(http.Busy);
  ms.Position:=0;
  if Assigned(Response) then
    Response.LoadFromStream(ms, false); // hm... can be compatible with PStrList ?

  if Assigned(Headers) then
    begin
      if Assigned(http.HeaderList) then
        begin
          Headers.NameDelimiter := http.HeaderList.NameDelimiter;
          Headers.Text := http.HeaderList.Text;
        end;
    end;

  Result:=ms.Size>0;
  {finally} except on E: err.Exception do OnExcept(E); end; begin
    ms.Free;
    http.Free;
  end;
end;

function HttpGetText(const http: PHTTPDownload; const URL: string; Response: PStrList; method: String=strDefMethodName; PostData: string=''): Boolean;
const
  DwnldInternet_Options : TArrOptions = (
    INTERNET_OPTION_CONNECT_TIMEOUT     , 60000,
    INTERNET_OPTION_DATA_RECEIVE_TIMEOUT, 60000,
    INTERNET_OPTION_DATA_SEND_TIMEOUT   , 60000,
    INTERNET_OPTION_FROM_CACHE_TIMEOUT  , 60000,
    INTERNET_OPTION_RECEIVE_TIMEOUT     , 60000,
    INTERNET_OPTION_SEND_TIMEOUT        , 60000
  );
var
  ms: PStream;
begin
  Result := False;

  Response.Clear;

  ms:=NewMemoryStream;
  //http:=NewHTTPDownload;

  try
  {http.RequestMethodName:=method;
  http.POSTData:=PostData;
  http.DataStream:=ms;
  http.OnDownload:=EvHandler.onDownload;  // must be!
  http.UsePreconfigProxy:=true; // proxy settings as in IE
  http.GetResource(URL);
  //http.SetCustomHeaders();
  WaitUntilTrue(http.Busy);
  ms.Position:=0;
  Response.LoadFromStream(ms, false); // hm... can be compatible with PStrList ?

  Result:=True;}
  http.Internet_Options := DwnldInternet_Options;
  http.RequestMethodName:=method;
  http.POSTData:=PostData;
  http.DataStream:=ms;
//  http.OnDownload:=EvHandler.onDownload;  // must be!
//  http.UsePreconfigProxy:=true; // proxy settings as in IE
  http.OnError:=EvHandler.onError;

  http.GetResource(URL);
  WaitUntilTrue(http.Busy);
  ms.Position:=0;
  Response.LoadFromStream(ms, false); // hm... can be compatible with PStrList ?

  Result:=ms.Size>0;

  {finally} except on E: err.Exception do OnExcept(E); end; begin
    ms.Free;
    //http.Free;
  end;

  //http.Free;
end;

function HttpGetStream(const URL: string; Response: PStream; method: String=strDefMethodName; PostData: string=''): Boolean;
var
  http: TKOLHTTPDownload;
begin
  Result := False;
  http:=NewHTTPDownload;

  try
  http.RequestMethodName:=method;
  http.POSTData:=PostData;
  http.DataStream:=Response;
  http.OnDownload:=EvHandler.onDownload;  // must be!
//  http.UsePreconfigProxy:=true; // proxy settings as in IE
  http.OnError:=EvHandler.onError;
  http.GetResource(URL);

  WaitUntilTrue(http.Busy);
  Response.Position:=0;

  Result:=Response.Size>0;
  {finally} except on E: err.Exception do OnExcept(E); end; begin
    //ms.Free;
    http.Free;
  end;
end;

function HttpGetStream(const http: PHTTPDownload; const URL: string; Response: PStream; method: String=strDefMethodName; PostData: string=''): Boolean;
begin
  Result := False;
  try
  http.RequestMethodName:=method;
  http.POSTData:=PostData;
  http.DataStream:=Response;
//  http.OnDownload:=EvHandler.onDownload;  // must be!
//  http.UsePreconfigProxy:=true; // proxy settings as in IE
  http.OnError:=EvHandler.onError;

  http.GetResource(URL);
  WaitUntilTrue(http.Busy);
  Response.Position:=0;

  Result:=Response.Size>0;
  {finally} except on E: err.Exception do OnExcept(E); end; begin

  end;
end;

// mmm_corp, add declaration, th Ìèõàèë)
function GetWinInetError(ErrorCode:Cardinal): string;
const
  winetdll = 'wininet.dll';
var
  Len: Integer;
  Buffer: PChar;
begin
  Len := FormatMessage(
  FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_FROM_SYSTEM or
  FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS or  FORMAT_MESSAGE_ARGUMENT_ARRAY,
  Pointer(GetModuleHandle(winetdll)), ErrorCode, 0, @Buffer, SizeOf(Buffer), nil);
  try
    while (Len > 0) and {$IFDEF UNICODE}(CharIn(Buffer[Len - 1], [#0..#32, '.'])) {$ELSE}(Buffer[Len - 1] in [#0..#32, '.']) {$ENDIF} do Dec(Len);
    SetString(Result, Buffer, Len);
  {finally} except on E: err.Exception do OnExcept(E); end; begin
    LocalFree(HLOCAL(Buffer));
  end;
end;

// mmm_corp, imported from synacode (Synapse)
function EncodeTriplet(const Value: string; Delimiter: Char; Specials: TSpecials): string;
var
	n: Integer;
	s: string;
begin
	for n := 1 to Length(Value) do
	begin
		s := Value[n];
  if CharIn(s[1], Specials) then
			s := Delimiter + Int2Hex(Ord(s[1]), 2);
		Result := Result + s;
	end;
end;

function EncodeTripletAnsi(const Value: Ansistring; Delimiter: AnsiChar; Specials: TSpecials): AnsiString;
var
	n: Integer;
	s: AnsiString;
begin
	for n := 1 to Length(Value) do
	begin
		s := Value[n];
  if s[1] in Specials then
			s := Delimiter + AnsiString(Int2Hex(Ord(s[1]), 2));
		Result := Result + s;
	end;
end;

function EncodeURIAnsi(const Value: AnsiString): AnsiString;
begin
  Result := EncodeTripletAnsi(Value, '%', URISpecialChar);
end;

function EncodeURI(const Value: String): String;
begin
  Result := EncodeTriplet(Value, '%', URISpecialChar);
end;

function EncodeURL(const Value: string): string;
begin
  Result := EncodeTriplet(Value, '%', URLSpecialChar);
end;

//-----------------------------------------------------
function NewHTTPDownload: PHTTPDownload;
begin
 New( Result, Create );

 Result^.fBusy:=false;
 Result^.fPreConfigProxy:= false;
 Result^.fProxyPort:= iDefProxyPort;

 // mmm_corp, add def prop
 Result^.fMethodName:= strDefMethodName;
 Result^.ProgressInterval:=0;
 Result^.UsePreconfigProxy:=True;
 Result^.fDataStreamEmpty:=True;
 Result^.UserAgent:=strUserAgentDefault;
 Result^.HttpOpenRequestFlag:=iHttpOpenRequestFlagDefault;
 Result^.fInternet_Options := DefInternet_Options;
end;

//-----------------------------------------------------
function NewDownloadWorker( AOwner: PHTTPDownload ): PDownloadWorker;
begin
 New( Result, Create );
 Result^.fOwner:= AOwner;
 InitializeCriticalSection( Result^.fCritSection );
end;

//-----------------------------------------------------
function StrPas(const Str: PChar): string;
begin
  Result:= Str;
end;

//-----------------------------------------------------
{ Find the count'th occurence of the s string in the t string.  }
{ If count < 0 then look from the back                          }
function Posn(const s , t : String; Count : Integer) : Integer;
var
    i, h, Last : Integer;
    u          : String;
begin
    u := t;
    if Count > 0 then
    begin
        Result := Length(t);
        for i := 1 to Count do
        begin
            h := Pos(s, u);
            if h > 0 then
                u := Copy(u, h + 1, Length(u))
            else
            begin
                u := '';
                Inc(Result);
            end;
        end;
        Result := Result - Length(u);
    end
    else if Count < 0 then
    begin
        Last := 0;
        for i := Length(t) downto 1 do
        begin
            u := Copy(t, i, Length(t));
            h := Pos(s, u);
            if (h <> 0) and ((h + i) <> Last) then
            begin
                Last := h + i - 1;
                Inc(count);
                if Count = 0 then
                    break;
            end;
        end;
        if Count = 0 then
            Result := Last
        else
            Result := 0;
    end
    else
        Result := 0;
end;

//-----------------------------------------------------
{ Syntax of an URL: protocol://[user[:password]@]server[:port]/path  }
procedure ParseURL(const url : String; var Proto, User, Pass, Host, Port, Path : String);
var
    p, q    : Integer;
    s       : String;
    CurPath : String;
begin
    CurPath := Path;
    proto   := '';
    User    := '';
    Pass    := '';
    Host    := '';
    Port    := '';
    Path    := '';

    if Length(url) < 1 then Exit;

    { Handle path beginning with "./" or "../".          }
    { This code handle only simple cases !               }
    { Handle path relative to current document directory }
    if (Copy(url, 1, 2) = './') then
    begin
        p := Posn('/', CurPath, -1);
        if p > Length(CurPath) then
            p := 0;
        if p = 0 then
            CurPath := '/'
        else
            CurPath := Copy(CurPath, 1, p);
        Path := CurPath + Copy(url, 3, Length(url));
        Exit;
    end
    { Handle path relative to current document parent directory }
    else if (Copy(url, 1, 3) = '../') then
    begin
        p := Posn('/', CurPath, -1);
        if p > Length(CurPath) then
            p := 0;
        if p = 0 then
            CurPath := '/'
        else
            CurPath := Copy(CurPath, 1, p);

        s := Copy(url, 4, Length(url));
        { We could have several levels }
        while TRUE do
        begin
            CurPath := Copy(CurPath, 1, p-1);
            p := Posn('/', CurPath, -1);
            if p > Length(CurPath) then
                p := 0;
            if p = 0 then
                CurPath := '/'
            else
                CurPath := Copy(CurPath, 1, p);
            if (Copy(s, 1, 3) <> '../') then
                break;
            s := Copy(s, 4, Length(s));
        end;

        Path := CurPath + Copy(s, 1, Length(s));
        Exit;
    end;

    p := pos('://',url);
    if p = 0 then
    begin
        if (url[1] = '/') then
        begin
            { Relative path without protocol specified }
            proto := 'http';
            p     := 1;
            if (Length(url) > 1) and (url[2] <> '/') then
            begin
                { Relative path }
                Path := Copy(url, 1, Length(url));
                Exit;
            end;
        end
              {$WARNINGS OFF}
        else if lowercase(Copy(url, 1, 5)) = 'http:' then
              {$WARNINGS ON}
        begin
            proto := 'http';
            p     := 6;
            if (Length(url) > 6) and (url[7] <> '/') then
            begin
                { Relative path }
                Path := Copy(url, 6, Length(url));
                Exit;
            end;
        end
              {$WARNINGS OFF}
        else if lowercase(Copy(url, 1, 7)) = 'mailto:' then
              {$WARNINGS ON}
        begin
            proto := 'mailto';
            p := pos(':', url);
        end;
    end
    else
    begin
        proto := Copy(url, 1, p - 1);
        inc(p, 2);
    end;
    s := Copy(url, p + 1, Length(url));

    p := pos('/', s);
    q := pos('?', s);
    if (q > 0) and ((q < p) or (p = 0)) then
        p := q;
    if p = 0 then
        p := Length(s) + 1;
    Path := Copy(s, p, Length(s));
    s    := Copy(s, 1, p-1);

    p := Posn(':', s, -1);
    if p > Length(s) then
        p := 0;
    q := Posn('@', s, -1);
    if q > Length(s) then
        q := 0;
    if (p = 0) and (q = 0) then
    begin   { no user, password or port }
        Host := s;
        Exit;
    end
    else if q < p then
    begin  { a port given }
        Port := Copy(s, p + 1, Length(s));
        Host := Copy(s, q + 1, p - q - 1);
        if q = 0 then
            Exit; { no user, password }
        s := Copy(s, 1, q - 1);
    end
    else
    begin
        Host := Copy(s, q + 1, Length(s));
        s := Copy(s, 1, q - 1);
    end;
    p := pos(':', s);
    if p = 0 then
        User := s
    else
    begin
        User := Copy(s, 1, p - 1);
        Pass := Copy(s, p + 1, Length(s));
    end;


end;

//---------------- { THTTPDownload } -------------------------------
procedure THTTPDownload.SetDataStream(ds: PStream); // set data stream
begin
  fDataStreamEmpty:=not Assigned(ds);
  fDataStream:=ds;
end;


// mmm_corp, add share OnError fix function
procedure THTTPDownload.fOnErrorCall(Sender: PHTTPDownload; ThreadSender: PThread; Error: Word);
  procedure CallError; //(Error: Word);
  var
    E: Exception;
  begin
    E:= Exception.Create(e_Custom, GetWinInetError(Error));
    E.ErrorCode := Error;
    raise E;  // im main thread
    E.Free;
  end;

  procedure SyncCallError;
  begin
    CallError; //(Error);
  end;

begin
  if Assigned(fOnError)
     then fOnError(Sender, Error)
     else ;

  // new try ((((
  Exit;
      if Assigned(ThreadSender)
         then ThreadSender.SynchronizeEx(TThreadMethodEx(MakeMethod(nil, @SyncCallError)), Pointer(Error)) // from thread
         else CallError; //(Error); // from main thread
end;

function THTTPDownload.ParseHeaders( var Header: PHTTPHeader ): Boolean;
var
 i: Integer; S: KOLstring;
begin
 Result:= false;

 if ( not Assigned( fHeaderList ) ) then Exit;

  // HTTP/1.1 200 OK
       {$WARNINGS OFF}
 Header.ReasonPhrase:= fHeaderList.Items[0];
       {$WARNINGS ON}
 Header.HTTPVersion:= Parse( Header.ReasonPhrase, ' ' );
 Header.StatusCode:= Str2Int( Parse(Header.ReasonPhrase, ' ') );
 // avoid curious things if value isn't present in the list
 Header.ContentLength:= -1;
 // begin from second list item
 for i:= 2 to fHeaderList.Count do
 begin
       {$WARNINGS OFF}
  S:= fHeaderList.Items[i-1];
        {$WARNINGS ON}
  // Date: Wed, 09 May 2007 14:31:23 GMT
  if ( Pos('Date: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.ServerDate:= S;
   Continue;
  end;
  // Server: Apache x.x.x (Unix)
  if ( Pos('Server: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.ServerStr:= S;
   Continue;
  end;
  // Last-Modified: Wed, 09 May 2007 14:31:23 GMT
  if ( Pos('Last-Modified: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.LastModified:= S;
   Continue;
  end;
  // Set-Cookie: PHPSESSID=xxxxxxxxx
  if ( Pos('Set-Cookie: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.SetCookie:= S;
   Continue;
  end;
  // Expires: Wed, 10 May 2007 14:31:23 GMT
  if ( Pos('Expires: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.Expires:= S;
   Continue;
  end;
  // Location: foobar.html
  if ( Pos('Location: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.Location:= S;
   Continue;
  end;
  // Content-Length: 12345
  if ( Pos('Content-Length: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.ContentLength:= Str2Int( S );
   Continue;
  end;
  // Transfer-Encoding: chunked
  if ( Pos('Transfer-Encoding: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.TransferEncoding:= S;
   Continue;
  end;
  // Content-Type: application/zip
  if ( Pos('Content-Type: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.ContentType:= S;
   Continue;
  end;

  // mmm_corp
  // Content-Disposition: attachment; filename="fname.ext"
  if ( Pos('Content-Disposition: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.Content_Disposition:= S;
   Continue;
  end;
   if ( Pos('Accept-Ranges: ', S) > 0 ) then
  begin
   Parse(S, ' '); Header.AcceptRanges:= S;
   Continue;
  end;

 end;

 Result:= true;
end;

//-----------------------------------------------------
procedure THTTPDownload.SetProxySettings( AProxyServer: string; iProxyPort: Integer = iDefProxyPort );
begin
 fProxySrv:= AProxyServer;
 fProxyPort:= iProxyPort;
end;

//-----------------------------------------------------
procedure THTTPDownload.SetAuthInfo( AUserName: string; APassword: string );
begin
 fUserName:= AUserName;
 fPassword:= APassword;
end;

//-----------------------------------------------------
{$IFDEF USE_CUSTOMHEADERS}
{procedure THTTPDownload.AddCustomHeader( AHeader: string );
begin
 if Length(AHeader)=0 then Exit;

 if not Assigned(fCHeaderList) then
    fCHeaderList:=NewStrList;
  $WARNINGS OFF
  fCHeaderList.Add(AHeader);
  $WARNINGS ON
end;   }

//-----------------------------------------------------
{procedure THTTPDownload.ClearCustomHeaders;
begin
 if Assigned( fCHeaderList ) then fCHeaderList.Clear;
end;  }

//-----------------------------------------------------
procedure THTTPDownload.SetCustomHeaders( AHeaderList: PStrList );
begin
// fCHeaderListEmpty:=not Assigned(AHeaderList);

 if not Assigned(AHeaderList) then Exit;

 if not Assigned(fCHeaderList) then
  begin
   fCHeaderList:=NewStrList;
   // fCHeaderList.Add2AutoFree( @Self );
  end; // 'if ( not Assigned( fCHeaderList )'
  fCHeaderList.Assign( AHeaderList );
end;
{$ENDIF}

//-----------------------------------------------------
function THTTPDownload.CheckConnection( AResourceName: string ): Boolean;
begin
  Result:= false;
  // I'm wondering why FLAG_ICC_FORCE_CONNECTION declaration is missing in WinInet.pas
  if ( InternetCheckConnection( PChar( AResourceName ), $00000001 {FLAG_ICC_FORCE_CONNECTION}, 0 ) ) then
   Result:= true
  else
      fOnErrorCall(@Self, nil, GetLastError);
end;

//-----------------------------------------------------
function THTTPDownload.GetResource( AResourceName: string ): Boolean;
var
 strPort, strProto: string;
begin
 Result:= false;
 fRealResource:=AResourceName;
 CancelDownload;

 if fBusy then Exit;
 fResource:= AResourceName;
  // checking request data
  ParseURL( fResource, strProto, fUserName, fPassword, fHostName, strPort, fPath );

  // mmm_corp, fix 12005 error if call 'http://www.redbird.te.ua' with empty fPath
  if fPath=''  then fPath:='/';


  if ( strProto = '' ) then strProto:= 'http';
  if ( ( fHostName = '' ) or ( fPath = '' ) or ( (strProto <> 'http') and (strProto <> 'https') )) then
  begin
   fOnErrorCall(@Self, nil, ERROR_INTERNET_INVALID_URL);
   Exit;
  end;
  if ( strPort = '' ) then fPort:= INTERNET_DEFAULT_HTTP_PORT
  else fPort:= Str2Int( strPort );


  // mmm_corp, fix mem leaks, Add2AutoFree not work correct
  if Assigned(fOnHeaderReceived) then
   if not Assigned(fHeaderList) then
   begin
   fHeaderList:= NewStrList;
//    fHeaderList.Add2AutoFree( @Self );
   end;


  if Assigned(fDataStream) then
     fDataStream.Size:= 0
    else
    begin
    if Assigned(fOnDownload) then
       fDataStream:= NewMemoryStream;
    end;

  fBusy:= true;
  fWorker:= NewDownloadWorker( @Self );
  fWorker.StartDownload;
  Result:= true;
end;

//-----------------------------------------------------
procedure THTTPDownload.CancelDownload;
begin
 if ( fBusy ) then
  fWorker.StopDownload;
end;

//-----------------------------------------------------
procedure THTTPDownload.FormFieldsClear;
begin
  if ( not Assigned( fFormFields ) ) then
  begin
    fFormFields:= NewStrList;
    //fFormFields.Add2AutoFree( @Self );
    fFormFields.NameDelimiter:='=';
  end;
  fFormFields.Clear;
end;

//-----------------------------------------------------
procedure THTTPDownload.FormField(name, value: string);
begin
  if ( not Assigned( fFormFields ) ) then
  begin
    fFormFields:= NewStrList;
   // fFormFields.Add2AutoFree( @Self );
  end;

        {$WARNINGS OFF}
  fFormFields.Values[name]:=EncodeURI(AnsiToUtf8(value));
        {$WARNINGS ON}
end;

//-----------------------------------------------------
destructor THTTPDownload.Destroy;
begin
 CancelDownload;
 fResource:= '';
 fHostName:= '';
 fPath:= '';
 fProxySrv:= '';
 fUserName:= '';
 fPassword:= '';

 fRealResource:='';
 fMethodName:='';
 fPOSTData:='';
 strUserAgent:='';

 // mmm_corp, mem leak, free fDataStream if use OnDownload and not assign fDataStream
  if Assigned(fCHeaderList) {and fCHeaderListEmpty=True} then
     fCHeaderList.Free;

  if Assigned(fFormFields) then
     fFormFields.Free;

  if Assigned(fDataStream) and fDataStreamEmpty=True then
     fDataStream.Free;

  if Assigned(fHeaderList) then
     fHeaderList.Free;

 inherited;
end;

//---------------- { TDownloadWorker } -------------------------------

procedure TDownloadWorker.StartDownload;
begin
 fWThread:= NewThread;
 fWThread.OnExecute:= On_WatchExecute;

  // mmm_corp, fix mem leak
 fWThread.AutoFree:=True;
// fWThread.Add2AutoFree( @Self );
 fWThread.Resume;
end;

//-----------------------------------------------------
function TDownloadWorker.On_WatchExecute( Sender: PThread ): Integer;
begin
 Result:= 0; // stub

 // create download working thread
 fDLThread:= NewThreadEx( On_DownloadExecute );
 // wait for download thread finished (any way)
 fDLThread.WaitFor;
 // destroy worker object
 Free;
end;

//-----------------------------------------------------
function TDownloadWorker.StopDownload: Integer;
var
 lpOwner: PHTTPDownload;
begin
 Result:= 0; // stub

 lpOwner:= nil; // avoid compiler warning
 EnterCriticalSection( fCritSection );
 try
  if Assigned( fOwner ) then
  begin
   lpOwner:= PHTTPDownload( fOwner );
   fOwner:= nil;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // trying to terminate thread gracefully
 if ( not fDLThread.Terminated ) then fDLThread.WaitForTime( iTimeOutValue );
 // terminate thread forcefully
 if ( not fDLThread.Terminated ) then fDLThread.Terminate;

 if Assigned( lpOwner ) then
 begin
  // don't keep partially downloaded file
  if Assigned( lpOwner.fDataStream ) then
   lpOwner.fDataStream.Size:= 0;
  lpOwner.fBusy:= false;
 end;

end;

//-----------------------------------------------------
procedure TDownloadWorker.On_UpdateProgress;
begin
  if Assigned(fOwner) then
     fOwner.fOnProgress(fOwner, iReadCount, iContentLen, fDownloadSpeed, fRemainingTime);
end;

//-----------------------------------------------------

// mmm_corp, realurl, containe real url if redirected, can catch any events
procedure InternetStatusCallback(hInt: HINTERNET; dwContext: DWORD_PTR;
      dwInternetStatus: DWORD; pvStatusInformation: Pointer;
      dwStatusInformationLength: DWORD); stdcall;
var
    cpContext: PREQUEST_CONTEXT;
    ht: THTTPDownload;
begin
 cpContext:= PREQUEST_CONTEXT(dwContext);
 // get HTTPDownload object
 ht:=PHTTPDownload(cpContext.nStatusList)^;
 case dwInternetStatus of
  INTERNET_STATUS_REDIRECT:
    if Assigned(pvStatusInformation) then
       {$WARNINGS OFF}
       ht.fWorker.fRealURL:=PAnsiChar(pvStatusInformation);   // Real URL
       {$WARNINGS ON}
 end;

  if Assigned(ht.OnHTTPStatus) then
    ht.fOnHTTPStatus(@ht, hInt, dwContext,
        dwInternetStatus, pvStatusInformation,
        dwStatusInformationLength);
end;


function TDownloadWorker.On_DownloadExecute( Sender: PThread ): Integer;
var
 hSession, hConnect, hRequest: HINTERNET;
 iBufSize, lpdwIndex, iNumRead: Cardinal;
 Buf: PChar; i, iErrorCode, timeout: Integer;
 dwFlags: Cardinal;
 dwContext: DWORD_PTR;
 dwContextRecord : TREQUEST_CONTEXT;
 d: real;

 dwBuffer:array[1..20] of Char;
 dwBufferLen {,dwIndex}:DWORD;
 pfStatus: PFNInternetStatusCallback;

 rawData:RawByteString;
 s: string;

 procedure CloseHandles;
 begin
   InternetCloseHandle( hRequest );
   InternetCloseHandle( hConnect );
   InternetCloseHandle( hSession );
 end;

begin
 Result:= 0; // stub

 EnterCriticalSection( fCritSection );
 try
  if Assigned( fOwner ) then
  begin
   // mmm_corp, add private prop
   fRequestMethodName :=fOwner.fMethodName;
   fPOSTData          :=fOwner.fPOSTData;


   fHostName:= fOwner.fHostName;
   fPath:= fOwner.fPath;
   fPort:= fOwner.fPort;
   fUserName:= fOwner.fUserName;
   fPassword:= fOwner.fPassword;
   fPreConfigProxy:= fOwner.fPreConfigProxy;
   if ( not fPreConfigProxy ) then
     begin
     fProxySrv:= fOwner.fProxySrv;
     fProxyPort:= fOwner.fProxyPort;
     end;
  end // 'if Assigned( fOwner ) then'
  else Exit;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // initializing Wininet, settings some connection parameters
 // mmm_corp, use flags, http://msdn.microsoft.com/en-us/library/windows/desktop/aa383928%28v=vs.85%29.aspx
 dwFlags := 0; //WinInet.INTERNET_FLAG_NO_CACHE_WRITE;

 if (fPreConfigProxy) then
  hSession:= InternetOpen(PWideChar(fOwner.strUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, dwFlags)
 else
  begin
   if (fProxySrv <> '') then
    hSession:= InternetOpen(PWideChar(fOwner.strUserAgent), INTERNET_OPEN_TYPE_PROXY,
                            PChar( 'http=' + fProxySrv + ':' + Int2Str( fProxyPort) ), nil, dwFlags)
   else
    hSession:= InternetOpen(PWideChar(fOwner.strUserAgent), INTERNET_OPEN_TYPE_DIRECT, nil, nil, dwFlags);
  end;
  if ( hSession = nil ) then
  begin
   fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
   Exit;
  end;

  // mmm_corp, add custom settings from Internet_Options
  for I:=0 to trunc(High(fOwner^.fInternet_Options)/2) do
     begin
     timeout:=fOwner^.fInternet_Options[i*2+1];
     if InternetSetOption(hSession, fOwner^.fInternet_Options[i*2], @timeout, sizeof(timeout))=False then
        fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
     end;

  // mmm_corp, handle status events
    with dwContextRecord do
        begin
        hWindow:=0;
        nStatusList:=Integer(@fOwner^); // link to Owner
        hResource:=hSession;
        for I := Low(szMemo) to High(szMemo) do
             szMemo[I] := #0;           // clear array
        end;
    dwContext:=DWORD_PTR(addr(dwContextRecord));
    if Assigned(hSession) then
       begin
       pfStatus:=PFNInternetStatusCallback(@InternetStatusCallback);
       pfStatus:=InternetSetStatusCallback(hSession, pfStatus);
       if NativeInt(pfStatus) = INTERNET_INVALID_STATUS_CALLBACK then
          fOwner^.fOnErrorCall(fOwner, Sender, NativeInt(pfStatus));
       end;


 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then Exit;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // connecting to http-server
 hConnect:= InternetConnect( hSession, PChar( fHostName ), fPort,
  PChar( fUserName ), PChar( fPassword ), INTERNET_SERVICE_HTTP, 0,   dwContext);
 if ( hConnect = nil ) then
 begin
  fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
  CloseHandles;
  Exit;
 end;

 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then
  begin
   CloseHandles;
   Exit;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // prepare resource request to http-server
 // we're prefer HTTP/1.0 version but this parameter can be ignored by Wininet
 // see KB258425 (http://support.microsoft.com/kb/258425) for more details.


   {Yes, InternetOpenUrl (and HttpSendRequest) will follow HTTP redirects.
  (However, WinInet may not automatically follow HTTPS to HTTP, or HTTP to
  HTTPS, redirects unless the application specifies the
  INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP[S] flags.)

  Automatic HTTP redirect following may be disabled by specifying the
  INTERNET_FLAG_NO_AUTO_REDIRECT flag to InternetOpenUrl (or HttpOpenRequest)
  to let the application manually handle a redirect response. By default,
  InternetOpenUrl will follow up to 100 redirects. There is no way via the
  WinInet API to override the 100 redirect maximum limit, but it can be
  configured by setting a registry key, although this will affect all
  WinInet-based applications, like Internet Explorer, for the current user.

  The registry value is:
      HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet
  Settings : MaxHttpRedirects (REG_DWORD)
 }
 // mmm_corp, get/head
 //hRequest:= HttpOpenRequest( hConnect, nil, PChar( fPath ), nil,
 // http://msdn.microsoft.com/en-us/library/windows/desktop/aa383661%28v=vs.85%29.aspx
 hRequest:= HttpOpenRequest(hConnect,
                            PChar(fRequestMethodName),
                            PChar(fPath),
                            nil,
                            nil,
                            nil,
                            fOwner^.fHttpOpenRequestFlag,
                            dwContext);
 if (hRequest = nil) then
 begin
  fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
  CloseHandles;
  Exit;
 end;


 // adding custom http headers to request
 {$IFDEF USE_CUSTOMHEADERS}
 if Assigned(fOwner^.fCHeaderList) then
   for i:=0 to fOwner^.fCHeaderList^.Count-1 do
    begin
    {$WARNINGS OFF}
    s:=fOwner^.fCHeaderList^.Items[i];
    {$WARNINGS ON}
    if not HttpAddRequestHeaders(hRequest, PWideChar(s), Length(s), HTTP_ADDREQ_FLAG_ADD) then
       begin
        fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
        CloseHandles;
        Exit;
       end;
    end;
 {$ENDIF}

 // setting http headers 'connection type' field (don't allow persistent connection)
 if ( fPreConfigProxy or ( fProxySrv <> '' ) ) then
  HttpAddRequestHeaders( hRequest, strProxyConnectType, Length( strProxyConnectType ), HTTP_ADDREQ_FLAG_ADD )
 else
  HttpAddRequestHeaders( hRequest, strConnectType, Length( strConnectType ), HTTP_ADDREQ_FLAG_ADD );

  // mmm_corp, add header for POST
  if fRequestMethodName=strMethodNamePOST then
     HttpAddRequestHeaders(hRequest, strContentTypePost , Length(strContentTypePost), HTTP_ADDREQ_FLAG_ADD );

 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then
  begin
   CloseHandles;
   Exit;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;


  // mmm_corp, add post data (POST, PUT)
  if Assigned( fOwner.fFormFields ) and (fOwner.fFormFields.Count>0) and (fPOSTData = '') then
  begin
    fPOSTData:=string(fOwner.fFormFields.Join('&'));
          {$WARNINGS OFF}
    fPOSTData:=chrTrim(fPOSTData,'&');
          {$WARNINGS ON}
  end;

  if    (fRequestMethodName<>strMethodNamePOST)
    and (fRequestMethodName<>strMethodNamePUT)
     then fPOSTData:='';

 // send http request to server
 rawData:=Utf8Encode(fPOSTData);
 if (not HttpSendRequest(hRequest,
                         nil,
                         0,
                         PRawByteString(rawData),
                         Length(rawData)
                         )) then


 begin
  fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
  CloseHandles;
  Exit;
 end;

 // mmm_corp, fill real resource url
 if Assigned(fOwner) and (fRealURL<>'') then
    fOwner.fRealResource:=fRealURL;

 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then
  begin
   CloseHandles;
   Exit;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // receiving headers (if event assigned)
 if Assigned( fOwner.fOnHeaderReceived ) then
 begin
   lpdwIndex:= 0; Buf:= nil; iBufSize:=0;
   HttpQueryInfo( hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, Buf, iBufSize, lpdwIndex );
   // NB: it's ok when 'unsufficient buffer' message received now
   iErrorCode:= GetLastError;

   if ( iErrorCode = ERROR_INSUFFICIENT_BUFFER ) then
   begin
    GetMem( Buf, iBufSize );
    lpdwIndex:= 0;
    try
     if ( HttpQueryInfo( hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, Buf, iBufSize, lpdwIndex ) ) then
     with ( fOwner^ ) do
     begin
           {$WARNINGS OFF}
       fHeaderList.SetText( Buf, false );
           {$WARNINGS ON}
      with ( fHeaderList^ ) do
       if ( Items[Count-1] = '' ) then Delete( Count-1 );
      fOnHeaderReceived( fOwner, fHeaderList );
     end  // 'if ( HttpQueryInfo( hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, Buf, iBufSize, iReserved ) )'
     else fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
     {finally} except on E: err.Exception do OnExcept(E); end; begin
     FreeMem( Buf );
    end;
   end  // 'if ( iErrorCode = ERROR_INSUFFICIENT_BUFFER )'
   else fOwner^.fOnErrorCall(fOwner, Sender, iErrorCode);

   // checking if thread must be terminated
   EnterCriticalSection( fCritSection );
   try
    if ( not Assigned( fOwner ) ) then
    begin
     CloseHandles;
     Exit;
    end;
   {finally} except on E: err.Exception do OnExcept(E); end; begin
    LeaveCriticalSection( fCritSection );
   end;

 end;

 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then
  begin
   CloseHandles;
   Exit;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // getting http status code
 iBufSize:= 16;
 iErrorCode:= 0;
 lpdwIndex:= 0;
 GetMem( Buf, iBufSize );
 try
  if ( HttpQueryInfo( hRequest, HTTP_QUERY_STATUS_CODE, Buf, iBufSize, lpdwIndex ) ) then
   iErrorCode:= Str2Int( StrPas( Buf ) )
  else fOwner^.fOnErrorCall(fOwner, Sender, GetLastError);
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  FreeMem( Buf );
 end;

 // checking if thread must be terminated
 EnterCriticalSection( fCritSection );
 try
  if ( not Assigned( fOwner ) ) then
  begin
   CloseHandles;
   Exit;
  end;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;

 // mmm_corp, prevent fOnDownload if HEAD method
 if fOwner.fMethodName=strMethodNameHEAD then
    begin
    fOwner.fOnDownload:=nil;
    fOwner.fDataStream:=nil;
    end;

 // mmm_corp,
 // checking if resource is available
// if ( ( Assigned( fOwner.fOnDownload ) and ( iErrorCode = HTTP_STATUS_OK {HTTP/1.1 200 OK} ) ) ) then
 if ( ( Assigned( fOwner.fDataStream ) and ( (iErrorCode = HTTP_STATUS_OK) or (iErrorCode = HTTP_STATUS_PARTIAL_CONTENT) {HTTP/1.1 200 OK} ) ) ) then
 begin
  iBufSize:= 16;
  lpdwIndex:= 0;
  iContentLen:= 0;
  GetMem( Buf, iBufSize );
  try
   dwBufferLen:=20;
   if ( HttpQueryInfo( hRequest, HTTP_QUERY_CONTENT_LENGTH,  @dwBuffer, dwBufferLen, lpdwIndex ) ) then
    iContentLen:= Str2Int( StrPas( @dwBuffer ) );

   // set iContentLen value to '-1' if not present or invalid
   if ( iContentLen <= 0 ) then  iContentLen:= -1;

   iReadCount:= 0;
   GetMem( fDataBuf, iDataBufSize );
   iStartTickCounter:=GetTickCount;
   try
    // downloading resource
    with ( fOwner^ ) do
    while ( InternetReadFile( hRequest, fDataBuf, iDataBufSize, iNumRead ) ) do
     if ( iNumRead > 0 ) then
     begin
      // checking if thread must be terminated
      EnterCriticalSection( fCritSection );
      try
       if ( not Assigned( fOwner ) ) then Break;
      {finally} except on E: err.Exception do OnExcept(E); end; begin
       LeaveCriticalSection( fCritSection );
      end;

      // write received data to stream
      fDataStream.Write( fDataBuf^, iNumRead );
      Inc( iReadCount, iNumRead );

      // fDownloadSpeed and fRemainingTime
      d:=((Integer(GetTickCount)-iStartTickCounter))/1000;
      fDownloadSpeed:=Trunc(iReadCount/d);
      fRemainingTime:=trunc((iContentLen-iReadCount)/fDownloadSpeed);

      // mmm_corp, update download progress, (no each time call, inc UI response)
      if Assigned(fOnProgress) then
         begin
         if fOwner.fProgressInterval=0
            then {$IFNDEF NO_APPLET}fDLThread.Synchronize(On_UpdateProgress){$ELSE}On_UpdateProgress{$ENDIF}
            else
            if (Integer(GetTickCount)-fOwner.fLastOnProgressUpdate) > fOwner.fProgressInterval then
               begin
               fOwner.fLastOnProgressUpdate:=GetTickCount;
               {$IFNDEF NO_APPLET}fDLThread.Synchronize(On_UpdateProgress){$ELSE}On_UpdateProgress{$ENDIF}
               end;
         end;
     end
    else Break;

    // checking if thread must be terminated
    EnterCriticalSection( fCritSection );
    try
     if ( not Assigned( fOwner ) ) then
     begin
      CloseHandles;
      Exit;
     end;
    {finally} except on E: err.Exception do OnExcept(E); end; begin
     LeaveCriticalSection( fCritSection );
    end;

    // download complete
    with ( fOwner^ ) do
    begin
     fDataStream.Position:= 0;
     // call assigned event handler
     fOnDownload( @Self, fDataStream );
    end;

   {finally} except on E: err.Exception do OnExcept(E); end; begin
    FreeMem( fDataBuf );
   end;

  {finally} except on E: err.Exception do OnExcept(E); end; begin
   FreeMem( Buf );
  end;

 end
 else
  if ( iErrorCode <> HTTP_STATUS_OK { HTTP/1.1 OK } ) then
     fOwner^.fOnErrorCall(fOwner, Sender, ERROR_INTERNET_EXTENDED_ERROR);
 CloseHandles;
end;

//-----------------------------------------------------
destructor TDownloadWorker.Destroy;
begin
 fDLThread.Free;
 fHostName:= '';
 fPath:= '';
 fUserName:= '';
 fPassword:= '';
 fProxySrv:= '';

 fRequestMethodName:='';
 fRealURL:='';
 fPOSTData:='';

 EnterCriticalSection( fCritSection );
 try
  if Assigned( fOwner ) then
   fOwner.fBusy:= false;
 {finally} except on E: err.Exception do OnExcept(E); end; begin
  LeaveCriticalSection( fCritSection );
 end;
 DeleteCriticalSection( fCritSection );
 inherited;
end;

//-----------------------------------------------------


end.