pop3.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 pop3;

interface

uses Classes, Controls, SysUtils, gnugettext, WinTypes, task, account, Pop3Send,
  Forms, Dialogs, Windows, Messages, mimemess_siMail, SyncObjs, synautil, DateUtils;

const WM_PROGRESS = WM_USER + 1223;

type EPop3StatemachineFailed = class(Exception);

type Tpop3Thread = class(TThread)
  private
    Fpop3: TPop3Send;
    FHandle: HWND;
    Fcmd: string;
    FmessageNo: Integer;
    FSuccessful: Boolean;
    FtmrHandle: HWND;
    FoldDownload: Integer;
    FCancel: Boolean;
    FDoNotPost: Boolean; //this flag indicates that we should not post progress status
    procedure MessageHandler(var Msg: TMessage);
  public
    procedure Execute; override;
    constructor Create(const po3Comp: TPop3Send; WndHandle: HWND);
    destructor Destroy; override;
  published
    property Cmd: String read Fcmd write Fcmd;
    property MessageNo: Integer read FmessageNo write FmessageNo;
    property Successful: Boolean read FSuccessful;
    property Cancel: Boolean read FCancel write FCancel;

  end;

(*type TmimeThread = class(TThread)
  private
  public
    procedure Execute; override;
    constructor Create(const po3Comp: TPop3Send; WndHandle:HWND);
    destructor  Destroy; override;
  published
    property  Cmd:String read Fcmd write Fcmd;
    property  MessageNo:Integer read FmessageNo write FmessageNo;
    property  Successful:Boolean read FSuccessful;
    property  MsgHandle:HWND read FtmrHandle;
end;*)

type Tpop3Task = class(TBaseTask)
  private
    FPop3: TPop3Send;
    FHandle: HWND;       //window handle
    FThread: Tpop3Thread;
    FTask: TTreeTask;       //task descr
    FUidlList: TUidlList; //old uidls
    FDoWhat: TDoWhat; //current msg do what
    FServerUidlList: TStringList; //server msg uidls
    FDeletedCount: Integer; //no of deleted messages
    procedure CheckError(const Value: Boolean);
    procedure StartThread(const _cmd: String; msgNo: Integer);
    procedure MessageHandler(var Msg: TMessage);
    function MessageNextCmd(msgNo: Integer; currCmd: String): String;
    function PrepareForNextMessage(msgNo: Integer): Integer;
    procedure OnPOP3ThreadDone(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute(_task: TTreeTask); override;
    procedure Cancel; override;
    function Uidl(msgNo: Integer): String;
  published
  end;

implementation

uses blcksock;

{ Tpop3Thread }

constructor Tpop3Thread.Create(const po3Comp: TPop3Send; WndHandle: HWND);
begin
  Fpop3 := po3Comp;
  FHandle := WndHandle;
  FtmrHandle := AllocateHWnd(MessageHandler);
  inherited Create(True);
  FreeOnTerminate := True;
end;

destructor Tpop3Thread.Destroy;
begin
  DeallocateHWnd(FtmrHandle);
  FtmrHandle := 0;
  inherited Destroy;
end;

procedure Tpop3Thread.Execute;
///label start;
begin
  try
    TaskCriticalCancel.Acquire;
    Cancel := False;
    TaskCriticalCancel.Release;
    //just execute command
    //other things happen in main thread
    ///start:
    SetTimer(FtmrHandle, 0, 50, nil);
    //progress and cancelation check is performed on 50ms intervals

    FDoNotPost := True;
    if cmd = 'login' then begin
      FSuccessful := Fpop3.Login;
    end
    else if cmd = 'stat' then begin
      FSuccessful := Fpop3.Stat;
    end
    else if cmd = 'list' then begin
      FSuccessful := Fpop3.List(MessageNo);
    end
    else if cmd = 'uidl' then begin
      FSuccessful := Fpop3.Uidl(MessageNo);
    end
    else if cmd = 'dele' then begin
      FSuccessful := Fpop3.Dele(MessageNo);
    end
    else if cmd = 'retr' then begin
      FoldDownload := Fpop3.Sock.RecvCounter;
      FDoNotPost := False;
      FSuccessful := Fpop3.Retr(MessageNo);
      //update progress bar to show 100%
      PostMessage(FtmrHandle, WM_TIMER, 0, 0);
    end
    else if cmd = 'top' then begin
      FSuccessful := Fpop3.Top(MessageNo, 0);
      //update progress bar to show 100%
      PostMessage(FtmrHandle, WM_TIMER, Fpop3.ListSize, 0);
    end
    else if cmd = 'logout' then begin
      FSuccessful := Fpop3.Logout;
    end
    else begin
      FSuccessful := False;
      Fpop3.FullResult.Insert(0, '******|' + cmd + '|******');
    end;

    KillTimer(FtmrHandle, 0);
    FtmrHandle := 0;
  except
    on E: Exception do ShowMessage(E.Message);
  end;
end;

{ Tpop3Task }


procedure Tpop3Task.Cancel;
begin
  TaskCriticalCancel.Acquire;
  FThread.Cancel := True;
  TaskCriticalCancel.Release;
end;

//display last error communication msg
procedure Tpop3Task.CheckError(const Value: Boolean);
var msg: String;
begin
  if Value then begin
    if Assigned(OnComm) then OnComm(Fpop3.ResultString, False)
  end
  else begin
    msg := Fpop3.Sock.LastErrorDesc;
    if msg = '' then msg := Fpop3.ResultString;
    if msg = '' then msg := _('Unknown error.');
    if Assigned(OnComm) then OnComm(msg, True);
  end;
end;

constructor Tpop3Task.Create;
begin
  inherited;
  Fpop3 := TPop3Send.Create;
  FHandle := AllocateHWnd(MessageHandler);
  TaskCriticalCancel := TCriticalSection.Create;
  FServerUidlList := TStringList.Create;
end;

destructor Tpop3Task.Destroy;
begin
  DeallocateHWnd(FHandle);
  FHandle := 0;
  Fpop3.Free;
  TaskCriticalCancel.Free;
  FUidlList.Free;
  FServerUidlList.Free;
  inherited;
end;

//only login happens here other commands are executed in MessageHandler
procedure Tpop3Task.Execute(_task: TTreeTask);
begin
  NoErrors := False; //we set this to false at the end of procedure to true
  FTask := _task;
    //application then knows if there was error
  with Fpop3 do begin
    TargetHost := TAccount(FTask.config).POP3Server;
    Password := TAccount(FTask.config).POP3Password;
    TargetPort := IntToStr(TAccount(FTask.config).POP3Port);
    Username := TAccount(FTask.config).POP3UserName;
    Timeout := TAccount(FTask.config).POP3Timeout * 1000;
    Sock.MaxBandwidth := 512 * 1024; //512 kb/s
    case TAccount(FTask.config).POP3SecureConnection of
      scAutoTSL:
        AutoTLS := True;
      scSSL:
        FullSSL := True;
    end;
  end;

    //load UIDLs if file exists (uniquie message IDs)
  FUidlList := TUidlList.Create(TAccount(FTask.config).AccountPath);

  FDeletedCount := 0; //no of deleted messages
    //LOGIN
  if Assigned(OnStatus) then
    OnStatus(Format(_('Connecting ''%s''...'), [TAccount(FTask.config).AccountName]));
  StartThread('login', 0);

end;

procedure Tpop3Task.MessageHandler(var Msg: TMessage);
begin
  if Msg.Msg = WM_PROGRESS then begin
    if Assigned(OnProgress) then OnProgress(Msg.WParam, tsdUpdate);
    Msg.Result := 1;
  end;
end;

//prepares evertyhing to fetch,delete,... new message
//we do not need to remove any uidl from local list here,
//because all non existent uidls are removed before any actual fetch in MessageHandler procedure

function Tpop3Task.PrepareForNextMessage(msgNo: Integer): Integer;
var i: Integer;
var tmpUidl: TUidl;
begin

  if (msgNo < High(FTask.msgDoWhat)) or (msgNo < Fpop3.StatCount) then
    Inc(msgNo)
  else begin
    Result := -1;
    exit;
  end;

  if FTask.taskType = ttFetchFromPreview then begin
    FDoWhat := FTask.msgDoWhat[msgNo - 1];
    case FDoWhat of
      tdwGetAndLeave:
      begin //if we leave msg then add its uidl to list
        tmpUidl.ignore := False;
        tmpUidl.uidl := FServerUidlList.Strings[msgNo - 1];
            //IncomingLeaveMailDays = 0 means never delete
        if TAccount(FTask.config).IncomingLeaveMailDays > 0 then
          tmpUidl.deleteDate :=
            IncDay(Now, TAccount(FTask.config).IncomingLeaveMailDays)
        else //if never delete is set and than changed settin deleteDate to Now will delete it on next check
          tmpUidl.deleteDate := Now;
        if FUidlList.Find(tmpUidl.uidl) < 0 then
          FUidlList.Add(tmpUidl);
      end;
      tdwIgnore:
      begin
        tmpUidl.ignore := True;
        tmpUidl.uidl := FServerUidlList.Strings[msgNo - 1];
            //IncomingLeaveMailDays = 0 means never delete
        if TAccount(FTask.config).IncomingLeaveMailDays > 0 then
          tmpUidl.deleteDate :=
            IncDay(Now, TAccount(FTask.config).IncomingLeaveMailDays)
        else //if never delete is set and than changed settin deleteDate to Now will delete it on next check
          tmpUidl.deleteDate := Now;
        if FUidlList.Find(tmpUidl.uidl) < 0 then
          FUidlList.Add(tmpUidl);
      end
    end;
  end
  else if FTask.taskType = ttFetchHeaders then begin
    FDoWhat := tdwGetHeaders;
  end
  else begin
        //msg allready downloaded?
    i := FUidlList.Find(FServerUidlList.Strings[msgNo - 1]);
    if i >= 0 then begin //yes
            //we delete message on server if ignore is NOT set
      if (FUidlList.ShouldDelete(i) and not (FUidlList.Uidl[i].ignore)) then
        FDoWhat := tdwDelete
      else
        FDoWhat := tdwIgnore;
      if TAccount(FTask.config).IncomingLeaveMailDays = 0 then
        FDoWhat := tdwIgnore;
    end
    else begin //no
            //leave on server set?
      if TAccount(FTask.config).IncomingLeaveMail then begin //yes
        FDoWhat := tdwGetAndLeave;
        tmpUidl.ignore := False;
        tmpUidl.uidl := FServerUidlList.Strings[msgNo - 1];
                //IncomingLeaveMailDays = 0 means never delete
        if TAccount(FTask.config).IncomingLeaveMailDays > 0 then
          tmpUidl.deleteDate :=
            IncDay(Now, TAccount(FTask.config).IncomingLeaveMailDays)
        else //if never delete is set and than changed setting deleteDate to Now will delete it on next check
          tmpUidl.deleteDate := Now;

        if FUidlList.Find(tmpUidl.uidl) < 0 then