tasks.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2000-2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)

unit tasks;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, GPanel, Buttons, ImgList, VirtualTrees,
  ComCtrls, XPMenu, gnugettext, task, pop3, mimemess_siMail,
  mimepart, smtp, mmsystem, CoolTrayIcon, signatures, StrUtils, account, defFldrs,
  JvExControls, JvComponent, JvSpecialProgress;

type
  TfrmTasks = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    log: TRichEdit;
    errors: TMemo;
    lstTasks: TVirtualStringTree;
    cmdStopAfterThis: TBitBtn;
    cmdCancel: TBitBtn;
    lblATP: TLabel;
    lblCTP: TLabel;
    lblStatus: TLabel;
    BitBtn3: TBitBtn;
    tmrTaskCheck: TTimer;
    lblETA: TLabel;
    progr1: TJvSpecialProgress;
    progr2: TJvSpecialProgress;
    procedure lstTasksGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure FormCreate(Sender: TObject);
    procedure lstTasksGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure lstTasksGetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure tmrTaskCheckTimer(Sender: TObject);
    procedure cmdStopAfterThisClick(Sender: TObject);
  private
    { Private declarations }
    FTaskInProgress: Boolean;
    FlastNode: PVirtualNode;
    FcurrentTask: TBaseTask;
    FCancelTasks: Boolean;
    FtaskData: PTreeTask;
    FETA: Int64;
    FNewMessages: Integer;
    procedure taskStatus(Msg: String);
    procedure taskComm(Msg: String; err: Boolean);
    procedure taskProgress(size: Integer; sizeDescription: TsizeDescription);
    procedure taskMessage(msg: TStringList; param1: Integer; param2: Integer);
    procedure taskGetMessage(msgNo: Integer; var mime: TMimeMess);
    procedure taskDone();
    procedure taskGetSignature(signatureName: String; var signature: String);
    procedure messageBreakApart(mime_: TMimePart; var attachment: Boolean);
    procedure updateETA;
    function getStrFromAccountType(at: TAccountType): String;
    function getStrFromTaskType(tt: TTaskType): String;
    procedure loadTheme;
    procedure doTask;
    procedure afterFetch;
    procedure afterFetchHeaders;
    procedure afterPreview;
    procedure prepareTask;
  public
    { Public declarations }
    procedure ProcessTasks;
    procedure TaskAdd(const _accountID: Integer; _messageID: array of Integer;
      _taskType: TtaskType);
    procedure TaskClear;
    property TaskInProgress: Boolean read FTaskInProgress;
    procedure CreateParams(var Params: TCreateParams); override;
    function  HasAttachments(mime: TMimePart): Boolean;
  end;

var
  frmTasks: TfrmTasks;

implementation

uses fMain, mailBox, fPreview, maillist, fNotification, dImages, uThemes;

{$R *.dfm}

procedure TfrmTasks.ProcessTasks;
begin
  if FtaskInProgress then Exit;
  FlastNode := lstTasks.GetFirst; //get first task

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

  if FlastNode <> nil then begin
    prepareTask;
    FtaskInProgress := True;
    FCancelTasks := False;
    doTask;
    lstTasks.Repaint;
  end;
end;

procedure TfrmTasks.TaskAdd(const _accountID: Integer; _messageID: array of Integer;
  _taskType: TtaskType);
var i: Integer;
var Node: PVirtualNode;
begin
  Node := lstTasks.AddChild(nil);
  with PTreeTask(lstTasks.GetNodeData(Node))^ do begin
    accountID := _accountID;
    taskType := _taskType;
    status := tsWaiting;
    SetLength(messageID, Length(_messageID));
    for i := 0 to High(_messageID) do
      messageID[i] := _messageID[i];
    msgDoWhat := nil;
  end;
  //give priority to ttFetchFromPreview
  if _taskType = ttFetchFromPreview then begin
    if Node.PrevSibling <> FlastNode then
      lstTasks.MoveTo(Node, FlastNode, amInsertAfter, False);
  end;
end;


procedure TfrmTasks.lstTasksGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := sizeOf(TTreeTask);
end;

procedure TfrmTasks.TaskClear;
begin
  lstTasks.Clear;
  log.Lines.Clear;
  errors.Lines.Clear;
end;

procedure TfrmTasks.FormCreate(Sender: TObject);
begin
  FtaskInProgress := False;
  lblStatus.Caption := '';
  lblETA.Caption := '';
end;

procedure TfrmTasks.lstTasksGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
begin
    //return each column's text
  with PTreeTask((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    case Column of
      0:
      begin
        CellText := frmMailbox.Profile.Accounts[accountID].AccountName;
      end;
      1:
      begin
        CellText := GetStrFromAccountType(
          frmMailbox.Profile.Accounts[accountID].AccountType);
      end;
      2:
      begin
        CellText := GetStrFromTaskType(taskType);
      end;
    end;
  end;
end;

procedure TfrmTasks.TaskComm(Msg: String; err: Boolean);
const cSpace = '   ';
begin
  if err then begin

    errors.Lines.Add(_('The following error occured:'));
    errors.Lines.Add(cSpace + _('Time: ' + DateTimeToStr(Now)));
    errors.Lines.Add(cSpace +
      _('Server: ' + TAccount(FtaskData^.config).AccountName));
    errors.Lines.Add(cSpace + _('Connection type: ' +
      GetStrFromAccountType(TAccount(FtaskData^.config).AccountType)));
    errors.Lines.Add(cSpace + _('Task type: ' +
      getStrFromTaskType(FtaskData^.taskType)));
    errors.Lines.Add(' ' + _('Error message: ') + Msg);
    errors.Lines.Add('-----*****-----*****-----');
    errors.Lines.Add('');
  end
  else log.Lines.Add('< ' + Msg);
end;

procedure TfrmTasks.TaskStatus(Msg: String);
begin
  lblStatus.Caption := Msg;
  frmMain.dlProgress.Hint := Msg;
  log.Lines.Add('@ ' + Msg);
end;

procedure TfrmTasks.TaskProgress(size: Integer; sizeDescription: TsizeDescription);
begin
  case sizeDescription of
    tsdTotal:
    begin //set total dl/ul size
      progr2.Maximum := size;
      progr2.Position := 0;
      frmMain.dlProgress.Maximum := size;
      frmMain.dlProgress.Position := 0;
      FETA := GetTickCount;
    end;
    tsdMessage:
    begin //set current message dl/ul size
        //we don't know full size when sending more than one message
        //so we recalculate it each time
      if FtaskData.taskType = ttSend then
        progr2.Maximum := progr2.Maximum + size;

      progr1.Maximum := size;
      progr1.Position := 0;
      FETA := GetTickCount;
    end;
    tsdUpdate:
    begin //update both progress bars
      progr1.Position := progr1.Position + size;
      progr2.Position := progr2.Position + size;
      frmMain.dlProgress.Position := progr2.Position;
    end;
  end;
end;

procedure TfrmTasks.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;

procedure TfrmTasks.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    //CanClose:=FpopThrd.Done;
end;

procedure TfrmTasks.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
  if msg.CharCode = 27 then begin
    Self.Close;
    Handled := True;
  end;
end;

procedure TfrmTasks.lstTasksGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
begin
    //return correct folder image
  with PTreeTask((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    if (Kind in [ikNormal, ikSelected]) then begin
      case Column of
        0:
          ImageIndex := Integer(status);
      end;
    end;
  end;
end;

procedure TfrmTasks.cmdCancelClick(Sender: TObject);
begin
    //it tag = 1 then button caption is 'Close'
  if cmdCancel.Tag = 1 then
    Self.Close
  else FcurrentTask.Cancel; //cancel download/upload

end;

procedure TfrmTasks.TaskMessage(msg: TStringList; param1: Integer; param2: Integer);
var descr: TmsgDescription;
var mime: TMimeMess;
var mPrev: TTreePreview;
var at: Boolean;
var strm: TMemoryStream;
var i: Integer;
begin
  strm := TMemoryStream.Create;
  mime := TMimeMess.Create;
  mime.Lines.Assign(msg);
  mime.DecodeMessage;
  mime.Lines.SaveToStream(strm);

  case FtaskData.taskType of
    ttFetch, ttFetchFromPreview, ttSend:
    begin
      if param2 = 0 then begin //store message
        at := HasAttachments(mime.MessagePart);
        with descr do begin
          subject := UTF8Decode(mime.Header.Subject);
          if FtaskData.taskType <> ttSend then
            from := UTF8Decode(mime.Header.From)
          else begin
            for i := 0 to mime.Header.ToList.Count - 1 do begin
              from := from + ',' + UTF8Decode(mime.Header.ToList.Strings[i]);
            end;
            from := RightStr(from, Length(from) - 1);
          end;
          comment := '';
          msgPart := '';
          date := mime.Header.Date;
          size := Length(mime.Lines.text);
          priority := Integer(mime.Header.Priority) + 1;
          replyDate := 0;
          forwardDate := 0;
          markId := 0;
          forwardedTo := '';
          account := frmMailbox.Profile.Accounts[FtaskData.accountID].AccountName;
          if FtaskData.taskType <> ttSend then begin
            Inc(FNewMessages);
            if at then
              status := [msgAttachmentInside]
            else
              status := [];
            uidl := Tpop3Task(FcurrentTask).Uidl(param1); //param1 stores msg ID
                    //add message
            frmMailbox.Profile.Accounts[FtaskData.accountID].TotalMessageCount :=
              frmMailbox.Profile.Accounts[FtaskData.accountID].TotalMessageCount + 1;
            frmMailbox.Profile.Accounts[FtaskData.accountID].UnreadMessageCount :=
              frmMailbox.Profile.Accounts[FtaskData.accountID].UnreadMessageCount + 1;
            frmMailbox.Profile.Accounts[FtaskData.accountID].Mailboxes
              [Integer(mboxInbox) - 1].AddMessage(strm, descr);

          end
          else begin
            if at then
              status := [msgRead, msgAttachmentInside]
            else
              status := [msgRead];

            uidl := '';
                    //add message
                    //frmMailbox.Profile.Accounts[FtaskData.accountID].TotalMessageCount:=frmMailbox.Profile.Accounts[FtaskData.accountID].TotalMessageCount + 1;
            frmMailbox.Profile.Accounts[FtaskData.accountID].Mailboxes
              [Integer(mboxSent) - 1].AddMessage(strm, descr);
                    //we delete message from unsent mailbox when sent
            if (FtaskData.accountID = frmMailbox.SelectedAccount) and
              (Integer(mboxUnsent) - 1 = frmMailbox.SelectedMailbox) then
              frmMaillist.RemoveMessageWithInternalID(param1);
            frmMailbox.Profile.Accounts[FtaskData.accountID].Mailboxes
              [Integer(mboxUnsent) - 1].RemoveMessage(param1);
          end;
        end;
        frmMailbox.trMailbox.Refresh;
        //we add new item to list only if we are in currently selected mailbox
        //and the message come to mailbox in selected account
        if frmMailbox.SelectedAccount <> -1 then begin
          if frmMailbox.Profile.Accounts[frmMailbox.SelectedAccount].AccountName = descr.account then begin
            try
              case FtaskData.taskType of
              ttFetch, ttFetchFromPreview: begin
                  if frmMailbox.SelectedMailbox = Integer(mboxInbox) - 1 then
                    frmMailList.lstMailList.AddChild(nil);
              end;
              ttSend: begin
                if frmMailbox.SelectedMailbox = Integer(mboxSent) - 1 then
                  frmMailList.lstMailList.AddChild(nil);
              end
              end; //case
            finally
            end;
          end; //if
        end; //if
      end
      else if param2 = 1 then begin //add message to preview window
        with mPrev do begin
          accountID := FtaskData.accountID;