На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > не могу скачать файл с интернета
      ExpandedWrap disabled
        ////////////////////////////////////////////////////////////////////////////////
        //
        //  ****************************************************************************
        //  * Project   : DownloadViaProxy
        //  * Purpose   : Демо скачивания файла с учетом бейсик авторизации и прокси
        //  * Author    : Александр (Rouse_) Багель
        //  * Copyright : © Fangorn Wizards Lab 1998 - 2007.
        //  * Version   : 1.03
        //  * Home Page : http://rouse.drkb.ru
        //  ****************************************************************************
        //
         
        program DownloadViaProxy;
         
        {$APPTYPE CONSOLE}
         
        uses
          Windows,
          SysUtils,
          Classes,
          WinInet;
         
        type
          TDownloadParams = record
            FileURL,                // Запрос для файла
            Proxy,                  // список прокси
            ProxyBypass,            // дополниотельный список прокси
            AuthUserName,           // логин для Authorization: Basic
            AuthPassword: String;   // пароль для Authorization: Basic
            DownloadFrom,           // смещение от начала данных
            NeedDataSize: DWORD;    // необходимый размер
          end;
         
        function DownloadFileEx(
         Params: TDownloadParams; OutputData: TStream): Boolean;
         
         function DelHttp(URL: String): String;
         var
           HttpPos: Integer;
         begin
           HttpPos := Pos('http://', URL);
           if HttpPos > 0 then Delete(Url, HttpPos, 7);
           Result := Copy(Url, 1, Pos('/', Url) - 1);
           if Result = '' then Result := URL;
         end;
         
        const
         Accept = 'Accept: */*' + sLineBreak;
         ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
         LNG = 'Accept-Language: ru' + sLineBreak;
         AGENT =
           'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
           'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
        var
         FSession, FConnect, FRequest: HINTERNET;
         FHost, FScript, SRequest, ARequest: String;
         Buff, IntermediateBuffer: array of Byte;
         BytesRead, Res, Len,
         FilePosition, OpenTypeFlags, ContentLength: Cardinal;
        begin
          Result := False;
          ARequest := Params.FileURL;
         
          // Небольшой парсинг
          // вытаскиваем имя хоста и параметры обращения к скрипту
          FHost := DelHttp(ARequest);
          FScript := ARequest;
          Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
         
          // Инициализируем WinInet
          if Params.Proxy = '' then
           OpenTypeFlags := INTERNET_OPEN_TYPE_PRECONFIG
          else
           OpenTypeFlags := INTERNET_OPEN_TYPE_PROXY;
          FSession := InternetOpen('',
          OpenTypeFlags, PChar(Params.Proxy), PChar(Params.ProxyBypass), 0);
         
          if not Assigned(FSession) then Exit;
          try
            // Попытка соединения с сервером
            FConnect := InternetConnect(FSession, PChar(FHost),
              INTERNET_DEFAULT_HTTP_PORT, PChar(Params.AuthUserName),
              PChar(Params.AuthPassword), INTERNET_SERVICE_HTTP, 0, 0);
         
            if not Assigned(FConnect) then Exit;
            try
         
              // Подготавливаем запрос
              FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), nil,
                '', nil, 0, 0);
         
              // добавляем необходимые заголовки к запросу
              HttpAddRequestHeaders(FRequest, Accept,
                Length(Accept), HTTP_ADDREQ_FLAG_ADD);
              HttpAddRequestHeaders(FRequest, ProxyConnection,
                Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
              HttpAddRequestHeaders(FRequest, LNG,
                Length(LNG), HTTP_ADDREQ_FLAG_ADD);
              HttpAddRequestHeaders(FRequest, AGENT,
                Length(AGENT), HTTP_ADDREQ_FLAG_ADD);
         
              // Проверяем запрос:
              Len := 0;
              Res := 0;
              SRequest := ' ';
              HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
                HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
              if Len > 0 then
              begin
                 SetLength(SRequest, Len);
                HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
                  HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
              end;
         
              if not Assigned(FConnect) then Exit;
              try
         
                // Отправляем запрос
                if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit;
         
                // Узнаем размер файла
                ContentLength := InternetSetFilePointer(
                  FRequest, 0, nil, FILE_END, 0);
                if ContentLength = DWORD(-1) then
                  ContentLength := 0;
         
                // выставляем позцию, откуда нужно начинать скачку
                FilePosition := InternetSetFilePointer(
                  FRequest, Params.DownloadFrom, nil, FILE_BEGIN, 0);
                if FilePosition = DWORD(-1) then
                  FilePosition := 0;
         
                // Выставляем размер приемного буффера
                if Params.NeedDataSize = 0 then
                  Params.NeedDataSize := ContentLength;
                if Integer(FilePosition) + Params.NeedDataSize >
                  Integer(ContentLength) then
                  Params.NeedDataSize := ContentLength - FilePosition;
         
                 // если не смогли определить размер данных - читаем все что прочтется
                if Params.NeedDataSize <= 0 then
                begin
                  SetLength(IntermediateBuffer, 8192);
                  ContentLength := 0;
                  Params.NeedDataSize := 0;
                  BytesRead := 0;
                  while InternetReadFile(FRequest, @IntermediateBuffer[0],
                    100, BytesRead) do
                      if BytesRead > 0 then
                    begin
                      SetLength(Buff, ContentLength + BytesRead);
                      Move(IntermediateBuffer[0], Buff[ContentLength], BytesRead);
                      Inc(ContentLength, BytesRead);
                    end
                    else
                    begin
                      Params.NeedDataSize := ContentLength;
                      Break;
                    end;
                end
                else
                begin
                  // в противном случае, принимаем данные как обычно
                  SetLength(Buff, Params.NeedDataSize);
                  if not InternetReadFile(FRequest, @Buff[0],
                    Params.NeedDataSize, BytesRead) then Exit;
                end;
         
                OutputData.Write(Buff[0], Params.NeedDataSize);
                Result := True;
         
              finally
                InternetCloseHandle(FRequest);
              end;
            finally
              InternetCloseHandle(FConnect);
            end;
          finally
            InternetCloseHandle(FSession);
          end;
        end;
         
        var
          Params: TDownloadParams;
          Data: TMemoryStream;
        begin
          try
            ZeroMemory(@Params, SizeOf(TDownloadParams));
            Params.FileURL :=
              'http://google.com/index.html';
            Data := TMemoryStream.Create;
            try
              if DownloadFileEx(Params, Data) then
                Data.SaveToFile('c:\test.htm');
            finally
              Data.Free;
            end;
            
          except
            on E:Exception do
              Writeln(E.Classname, ': ', E.Message);
          end;
        end.


      Еще пример использования

      ExpandedWrap disabled
        function GetMultiproxyProxyList(ResultList: TStringList): Boolean;
        var
          Params: TDownloadParams;
          Data: TStringStream;
          AResult: String;
        begin
          Result := False;
          ZeroMemory(@Params, SizeOf(TDownloadParams));
          Params.FileURL :=
            'http://multiproxy.org/txt_all/proxy.txt';
          Data := TStringStream.Create('');
          try
            if DownloadFileEx(Params, Data) then
            begin
              SetLength(AResult, Data.Size);
              Data.Read(AResult, Data.Size);
              ResultList.Text := AResult;
              Result := True;
            end;
          finally
            Data.Free;
          end;
        end;


      Еще один пример использования, но вот этот сервер не дает размер файла:

      ExpandedWrap disabled
        function GetProxyListOrgProxyList(ResultList: TStringList): Boolean;
        var
          Params: TDownloadParams;
          Data: TStringStream;
          AResult: String;
        begin
          Result := False;
          ZeroMemory(@Params, SizeOf(TDownloadParams));
          Params.FileURL :=
            'http://proxy-list.org/downloadproxylist.php?sp=-1&pp=any&pt=any&pc=any&ps=any';
          // Params.DownloadFrom := 4; // <- попытка дозакачки...
          Data := TStringStream.Create('');
          try
            if DownloadFileEx(Params, Data) then
            begin
              if Data.Size = 0 then
              begin
                ResultList.Add('Сервер не поддерживает дозакачку.');
                Exit;
              end;
              SetLength(AResult, Data.Size);
              Data.Read(AResult, Data.Size);
              ResultList.Text := AResult;
              Result := True;
            end;
          finally
            Data.Free;
          end;
        end;
        Вот полноценный набор классов для работы с HTTP без браузера.
        Способен работать через Proxy и не боится плохой связи.
        Даю как есть, не сочтите за рекламу :)

        Код реально работает, передаёт и принимает любые файлы
        и позволяет надстраивать над CustomChannel классы для
        произвольных протоколов. Поскольку ничего кроме HTTP
        было не нужно, то иерархия такая: TCustomChannel -> THttpChannel.
        Для компиляции под Delphi 5 и старше, также для
        правильной работы в системе должен быть установлен
        IE5 или старше - иначе WinInet может работать неправильно.

        Исходное название - Channels.pas


        ExpandedWrap disabled
          {==============================================================================
          Copyright (C) 2006-2007 Denisov Alexey Vladimirovich for Tewek Ltd
          mailto:alexey-denisov@mail.ru or mailto:alexey-denisov@tewek.ru
           
          Эта программа является свободным программным обеспечением. Вы можете
          распространять и/или модифицировать её согласно условиям Стандартной
          Общественной Лицензии GNU, опубликованной Фондом Свободного Программного
          Обеспечения, версии 3 или, по Вашему желанию, любой более поздней версии.
           
          Эта программа распространяется в надежде, что она будет полезной, но БЕЗ
          ВСЯКИХ ГАРАНТИЙ, в том числе подразумеваемых гарантий ТОВАРНОГО СОСТОЯНИЯ ПРИ
          ПРОДАЖЕ и ГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННОГО ПРИМЕНЕНИЯ. Смотрите Стандартную
          Общественную Лицензию GNU для получения дополнительной информации.
           
          Вы должны были получить копию Стандартной Общественной Лицензии GNU
          вместе с программой. В случае её отсутствия, посмотрите
          <http://www.gnu.org/licenses/>.
          ==============================================================================}
           
          // Каналы. Модуль служит для организации связи.
          // Содержит базовый класс канала.
          // Обеспечивает также чтение/запись через HTTP, в основном или
          // дополнительном потоке, по выбору.
           
          {$I defines.pas}
           
          // Если раскомментировать, то все запросы к WinInet будут записываться
          // в лог ChangeFileExt(Application.ExeName, '.channel.log');
          {$IFOPT O-}
            //{$DEFINE WRITELOG}
          {$ENDIF}
           
          unit Channels;
           
          interface
           
          uses
            Windows, Forms, SysUtils, Classes, ExtCtrls, WinInet;
           
          type
            TUserAgentRec = record
              Ident: String;
              Agent: String;
            end;
           
          const // из MFC
            HTTP_VERB_POST = 0;
            HTTP_VERB_GET = 1;
            HTTP_VERB_HEAD = 2;
            HTTP_VERB_PUT = 3;
            HTTP_VERB_LINK = 4;
            HTTP_VERB_DELETE = 5;
            HTTP_VERB_UNLINK = 6;
           
            USER_AGENT_COUNT = 38;
            USER_AGENT_DEFAULT = 0;
            USER_AGENT_IE5 = USER_AGENT_DEFAULT;
           
            UserAgents: array[0..USER_AGENT_COUNT-1] of TUserAgentRec = ((
              Ident: 'Internet Explorer 5.0';
              Agent: 'Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)'),
              (
              Ident: 'Amaya 9';
              Agent: 'amaya/9.53 libwww/5.4.0'),
              (
              Ident: 'Avant Browser (old)';
              Agent: 'Avant Browser (http://www.avantbrowser.com)'),
              (
              Ident: 'Avant Browser (new)';
              Agent: 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Avant Browser [avantbrowser.com]; iOpus-I-M; QXW03416; .NET CLR 1.1.4322)'),
              (
              Ident: 'Camino';
              Agent: 'Mozilla/5.0 (Macintosh; U; PPC Max OS X Mach-O; en-US; rv:1.8.0.7) Gecko/200609211 Camino/1.0.3'),
              (
              Ident: 'ELinks';
              Agent: 'ELinks (0.4pre5; Linux 2.4.27 i686; 80x25)'),
              (
              Ident: 'Epiphany';
              Agent: 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.7) Gecko/20060928 (Debian|Debian-1.8.0.7-1) Epiphany/2.14'),
              (
              Ident: 'Firefox (Linux)';
              Agent: 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.2) Gecko/20070220 Firefox/2.0.0.2'),
              (
              Ident: 'Firefox (MacOS)';
              Agent: 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-US; rv:1.8.0.7) Gecko/20060909 Firefox/1.5.0.7'),
              (
              Ident: 'Firefox (Windows)';
              Agent: 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.6) Gecko/20070725 Firefox/2.0.0.6'),
              (
              Ident: 'Flock';
              Agent: 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.7) Gecko/20061031 Firefox/1.5.0.7 Flock/0.7.7'),
              (
              Ident: 'Googlebot';
              Agent: 'Googlebot/2.1 (+http://www.google.com/bot.html)'),
              (
              Ident: 'iCab';
              Agent: 'Mozilla/5.0 (compatible; iCab 3.0.3; Macintosh; U; PPC Mac OS X)'),
              (
              Ident: 'Internet Explorer 1.0';
              Agent: 'Microsoft Internet Explorer/4.0b1 (Windows 95)'),
              (
              Ident: 'Internet Explorer 1.5';
              Agent: 'Mozilla/1.22 (compatible; MSIE 1.5; Windows NT)'),
              (
              Ident: 'Internet Explorer 2.0';
              Agent: 'Mozilla/1.22 (compatible; MSIE 2.0; Windows 95)'),
              (
              Ident: 'Internet Explorer 3.0';
              Agent: 'Mozilla/2.0 (compatible; MSIE 3.01; Windows 98)'),
              (
              Ident: 'Internet Explorer 6.0';
              Agent: 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)'),
              (
              Ident: 'Internet Explorer 7.0';
              Agent: 'Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)'),
              (
              Ident: 'K-Meleon';
              Agent: 'Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv:1.8.0.5) Gecko/20060706 K-Meleon/1.0'),
              (
              Ident: 'Konqueror';
              Agent: 'Mozilla/5.0 (compatible; Konqueror/3.5; Linux) KHTML/3.5.5 (like Gecko) (Debian|Debian)'),
              (
              Ident: 'Links';
              Agent: 'Links (2.1pre17; Linux 2.6.11-gentoo-r8 i686; 80x24)'),
              (
              Ident: 'Lynx';
              Agent: 'Lynx/2.8.4rel.1 libwww-FM/2.14'),
              (
              Ident: 'Minimo';
              Agent: 'Mozilla/5.0 (Windows; U; Windows CE 4.21; rv:1.8b4) Gecko/20050720 Minimo/0.007'),
              (
              Ident: 'Mozilla';
              Agent: 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.8) Gecko/20050511'),
              (
              Ident: 'NetPositive';
              Agent: 'Mozilla/3.0 (compatible; NetPositive/2.2)'),
              (
              Ident: 'Netscape';
              Agent: 'Mozilla/5.0 (Windows; U; Windows NT 5.0; en-US; rv:0.9.2) Gecko/20020508 Netscape6/6.1'),
              (
              Ident: 'Netscape Navigator';
              Agent: 'Mozilla/4.8 [en] (Windows NT 5.0; U)'),
              (
              Ident: 'Off By One';
              Agent: 'Mozilla/4.7 (compatible; OffByOne; Windows 2000)'),
              (
              Ident: 'OmniWeb';
              Agent: 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-US) AppleWebKit/125.4 (KHTML, like Gecko, Safari) OmniWeb/v563.51'),
              (
              Ident: 'Openwave';
              Agent: 'OPWV-SDK/62 UP.Browser/6.2.2.1.208 (GUI) MMP/2.0'),
              (
              Ident: 'Opera';
              Agent: 'Opera/9.10 (Windows NT 5.1; U; en)'),
              (
              Ident: 'PlayStation 3';
              Agent: 'Mozilla/5.0 (PLAYSTATION 3; 1.00)'),
              (
              Ident: 'Safari';
              Agent: 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3'),
              (
              Ident: 'SeaMonkey';
              Agent: 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.2pre) Gecko/20070111 SeaMonkey/1.1'),
              (
              Ident: 'Shiira';
              Agent: 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; de-de) AppleWebKit/418 (KHTML, like Gecko) Shiira/1.2.2 Safari/125'),
              (
              Ident: 'w3m';
              Agent: 'w3m/0.5.1'),
              (
              Ident: 'WebExplorer';
              Agent: 'IBM-WebExplorer-DLL/v1.1h'));
           
          function SetStr(Condition: Boolean; const TrueStr: String; const FalseStr: String = ''): String;
           
          type
            TCustomChannel = class;
            TChannelClass = class of TCustomChannel;
           
            TChannelEvent = TNotifyEvent;
            TOnChannelBeforeCloseEvent = procedure(Sender: TObject; var CanClose: Boolean) of object;
            TOnChannelBeforeDisconnectEvent = procedure(Sender: TObject; var CanDisconnect: Boolean) of object;
            TOnChannelErrorEvent = procedure(Sender: TObject; const ErrorCode: Cardinal) of object;
           
            TCustomChannel = class
            private
              FHInet: HINTERNET;
              FHConnect: HINTERNET;
              FDestinationData: String;
              FReceivedData: String;
              FFlags: Cardinal;
              FObjectName: String;
              FServerPort: Word;
              FProxy: String;
              FProxyBypass: String;
              FUserPassword: String;
              FServerName: String;
              FServiceType: Word;
              FUserAgent: String;
              FUserName: String;
              FOnBeforeOpen: TNotifyEvent;
              FOnOpened: TNotifyEvent;
              FOnBeforeConnect: TNotifyEvent;
              FOnConnected: TNotifyEvent;
              FOnBeforeClose: TOnChannelBeforeCloseEvent;
              FOnClosed: TNotifyEvent;
              FLastError: Cardinal;
              FOnBeforeDisconnect: TOnChannelBeforeDisconnectEvent;
              FOnDisconnected: TNotifyEvent;
              FOnError: TOnChannelErrorEvent;
              FTimeout: Word;
              FProxyUser: String;
              FProxyPassword: String;
              FUseProxy: Boolean;
              FProxyNeedAuthorization: Boolean;
              procedure BeforeOpen;
              procedure AfterOpen;
              function CanClose: Boolean; virtual;
              procedure AfterClose;
              procedure BeforeConnect;
              procedure AfterConnect;
              function CanDisconnect: Boolean; virtual;
              procedure AfterDisconnect;
            protected
              function InternetCloseHandle(var Handle: Pointer): Boolean;
              function SetError(Success: Boolean): Boolean;
              function GetDestinationData: String; virtual;
              procedure SetDestinationData(const Value: String); virtual;
              function DoOpen: Boolean; virtual;
              function DoClose: Boolean; virtual;
              function DoConnect: Boolean; virtual;
              function DoDisconnect: Boolean; virtual;
              property Flags: Cardinal read FFlags write FFlags;
            public
              destructor Destroy; override;
              { подключение }
              function Opened: Boolean;
              function Open: Boolean; virtual;
              function Closed: Boolean;
              function Close: Boolean; virtual;
              function Connected: Boolean;
              // если входные параметры не указаны,
              // берёт из свойств
              function Connect(const ServerName: String = '';
                const UserName: String = '';
                const UserPassword: String = ''): Boolean; virtual;
              function Disconnected: Boolean;
              function Disconnect: Boolean; virtual;
              { данные }
              { чтение и запись }
              function GetDataSize(out DataSize: Cardinal): Boolean;
              function Read(DataSize: Cardinal; var S: String): Boolean; overload; virtual;
              function Read(DataSize: Cardinal = 0): Boolean; overload; virtual;
              function Write(S: String = ''): Boolean; virtual;
              { ошибки }
              function GetLastError: Cardinal;
              { общие свойства протоколов }
              property DestinationData: String read GetDestinationData write SetDestinationData;
              property ReceivedData: String read FReceivedData;
              property HInet: HINTERNET read FHInet;
              property HConnect: HINTERNET read FHConnect;
            published
              { общие свойства протоколов }
              property ObjectName: String read FObjectName write FObjectName;
              property ServerPort: Word read FServerPort write FServerPort;
              property Timeout: Word read FTimeout write FTimeout;
              property Proxy: String read FProxy write FProxy;
              property ProxyBypass: String read FProxyBypass write FProxyBypass;
              property UserName: String read FUserName write FUserName;
              property UserPassword: String read FUserPassword write FUserPassword;
              property ProxyNeedAuthorization: Boolean read FProxyNeedAuthorization write FProxyNeedAuthorization;
              property ProxyUser: String read FProxyUser write FProxyUser;
              property ProxyPassword: String read FProxyPassword write FProxyPassword;
              property UseProxy: Boolean read FUseProxy write FUseProxy;
              property ServerName: String read FServerName write FServerName;
              property ServiceType: Word read FServiceType;
              property UserAgent: String read FUserAgent write FUserAgent;
              { события }
              property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen;
              property OnOpened: TNotifyEvent read FOnOpened write FOnOpened;
              property OnBeforeClose: TOnChannelBeforeCloseEvent read FOnBeforeClose write FOnBeforeClose;
              property OnClosed: TNotifyEvent read FOnClosed write FOnClosed;
              property OnBeforeConnect: TNotifyEvent read FOnBeforeConnect write FOnBeforeConnect;
              property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
              property OnBeforeDisconnect: TOnChannelBeforeDisconnectEvent read FOnBeforeDisconnect write FOnBeforeDisconnect;
              property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
              property OnError: TOnChannelErrorEvent read FOnError write FOnError;
            { переопределяемые при необходимости }
            public
              procedure Assign(Channel: TCustomChannel); virtual;
            { обязательно переопределяемые }
            public
              constructor Create; virtual;
              function DoGetDataSize(out DataSize: Cardinal): Boolean; virtual; abstract;
              function DoRead(DataSize: Cardinal; var S: String): Boolean; virtual; abstract;
              function DoWrite(const S: String): Boolean; virtual; abstract;
            end;
           
            THttpChannel = class(TCustomChannel)
            private
              FHRequest: HINTERNET;
              FDataList: TStringList;
              FBoundary: String;
            protected
              property HRequest: HINTERNET read FHRequest;
              property DataList: TStringList read FDataList;
              property Boundary: String read FBoundary;
              function CreateBoundary: String;
              function OpenRequest(Verb: Integer; Flags: Cardinal; const ObjectName: String = ''): Boolean; virtual;
              function SendRequest(const Header, Data: String): Boolean; virtual;
              function CloseRequest: Boolean; virtual;
              procedure SetDestinationData(const Value: String); override;
              function GetDestinationData: String; override;
            public
              destructor Destroy; override;
              // Добавляет поле в буфер для отправляемых данных
              function AddDestinationData(const FieldName, FieldValue: String): String;
              // Аналогично AddDestinationData, но если нет файла,
              // то вернёт пустую строку
              function AddDestinationFile(const FieldName, FileName: String): String;
            { переопределяемые при необходимости }
            public
              procedure Assign(Channel: TCustomChannel); override;
            { обязательно переопределяемые }
            public
              constructor Create; override;
              function DoGetDataSize(out DataSize: Cardinal): Boolean; override;
              function DoRead(DataSize: Cardinal; var S: String): Boolean; override;
              function DoWrite(const S: String): Boolean; override;
            end;
           
          implementation
           
          function SetStr(Condition: Boolean; const TrueStr: String; const FalseStr: String = ''): String;
          begin
            if Condition then
              Result := TrueStr
            else
              Result := FalseStr;
          end;
           
          function GetTickCount: Cardinal; external 'kernel32.dll' name 'GetTickCount';
           
          function IsTimeout(StartCount, TickCount: Cardinal; TimeoutSec: Word): Boolean;
          var
            lDelta: Cardinal;
          begin
            lDelta := TickCount - StartCount;
            if StartCount > TickCount then
              lDelta := Cardinal(-1) + Succ(lDelta);
            Result := (lDelta > TimeoutSec*1000);
          end;
           
          {$IFDEF WRITELOG}
           
          procedure WriteLog(const S: String);
          var
            lFileName: String;
            f: TextFile;
          begin
            lFileName := ChangeFileExt(Application.ExeName, '.channel.log');
            AssignFile(f, lFileName);
            if FileExists(lFileName) then
              Append(f)
            else
              Rewrite(f);
            WriteLn(f, S);
            CloseFile(f);
          end;
           
          function BS(Value: Boolean): String;
          begin
            if Value then
              Result := 'True'
            else
              Result := 'False';
          end;
           
          function InternetQueryDataAvailable(hFile: HINTERNET;
            var lpdwNumberOfBytesAvailable: DWORD; dwFlags, dwContext: DWORD): BOOL;
          var
            S: String;
          begin
            Result := WinInet.InternetQueryDataAvailable(hFile, lpdwNumberOfBytesAvailable, dwFlags, dwContext);
            S := 'InternetQueryDataAvailable hFile=%u lpdwNumberOfBytesAvailable=%u dwFlags=%u dwContext=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hFile), lpdwNumberOfBytesAvailable, dwFlags, dwContext, BS(Result), GetLastError]));
          end;
           
          function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD;
            lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET;
          var
            S: String;
          begin
            WriteLog('');
            WriteLog('');
            Result := WinInet.InternetOpen(lpszAgent, dwAccessType, lpszProxy, lpszProxyBypass, dwFlags);
            S := 'InternetOpen lpszAgent=%s dwAccessType=%u lpszProxy=%s lpszProxyBypass=%s dwFlags=%u Result=%u GetLastError=%d';
            WriteLog(Format(S, [lpszAgent, dwAccessType, lpszProxy, lpszProxyBypass, dwFlags, DWORD(Result), GetLastError]));
          end;
           
          function InternetSetOption(hInet: HINTERNET; dwOption: DWORD;
            lpBuffer: Pointer; dwBufferLength: DWORD): BOOL;
          var
            S: String;
          begin
            Result := WinInet.InternetSetOption(hInet, dwOption, lpBuffer, dwBufferLength);
            S := 'InternetSetOption hInet=%u dwOption=%u dwBufferLength=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hInet), dwOption, dwBufferLength, BS(Result), GetLastError]));
          end;
           
          function InternetConnect(hInet: HINTERNET; lpszServerName: PChar;
            nServerPort: INTERNET_PORT; lpszUsername: PChar; lpszPassword: PChar;
            dwService: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET;
          var
            S: String;
          begin
            Result := WinInet.InternetConnect(hInet, lpszServerName, nServerPort,
              lpszUsername, lpszPassword, dwService, dwFlags, dwContext);
            S := 'InternetConnect hInet=%u lpszServerName=%s nServerPort=%u lpszUsername=%s lpszPassword=%s dwService=%u dwFlags=%u dwContext=%u Result=%u GetLastError=%d';
            WriteLog(Format(S, [DWORD(hInet), lpszServerName, nServerPort, lpszUsername, lpszPassword, dwService, dwFlags, dwContext, DWORD(Result), GetLastError]));
          end;
           
          function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer;
            dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL;
          var
            S: String;
          begin
            Result := WinInet.InternetReadFile(hFile, lpBuffer, dwNumberOfBytesToRead, lpdwNumberOfBytesRead);
            S := 'InternetReadFile hFile=%u dwNumberOfBytesToRead=%u lpdwNumberOfBytesRead=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hFile), dwNumberOfBytesToRead, lpdwNumberOfBytesRead, BS(Result), GetLastError]));
          end;
           
          function InternetWriteFile(hFile: HINTERNET; lpBuffer: Pointer;
            dwNumberOfBytesToWrite: DWORD; var lpdwNumberOfBytesWritten: DWORD): BOOL;
          var
            S: String;
          begin
            Result := WinInet.InternetWriteFile(hFile, lpBuffer, dwNumberOfBytesToWrite, lpdwNumberOfBytesWritten);
            S := 'InternetWriteFile hFile=%u dwNumberOfBytesToWrite=%u lpdwNumberOfBytesWritten=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hFile), dwNumberOfBytesToWrite, lpdwNumberOfBytesWritten, BS(Result), GetLastError]));
          end;
           
          function HttpOpenRequest(hConnect: HINTERNET; lpszVerb: PChar;
            lpszObjectName: PChar; lpszVersion: PChar; lpszReferrer: PChar;
            lplpszAcceptTypes: PLPSTR; dwFlags: DWORD; dwContext: DWORD): HINTERNET;
          var
            S: String;
          begin
            Result := WinInet.HttpOpenRequest(hConnect, lpszVerb, lpszObjectName, lpszVersion, lpszReferrer, lplpszAcceptTypes, dwFlags, dwContext);
            S := 'HttpOpenRequest hConnect=%u lpszVerb=%s lpszObjectName=%s lpszVersion=%s dwFlags=%u dwContext=%u Result=%u GetLastError=%d';
            WriteLog(Format(S, [DWORD(hConnect), lpszVerb, lpszObjectName, lpszVersion, dwFlags, dwContext, DWORD(Result), GetLastError]));
          end;
           
          function HttpSendRequest(hRequest: HINTERNET; lpszHeaders: PChar;
            dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD): BOOL;
          var
            S: String;
          begin
            Result := WinInet.HttpSendRequest(hRequest, lpszHeaders, dwHeadersLength, lpOptional, dwOptionalLength);
            S := 'HttpSendRequest(hRequest=%u lpszHeaders=%s dwHeadersLength=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hRequest), lpszHeaders, dwHeadersLength, BS(Result), GetLastError]));
          end;
           
          function InternetCloseHandle(hInet: HINTERNET): BOOL;
          var
            S: String;
          begin
            Result := WinInet.InternetCloseHandle(hInet);
            S := 'InternetCloseHandle hInet=%u Result=%s GetLastError=%d';
            WriteLog(Format(S, [DWORD(hInet), BS(Result), GetLastError]));
          end;
           
          {$ENDIF}
           
          { TCustomChannel }
           
          constructor TCustomChannel.Create;
          begin
            inherited;
            Timeout := 20;
            Flags := INTERNET_FLAG_PRAGMA_NOCACHE + INTERNET_FLAG_RELOAD;
            UserAgent := UserAgents[USER_AGENT_DEFAULT].Agent;
            UseProxy := False;
            UserName := '';
            UserPassword := '';
            ProxyUser := '';
            ProxyPassword := '';
          end;
           
          destructor TCustomChannel.Destroy;
          begin
            Close;
            inherited;
          end;
           
          procedure TCustomChannel.Assign(Channel: TCustomChannel);
          begin
            Self.FHInet := Channel.FHInet;
            Self.FHConnect := Channel.FHConnect;
            Self.FDestinationData := Channel.FDestinationData;
            Self.FReceivedData := Channel.FReceivedData;
            Self.FFlags := Channel.FFlags;
            Self.FObjectName := Channel.FObjectName;
            Self.FServerPort := Channel.FServerPort;
            Self.FProxy := Channel.FProxy;
            Self.FProxyBypass := Channel.FProxyBypass;
            Self.FUserPassword := Channel.FUserPassword;
            Self.FUserName := Channel.FUserName;
            Self.FProxyUser := Channel.FProxyUser;
            Self.FProxyPassword := Channel.FProxyPassword;
            Self.FUseProxy := Channel.FUseProxy;
            Self.FProxyNeedAuthorization := Channel.FProxyNeedAuthorization;
            Self.FUserAgent := Channel.FUserAgent;
            Self.FServerName := Channel.FServerName;
            Self.FServiceType := Channel.FServiceType;
            Self.FOnBeforeOpen := Channel.FOnBeforeOpen;
            Self.FOnOpened := Channel.FOnOpened;
            Self.FOnBeforeConnect := Channel.FOnBeforeConnect;
            Self.FOnConnected := Channel.FOnConnected;
            Self.FOnBeforeClose := Channel.FOnBeforeClose;
            Self.FOnClosed := Channel.FOnClosed;
            Self.FLastError := Channel.FLastError;
            Self.FOnBeforeDisconnect := Channel.FOnBeforeDisconnect;
            Self.FOnDisconnected := Channel.FOnDisconnected;
            Self.FOnError := Channel.FOnError;
          end;
           
          // ===== TCustomChannel - functions ====================================
           
          function TCustomChannel.GetLastError: Cardinal;
          begin
            Result := FLastError;
            FLastError := 0;
          end;
           
          function TCustomChannel.InternetCloseHandle(var Handle: Pointer): Boolean;
          begin
            {$IFDEF WRITELOG}
              Result := Channels.InternetCloseHandle(Handle);
            {$ELSE}
              Result := WinInet.InternetCloseHandle(Handle);
            {$ENDIF}
            if Result then
              Handle := nil;
          end;
           
          function TCustomChannel.SetError(Success: Boolean): Boolean;
          begin
            if Success then
              FLastError := 0
            else
            begin
              FLastError := Windows.GetLastError;
              if Assigned(FOnError) then
                FOnError(Self, FLastError);
            end;
            Result := Success;
          end;
           
          function TCustomChannel.GetDataSize(out DataSize: Cardinal): Boolean;
          begin
            Result := SetError(DoGetDataSize(DataSize));
          end;
           
          function TCustomChannel.GetDestinationData: String;
          begin
            Result := FDestinationData;
          end;
           
          procedure TCustomChannel.SetDestinationData(const Value: String);
          begin
            FDestinationData := Value;
          end;
           
          function TCustomChannel.Read(DataSize: Cardinal; var S: String): Boolean;
          begin
            if DataSize = 0 then DataSize := Cardinal(-1);
            Result := SetError(DoRead(DataSize, S));
            FReceivedData := SetStr(Result, S);
          end;
           
          function TCustomChannel.Read(DataSize: Cardinal = 0): Boolean;
          begin
            Result := Read(DataSize, FReceivedData);
          end;
           
          function TCustomChannel.Write(S: String = ''): Boolean;
          begin
            S := SetStr(S = '', DestinationData);
            Result := SetError(DoWrite(S));
          end;
           
          // ===== TCustomChannel - open =========================================
           
          procedure TCustomChannel.BeforeOpen;
          begin
            if Assigned(FOnBeforeOpen) then
              FOnBeforeOpen(Self);
          end;
           
          function TCustomChannel.DoOpen: Boolean;
          begin
            if Opened then
              Result := True
            else
            begin
              FHInet := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, '', '', FFlags);
              Result := SetError(Opened);
            end;
          end;
           
          procedure TCustomChannel.AfterOpen;
          begin
            if Assigned(FOnOpened) then
              FOnOpened(Self);
          end;
           
          function TCustomChannel.Opened: Boolean;
          begin
            Result := (FHInet <> nil);
          end;
           
          function TCustomChannel.Open: Boolean;
          begin
            BeforeOpen;
            Result := DoOpen;
            if Result then
              AfterOpen;
          end;
           
          // ===== TCustomChannel - close ========================================
           
          function TCustomChannel.CanClose: Boolean;
          var
            lCanClose: Boolean;
          begin
            lCanClose := True;
            if Assigned(FOnBeforeClose) then
              OnBeforeClose(Self, lCanClose);
            Result := lCanClose;
          end;
           
          function TCustomChannel.DoClose: Boolean;
          begin
            Result := Disconnect;
            if Result and Opened then
              Result := SetError(InternetCloseHandle(FHInet));
          end;
           
          procedure TCustomChannel.AfterClose;
          begin
            if Assigned(FOnClosed) then
              FOnClosed(Self);
          end;
           
          function TCustomChannel.Closed: Boolean;
          begin
            Result := not Opened;
          end;
           
          function TCustomChannel.Close: Boolean;
          begin
            if Closed then
              Result := True
            else if not CanClose then
              Result := False
            else
            begin
              Result := DoClose;
              if Result then
                AfterClose;
            end;
          end;
           
          // ===== TCustomChannel - connect ======================================
           
          procedure TCustomChannel.BeforeConnect;
          begin
            if Assigned(FOnBeforeConnect) then
              FOnBeforeConnect(Self);
          end;
           
          function TCustomChannel.DoConnect: Boolean;
          var
            lPI: TInternetProxyInfo;
          begin
            if Connected then
              Result := True
            else
            begin
              if UseProxy and ((Proxy <> '') or (ProxyBypass <> '')) then
              begin
                lPI.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
                lPI.lpszProxy := PChar(Proxy);
                lPI.lpszProxyBypass := PChar(ProxyBypass);
                InternetSetOption(HInet, INTERNET_OPTION_PROXY, @lPI, SizeOf(lPI));
                if ProxyNeedAuthorization and ((ProxyUser <> '') or (ProxyPassword <> '')) then
                begin
                  InternetSetOption(HInet, INTERNET_OPTION_PROXY_USERNAME, PChar(ProxyUser), Length(ProxyUser));
                  InternetSetOption(HInet, INTERNET_OPTION_PROXY_PASSWORD, PChar(ProxyPassword), Length(ProxyPassword));
                end;
              end
              else
              begin
                lPI.dwAccessType := INTERNET_OPEN_TYPE_PRECONFIG;
                lPI.lpszProxy := nil;
                lPI.lpszProxyBypass := nil;
                InternetSetOption(HInet, INTERNET_OPTION_PROXY, @lPI, SizeOf(lPI));
              end;
              InternetSetOption(nil, INTERNET_OPTION_SETTINGS_CHANGED, nil, 0);
              InternetSetOption(nil, INTERNET_OPTION_REFRESH , nil, 0);
              FHConnect := InternetConnect(HInet, PChar(FServerName), FServerPort,
                PChar(FUserName), PChar(FUserPassword), FServiceType, FFlags, 0);
              Result := SetError(Connected);
            end;
          end;
           
          procedure TCustomChannel.AfterConnect;
          begin
            if Assigned(FOnConnected) then
              FOnConnected(Self);
          end;
           
          function TCustomChannel.Connected: Boolean;
          begin
            Result := (FHConnect <> nil);
          end;
           
          function TCustomChannel.Connect(const ServerName: String = '';
            const UserName: String = '';
            const UserPassword: String = ''): Boolean;
          begin
            if ServerName <> '' then
              Self.ServerName := ServerName;
            if UserName <> '' then
              Self.UserName := UserName;
            if UserPassword <> '' then
              Self.UserPassword := UserPassword;
            BeforeConnect;
            Result := DoConnect;
            if Result then
              AfterConnect;
          end;
           
          // ===== TCustomChannel - disconnect ===================================
           
          function TCustomChannel.CanDisconnect: Boolean;
          var
            lCanDisconnect: Boolean;
          begin
            lCanDisconnect := True;
            if Assigned(FOnBeforeDisconnect) then
              OnBeforeDisconnect(Self, lCanDisconnect);
            Result := lCanDisconnect;
          end;
           
          function TCustomChannel.DoDisconnect: Boolean;
          begin
            if Disconnected then
              Result := True
            else
              Result := SetError(InternetCloseHandle(FHConnect));
          end;
           
          procedure TCustomChannel.AfterDisconnect;
          begin
            if Assigned(FOnDisconnected) then
              FOnDisconnected(Self);
          end;
           
          function TCustomChannel.Disconnected: Boolean;
          begin
            Result := not Connected;
          end;
           
          function TCustomChannel.Disconnect: Boolean;
          begin
            if not CanDisconnect then
              Result := False
            else
            begin
              Result := DoDisconnect;
              if Result then
                AfterDisconnect;
            end;
          end;
           
          { THttpChannel }
           
          constructor THttpChannel.Create;
          begin
            inherited;
            FDataList := TStringList.Create;
            FServerPort := INTERNET_DEFAULT_HTTP_PORT;
            FServiceType := INTERNET_SERVICE_HTTP;
          end;
           
          destructor THttpChannel.Destroy;
          begin
            FDataList.Free;
            inherited;
          end;
           
          procedure THttpChannel.Assign(Channel: TCustomChannel);
          begin
            inherited Assign(Channel);
            if Channel is THttpChannel then
              DataList.Assign(THttpChannel(Channel).DataList)
            else
              DataList.Clear;
          end;
           
          function THttpChannel.CreateBoundary: String;
          var
            S: String;
            i: Integer;
          begin
            S := '';
            for i := 0 to Pred(DataList.Count) do
              S := S + DataList[i];
            repeat
              Result := '';
              for i := 0 to 4 do
                Result := Result + Chr(Random(27) + Ord('A')) + Chr(Random(27) + Ord('a'));
            until Pos(Result, S) < 1;
            FBoundary := Result;
          end;
           
          function THttpChannel.GetDestinationData: String;
          var
            S: String;
            lCount: Integer;
            i: Integer;
          begin
            Result := '';
            if DataList.Count > 0 then
            begin
              CreateBoundary;
              lCount := Pred(DataList.Count);
              for i := 0 to lCount do
              begin
                S := #13#10'--' + Boundary + #13#10 + DataList[i];
                if i < lCount then
                  Result := Result + S
                else
                  Result := Result + S + #13#10'--' + Boundary + '--'#13#10;
              end;
            end;
          end;
           
          procedure THttpChannel.SetDestinationData(const Value: String);
          begin
            DataList.Clear;
            if Value <> '' then
              DataList.Add(Value);
          end;
           
          function THttpChannel.DoGetDataSize(out DataSize: Cardinal): Boolean;
          begin
            Result := InternetQueryDataAvailable(HRequest, DataSize, 0, 0);
          end;
           
          function THttpChannel.DoRead(DataSize: Cardinal; var S: String): Boolean;
          var
            lDataSize: Cardinal;
            lDataReaded: Cardinal;
            lTickCount: Cardinal;
          begin
            if DataSize = 0 then
              DataSize := Cardinal(-1);
            S := '';
            lTickCount := GetTickCount;
            repeat
              Result := Open and Connect;
              if not Result then
                Close
              else
              begin
                Result := OpenRequest(HTTP_VERB_GET, INTERNET_FLAG_DONT_CACHE + INTERNET_FLAG_NO_COOKIES);
                if not Result then
                  Close
                else
                begin
                  Result := SendRequest('', '');
                  if not Result then
                    Close
                  else
                  begin
                    Result := GetDataSize(lDataSize) and (lDataSize > 511);
                    if not Result then
                      Close
                    else if lDataSize = 0 then
                      Result := True
                    else
                    begin
                      if lDataSize > DataSize then lDataSize := DataSize;
                      SetLength(S, lDataSize);
                      Result := InternetReadFile(HRequest, @S[1], lDataSize, lDataReaded)
                        and (lDataSize = lDataReaded);
                      if not Result then
                        Close
                      else
                        SetLength(S, lDataReaded);
                    end;
                  end;
                  CloseRequest;
                end;
              end;
              if not Result then Sleep(500);
            until Result or IsTimeout(lTickCount, GetTickCount, Timeout);
            if not Result then FLastError := GetLastError;
            Close;
          end;
           
          function THttpChannel.DoWrite(const S: String): Boolean;
          var
            lReaded: Cardinal;
            lHeader: String;
            lTickCount: Cardinal;
            Stemp: String;
          begin
            lTickCount := GetTickCount;
            repeat
              Result := Open and Connect;
              if not Result then
                Close
              else
              begin
                Result := OpenRequest(HTTP_VERB_POST, INTERNET_FLAG_RELOAD);
                if not Result then
                  Close
                else
                begin
                  lHeader := 'Content-Type: multipart/form-data; boundary=' + Boundary + ''#13#10;
                  Result := HttpAddRequestHeaders(FHRequest, PChar(lHeader), Length(lHeader),
                    HTTP_ADDREQ_FLAG_REPLACE + HTTP_ADDREQ_FLAG_ADD);
                  if not Result then
                    Close
                  else
                  begin
                    Result := SendRequest(lHeader, S);
                    if not Result then
                      Close
                    else
                    begin
                      FReceivedData := '';
                      repeat
                        SetLength(Stemp, 4096);
                        Result := InternetReadFile(HRequest, @Stemp[1], 4096, lReaded);
                        SetLength(Stemp, lReaded);
                        FReceivedData := FReceivedData + Stemp;
                      until not Result or (lReaded < 1);
                    end;
                  end;
                  CloseRequest;
                end;
              end;
              if not Result then Sleep(500);
            until Result or IsTimeout(lTickCount, GetTickCount, Timeout);
            if not Result then FLastError := GetLastError;
            Close;
          end;
           
           
          function THttpChannel.OpenRequest(Verb: Integer; Flags: Cardinal; const ObjectName: String = ''): Boolean;
          var
            lVerb: PChar;
          begin
            if ObjectName <> '' then
              Self.ObjectName := ObjectName;
            case Verb of
              HTTP_VERB_POST: lVerb := 'POST';
              HTTP_VERB_GET: lVerb := 'GET';
              HTTP_VERB_HEAD: lVerb := 'HEAD';
              HTTP_VERB_PUT: lVerb := 'PUT';
              HTTP_VERB_LINK: lVerb := 'LINK';
              HTTP_VERB_DELETE: lVerb := 'DELETE';
              HTTP_VERB_UNLINK: lVerb := 'UNLINK';
            else
              lVerb := 'GET';
            end;
            FHRequest := HttpOpenRequest(HConnect, lVerb, PChar(FObjectName), 'HTTP/1.0', nil, nil, FFlags, 0);
            Result := SetError(FHRequest <> nil);
          end;
           
          function THttpChannel.SendRequest(const Header, Data: String): Boolean;
          begin
            Result := SetError(HttpSendRequest(HRequest, PChar(Header), Length(Header), PChar(Data), Length(Data)));
          end;
           
          function THttpChannel.CloseRequest: Boolean;
          begin
            Result := SetError(InternetCloseHandle(FHRequest));
          end;
           
          function THttpChannel.AddDestinationData(const FieldName, FieldValue: String): String;
          var
            S: String;
          begin
            S := 'Content-Disposition: form-data; name="%s"'#13#10#13#10'%s';
            DataList.Add(Format(S, [FieldName, FieldValue]));
          end;
           
          function THttpChannel.AddDestinationFile(const FieldName, FileName: String): String;
          var
            f: File;
            lReadCount: Integer;
            S, Stemp: String;
          begin
            Result := '';
            if FileExists(FileName) then
            begin
              AssignFile(f, FileName);
              Reset(f, 1);
              try
                S := '';
                repeat
                  SetLength(Stemp, 2048);
                  BlockRead(f, Stemp[1], 2048, lReadCount);
                  SetLength(Stemp, lReadCount);
                  S := S + Stemp;
                until Eof(f) or (lReadCount < 2048)
              finally
                CloseFile(f);
              end;
              if S <> '' then
              begin
                Stemp := 'Content-Disposition: form-data; name="%s"; filename="%s"'#13#10'Content-Type: application/octet-stream'#13#10#13#10'%s';
                S := Format(Stemp, [FieldName, FileName, S]);
                DataList.Add(S);
                Result := DestinationData;
              end;
            end;
          end;
           
          end.


        Добавлено
        И вот кусок кода, который работает с каналом.
        Очень простой.

        ExpandedWrap disabled
          procedure TConnector.SetElementValue(const AValue, AName: String);
          const
            lProcName = 'TConnector.SetElementValue';
          begin
            if IsPageOpened then
              Channel.AddDestinationData(AName, AValue)
            else RaiseError(lProcName, PAGE_NOT_OPENED);
          end;
           
          procedure TConnector.Submit(const RequestToLog: TSimpleRequest);
          begin
            AddToLog(RequestToLog);
            Channel.Timeout := Timeout;
            FBreakByTimeout := not Channel.Write;
            Channel.DestinationData := '';
          end;
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0433 ]   [ 16 queries used ]   [ Generated: 28.03.24, 10:35 GMT ]