[Delphi] Synapse -> HTTPSend -> ProgressBar

Witam,

Pisze aplikacje internetowa wykorzystujac komponent Synapse a dokladniej HTTPSend. Aplikacja pobiera mi juz dane ale chcial bym zrobic stan pobrania (ProgressBar), niestety nie mam pojecia jak pobrac potrzebne informacje tzn. wielkosc pliku oraz ile aktualnie zostalo pobrane. Aplikacja oparta jest na watkach.
Sprawdzalem na stronie producenta komponentu, jedynie znalazlem cos takiego:
http://synapse.ararat.cz/doku.php/public:howto:onstatus
niestety nie wiem jak sie za to zabrac ;/

Pozdrawiam

unit cSendThread;

interface

uses
  uTypes,
  blcksock,
  smtpsend,
  mimemess,
  mimepart,
  cEmail,
  Classes;

type
  TSendingDataProc = procedure(Sender: TObject; Count: Integer; Time: TDateTime) of object;
  TEndSendingProc = procedure(Sender: TObject) of object;
  TProgressProc = procedure(Sender: TObject; Pos: Integer) of object;
  TChangeStatusProc = procedure(Sender: TObject; Status: string) of object;
  TThreadDoneProc = procedure(Sender: TObject; Error: Boolean; ErrorStr: string) of object;

  TSendEmail = class(TThread)
  private
    FEmail: TEmail;
    FPos: Integer;
    FCount: Integer;
    FTime: TDateTime;
    FStatus: string;
    FError: string;
    FSendData: Boolean;
    FOnChangeStatus: TChangeStatusProc;
    FOnProgress: TProgressProc;
    FOnSendingData: TSendingDataProc;
    FOnDone: TThreadDoneProc;
  protected
    procedure Execute; override;
    function Send: Boolean;
    procedure DoSendingData;
    procedure DoProgress;
    procedure DoChangeStatus;
    procedure OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
    procedure OnMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
    procedure DoDone;
  public
    constructor Create(Email: TEmail);
    property OnSendingData: TSendingDataProc read FOnSendingData write FOnSendingData;
    property OnProgress: TProgressProc read FOnProgress write FOnProgress;
    property OnChangeStatus: TChangeStatusProc read FOnChangeStatus write FOnChangeStatus;
    property OnDone: TThreadDoneProc read FOnDone write FOnDone;
  end;

implementation

uses
  ssl_cryptlib,
  synautil,
  SysUtils,
  uConsts;

{ TSendEmail }

constructor TSendEmail.Create(Email: TEmail);
begin
  FreeOnTerminate := True;
  FEmail := Email;
  FSendData := False;
  inherited Create(True);
end;

procedure TSendEmail.DoChangeStatus;
begin
  if Assigned(FOnChangeStatus) then
    FOnChangeStatus(nil, FStatus);
end;

procedure TSendEmail.DoProgress;
begin
  if Assigned(FOnProgress) then
    FOnProgress(nil, FPos);
end;

procedure TSendEmail.DoSendingData;
begin
  if Assigned(FOnSendingData) then
    FOnSendingData(nil, FCount, FTime);
end;

procedure TSendEmail.Execute;
begin
  inherited;
  FStatus := sStartSending;
  Synchronize(DoChangeStatus);
  if Send then
    FStatus := sDone
  else
    FStatus := FError;
  Synchronize(DoChangeStatus);
  Synchronize(DoDone);
end;

procedure TSendEmail.DoDone;
begin
  if Assigned(FOnDone) then
    FOnDone(nil, FStatus <> sDone, FStatus);
end;

procedure TSendEmail.OnMonitor(Sender: TObject; Writing: Boolean;
  const Buffer: TMemory; Len: Integer);
var
  buf: AnsiString;
begin
  buf := PChar(buffer);
  SetLength(buf, Len);
  if Pos('DATA'#13#10, AnsiUpperCase(buf)) = 1 then
  begin
    FSendData := True;
    FStatus := sSendingData;
    FPos := 0;
    FTime := Now;
    Synchronize(DoSendingData);
    Synchronize(DoChangeStatus);
  end
  else if Pos('ESMTP', AnsiUpperCase(buf)) > 0 then
  begin
    FStatus := sLogin;
    Synchronize(DoChangeStatus);
  end
  else if Pos('MAIL FROM', AnsiUpperCase(buf)) > 0 then
  begin
    FStatus := sMailFrom;
    Synchronize(DoChangeStatus);
  end
  else if Pos('RCPT TO', AnsiUpperCase(buf)) > 0 then
  begin
    FStatus := sMailTo;
    Synchronize(DoChangeStatus);
  end
  else if buf = '.' then
  begin
    FStatus := sLogOut;
    Synchronize(DoChangeStatus);
  end;
end;

procedure TSendEmail.OnStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: string);
begin
  if FSendData then
  begin
    if (Reason = HR_WriteCount) and (StrToIntDef(Value, 0) > 10) then
    begin
      FPos := FPos + StrToIntDef(Value, 0);
      Synchronize(DoProgress);
    end;
  end;
end;

function TSendEmail.Send: Boolean;
var
  SMTPSend: TSMTPSend;
  MimeMsg: TMimeMess;
  MIMEPart, MIMEFile: TMimePart;
  i: Integer;
begin
  Result := True;
  SMTPSend := TSMTPSend.Create;
  MimeMsg := TMimeMess.Create;
  try
    FSendData := False;
    SMTPSend.Sock.OnStatus := OnStatus;
    SMTPSend.Sock.OnMonitor := OnMonitor;

    FStatus := sCreatingEmail;
    Synchronize(DoChangeStatus);

    MimeMsg.Header.From := FEmail.Account.FromName + ' <' + FEmail.Account.FromAddress + '>';
    MimeMsg.Header.ToList.Assign(FEmail.Ct);
    MimeMsg.Header.CCList.Assign(FEmail.Cc);
    MimeMsg.Header.Subject := FEmail.Subject;
    MimeMsg.Header.Organization := FEmail.Account.Organisation;
    MimeMsg.Header.Date := Now;
    MimeMsg.Header.XMailer := 'Misiekd';
    MimeMsg.Header.CharsetCode := FEmail.Encode;
    MimeMsg.Header.ReplyTo := FEmail.Account.ReplyToName + ' <' + FEmail.Account.ReplyToAddress + '>';

    MIMEPart := MimeMsg.AddPartMultipart('mixed', nil);

    MimeMsg.AddPartText(FEmail.Body, MIMEPart);
    for i := 0 to FEmail.AttachmentList.Count - 1 do
    begin
      MIMEFile := MimeMsg.AddPartBinary(FEmail.AttachmentList[i], FEmail.AttachmentList[i].AttachmentName, MIMEPart);
      MIMEFile.EncodingCode := ME_BASE64;
    end;
    MimeMsg.EncodeMessage;
    SMTPSend.TargetHost := FEmail.Account.Host;
    SMTPSend.TargetPort := IntToStr(FEmail.Account.Port);
    SMTPSend.UserName := FEmail.Account.UserName;
    SMTPSend.Password := FEmail.Account.UserPass;
    SMTPSend.AutoTLS := True;
    if SMTPSend.Login then
    begin
      if SMTPSend.AuthDone then
      begin
        SMTPSend.MailFrom(FEmail.Account.UserName + '@' + FEmail.Account.Host, Length(MimeMsg.Lines.Text));
        for i := 0 to FEmail.Ct.Count - 1 do
          SMTPSend.MailTo(GetEmailAddr(FEmail.Ct[i]));
        for i := 0 to FEmail.Cc.Count - 1 do
          SMTPSend.MailTo(GetEmailAddr(FEmail.Cc[i]));
        for i := 0 to FEmail.Bcc.Count - 1 do
          SMTPSend.MailTo(GetEmailAddr(FEmail.Bcc[i]));

        FCount := Length(MimeMsg.Lines.Text);
        if SMTPSend.MailData(MimeMsg.Lines) then
          SMTPSend.Logout
        else begin
          FError := sErrSendData;
          Result := False;
        end;
      end
      else begin
        FError := sErrSendAuth;
        Result := False;
      end;
    end
    else begin
      FError := sErrLogin;
      Result := False;
    end;
  finally
    FreeAndNil(MimeMsg);
    FreeAndNil(SMTPSend);
  end;
end;

end.

TEmail to klasa przechowująca dane maila - do kogo, temat, treść, załączniki itp

OnSendingData wywoływane raz po rozpocząciu wysyłania danych maila. Przekazuje czas rozpoczęcia wysyłania i ilość danych do wysłania
OnProgress wywoływane co jakiś czas (nie pamiętam dokładnie co ile) i przekazuje ile już wysłano
OnChangeStatus wywoływane przy zmianie statusu, np. rozpoczęcie wysyłania, logowanie, uwierzytelnianie, rozpoczęcie wysyłania maila, zakończenie, błąd
OnDone wywoływane po zakończeniu wysyłania