unit TDOnline;

interface

uses
  Windows, Messages, SysUtils, ShellAPI, Classes, Graphics, Controls, Forms, Dialogs,
  PXStuff, Winsock, ParserSup, MailParser, ComCtrls, FMSelectMail, FileCtrl,
  WinSocket, BASE64Sup;

{
 After ending the OnlineThread there are more threads than before you started
 it, because some methodes (like PlaySnd) create their own thread.
}

type
  TOnlineThread = class(TThread)
  private

    WinSocket: TWinSocket;
    Server, Port, User, Pass, Sender, StandardDownload: string;
    DeleteFilter, KeepFilter, AccPath, NodePtr: string;
    SLItemCount, CDown, CDel, ShowDownloadDialog: Integer; // AH19 --
    SL, Books: TStringList; //AH
    FErrorMsg, FDispMessage, FAnswerBuffer: string;
    FStatus1, FStatus2, FCommand, FSLItem: string;
    FCounterMax, FCounterPos, FOldCounterPos, FIconState, FDummy1, FDummy2, FDummy3:
    Integer; //AH11 Iconstate added...
    FProtFile: file;
    FMailPrepared, FDummyBol, FBCCED, FSocketConnection: Boolean; //AH16 added FBCCED
    FFilename, FOldFilename, FPOPMailListItem: string;
    procedure AddPOPMailToList;
    procedure Wait;
    procedure AskForPOPPassword;
    function IsSMTPOK(S: string): string;
    function IsPOPOK(S: string): string;
    procedure FUpdateStatus;
    procedure FGetLangString;
    procedure FGetCommand;
    procedure FShowError;
    procedure FDisplayMessage;
    procedure FSetCounter; // AH11
    procedure FSetIconState; //AH11
    procedure FGetSLItem;
    procedure FPrepareMailForSending;
    procedure FGetPOPMailListItem;
    procedure FAddSLItem;
    procedure FParsePOPMailHeader;
    procedure FUserChoosesPOPMail;
    procedure FSavePOPNewMailToFolder;
    procedure FAskToDeleteFromServer;
    procedure FShowStatusMessage;
    procedure OnWinSocketClose(Sender: TObject);
    procedure OnWinSocketError(Sender: TObject; Msg: string);
    procedure FRefreshNodes; //AH16
    function FReadAndFilter : boolean; // AH16
    function FReadNoFilter : Boolean; // AH16
    procedure FGetBooks; // AHRK113
    procedure FCheckReceivers(s : string; StringList : TStringList);
    procedure FSafeConnection;    
  protected
    procedure Execute; override;
  public
    Name: string;
    CommandCount: Integer;
    TrayStateIcon : TIcon;
    procedure SetStatusString(Index: Integer; Status1, Status2: string);
    function GetNextCommand: string;
    function Aborted: Boolean;
    function AddToLog(Typ: TLogTyp; S: string): string;
    function Receive: string;
    procedure Send(S: string);
    procedure ShowError(ErrorMsg: string);
    procedure DisplayMessage(Msg: string);
    procedure SetCounter(Pos: Integer);
    function GetNextSLItem: string;
    function PrepareMailForSending(Filename: string): Boolean;
    procedure GetPOPMailListItem(Index: Integer; var Number, Download: Integer);
    constructor Create;
    destructor Destroy; override;
  end;

var
  OnlineThread: TOnlineThread;
  Abort, UsingProtPOP3, UsingProtSMTP, UsingProtocol: Boolean;
  AvailableMailCount, FetchedMailCount, SendMailCount, OnlineCounter: Integer;

implementation

uses
  Main, FMOnline,ShowError;

var
  F: Text;

procedure TOnlineThread.FSafeConnection;
begin
  MainForm.SocketConnecting := FSocketConnection;
end;

procedure TOnlineThread.FCheckReceivers(s : string; StringList : TStringList);
begin
  // Can be used to validate e-mails too <g>.
  if Books.IndexOf(s + '.ssf') > -1 then
  begin
    // Do Book processing.
    AddBookToStringList(s, StringList);
  end
  else
  begin
     StringList.Add('<' + ExtractEMailAddress(s) + '>')
  end;
end;

procedure TOnLineThread.FGetBooks;
var
  SearchRec: TSearchRec;
  Found : Integer;
begin
  Books.Clear;
  Found := FindFirst(sAddressBookFolder + '*.ssf', faAnyFile, SearchRec);
  while Found = 0 do
  begin
    Books.Add(SearchRec.Name);
    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

// Begin Synchronized Methods //////////////////////////////////////////////////
procedure TOnlineThread.FUpdateStatus;
//Shows the Status in the Statusbar
begin
  FrmShowError.LblTitle.Caption:='正在连接到'+Name+'...';
  FrmShowError.LblDetail.Caption:=FStatus1;
  MainForm.Label5.Caption :=FStatus1;
  FrmShowError.ProgressBar1.Position:=FrmShowError.ProgressBar1.Position+30;
//  MainForm.Label5.Caption := Name + ': ' + FStatus1;
//  MainForm.StatusBar1.Panels[1].Text:= Name + ': ' + FStatus1;

end;

procedure TOnlineThread.FSetIconState;
begin
  case FIconState of
  0 : begin
         // Online Icon...
        StrPCopy(MainForm.NotifyIconData.szTip, 'SMAIL - Online');
        TrayStateIcon.Assign(MainForm.imgOnline.Picture.Icon);
        MainForm.NotifyIconData.hicon := TrayStateIcon.Handle;
       end;
  1 :  begin
         // SMTP icon...
        // AH11 Set TrayStateIcon
        StrPCopy(MainForm.NotifyIconData.szTip, 'SMAIL - SMTP');
        MainForm.imlStateIcons.GetIcon(0, TrayStateIcon);
        MainForm.NotifyIconData.hicon := TrayStateIcon.Handle;
       end;
  2 :  begin
         // POP3 icon...
        // AH11 Set State Icon...
        StrPCopy(MainForm.NotifyIconData.szTip, 'SMAIL - POP3');
        MainForm.imlStateIcons.GetIcon(1, TrayStateIcon);
        MainForm.NotifyIconData.hicon := TrayStateIcon.Handle;
       end;
  end;
end;

procedure TOnlineThread.FSetCounter;
//Sets the counter in the Statusbar of MainForm
var ic : integer;
begin
  if FOldCounterPos = -1 then begin
    MainForm.Label4.Caption := '';
  end
  else
  begin
    MainForm.Label4.Caption := Format(GetMessageString(88),
      [IntToStr(FOldCounterPos) + '%', FormatByteText(FCounterMax)]);

    StrPCopy(MainForm.NotifyIconData.szTip, MainForm.Label4.Caption);
    ic := FOldCounterPos div 5;
    MainForm.StatusBar1.Invalidate;

    if Odd(ic) then
    begin
      MainForm.NotifyIconData.hIcon := MainForm.TrayIcon;
    end
    else
    begin
      MainForm.NotifyIconData.hicon := TrayStateIcon.Handle;
    end;

    Shell_NotifyIcon(NIM_MODIFY, @MainForm.NotifyIconData);
    // END AH11
  end;
end;

procedure TOnlineThread.FGetLangString;
//Get Language String by Number from ListBox1
begin
  FStatus2 := GetMessageString(StrToInt(FStatus2));
end;

procedure TOnlineThread.FGetCommand;
//Get next command from OnlineForm.CommandList and sets CommandCount
begin
  if OnlineForm.CommandList.Count > 0 then begin
    FCommand := OnlineForm.CommandList[0];
    OnlineForm.CommandList.Delete(0);
  end
  else
    FCommand := '';
  CommandCount := OnlineForm.CommandList.Count;
end;

procedure TOnlineThread.FGetSLItem;
//Get the next item of the SL-StringList
begin
  if SL.Count > 0 then begin
    FSLItem := SL[0];
    SL.Delete(0);
  end
  else
    FSLItem := '';
  SLItemCount := SL.Count;
end;

procedure TOnlineThread.FShowError;
var
  S: string;
  pBuff: PChar;
  I: Integer;
  FrmShowError: TFrmShowError;
begin
  FrmShowError:= TFrmShowError.Create(nil);
  if Abort then
    Exit;
  Suspend;
  try
    Abort := True;
    try
      AddToLog(ltStatus, FErrorMsg);
      if UsingProtPOP3 or UsingProtSMTP then begin
        if WinSocket.Socket <> INVALID_SOCKET then begin
          S := 'QUIT' + CrLf;
          pBuff := StrAlloc(Length(S) + 1);
          StrPCopy(pBuff, S);
          Winsock.Send(WinSocket.Socket, pBuff^, Length(S), 0);
          StrDispose(pBuff);
        end;
        UsingProtPOP3 := False;
        UsingProtSMTP := False;
      end;
      WinSocket.Close;

      if FFilename = sWinTempFolder + 'pxrecv' then
        DeleteFile(FFilename)
      else
        RenameFile(FFilename, FOldFilename);
      if UsingProtocol then begin
        UsingProtocol := False;
        try
          CloseFile(FProtFile);
        except
        end;
      end;


      with OnlineForm do begin
        SetCancelOpportunitiesFalse;
        Label2.Caption := FErrorMsg;
//        LblTitle.Caption := '处理请求的任务时出错，请复查下列错误列表以获取详细信息。';
        Label7.Caption := GetMessageString(58);
        BtmDetail.Enabled := bMakeProtocol;
        Notebook1.ActivePage := 'Error';
        ProgressBar1.Position:=100;
        Caption:='SMAIL';
      end;
      FrmShowError.LblTitle.Visible:=false;
      FrmShowError.LblDetail.Visible:=false;
      FrmShowError.Label1.Visible:=true;
      FrmShowError.ProgressBar1.Position:=100;


      Screen.Cursor := crDefault;
      if bDUNNormalQuit then
        MainForm.DialUp1.GoOffline;
      PlaySound(sSoundFile2);

      if not MainForm.Terminating then begin
        for I := 0 to 15 do
          Wait;
//        OnlineForm.ShowModal;
        FrmShowError.ShowModal;
      end;
    except
    end;
    FShowStatusMessage;
  finally
    Resume;
  end;
end;

procedure TOnlineThread.FShowStatusMessage;
//Shows the status. MUST be called at the end of the online session
begin
  OnlineForm.ShowStatusMessage;
end;

procedure TOnlineThread.Wait;
//Waits a time span (the application is not frozen)
begin
  Application.HandleMessage;
end;

procedure TOnlineThread.FDisplayMessage;
//Displays a message - for debugging use
begin
  MessageDlg(FDispMessage, mtInformation, [mbOK], 0);
end;



procedure TOnlineThread.FPrepareMailForSending;
var
  EMail: TEMail;
  NewName: string;
  I: Integer;
begin
  FBCCED := False;
  FMailPrepared := False;
  SL.Clear;
  FFilename := LowerCase(FFilename);
  FOldFilename := FFilename;
  if FileExists(FFilename) = False then
    Exit;
  FCounterPos := 0;
  FOldCounterPos := -2;
  NewName := MakeValidDirName(ExtractFilePath(FFilename)) + 'sending';
  {AHRK80 if LowerCase(MainForm.ActualMailFile) = FFilename then
    Exit;}
  SetFileAttr(FFilename, False, True, False, False);
  RenameFile(FFilename, NewName);

  // AH17
  DeleteItemListView(ciFileName, FFileName);

  FCounterMax := GetFileSize(NewName);
  EMail := TEMail.Create;
  EMail.ParseMail(NewName, True);
  for I := 0 to EMail.ToReceiver.Count - 1 do
  begin
    //SL.Add('<' + ExtractEMailAddress(EMail.ToReceiver.Strings[I]) + '>')
    FCheckReceivers(EMail.ToReceiver.Strings[I], SL);
  end;
  for I := 0 to EMail.CC.Count - 1 do
  begin
    // SL.Add('<' + ExtractEMailAddress(EMail.CC.Strings[I]) + '>')
    FCheckReceivers(EMail.CC.Strings[I], SL);
  end;
  for I := 0 to EMail.BCC.Count - 1 do
  begin
    //SL.Add('<' + ExtractEMailAddress(EMail.BCC.Strings[I]) + '>')
    FCheckReceivers(EMail.BCC.Strings[I], SL);
  end;

  FBCCED := (EMail.BCC.Count > 0);

  SLItemCount := SL.Count;
  EMail.Free;
  FFilename := NewName;
  FMailPrepared := True;
end;

procedure TOnlineThread.AskForPOPPassword;
//Asks user for POP3 password if it is undefined
begin
  if Pass = '' then begin
    with OnlineForm do begin
 //     SetStatusString(-1, Label16.Caption + '...', '');
      Notebook1.ActivePage := 'Password';
      ActiveControl := Edit1;
      Edit1.Text := pass;
      Edit3.Text:=User;
      Caption :='登录-' +Server;
      Label11.Caption:=Server;
//      User    Server
      //MainForm.ShowPhoenixMail1Click(Self);
      if ShowModal = mrOK then
        Pass := Edit1.Text
      else
        ShowError(GetMessageString(82));
      Caption := 'SMAIL - ' + GetMessageString(36);
    end;
  end;
end;

procedure TOnlineThread.AddPOPMailToList;
//Add mailheader to SelectMailForm.ListView
var
  Item: TListItem;
  I, D1, D2: Integer;
begin
  if FPOPMailListItem = '' then begin
    SelectMailForm.ListView1.Items.Clear;
    SelectMailForm.Label8.Caption := Name;
    Exit;
  end;
  try
    D1 := StrToInt(GetToken(FPOPMailListItem));
    D2 := StrToInt(GetToken(FPOPMailListItem));
  except
    Exit;
  end;
  Item := SelectMailForm.ListView1.Items.Add;
  Item.ImageIndex := D1; // Msg Index
  Item.StateIndex := StrToInt(StandardDownload);
  I := D2 + 5;
  with Item.SubItems do begin
    Add('');
    Add('');
    Add(FormatByteText(I)); // Size of mail
    Add('');
    Add('');
    Add('');
    Add(IntToStr(I));
  end;
  Inc(AvailableMailCount);
end;

procedure TOnlineThread.FGetPOPMailListItem;
//Get Item of SelectMailForm.ListView
begin
  with SelectMailForm.ListView1.Items[FDummy1] do begin
    FDummy2 := ImageIndex;
    FDummy3 := StateIndex;
    FCounterPos := 0;
    FCounterMax := StrToInt(SubItems[6]);
    FOldCounterPos := -2;
  end;
end;

procedure TOnlineThread.FAddSLItem;
//Add Item to the SL-StringList
begin
  SL.Add(FSLItem);
end;

procedure TOnlineThread.FParsePOPMailHeader;
//Apply filters to mail header
var
  EMail: TEMail;
  Item: TListItem;
  E, G: Integer;
begin
  if FDummy1 = -1 then begin
    SL.Clear;
    Exit;
  end;
  EMail := TEMail.Create;
  EMail.GetMailHeader(SL);
  Item := SelectMailForm.ListView1.Items[FDummy1];
  Item.SubItems[0] := EMail.Subject;
  Item.SubItems[1] := EMail.From;
  Item.SubItems[3] := DateToStr(EMail.ADate) + ' ' + TimeToStr(EMail.ATime);
  Item.SubItems[5] := EMail.From + EMail.Subject + EMail.Keywords; // hidden
  E := 0;
  G := 0;
  if DeleteFilter <> '' then
    ApplyFilter(Item.SubItems[5], DeleteFilter, E);
  if KeepFilter <> '' then
    ApplyFilter(Item.SubItems[5], KeepFilter, G);
  if (G > 0) or (E > 0) then
    if G >= E then
      Item.StateIndex := 2
    else
      Item.StateIndex := 1;
  EMail.Free;
end;

procedure TOnlineThread.FUserChoosesPOPMail;
//Show SelectMailForm
var
  I: Integer;
begin
  SelectMailForm.ListView1.Resort;
  if Aborted then
    Exit;
  // AHRK20 Moved out of if branch
  PlaySound(sSoundFile1);
  // AH19  if bListMailsAtDownload then begin
  if ShowDownloadDialog = 1 then
  begin
    // AHRK20 PlaySound(sSoundFile1);
    SetStatusString(-1, SelectMailForm.Caption, '');
    //MainForm.ShowPhoenixMail1Click(Self);
    if SelectMailForm.ShowModal <> mrOK then begin
      ShowError(GetMessageString(82));
      Exit;
    end;
  end;
  CDown := 0;
  CDel := 0;
  with SelectMailForm.ListView1 do begin
    for I := 0 to Items.Count - 1 do begin
      if Items[I].StateIndex in [0, 3] then
        Inc(CDown);
      if Items[I].StateIndex in [0, 1] then
        Inc(CDel);
    end;
  end;
end;

procedure TOnlineThread.FSavePOPNewMailToFolder;
//Copies the downloaded mail into folder and adds it (if available) to the MainForm.ListView1
var
  SL, PL: TStringList;
  FL: TList;
  AccountPath, FilterMsg, Result: string;
  I, E, K: Integer;
  Folder, Node: TTreeNode;
  InboxFile,InBoxIndex,TempFile:File of byte;
  sFileName,sIndexName,stemp:string;
  tempTitle,tempDetail:string;
  iSize,iPosition:integer;
  Item : TListItem;
  procedure GetSubNotes(Node: TTreeNode);
  var
    I, P: Integer;
  begin
    for I := 0 to Node.Count - 1 do
    begin
      if not ((Node.Item[i].StateIndex=tnRepository) or (Node.Item[i].StateIndex=tnThrashBag)) then begin
      if PFolderData(Node.Item[I].Data)^.Inbox then
      begin
        ApplyFilter(FilterMsg, PFolderData(Node.Item[I].Data)^.Filter, P);
        if P >= 0 then
        begin
          SL.Add(PFolderData(Node.Item[I].Data)^.Path);
          PL.Add(IntToStr(P));
          FL.Add(Node.Item[I]);
          sFileName:=AccountPath+trim(PFolderData(Node.Item[I].Data)^.Name)+'.SML';
          sIndexName:=AccountPath+trim(PFolderData(Node.Item[I].Data)^.Name)+'.IND';
        end;
      end;
      end;

      if Node.Count > 0 then
        GetSubNotes(Node.Item[I]);
    end;
  end;

//DONE -omjg:receive Tthread
begin
  Folder := nil;
  if DirectoryExists(AccPath) then
  begin // Does the account still exist ;-)
    Node := MainForm.GetActualAccount; //You never know...
    for I := 0 to MainForm.TreeView1.Items.Count - 1 do
      if MainForm.TreeView1.Items[I].StateIndex = tnAccount then
        if CompareText(PAccountData(MainForm.TreeView1.Items[I].Data)^.Path, AccPath) = 0 then
          Node := MainForm.TreeView1.Items[I];


    if Node = nil then
      Node := RepositoryNode;
    FilterMsg := SelectMailForm.ListView1.Items[FDummy1].SubItems[5];
    SL := TStringList.Create;
    PL := TStringList.Create;
    FL := TList.Create;
    AccountPath := PAccountData(Node.Data)^.Path;
    GetSubNotes(Node);
    K := -1;
    E := -1;
    for I := 0 to PL.Count - 1 do
    begin
      if StrToInt(PL.Strings[I]) > E then
      begin
        E := StrToInt(PL.Strings[I]);
        K := I;
      end;
    end;

    if K = -1 then
    begin
      Result := AccountPath + GetUniqueMailName + '.msg';
      Folder := Node;
      AddToLog(7, AccountPath + ' points: ' + IntToStr(K));
    end
    else
    begin
      Result := SL.Strings[K] + GetUniqueMailName + '.msg';
      Folder := FL[K];
      AddToLog(7, SL.Strings[K] + ' points: ' + IntToStr(K));
    end;
    SL.Free;
    PL.Free;
    FL.Free;
  end
  else
  begin
    Result := sRepositoryFolder + GetUniqueMailName + '.msg'
  end;

//  FileCopy(nil, FFilename, Result);

  ////////////////////////////////////write into database///////////////
  CurrentEMail.Clear;
  CurrentEMail.ParseMail(FFilename,true);

  AssignFile(TempFile,FFilename);
  AssignFile(InboxFile,sFileName);
  AssignFile(InBoxIndex,sIndexName);
  if FileExists(sFileName) then Reset(InboxFile) else ReWrite(InboxFile);
  if FileExists(sIndexName) then Reset(InBoxIndex) else ReWrite(InBoxIndex);

  Seek(InboxFile,FileSize(InboxFile));
  BlockWrite(InboxFile,'****************',16);
  iPosition:=FilePos(InboxFile);

  Reset(TempFile);
  iSize:=FileSize(TempFile);
  buf:=StrAlloc(iSize);
  BlockRead(TempFile,buf^,iSize);
  BlockWrite(InboxFile,buf^,iSize);
  Seek(InBoxIndex,FileSize(InBoxIndex));



  IndexData.Index:=(FileSize(InBoxIndex) div sizeof(TIndexData))+1;
  IndexData.delete:=false;
  IndexData.Address:=CurrentEMail.ToReceiver[0];
  IndexData.Subject:=CurrentEMail.Subject;
  IndexData.SDate:=CurrentEMail.ADate;
  IndexData.STime:=CurrentEMail.ATime;
  IndexData.Priority:=CurrentEMail.Priority;
  IndexData.Read:=false;
  IndexData.Attach:=CurrentEMail.cntAttachments;
  IndexData.Position:=iPosition;
  IndexData.Size:=iSize;
  IndexData.Edit:=false;
  BlockWrite(InBoxIndex, IndexData,sizeof(TIndexData));
  CloseFile(InBoxIndex);
  CloseFile(InboxFile);
  CloseFile(TempFile);
  StrDispose(buf);
  ////////////////////////////////////write into database///////////////




  DeleteFile(FFilename);

 if MainForm.TreeView1.Selected = Folder then
  begin
//    AddItemListView(Result);
//=====================
    MainForm.ListView1.Items.BeginUpdate;
    Item := MainForm.ListView1.Items.Add;
    if IndexData.Read then Item.ImageIndex:=0 else  Item.ImageIndex:=1;
    if IndexData.edit then Item.ImageIndex := 2;
      with Item.SubItems do begin
        Add(IndexData.Subject);
        Add(IndexData.Address);
        Add(IndexData.Priority);
        Add(DateToStr(IndexData.SDate) + ' ' +
          TimeToStr(IndexData.STime));
        Add(FormatByteText(IndexData.Size));
        Add(IntTostr(IndexData.Attach));
        Add(inttostr(IndexData.Index)); // invisible
    end;
    MainForm.ListView1.EndUpdate;
    MainForm.ListView1.Invalidate;
 end;



  SetPXTreeNodeName(Folder);
  Inc(FetchedMailCount);
end;

//Ask user if he wants to delete a message from the server
procedure TOnlineThread.FAskToDeleteFromServer;
var
  S: string;
begin
  S := Format(GetMessageString(89),
    [SelectMailForm.ListView1.Items[FDummy1].SubItems[0],
    SelectMailForm.ListView1.Items[FDummy1].SubItems[1]]);
  if MessageDlg(S, mtWarning, [mbYes, mbNo], 0) = mrNo then
    FDummyBol := False;
end;
// End Synchronized Methods ////////////////////////////////////////////////////


//Parses the mail before it will be sent
//TODO -OMJG:important send mail
function TOnlineThread.PrepareMailForSending(Filename: string): Boolean;
var
  IndexData:TIndexData;
  FromF,TempIndexFile: file of byte;
  i: Integer;
  buf:array[1..2048] of Char;
  buf2:Pchar;
  NumRead, NumWritten: Integer;
  sPosition,sSize:int64;
  sTempIndexFile,sTempMailFile:string;
begin
  FFilename := Filename;
  Synchronize(FPrepareMailForSending);
  Result := FMailPrepared;

  //////////////////////////////////////////////////////////////
  sSize:=0;
  CurrentEMail.CompileMsgFileOnDisk(Filename);
  AssignFile(FromF,Filename);
  Reset(FromF);

  Dir := PAccountData(ActiveAccount.Data)^.Path;
  sTempIndexFile:=Dir+'已发送邮件'+'.IND';
  sTempMailFile:=Dir+'已发送邮件'+'.SML';

  AssignFile(TempMailFile,sTempMailFile);
  if FileExists(sTempMailFile) then Reset(TempMailFile) else ReWrite(TempMailFile);
  Seek(TempMailFile,FileSize(TempMailFile));

  //read the responding mail file and write to destination mail file
  BlockWrite(TempMailFile,'****************',16);
  sPosition:=FilePos(TempMailFile);
  repeat
    BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
    BlockWrite(TempMailFile, Buf, NumRead,NumWritten );
    sSize:=sSize+ NumWritten;
  until (NumRead = 0) or (NumWritten <> NumRead);
    CloseFile(FromF);
    CloseFile(TempMailFile);

  AssignFile(TempIndexFile,sTempIndexFile);
  if FileExists(sTempIndexFile) then Reset(TempIndexFile) else ReWrite(TempIndexFile);
  Seek(TempIndexFile,FileSize(TempIndexFile));

  IndexData.Index:=(FileSize(TempIndexFile) div sizeof(TIndexData))+1;
  IndexData.delete:=false;
  IndexData.Address:=CurrentEMail.ToReceiver[0];
  IndexData.Subject:=CurrentEMail.Subject;
  IndexData.SDate:=CurrentEMail.ADate;
  IndexData.STime:=CurrentEMail.ATime;
  IndexData.Priority:=CurrentEMail.Priority;
  IndexData.Read:=true;
  IndexData.Attach:=CurrentEMail.cntAttachments;
  IndexData.Position:=sPosition;
  IndexData.Size:=sSize;
  IndexData.Edit:=true;
  BlockWrite(TempIndexFile, IndexData,sizeof(TIndexData));
  CloseFile(TempIndexFile);


end;

//Sets the counter in the Statusbar of MainForm
procedure TOnlineThread.SetCounter(Pos: Integer);
begin
  if Pos = -1 then begin
    FOldCounterPos := Pos;
    Synchronize(FSetCounter);
  end
  else begin
    Inc(FCounterPos, Pos);
    Pos := Round(100 / FCounterMax * FCounterPos);
    if Pos <> FOldCounterPos then begin
      FOldCounterPos := Pos;
      Synchronize(FSetCounter);
    end;
  end;
end;

procedure TOnlineThread.SetStatusString(Index: Integer; Status1, Status2:
  string);
var
  T: string;
  I: Integer;
begin
  FStatus1 := Status1;
  if Index <> -1 then begin
    FStatus2 := IntToStr(Index);
    Synchronize(FGetLangString);
    if Status1 <> '' then begin
      if Status2 <> '' then
        FStatus1 := Format(FStatus2, [Status1, Status2])
      else
        FStatus1 := Format(FStatus2, [Status1]);
    end
    else
      FStatus1 := FStatus2;
  end;
  T := '';
  FStatus1 := SkipChar(FStatus1, #10);
  for I := 1 to Length(FStatus1) do
    if FStatus1[I] = #13 then
      T := T + ' | '
    else
      T := T + FStatus1[I];
  FStatus1 := T;
  Synchronize(FUpdateStatus);
end;

function TOnlineThread.GetNextCommand: string;
//Get next command from OnlineForm.CommandList
begin
  Synchronize(FGetCommand);
  Result := FCommand;
end;

function TOnlineThread.GetNextSLItem: string;
//Get the next item of the SL-StringList
begin
  Synchronize(FGetSLItem);
  Result := FSLItem;
end;

function TOnlineThread.Aborted: Boolean;
//True if Abort is True or if the Thread is terminated
begin
  Result := False;
  if Terminated then
    Result := True;
  if Abort then
    Result := True;
//  if Result then MainForm.UpdateTreeView1;
end;

function TOnlineThread.AddToLog(Typ: TLogTyp; S: string): string;
//Adds string to protocol.txt
var
  T: string;
  I: Integer;
begin
  T := '';
  S := SkipChar(S, #10);
  for I := 1 to Length(S) do
    if S[I] = #13 then
      T := T + ' | '
    else
      T := T + S[I];
  case Typ of
    1: T := 'stat: ' + T + CrLf;
    2: T := 'send: ' + T + CrLf;
    3: T := 'recv: ' + T + CrLf;
    else {TESTAH }
    begin
      T := 'oth.: ' + T + CrLf;
    end;  {TESTAH}
  end;
  if UsingProtocol then try
    BlockWrite(FProtFile, T[1], Length(T));
  except
  end;
  Result := S;
end;

procedure TOnlineThread.Send(S: string);
//Sends a string to the web
begin
  if Aborted then
    Exit;
  WinSocket.Send(S + CrLf);
end;

function TOnlineThread.Receive: string;
//Receives a string from the web
var
  I, K: Integer;
begin
  if Aborted then
    Exit;
  repeat
    K := Pos(#13, FAnswerBuffer);
    I := Pos(CrLf, FAnswerBuffer);
    if Aborted then
      Exit;
    if (I = 0) and (K = 0) then
      FAnswerBuffer := FAnswerBuffer + WinSocket.Receive;
    //if (I <= 0) and (K <= 0) then Synchronize(Wait);
  until ((I > 0) or (K > 0));
  if (I > 0) then begin
    Result := Copy(FAnswerBuffer, 1, I - 1);
    Delete(FAnswerBuffer, 1, I + 1);
  end;
  if (I = 0) and (K > 0) then begin
    Result := Copy(FAnswerBuffer, 1, K - 1);
    Delete(FAnswerBuffer, 1, K);
  end;
end;

procedure TOnlineThread.ShowError(ErrorMsg: string);
//Shows an error message
begin
  if Abort then Exit;
  FErrorMsg := ErrorMsg;
  Synchronize(FShowError);
end;

procedure TOnlineThread.DisplayMessage(Msg: string);
//Displays a message - for debugging use
begin
  FDispMessage := Msg;
  Synchronize(FDisplayMessage);
end;

function TOnlineThread.IsSMTPOK(S: string): string;
//Is the SMTP command positive?
var
  I: Integer;
begin
  Result := S;
  try
    I := StrToInt(Copy(S, 1, 3));
    if I >= 400 then
      if I <> 550 then
        ShowError('SMTP error ' + S);
  except
  end;
end;

function TOnlineThread.IsPOPOK(S: string): string;
//Is the POP3 command positive?
begin
  Result := S;
  try
    if CompareText(Copy(S, 1, 3), '+OK') <> 0 then
      ShowError(Copy(S, 5, Length(S) - 4));
  except
  end;
end;

procedure TOnlineThread.GetPOPMailListItem(Index: Integer; var Number, Download:
  Integer);
//Get Item of SelectMailForm.ListView
begin
  FDummy1 := Index;
  Synchronize(FGetPOPMailListItem);
  Number := FDummy2;
  Download := FDummy3;
end;

procedure TOnlineThread.OnWinSocketClose(Sender: TObject);
var
  S: string;
begin
  S := Format('Lost connection on socket %s', [IntToStr(WinSocket.Socket)]);
  if UsingProtPOP3 or UsingProtSMTP then
    ShowError(S)
  else
    AddToLog(ltStatus, S);
end;

procedure TOnlineThread.OnWinSocketError(Sender: TObject; Msg: string);
begin
  if Abort then
    Exit;
  ShowError(Msg);
end;
// AH16 -----------------------------


procedure TOnlineThread.FRefreshNodes;
var BarbaraPapaNode, BarbaraKidNode : TTreeNode;
begin
{  BarbaraPapaNode := TTreeNode(StrToInt(NodePtr));
  BarbaraKidNode := BarbaraPapaNode;
  BarbaraKidNode := WalkAccountChildren(BarbaraPapaNode,
    BarbaraKidNode, [tnFolder]);
  while BarbaraKidNode <> nil do
  begin
    if (PFolderData(BarbaraKidNode.Data)^.OutBox = true) or
      (PFolderData(BarbaraKidNode.Data)^.Drafts = true)  then
    begin
      SetPXTreeNodeName(BarbaraKidNode);
      if BarbaraKidNode.Selected then
        MainForm.TreeView1Change(Self, BarbaraKidNode);
    end;
    BarbaraKidNode := WalkAccountChildren(BarbaraPapaNode,
      BarbaraKidNode.GetNext, [tnFolder]);
  end;

  MainForm.UpdateRepository;
  if MainForm.TreeView1.Selected = RepositoryNode then
    MainForm.TreeView1Change(Self, RepositoryNode);}
end;

function TOnlineThread.FReadNoFilter : Boolean;
var s2 : string;
begin
  // For normal processing (speedier)...
  Result := False;
  AssignFile(F, FFilename);
  Reset(F);
  while not EoF(F) do begin
    if Aborted then begin
      CloseFile(F);
      RenameFile(FFilename, FOldFilename);
      Result := False;
      exit;
    end;
    ReadLn(F, S2);
    if S2 = '.' then
      S2 := '..';
    Send(AddToLog(ltSend, S2));
    SetCounter(Length(S2) + 2);
  end;
  SetCounter(-1);
  try
    CloseFile(F);
  except
  end;
  Result := True;
end;

function TOnlineThread.FReadAndFilter : boolean;
var Head, toe, s2 : string;
    StartHeader, FoundHeader : Boolean;
begin
  // For filtered processing: not so speedy
  Result := False;
  StartHeader := True;
  FoundHeader := False;
  AssignFile(F, FFilename);
  Reset(F);
  while not EoF(F) do
  begin
    if Aborted then
    begin
      CloseFile(F);
      RenameFile(FFilename, FOldFilename);
      Result := False;
      exit;
    end;

    ReadLn(F, S2);

    if S2 = '.' then
      S2 := '..';

    if (s2 = '') and startheader then
      StartHeader := false;

    if StartHeader then
    begin
      GetFieldArguments(s2, head, toe);
      if CompareText(head, 'bcc') = 0 then
        FoundHeader := True
      else
      begin
        if FoundHeader and (head = '') then
        begin
          FoundHeader := True;
        end
        else
        begin
          FoundHeader := False;
          Send(AddToLog(ltSend, S2));
          SetCounter(Length(s2) + 2);
        end;
      end;
    end
    else
    begin
      Send(AddToLog(ltSend, S2));
      SetCounter(Length(S2) + 2);
    end;
  end;

  SetCounter(-1);
  try
    CloseFile(F);
  except
  end;
  Result := True;
end;

// AH16 -----------------------------

// Execute /////////////////////////////////////////////////////////////////////

procedure TOnlineThread.Execute;
var
  ProtType, S1 : string; // S2 removed...
  I, Count, Nb, Dt, CIndex: Integer;
  B, AuthLogin: Boolean;
  AuthUserName, AuthPassword: string;

  procedure GetCommands;
  begin
    ProtType := GetNextCommand;
    Name := GetNextCommand;
    Server := GetNextCommand;
    Port := GetNextCommand;
    User := GetNextCommand;
    Pass := GetNextCommand;
    Sender := GetNextCommand;
    StandardDownload := GetNextCommand;
    DeleteFilter := GetNextCommand;
    KeepFilter := GetNextCommand;
    AccPath := GetNextCommand;
    NodePtr := GetNextCommand;
    // AHRK19 --
    ShowDownloadDialog := StrToIntDef(GetNextCommand, 0);
  end;

  procedure DoSMTPAuthLogin;
  begin
    // ---------------- no idea whether this is right or not ---------------
    {#ToDo2 SMTP Authenticate: Check whether this works or not!}
    //    Send(AddToLog(ltSend, 'AUTH EHLO'));
    // HHRK28 --- Bugfix for ESMPT
    Send(AddToLog(ltSend, 'EHLO ' + Server));
    if Aborted then
      Exit;
    IsSMTPOK(AddToLog(ltReceive, Receive));

    Send(AddToLog(ltSend, 'AUTH LOGIN'));
    if Aborted then
      Exit;
    IsSMTPOK(AddToLog(ltReceive, Receive));
    // HHRK28 --- Bugfix for ESMPT
    Send(AddToLog(ltSend, StringToBase64(AuthUserName)));
    if Aborted then
      Exit;
    IsSMTPOK(AddToLog(ltReceive, Receive));
    Send(StringToBase64(AuthPassword));
    AddToLog(ltSend, '********');
    if Aborted then
      Exit;
    IsSMTPOK(AddToLog(ltReceive, Receive));
  end;

  procedure DoConnect;
  begin
    //Connect to server
    // DBRK17
    // WinSocket := TWinSocket.Create(Application);

    with WinSocket do begin
      Parent := OnlineForm;
      OnError := OnWinSocketError;
      OnClose := OnWinSocketClose;
      BlockTime := 0;
      Blocking := True;
      PortName := Port;
      HostName := Server;
      Open;
    end;
  end;

begin
  while CommandCount > 0 do
  begin
    GetCommands;

    //Ask for POP3 password
    if ProtType = 'POP3' then
      Synchronize(AskForPOPPassword);
    if Aborted then
      Exit;

    // AH11 Set State Icon...
    FIconState := 0;
    Synchronize(FSetIconState);
    // End AH11
    if Aborted then exit;
    WinSocket := TWinSocket.Create(Application); //DBRK17
    try //DBRK17
      if Aborted then exit;
      FSocketConnection := True;
      Synchronize(FSafeConnection);
      DoConnect;
      FSocketConnection := False;
      Synchronize(FSafeConnection);
      if Aborted then
        Exit;
      if CompareText(ProtType, 'SMTP') = 0 then begin
        // -------------- Simple Mail Transfer Protocol ------------------------

        AddToLog(ltStatus, 'Connected to ' + Server + ' at port ' + Port);

        UsingProtSMTP := True;
        IsSMTPOK(AddToLog(ltReceive, Receive));
        SetStatusString(71, '', '');
        if Aborted then
          Exit;

        AuthLogin := (GetNextCommand = '1');
        AuthUserName := GetNextCommand;
        AuthPassword := GetNextCommand;
        if AuthLogin then begin
          DoSMTPAuthLogin;
          if Aborted then
            Exit;
        end;

        // AH11 Set TrayStateIcon SMTP (0)
        FIconState := 1;
        Synchronize(FSetIconState);
        // AH11 End
        Send(AddToLog(ltSend, 'HELO ' + GetLocalHostName));
        if Aborted then
          Exit;
        IsSMTPOK(AddToLog(ltReceive, Receive));

        Count := StrToInt(GetNextCommand);
        for I := 0 to Count - 1 do begin
          S1 := GetNextCommand;
          if Aborted then
            Exit;

            //TODO -omjg:send mail
          //===============================prepare for sending mail====================================//
          if PrepareMailForSending(S1) then begin

            SetStatusString(72, '', '');
            if Aborted then
              Exit;
            Send(AddToLog(ltSend, 'MAIL FROM:' + Sender));
            if Aborted then
              Exit;
            IsSMTPOK(AddToLog(ltReceive, Receive));
            while SLItemCount > 0 do begin
              if Aborted then
                Exit;
              Send(AddToLog(ltSend, 'RCPT TO:' + GetNextSLItem));
              if Aborted then
                Exit;
              IsSMTPOK(AddToLog(ltReceive, Receive));
            end;
            SetStatusString(73, '', '');
            if Aborted then
              Exit;
            Send(AddToLog(ltSend, 'DATA'));
            if Aborted then
              Exit;
            IsSMTPOK(AddToLog(ltReceive, Receive));
            if Abort then
              Exit;

            if FBCCED then
              B := FReadAndFilter
            else
              B := FReadNoFilter;

            if B = False then
              exit;

            Send(AddToLog(ltSend, ''));
            Send(AddToLog(ltSend, '.'));
            SetStatusString(74, '', '');
            if Aborted then
              Exit;
            IsSMTPOK(AddToLog(ltReceive, Receive));
            if Aborted then
              Exit;
            Inc(SendMailCount);
            DeleteFile(PChar(FFilename));
            DeleteFile(PChar(S1));
          end;
          //===============================prepare for sending mail====================================//

        end;
        SetStatusString(70, '', '');
        if Aborted then
          Exit;
        UsingProtSMTP := False;
        Send(AddToLog(ltSend, 'QUIT'));
        IsSMTPOK(AddToLog(ltReceive, Receive));
        WinSocket.Close;
        Synchronize(FRefreshNodes); // AH16.... Use NodePtr to find Account node
      end;

      if CompareText(ProtType, 'POP3') = 0 then begin
        // ------------------- Post Office Protocol Vers. 3 --------------------
        AddToLog(ltStatus, 'Connected to ' + Server + ' at port ' + Port);

        UsingProtPOP3 := True;
        SetStatusString(64, Server, '');
        if Aborted then
          Exit;
        IsPOPOK(AddToLog(ltReceive, Receive));
        SetStatusString(65, '', '');
        if Aborted then
          Exit;
        Send(AddToLog(ltSend, 'USER ' + User));
        if Aborted then
          Exit;
        IsPOPOK(AddToLog(ltReceive, Receive));
        if Aborted then
          Exit;
        Send('PASS ' + Pass);
        AddToLog(ltSend, 'PASS ********');
        if Aborted then
          Exit;
        IsPOPOK(AddToLog(ltReceive, Receive));
        SetStatusString(66, '', '');
        if Aborted then
          Exit;
        //Clear Msg List
        FPOPMailListItem := '';
        Synchronize(AddPOPMailToList);
        //List mails
        Count := 0;
        B := False;
        if Aborted then
          Exit;
        Send(AddToLog(ltSend, 'LIST'));
        if Aborted then
          Exit;

        // AH11 Set State Icon...
        FIconState := 2;
        Synchronize(FSetIconState);
        // End AH11

        S1 := AddToLog(ltReceive, Receive);
        if CompareText(Copy(S1, 1, 3), '+OK') = 0 then
          B := True;
        if B then begin
          // Get Mail Count/Size
          if Aborted then
            Exit;
          S1 := AddToLog(ltReceive, Receive);
          while S1 <> '.' do begin
            FPOPMailListItem := S1;
            Inc(Count);
            Synchronize(AddPOPMailToList);
            if Aborted then
              Exit;
            S1 := AddToLog(ltReceive, Receive);
          end;
          for I := 0 to Count - 1 do begin
            SetStatusString(67, IntToStr(I + 1), IntToStr(Count));
            GetPOPMailListItem(I, Nb, Dt);
            if Aborted then
              Exit;
            Send(AddToLog(ltSend, 'TOP ' + IntToStr(Nb) + ' 0'));
            if Aborted then
              Exit;
            IsPOPOK(AddToLog(ltReceive, Receive));
            if Aborted then
              Exit;
            FDummy1 := -1;
            Synchronize(FParsePOPMailHeader); // Clear StringList
            S1 := AddToLog(ltReceive, Receive);
            while S1 <> '.' do begin
              if S1 = '..' then
                S1 := '.';
              FSLItem := S1;
              Synchronize(FAddSLItem);
              if Aborted then
                Exit;
              S1 := AddToLog(ltReceive, Receive);
            end;
            FDummy1 := I;
            Synchronize(FParsePOPMailHeader);
          end;
          if Count > 0 then
            Synchronize(FUserChoosesPOPMail);
          if Aborted then
            Exit;

          //Download Mail
          CIndex := 1;
          for I := 0 to Count - 1 do begin
            GetPOPMailListItem(I, Nb, Dt);
            if Dt in [0, 3] then begin
              SetStatusString(68, IntToStr(CIndex), IntToStr(CDown));
              if Aborted then
                Exit;
              Send(AddToLog(ltSend, 'RETR ' + IntToStr(Nb)));
              if Aborted then
                Exit;
              IsPOPOK(AddToLog(ltReceive, Receive));
              FFilename := sWinTempFolder + 'pxrecv';
              if Aborted then
                Exit;
              AssignFile(F, FFilename);
              Rewrite(F);
              S1 := AddToLog(ltReceive, Receive);
              while S1 <> '.' do begin
                if S1 = '..' then
                  S1 := '.';
                WriteLn(F, S1);
                if Aborted then begin
                  CloseFile(F);
                  DeleteFile(S1);
                  Exit;
                end;
                S1 := AddToLog(ltReceive, Receive);
                SetCounter(Length(S1));
              end;
              // DBRK17 try
              CloseFile(F);

              // DBRK17 except
              // DBRK17 end;
              SetCounter(-1);
              FDummy1 := I;
              Synchronize(FSavePOPNewMailToFolder);
              Inc(CIndex);
            end;
          end;
          // Delete mails
          CIndex := 1;
          for I := 0 to Count - 1 do begin
            GetPOPMailListItem(I, Nb, Dt);
            if Dt in [0, 1] then begin
              SetStatusString(69, IntToStr(CIndex), IntToStr(CDel));
              FDummyBol := True;
              FDummy1 := I;
              if (Dt = 1) and (bAskForDelFromServer = True) then
                Synchronize(FAskToDeleteFromServer);
              if FDummyBol then begin
                if Aborted then
                  Exit;
                Send(AddToLog(ltSend, 'DELE ' + IntToStr(Nb)));
                if Aborted then
                  Exit;
                IsPOPOK(AddToLog(ltReceive, Receive));
              end;
              Inc(CIndex);
            end;
          end;
        end;
        SetStatusString(70, '', '');
        if Aborted then
          Exit;
        UsingProtPOP3 := False;
        Send(AddToLog(ltSend, 'QUIT'));
        IsPOPOK(AddToLog(ltReceive, Receive));
        WinSocket.Close;

      end;
    finally //DBRK17
      WinSocket.Free; //DBRK17
    end;//DBRK17
  end; //end while commandcount > 0

  UsingProtocol := False;
  if UsingProtocol then //DBRK17 try
    CloseFile(FProtFile);
  Synchronize(FShowStatusMessage);
  if MainForm.OnlineThreadTerminated then
  begin
    FrmShowError.Close;
//    isReceipt:=false;
    try
      CloseFile(FProtFile);
    except
    end;
//    closefile(FProtFile);
 end;
end;

constructor TOnlineThread.Create;
begin
  inherited Create(True); // AHRK95, Moved up...
  Priority := tpNormal;
  UsingProtPOP3 := False;
  UsingProtSMTP := False;
  UsingProtocol := False;
  OnlineCounter := 0;
  FAnswerBuffer := '';
  FSocketConnection := False;
  SL := TStringList.Create;
  Books := TStringList.Create;
  FGetBooks;
  TrayStateIcon := TIcon.Create;   // AH11
  if bMakeProtocol then begin
    try
      AssignFile(FProtFile, sProtocolFile);
      Rewrite(FProtFile, 1);
      UsingProtocol := True;
    except
    end;

  end;
  AddToLog(ltStatus, sXMailer);
  AddToLog(ltStatus, 'Session started on ' + DateToStr(Date) + ' ' + TimeToStr(Time));
  AddToLog(ltStatus, 'Winsock Description: ' + GetWinsockDescription);
  AddToLog(ltStatus, 'System Status: ' + GetWinsockSystemStatus);
end;

destructor TOnlineThread.Destroy;
begin
  try
    SL.Free;
    Books.Free;
    TrayStateIcon.Free; //AH11
  except
  end;
  inherited Destroy;
end;

initialization
  OnlineThread := nil;
end.

