tasks.pas

siMail, siMail, siMail, siMail

          id := param1; //param1 is message No
          doWhat := tdwGetAndDelete;
          subject := UTF8Decode(mime.Header.Subject);
          from := UTF8Decode(mime.Header.From);
          size := progr1.Maximum;//contains message size
          date := mime.Header.Date;
        end;
        frmPreview.AddMessage(mPrev);
      end;
    end;
    ttFetchHeaders:
    begin
      with mPrev do begin
        accountID := FtaskData.accountID;
        id := param1; //param1 is message No
        doWhat := tdwGetAndDelete;
        subject := UTF8Decode(mime.Header.Subject);
        from := UTF8Decode(mime.Header.From);
        size := progr1.Maximum;//contains message size
        date := mime.Header.Date;
      end;
      frmPreview.AddMessage(mPrev);
    end;
  end;
  mime.Free;
  strm.Free;
end;

procedure TfrmTasks.FormShow(Sender: TObject);
begin

  //translate me
  TranslateComponent(Self);

  if TaskInProgress then begin
    cmdCancel.Caption := _('Cancel All');
    cmdCancel.Tag := 0; //means cmdCancel.Caption is 'Cancel all'
  end
  else PageControl1.TabIndex := 0;
  Self.Refresh;

  loadTheme;
  //read self position & size
  frmMailbox.Profile.Config.ReadControlSettings(Self);

end;

procedure TfrmTasks.FormHide(Sender: TObject);
begin
    //write self position & size
  frmMailbox.Profile.Config.WriteControlSettings(Self);

end;

function TfrmTasks.HasAttachments(mime: TMimePart): Boolean;
var attachment: Boolean;
begin
  attachment := False;
  MessageBreakApart(mime, attachment);
  Result := attachment;
end;

procedure TfrmTasks.MessageBreakApart(mime_: TMimePart; var attachment: Boolean);
var i: Integer;
var tmpStr: String;
var at: PVirtualNode;
begin
  if attachment then Exit;
  for i := 0 to mime_.GetSubPartCount - 1 do begin
    if mime_.GetSubPart(i).FileName <> '' then begin //attachment
      attachment := True;
      break;
    end
    else if mime_.GetSubPart(i).GetSubPartCount > 0 then begin
      MessageBreakApart(mime_.GetSubPart(i), attachment);
    end;
  end;
end;

procedure TfrmTasks.tmrTaskCheckTimer(Sender: TObject);
begin
  ProcessTasks;
  updateETA;
end;

procedure TfrmTasks.updateETA;
var hrs, min, sec, tmp: Integer;
var elapsed: Integer;
var percent: Double;
begin
  if FTaskInProgress and (progr1.Position <> 0) and
    (progr1.Position < progr1.Maximum) then begin
    elapsed := (GetTickCount - FETA) div 1000; //in seconds
    percent := 100 * (progr1.Position / progr1.Maximum);
    tmp := Trunc(elapsed * (100 / percent - 1));

    hrs := tmp div 3600;
    tmp := tmp mod 3600;
    min := tmp div 60;
    tmp := tmp mod 60;
    sec := tmp;
    lblETA.Caption := Format(_('ETA:%s:%s:%s'), [frmMain.AddLeadingZeroes(hrs, 2),
      frmMain.AddLeadingZeroes(min, 2), frmMain.AddLeadingZeroes(sec, 2)]);
    frmMain.dlProgress.Caption := '%d%% - [' + lblETA.Caption + ']';
  end
  else
    lblETA.Caption := '';

end;

procedure TfrmTasks.cmdStopAfterThisClick(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeTask;
begin
  Node := lstTasks.GetFirst; //get first task

  while Node <> nil do begin //go trough tasks
    nd := lstTasks.GetNodeData(Node);
    if nd.status = tsWaiting then
      nd.status := tsError;
    Node := lstTasks.GetNext(Node);
  end;
  lstTasks.Repaint;
end;

procedure TfrmTasks.taskGetMessage(msgNo: Integer; var mime: TMimeMess);
var msg: TMemoryStream;
begin
  msg := TMemoryStream(frmMailbox.Profile.Accounts[FtaskData.accountID].Mailboxes[
    Integer(mboxUnsent) - 1].GetMessageContent(msgNo));
  msg.Position := 0;

  mime.Lines.LoadFromStream(msg);
  msg.Free;
end;

procedure TfrmTasks.taskGetSignature(signatureName: String; var signature: String);
begin
  signature := frmMailbox.Profile.Signatures.Find(signatureName);
end;

function TfrmTasks.getStrFromAccountType(at: TAccountType): String;
begin
  case at of
    accPOP:
      Result := _('POP3');
    accIMAP:
      Result := _('IMAP');
    accHTML:
      Result := _('HTML');
  end;

end;

function TfrmTasks.getStrFromTaskType(tt: TTaskType): String;
begin
  case tt of
    ttSend:
      Result := _('Send messages');
    ttFetch, ttFetchFromPreview:
      Result := _('Fetch messages');
    ttFetchHeaders:
      Result := _('Fetch message headers');
  end;

end;

procedure TfrmTasks.loadTheme;
var f: TFont;
begin
  if frmMailbox.SelectedTheme < 0 then Exit;
  f := TFont.Create;
  lstThemes[frmmailbox.SelectedTheme].Tasks.Progress.Font.GetFont(f);
  progr1.Font.Assign(f);
  progr2.Font.Assign(f);
  FreeAndNil(f);
  progr1.StartColor := lstThemes[frmmailbox.SelectedTheme].Tasks.Progress.Color.GetStartColor;
  progr1.EndColor := lstThemes[frmmailbox.SelectedTheme].Tasks.Progress.Color.GetEndColor;
  progr2.StartColor := lstThemes[frmmailbox.SelectedTheme].Tasks.Progress.Color.GetStartColor;
  progr2.EndColor := lstThemes[frmmailbox.SelectedTheme].Tasks.Progress.Color.GetEndColor;
end;

procedure TfrmTasks.taskDone;
begin
  if FcurrentTask.NoErrors then FtaskData.status := tsComplete
  else FtaskData.status := tsError;

  case FtaskData.taskType of
  ttFetch: afterFetch;
  ttFetchHeaders: afterFetchHeaders;
  ttFetchFromPreview: afterPreview;
  end;

  FreeAndNil(FcurrentTask);

  while True do begin
    FlastNode := lstTasks.GetNext(FlastNode);
    if FlastNode = nil then Break;
    if PTreeTask(lstTasks.GetNodeData(FlastNode))^.status = tsWaiting then Break;
  end;
  lstTasks.Repaint;

  if FlastNode <> nil then begin
    prepareTask;
    doTask;
  end
  else begin
    FtaskInProgress := False;
    frmMain.dlProgress.Visible := False;
    if errors.Lines.Count = 0 then begin
      Self.Close;
      lstTasks.Clear;
      log.Clear;
    end
    else begin
      cmdCancel.Caption := _('Close');
      cmdCancel.Tag := 1; //means cmdCancel.Caption is 'Close'
      Self.Cursor := crDefault;
      PageControl1.ActivePageIndex := 2;
    end;
  end;
end;

procedure TfrmTasks.doTask;
var i, tmpInt: Integer;
var tmpDoWhat: array of TDoWhat;
begin
  case frmMailbox.Profile.Accounts[FtaskData.accountID].AccountType of
    accPOP:
    begin
      case FtaskData.taskType of
        ttFetch:
        begin //pop3
          FNewMessages := 0;
          frmPreview.Clear;
          FcurrentTask := Tpop3Task.Create;
          try
            with FcurrentTask do begin
              //status functions
              OnComm := TaskComm;
              OnStatus := TaskStatus;
              OnProgress := TaskProgress;
              OnMessage := TaskMessage;
              OnDone := taskDone;
              //execute
              FtaskData^.config := frmMailbox.Profile.Accounts[FtaskData.accountID];
              Execute(FtaskData^);
            end;
          finally
            //FreeAndNil(FcurrentTask);
          end;
        end;
        ttFetchHeaders:
        begin //pop3
          frmPreview.Clear;
          FcurrentTask := Tpop3Task.Create;
          try
            with FcurrentTask do begin
              //status functions
              OnComm := TaskComm;
              OnStatus := TaskStatus;
              OnProgress := TaskProgress;
              OnMessage := TaskMessage;
              OnDone := taskDone;
              //execute
              FtaskData^.config :=
                frmMailbox.Profile.Accounts[FtaskData.accountID];
              Execute(FtaskData^);
            end;
          finally
            //FreeAndNil(FcurrentTask);
          end;
        end;
        ttFetchFromPreview:
        begin
          //copy todo from preview window
          SetLength(tmpDoWhat, 1);
          i := frmPreview.MessagesDoWhat(tmpDoWhat, True);
          SetLength(FtaskData^.msgDoWhat, i);
          frmPreview.MessagesDoWhat(FtaskData^.msgDoWhat, False);
          FcurrentTask := Tpop3Task.Create;
          try
            with FcurrentTask do begin
              //status functions
              OnComm := TaskComm;
              OnStatus := TaskStatus;
              OnProgress := TaskProgress;
              OnMessage := TaskMessage;
              OnDone := taskDone;
              //execute
              FtaskData^.config :=
                frmMailbox.Profile.Accounts[FtaskData.accountID];
              Execute(FtaskData^);
            end;
          finally
            //FreeAndNil(FcurrentTask);
            //FtaskData^.msgDoWhat := nil; //free memory
          end;
        end;
        ttSend:
        begin //smtp
          frmPreview.Clear;
          FcurrentTask := TsmtpTask.Create;
          try
            with FcurrentTask do begin
              //status functions
              OnComm := TaskComm;
              OnStatus := TaskStatus;
              OnProgress := TaskProgress;
              OnMessage := TaskMessage;
              OnDone := taskDone;
              TsmtpTask(FcurrentTask).OnGetMessage := taskGetMessage;
              //execute
              FtaskData^.config :=
                frmMailbox.Profile.Accounts[FtaskData.accountID];
              Execute(FtaskData^);
            end;
          finally
            //FreeAndNil(FcurrentTask);
          end;
        end;
      end;
    end;
    accIMAP:
    begin
    end;
    accHTML:
    begin
    end;
  end;
end;

procedure TfrmTasks.afterFetch;
begin
  if frmPreview.MessageCount > 0 then begin
    frmPreview.Status :=
      Format(dngettext('plurals', '%d message found, total size %s',
      '%d messages found, total size %s', frmPreview.MessageCount),
      [frmPreview.MessageCount, frmMain.sizeToString(progr2.Maximum)]);
    frmPreview.ShowModal;
  end //show notification
  else if (FtaskData.status = tsComplete) and (FNewMessages > 0) then begin
    with frmMailbox.Profile.Accounts[FtaskData.accountID] do begin
      if NotificationNotify then begin
        if NotificationPlaySound then
          PlaySound(PChar(NotificationSoundFile), 0, SND_ASYNC);
          if NotificationDisplay then begin
            case NotificationType of
            ntBalloon:
              frmMain.tray.ShowBalloonHint(_('New message(s)'),
                Format(_('''%s'' has %d new messages.'),
                [frmMailbox.Profile.Accounts[
                FtaskData.accountID].AccountName, FNewMessages]), bitInfo, 10);
            ntWindow:
            begin
              frmNotification.lblMsg.Caption :=
                Format(_('''%s'' has %d new messages.'),
                [frmMailbox.Profile.Accounts[
                FtaskData.accountID].AccountName, FNewMessages]);
                frmNotification.ShowModal;
            end
          end;
        end;
      end;
    end;
  end;
end;

procedure TfrmTasks.afterFetchHeaders;
begin
  if frmPreview.MessageCount > 0 then begin
    frmPreview.Status :=
      Format(dngettext('plurals', '%d message found, total size %s',
      '%d messages found, total size %s', frmPreview.MessageCount),
      [frmPreview.MessageCount, frmMain.sizeToString(progr2.Maximum)]);
      frmPreview.ShowModal;
  end;
end;

procedure TfrmTasks.afterPreview;
begin
  FtaskData^.msgDoWhat := nil; //free memory
end;

procedure TfrmTasks.prepareTask;
begin
  FtaskData := lstTasks.GetNodeData(FlastNode);
  progr1.Position := 0;
  progr2.Position := 0;
  FETA := 0;
  if (FtaskData.status = tsWaiting) then begin
    frmMain.dlProgress.Visible := True;
    frmMain.dlProgress.Refresh;
    if Self.Cursor <> crHourGlass then
      Self.Cursor := crHourGlass;
    cmdCancel.Caption := _('Cancel All');
    cmdCancel.Tag := 0; //means cmdCancel.Caption is 'Cancel all'
    FtaskData.status := TtaskStatus(Integer(FtaskData.status) + 1);
    lstTasks.Repaint;
    Application.ProcessMessages;
  end;
end;

end.