VPF::Прогресс бар и асинхронность - Форум программистов

fack00

Дата 10.5.2009, 16:32 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

Здравствуйте.
Пишу загрузчик файлов, имеется код:

Цитата

responseres:=idHTTP1.Post('http://123.ru/upload.php',params);
Edit1.Text:=responseres;

так вот первая строчка, если файл большой, выполняется очень долго и программа зависает на время его выполнения.
Эту проблему я решил кинув компонент IdAntiFreeze из Indy Misc.

Для асинхронности мне посоветовали использовать ISC, но я не смог с помощью данного компонента отправить файл (только текст).

Итак, прошу помощи в следующем:
1) что лучше использовать Indy или ICS (подкиньте код, который будет отправлять файл)? Самому ICS нравится больше..
2) как сделать прогресс бар, который будет отображать сколько уже % загружено?

Nofate

Дата 10.5.2009, 21:15 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 266
Регистрация: 13.10.2008

Репутация: нет
Всего: 8

Максимального контроля над процессом можно добиться, если запустить TThread, открыть сокет и писать-читать в нем.

то есть чтото вроде

Код


Procedure TMyThread.Execute();
begin
   создаем сокет
   открываем соединение
   цикл  begin
       читаем из файла n байт
       пишем в сокет 
       синхронизируем прогресс бар
   end; 
   читаем ответ
   кладем в Edit1.Text
end;

а всякие индийские компоненты - от лукавого smile

--------------------

The future is not set, there is no fate but what we make for ourselves.
Нофейтово пространство и смежные области

Matematik

Дата 10.5.2009, 22:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

Вот пример загрузки картинки на ipicture в потоке

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdMultipartFormData, IdException;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure StatusEvent(ASender:TObject; const AString:String);
    procedure WorkEvent(ASender:TObject; const AWorkCount: Integer);
    procedure WorkBegin(ASender:TObject; const AWorkCountMax: Integer);
    procedure WorkEnd(ASender:TObject);
    procedure ThreadTerminate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TStatusEvent = procedure(ASender:TObject; const AString:String) of object;
  TWorkEvent   = procedure(ASender:TObject; const AWorkCount: Integer) of object;
  TWorkBegin   = procedure(ASender:TObject; const AWorkCountMax: Integer) of object;
  TWorkEnd     = procedure(ASender:TObject) of object;

type
  THttpThread = class(TThread)
  private
    FTmpStr      : String;
    FTmpInt      : Integer;
    FWorkMax     : Integer;
    FHttp        : TIdHTTP;
    FFileName    : string;
    FResponse    : string;
    FOnStatus    : TStatusEvent;
    FOnWork      : TWorkEvent;
    FOnWorkBegin : TWorkBegin;
    FOnWorkEnd   : TWorkEnd;
    //---------------------------
    procedure Status(const AString:String);
    procedure DoStatus;
    procedure Work(const AWorkCount:Integer);
    procedure DoWork;
    procedure WorkBegin(const AWorkCountMax:Integer);
    procedure DoWorkBegin;
    procedure WorkEnd;
    procedure DoWorkEnd;
    //---------------------------
    procedure HTTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure HTTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
  public
    constructor Create;
    destructor Destroy; override;
    //---------------------------
    procedure Execute; override;
    //---------------------------
    property FileName    : string       read FFileName    write FFileName;
    property Response    : string       read FResponse    write FResponse;
    property OnStatus    : TStatusEvent read FOnStatus    write FOnStatus;
    property OnWork      : TWorkEvent   read FOnWork      write FOnWork;
    property OnWorkBegin : TWorkBegin   read FOnWorkBegin write FOnWorkBegin;
    property OnWorkEnd   : TWorkEnd     read FOnWorkEnd   write FOnWorkEnd;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ THttpThread }

constructor THttpThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FHttp := TIdHTTP.Create(nil);
  with FHttp do
  begin
    ReadTimeout     := 30000;
    ConnectTimeout  := 30000;
    SendBufferSize  := 1024;
    RecvBufferSize  := 1024;
    HTTPOptions     := [hoKeepOrigProtocol];
    HandleRedirects := False;
    RedirectMaximum := 5;
    AllowCookies    := True;
    OnWork          := HTTPWork;
    OnWorkBegin     := HTTPWorkBegin;
    OnWorkEnd       := HTTPWorkEnd;
    OnStatus        := HTTPStatus;
    with Request do
    begin
      UserAgent := 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.8) Gecko/20071022 Ubuntu/7.10 (gutsy) Firefox/2.0.0.11';
      Referer   := 'http://ipicture.ru/';
      Accept    := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
      AcceptLanguage := 'ru,en-us;q=0.7,en;q=0.3';
      AcceptEncoding := 'gzip,deflate';
      AcceptCharset  := 'windows-1251,utf-8;q=0.7,*;q=0.7';
      Connection := 'keep-alive';
      with CustomHeaders do
      begin
        Add('Keep-Alive: 300');
      end;
    end;
  end;
  FFileName    := ''; 
  FResponse    := '';
  FOnStatus    := nil;
  FOnWork      := nil;
  FOnWorkBegin := nil;
  FOnWorkEnd   := nil;

end;

destructor THttpThread.Destroy;
begin
  FHttp.Free;
  inherited;
end;


procedure THttpThread.DoWork;
begin
  FOnWork(Self, FTmpInt);
end;

procedure THttpThread.Work(const AWorkCount: Integer);
begin
  if Assigned(FOnWork) then
  begin
    FTmpInt := AWorkCount;
    Synchronize(DoWork);
  end;
end;

procedure THttpThread.DoWorkBegin;
begin
  FOnWorkBegin(Self, FTmpInt);
end;

procedure THttpThread.WorkBegin(const AWorkCountMax: Integer);
begin
  if Assigned(FOnWorkBegin) then
  begin
    FTmpInt := AWorkCountMax;
    Synchronize(DoWorkBegin);
  end;
end;

procedure THttpThread.DoWorkEnd;
begin
  FOnWorkEnd(Self)
end;

procedure THttpThread.WorkEnd;
begin
  if Assigned(FOnWorkEnd) then
  begin
    Synchronize(DoWorkEnd);
  end;
end;

procedure THttpThread.DoStatus;
begin
  FOnStatus(Self, FTmpStr);
end;

procedure THttpThread.Status(const AString: String);
begin
  if Assigned(FOnStatus) then
  begin
    FTmpStr := AString;
    Synchronize(DoStatus);
  end;
end;

procedure THttpThread.HTTPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
//  Status(AStatusText);
end;

procedure THttpThread.HTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  Work(Round(AWorkCount / FWorkMax * 100));
end;

procedure THttpThread.HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  if AWorkMode=wmWrite then
    Status('Отправка файла')
  else if AWorkMode=wmRead then
    Status('Получение ответа');

  FWorkMax := AWorkCountMax;
  WorkBegin(AWorkCountMax);
end;

procedure THttpThread.HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  Status('Завершено');
  WorkEnd;
end;


procedure THttpThread.Execute;
var
  dat : TIdMultiPartFormDataStream;
  url : string;
begin
//  Status('Start');
  // получение печенек
//  FHttp.Get('http://ipicture.ru/');

  dat := TIdMultiPartFormDataStream.Create;
  try
    dat.AddFormField('method', 'file');
    dat.AddFile('userfile', FFileName, '');
    dat.AddFormField('userurl[]', '');
    dat.AddFormField('orig_resize', '100');
    dat.AddFormField('rotate', '0');
    dat.AddFormField('string_big', '');
    dat.AddFormField('status', 'on');
    dat.AddFormField('quality', '100');
    dat.AddFormField('thumb_resize', '180');
    dat.AddFormField('string_small', 'Увеличить');
    dat.AddFormField('galleries', '12');
    dat.AddFormField('comment', '');

    FHttp.Post('http://ipicture.ru/Upload/', dat)
  finally
    dat.Free;
  end;

  url := FHttp.Response.RawHeaders.Values['Refresh'];
  delete(url,1,3);
  FResponse := FHttp.Get(URL);

  Status('Готово');

end;

procedure TForm1.Button1Click(Sender: TObject);
var T:THttpThread;
begin
  T := THttpThread.Create;
  T.FileName    := '9may2.jpg';
  T.OnStatus    := StatusEvent;
  T.OnWork      := WorkEvent;
  T.OnWorkBegin := WorkBegin;
  T.OnWorkEnd   := WorkEnd;
  T.OnTerminate := ThreadTerminate;
  T.Resume;
end;

procedure TForm1.StatusEvent(ASender: TObject; const AString: String);
begin
  Memo1.Lines.Add(AString)
end;

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
  if (Sender is THttpThread) then
  begin
    with (Sender as THttpThread) do
    begin
      if FatalException<>nil then
      begin
        Application.ShowException(Exception(FatalException));
      end;
      Memo1.Lines.Add(Response)
    end;
  end;
end;

procedure TForm1.WorkBegin(ASender: TObject; const AWorkCountMax: Integer);
begin
//  Memo1.Lines.Add('WorkBegin '+IntToStr(AWorkCountMax))
end;

procedure TForm1.WorkEnd(ASender: TObject);
begin
//  Memo1.Lines.Add('WorkEnd')
end;

procedure TForm1.WorkEvent(ASender: TObject; const AWorkCount: Integer);
begin
  Memo1.Lines.Add(IntToStr(AWorkCount)+'%')
end;

end.

kami

Дата 10.5.2009, 23:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 22
Всего: 72

Цитата(Nofate @ 10.5.2009, 21:15

)

кладем в Edit1.Text

Как раз вот этот код в контексте доп.потока - от лукавого.
как и

Цитата(Nofate @ 10.5.2009, 21:15

)

синхронизируем прогресс бар

НЕЛЬЗЯ использовать доступ к VCL компонентам из доп.потока. Нарвешься на такие грабли, которые будут выскакивать незнамо где и незнамо когда. Без видимых причин.

Демо

Дата 10.5.2009, 23:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 7
Всего: 50

Вот ещё вариант:

Код


{
Модуль uGetHTTPThread
Выполнение запроса HTTP GET в отдельном потоке с
возможностью повторного использования.
Ведется учет количества потоков

Требования - установленный Indy10

 (c) Демо

Специально для Sources.ru (2005)

Пример использования:

procedure TForm1.Button1ClickSender: TObject);
var
  s: String;
begin
  with TGetHTTP.Create do
  begin
    OnComplete := Complete;
    Get('http://www.sources.ru');
  end;
  with TGetHTTP.Create do
  begin
    OnComplete := Complete;
    Get('http://localhost');
  end;

procedure TForm1.Complete(Sender: TGetHTTP; var Action: TActionHTTPThread);
begin
  Memo1.Lines.Add('Complete');
  Memo1.Lines.Add(Sender.Result.RecvStr);
  Action := ahFree;
end;

}
unit uGetHttpThread;

interface

uses
  windows,classes, SysUtils, idHTTP, idLogDebug, idComponent, idGlobal,IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack,  IdIntercept,idException;

var
  ThrList: TThreadList;

type

//Состояние потока
  TStateHTTPThread=(shNone,shReady,shComplete,shWork);
//Действие при обработке OnComplete
  TActionHTTPThread=(ahNone,ahFree);
  TGetHTTP=class;
  TCompleteQuery=procedure(Sender: TGetHTTP; var Action:TActionHTTPThread) of Object;
  TProgressQuery=procedure(Sender: TGetHTTP; aReadCount,aSendCount: Integer) of Object;

//Структура, заполняемая в потоке.
  THTTPRec=record
    Query: String;              //Запрос в виде http://url
    ErrorMsg: String;           //Результатт в текстовом виде
    ErrorCode: Integer;         //Результат в числовом виде
    RecvStr: String;            //Принятая строка(полностью с заголовком)
    SendStr: String;            //Отосланная строка
    CountSend: Integer;         //Количество отосланных байт
    CountRcv: Integer;          //Количество принятых байт
    Page: String;               //Возвращенная страница(без заголовка)
  end;

//Собственно, сам поток
  TGetHTTP=class(TThread)
  private
    FCS: RTL_CRITICAL_SECTION;
    FH: TidHTTP;
    FL: TidLogDebug;
    FS: TIdIOHandlerStack;
    FTimeOut: Integer;
    FQuery: String;
    FResult: THTTPRec;
    FState: TStateHTTPThread;
    FOnComplete: TCompleteQuery;
    FOnProgress: TProgressQuery;
    procedure FComplete;
    procedure FProgress;
    procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure FLReceive(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure FLSend(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    function GetTimeOut: Integer;
    procedure SetTimeOut(const Value: Integer);

    procedure Lock;
    procedure Unlock;
    function GetFResult: THTTPRec;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Free;
    procedure Release;

    procedure Get(const Query: String);

    property OnComplete: TCompleteQuery read FOnComplete write FOnComplete;
    property OnProgress: TProgressQuery read FOnProgress write FOnProgress;
    property Result: THTTPRec read GetFResult;
    property State: TStateHTTPThread read FState;
    property TimeOut: Integer read GetTimeOut write SetTimeOut;
  end;

//Получение максимального количества потоков
function GetMaxThreads: Integer;

//Установка максимального количества потоков
procedure SetMaxThreads(aMaxThreads: Integer=10);

//завершение всех потоков и очистка списка
procedure TerminateAllThreads;

//Завершение конкретного потока
procedure ReleaseThread(Thread:TGetHTTP);

//Получение количества потоков в списке
function CheckCountThreads: Integer;

implementation

var
//Максимальное количество потоков - недоступно из других модулей напрямую
  MaxThreads: Integer;

{ TGetHTTP }

constructor TGetHTTP.Create;
begin
  if CheckCountThreads=GetMaxThreads then raise Exception.Create('Can''t create thread. MaxThreads='+IntToStr(MaxThreads));
  inherited Create(True);
  FreeOnTerminate := False;
  FState := shNone;             //Поток еще не готов принять запрос
  with ThrList.LockList do      //Добавляем поток в список
  try
    Add(Self);
  finally
    ThrList.UnlockList;
  end;
  TimeOut := 30000;
  InitializeCriticalSection(FCS);
  Resume;
end;

destructor TGetHTTP.Destroy;
begin
  FH.Free;
  FS.Free;
  FL.Free;
  DeleteCriticalSection(FCS);
end;

procedure TGetHTTP.Execute;
begin
  FH := TidHTTP.Create(nil);
  FL := TidLogDebug.Create(nil);
  FS := TIdIOHandlerStack.Create(nil);
  FS.Intercept := FL;
  FH.IOHandler := FS;
  FL.Active := True;
  FH.OnWork := FHWork;
  FL.OnReceive := FLReceive;
  FL.OnSend := FLSend;
  FState := shReady;
  if FQuery='' then Suspend;    //Запрос пустой - засыпаем
  try
    while not Terminated do
    begin
      FState := shWork;           //Поток занят
      FResult.Query := FQuery;
      FResult.ErrorMsg := '';
      FResult.ErrorCode := 0;
      FResult.RecvStr := '';
      FResult.SendStr := '';
      FResult.CountSend := 0;
      FResult.CountRcv := 0;
      FResult.Page := '';
      FQuery := '';

      try
        FH.ReadTimeout := TimeOut;       //Таймаут
        FResult.Page := FH.Get(FResult.Query);
        FResult.ErrorMsg := FH.ResponseText;
        FResult.ErrorCode := FH.ResponseCode;
      except
        on e: Exception do
        begin
          FResult.ErrorMsg := e.Message;
          FResult.ErrorCode := -1;
        end;
      end;
      FState := shComplete;       //Поток закончил выполнение запроса
      Synchronize(FComplete);     //Сообщаем пользователю
      if not Terminated then Suspend;
    end;
  finally
    ReleaseThread(Self);
  end;
end;

procedure TGetHTTP.FComplete;
var
  Action: TActionHTTPThread;
begin
  Action := ahNone;
  if Assigned(FOnComplete) then FOnComplete(Self,Action);
  if Action = ahFree
    then  Terminate;//ReleaseThread(Self)    //Завершаем поток
//    else Suspend;               //Засыпаем снова - до следующего запроса
end;

procedure TGetHTTP.FHWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
//Увеличиваем соответствующий счетчик
  Lock;
  try
    case AWorkMode of
      wmRead: FResult.CountRcv := FResult.CountRcv + AWorkCount;
      wmWrite: FResult.CountSend := FResult.CountSend + AWorkCount;
    end;
  finally
    Unlock;
  end;
  Synchronize(FProgress);
end;

procedure TGetHTTP.FLReceive(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: String;
begin
//  Добавляем в буфер полученную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[0],s[1],Length(ABuffer));
  FResult.RecvStr := FResult.RecvStr + s;
end;

procedure TGetHTTP.FLSend(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: String;
begin
//  Добавляем в буфер отправленную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[1],s[1],Length(ABuffer));
  FResult.SendStr := FResult.SendStr + s;
end;

procedure TGetHTTP.Free;
begin
//заменяем процедуру Free на нашу
  Release;
end;

procedure TGetHTTP.Get(const Query: String);
var
  i: Integer;
begin
//Проверяем, закончена ли предыдущая обработка.
  if (FState=shComplete) or (FState=shWork)
    then raise Exception.Create('Error state thread');

//Если поток еще только стартует - ожидаем.
  i := 100;
  while FState<>shReady do
  begin
    Sleep(10);
    //Слишком долго поток не переходит в статус shReady
    if i<0 then raise Exception.Create('Unknown error');
    Dec(i,10);
  end;
  FQuery := Query;
//Будим поток для выполнения запроса
  Resume;
end;

function TGetHTTP.GetTimeOut: Integer;
begin
  Result := InterlockedExchange(FTimeOut,FTimeOut);
end;

procedure TGetHTTP.SetTimeOut(const Value: Integer);
begin
  InterlockedExchange(FTimeOut,Value);
end;

procedure TGetHTTP.Release;
begin
  FreeOnTerminate := True;      //Переводим в состояние автоуничтожения
  Terminate;                    //Взводим флаг Terminated
  Resume;                       //Будим поток для завершения
end;

procedure TerminateAllThreads;
var
  i: Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        TGetHTTP(Items[i]).Release;
      except
      end;
    end;
  finally
    ThrList.UnlockList;
  end;
end;

//Получить максимальное количество потоков.
function GetMaxThreads: Integer;
begin
  Result := InterlockedExchange(MaxThreads,MaxThreads);
end;

//Установить максимальное количество потоков.
procedure SetMaxThreads(aMaxThreads: Integer=10);
var
  CurrValue: Integer;
begin
  CurrValue := InterlockedExchange(MaxThreads,MaxThreads);
  if CurrValue>aMaxThreads then
  InterlockedExchange(MaxThreads,aMaxThreads);
end;

//Получить теккущее количество потоков
function CheckCountThreads: Integer;
begin
  with ThrList.LockList do
  try
    Result := Count;
  finally
    ThrList.UnlockList;
  end;
end;

//Завершить поток
procedure ReleaseThread(Thread:TGetHTTP);
var
  i:Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        if TGetHTTP(Items[i])=Thread then
        begin
          TGetHTTP(Items[i]).Free;
          Delete(i);
          break;
        end;
      except
      end;
    end;
  finally
    ThrList.UnlockList;
  end;
end;

procedure TGetHTTP.Lock;
begin
  EnterCriticalSection(FCS);
end;

procedure TGetHTTP.Unlock;
begin
  LeaveCriticalSection(FCS);
end;


procedure TGetHTTP.FProgress;
var
  r,s: Integer;
begin
  if Assigned(FOnProgress) then
  begin
    Lock;
    try
      r := FResult.CountRcv;
      s := FResult.CountSend;
    finally
      Unlock;
    end;
    FOnProgress(Self,r,s);
  end;
end;

function TGetHTTP.GetFResult: THTTPRec;
begin
  Lock;
  try
    Result := FResult;
  finally
    Unlock;
  end;
end;

initialization
  MaxThreads := 10;
  ThrList := TThreadList.Create;
finalization
  TerminateAllThreads;
  ThrList.Free;
end.

--------------------

fack00

Дата 11.5.2009, 10:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

Цитата(Matematik @ 10.5.2009, 22:36

)

Вот пример загрузки картинки на ipicture в потоке

код огромен и делфи его не компилит.
я в нем не разобрался. его суть в том что он отправляет файл? дык это я тоже могу, только не знаю как сделать прогресс бар, показывающую сколько % файла уже отправлено..

Цитата(Демо @ 10.5.2009, 23:50

)

Вот ещё вариант:

там вроде только Get...

вы меня видимо неправильно поняли, мне вот что надо:
1) как сделать прогресс бар, если я отправляю файл с помощью компонента INDY (IdHTTP)?
2) как отправить файл с помощью компонента ICS? Как сделать прогресс бар я примерно знаю, но попробовать не могу - файл то не могу отправить.
мне желательно 2 вариант.

Matematik

Дата 11.5.2009, 12:58 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

fack00, код как раз и отображает прогресс отправки файла в мемо в процентах, прогресбар прикрутить несложно.
Заставить работать легко: кидаешь на форму кнопку и мемо, делаешь копи-паст всего кода и прописываешь обработчик OnClick у кнопки.

fack00

Дата 11.5.2009, 14:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

Цитата(Matematik @ 11.5.2009, 12:58

)

Заставить работать легко: кидаешь на форму кнопку и мемо, делаешь копи-паст всего кода и прописываешь обработчик OnClick у кнопки.

так и делал, но вылазит ошибка:
http://s61.radikal.ru/i171/0905/78/286597376ef0.jpg

первые 2 можно исправить, дабавив в VAR

Цитата

SendBufferSize:integer;
RecvBufferSize:integer;

а что делать с еще 2-мя не знаю, можно просто удалить - тогда нужных процентов в Memo не будет.
подскажите как исправить.

Nofate

Дата 11.5.2009, 16:05 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 266
Регистрация: 13.10.2008

Репутация: нет
Всего: 8

Цитата(kami @ 10.5.2009, 23:36

)

Дык синхронизировать, а не тупо подставлять значение.

--------------------

The future is not set, there is no fate but what we make for ourselves.
Нофейтово пространство и смежные области

Демо

Дата 11.5.2009, 18:39 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 7
Всего: 50

Цитата(fack00 @ 11.5.2009, 10:57

)

там вроде только Get...

Так добавть метод POST и делов-то!

--------------------

fack00

Дата 11.5.2009, 19:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

Демо,

Цитата(Демо @ 10.5.2009, 23:50

)

Модуль uGetHTTPThread

я думал он тока для get написан smile

ответьте кто-нибудь на http://forum.vingrad.ru/index.php?showtopi...t&p=1865476
и на

Цитата(fack00 @ 11.5.2009, 10:57

)

2) как отправить файл с помощью компонента ICS? Как сделать прогресс бар я примерно знаю, но попробовать не могу - файл то не могу отправить

Это сообщение отредактировал(а) fack00 - 11.5.2009, 19:21

Matematik

Дата 11.5.2009, 22:19 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

Цитата(fack00 @ 11.5.2009, 14:47

)

так и делал, но вылазит ошибка:
http://s61.radikal.ru/i171/0905/78/286597376ef0.jpg

SendBufferSize/RecvBufferSize - Это параметры TIdHTTP, устанавливают размеры буферов чтения и записи в сокет. Размер буфера влияет (по-умолчанию 32кб) на кол-во считываний данных из сокета, соответственно плавность прогресса отправки\чтения данных.

Событие TIdHTTP.OnWork вызывается как раз при считывании\записи в сокет данных размером SendBufferSize/RecvBufferSize.

Судя по ошибкам, это Indy10 (в 8\9 эти параметры есть), в 10 SendBufferSize/RecvBufferSize убраны в IOHandle и OnWork+OnWorkBegin немного поменялись

Код


  TWorkBeginEvent = procedure(ASender: TObject; AWorkMode: TWorkMode;
   AWorkCountMax: Integer) of object;
  TWorkEvent = procedure(ASender: TObject; AWorkMode: TWorkMode;
   AWorkCount: Integer) of object;

Думаю достаточно будет убрать const
http://forum.vingrad.ru/index.php?showtopi...t&p=1865159

Код


56.    procedure HTTPWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
57.    procedure HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
196.  AWorkCount: Integer);
202.  AWorkCountMax: Integer);

По поводу SendBufferSize/RecvBufferSize я не уверен сработает ли, проверить негде

Код


  with FHttp do
  begin
    CreateIOHandler;
    IOHandler.SendBufferSize  := 1024;
    IOHandler.RecvBufferSize  := 1024;

fack00

Дата 12.5.2009, 11:05 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

1) Да у меня 10 версия INDY.
2) поправил на то что дали - другие ошибки:
http://s57.radikal.ru/i158/0905/df/e85612be5cbc.jpg
То есть несоответствие типов Int64 и Integer.
если в коде поменять все на Int64, то в принципе копилируется и запускается, файл отправляется и показываются проценты, НО:
http://s44.radikal.ru/i105/0905/28/360e7a77cdf3.jpg
может откатиться на Indy 9 ?

Matematik

Дата 12.5.2009, 11:55 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50

fack00,
division by zero происходит точно тут

Код


  Work(Round(AWorkCount / FWorkMax * 100));

При получении ответа от сервера, он (сервер) не сообщает размер пересылаемых данных, FWorkMax = 0
соответственно деление на ноль

fack00

Дата 12.5.2009, 15:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 10.5.2009

Репутация: нет
Всего: нет

Цитата(Matematik @ 12.5.2009, 11:55

)

division by zero происходит точно тут

Именно, забыл написать об этом.

Спасибо!
Все доделал smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »