[lukash]

здрасте!
помогите сделать поддержку докачки файлов со стороны idHttpServer 'a.

[~ SaM ~]

Код:

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  wininet,
  StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit; //<-строка для УРЛа
    Label1: TLabel;
    Button1: TButton; //<-кнопка Start
    Button2: TButton; //<-кнопка Stop
    ProgressBar1: TProgressBar; //<-декорация
    procedure Button1Click(Sender: TObject); //<-|процедура начала скачки
    procedure Button2Click(Sender: TObject); //<-|принудительный обрыв
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  stop: boolean; //<-|вспомогательная переменная отв. за
  //  |остановку скачки
implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  hInet, //<-переменная сод. указатель на сессию
  hURL: HINTERNET; //<-указатель на URL
  fSize, //<-размер файла
  ReadLen, //<-количество реально прочитанных байт
  RestartPos: DWORD; //<-|позиция с которой начинается
  //  |докачка
  fBuf: array[1..1024] of byte; //<-буфер куда качаем
  f: file; //<-файл куда качаем
  Header: string; //<-|дополнительная переменная в HTTP
  //  |заголовок
begin
  RestartPos := 0; //<- |инициализация
  fSize := 0; //<- |переменных
  Button1.Enabled := false;
  Button2.Enabled := true;
  //Если на винте есть файл то считаем, что нужно докачивать
  if FileExists('c:\123.tmp') then
  begin
    AssignFile(f, 'c:\123.tmp');
    Reset(f, 1);
    RestartPos := FileSize(F);
    Seek(F, FileSize(F));
  end
  else
  begin
    //иначе с начала
    AssignFile(f, 'c:\123.tmp');
    ReWrite(f, 1);
  end;
  //открываем сессию
  hInet := InternetOpen('Mozilla',
    PRE_CONFIG_INTERNET_ACCESS,
    nil,
    nil,
    0);
  //Пишем дополнительную строку для заголовка
  Header := 'Accept: */*';
  //открываем URL
  hURL := InternetOpenURL(hInet,
    PChar(Edit1.Text),
    pchar(Header),
    StrLen(pchar(Header)),
    0,
    0);
  //устанавливаем позицию в файле для докачки
  if RestartPos > 0 then
    InternetSetFilePointer(hURL,
      RestartPos,
      nil,
      0,
      0);
  //смотрим ск-ко надо скачать
  InternetQueryDataAvailable(hURL, fSize, 0, 0);
  if RestartPos > 0 then
  begin
    ProgressBar1.Min := 0;
    ProgressBar1.Max := fSize + RestartPos;
    ProgressBar1.Position := RestartPos;
  end
  else
  begin
    ProgressBar1.Min := 0;
    ProgressBar1.Max := fSize + RestartPos;
  end;
  //качаем до тех пор пока реально прочитаное число байт не
  //будет равно нулю или не стор
  while (ReadLen <> 0) and (stop = false) do
  begin
    //читаем в буфер
    InternetReadFile(hURL, @fBuf, SizeOf(fBuf), ReadLen);
    //смотрим ск-ко осталось докачать
    InternetQueryDataAvailable(hURL, fSize, 0, 0);
    ProgressBar1.Position := ProgressBar1.Max - fSize;
    BlockWrite(f, fBuf, ReadLen); //<-пишем в файл
    Application.ProcessMessages;
  end;
  stop := false;
  Button1.Enabled := true;
  Button2.Enabled := false;
  InternetCloseHandle(hURL); //<-|закрываем
  InternetCloseHandle(hInet); //<-|сесcии
  CloseFile(f); //<-|и файл
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  stop := false; //<-прервать скачку
  Button2.Enabled := false; //<-кнопка останова скачки
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  stop := true; //<-сообщаем о необходимости прерывания скачки
end;

end.

взято с DelphiWorld.narod.ru

[lukash]

спасибо но этот код клиента, а idhttpserver - серверная часть. и вот она то и не поддерживает докачку(по дефолту). я имел в виду сервер.

[~ SaM ~]

Извини, тупанул!