home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / phoenix / TDOnline.pas < prev   
Pascal/Delphi Source File  |  1998-12-04  |  30KB  |  923 lines
  1. {*****************************************************************************
  2.  *
  3.  *  TDOnline.pas - Online Thread  (28-January-1999)
  4.  *
  5.  *  Copyright (c) 1998-99 Michael Haller
  6.  *
  7.  *  Author:     Michael Haller
  8.  *  E-mail:     michael@discountdrive.com
  9.  *  Homepage:   http://www.discountdrive.com/sunrise/
  10.  *
  11.  *  This program is free software; you can redistribute it and/or
  12.  *  modify it under the terms of the GNU General Public License
  13.  *  as published by the Free Software Foundation;
  14.  *
  15.  *  This program is distributed in the hope that it will be useful,
  16.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.  *  GNU General Public License for more details.
  19.  *
  20.  *  You should have received a copy of the GNU General Public License
  21.  *  along with this program; if not, write to the Free Software
  22.  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  23.  *
  24.  *----------------------------------------------------------------------------
  25.  *
  26.  *  Revision history:
  27.  *
  28.  *     DATE     REV                 DESCRIPTION
  29.  *  ----------- --- ----------------------------------------------------------
  30.  *
  31.  *****************************************************************************}
  32.  
  33. unit TDOnline;
  34.  
  35. interface
  36.  
  37. uses
  38.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  39.     PXStuff, Winsock, ParserSup, MailParser, ComCtrls, FMSelectMail, FileCtrl,
  40.     WinSocket;
  41.  
  42. {
  43.  After ending the OnlineThread there are more threads than before you started
  44.  it, because some methodes (like PlaySnd) create their own thread.
  45. }
  46.  
  47. type
  48.   TOnlineThread = class(TThread)
  49.   private
  50.     WinSocket: TWinSocket;
  51.     Server, Port, User, Pass, Sender, StandardDownload: String;
  52.     DeleteFilter, KeepFilter, AccPath, NodePtr: String;
  53.     SLItemCount, CDown, CDel: Integer;
  54.     SL: TStringList;
  55.     FErrorMsg, FDispMessage, FAnswerBuffer: String;
  56.     FStatus1, FStatus2, FCommand, FSLItem: String;
  57.     FCounterMax, FCounterPos, FOldCounterPos, FDummy1, FDummy2, FDummy3: Integer;
  58.     FProtFile: File;
  59.     FMailPrepared, FDummyBol: Boolean;
  60.     FFilename, FOldFilename, FPOPMailListItem: String;
  61.     procedure AddPOPMailToList;
  62.     procedure Wait;
  63.     procedure AskForPOPPassword;
  64.     function IsSMTPOK(S: String): String;
  65.     function IsPOPOK(S: String): String;
  66.     procedure FUpdateStatus;
  67.     procedure FGetLangString;
  68.     procedure FGetCommand;
  69.     procedure FShowError;
  70.     procedure FDisplayMessage;
  71.     procedure FSetCounter;
  72.     procedure FGetSLItem;
  73.     procedure FPrepareMailForSending;
  74.     procedure FGetPOPMailListItem;
  75.     procedure FAddSLItem;
  76.     procedure FParsePOPMailHeader;
  77.     procedure FUserChoosesPOPMail;
  78.     procedure FSavePOPNewMailToFolder;
  79.     procedure FAskToDeleteFromServer;
  80.     procedure FShowStatusMessage;
  81.     procedure OnWinSocketClose(Sender: TObject);
  82.     procedure OnWinSocketError(Sender: TObject; Msg: String);
  83.   protected
  84.     procedure Execute; override;
  85.   public
  86.     Name: String;
  87.     CommandCount: Integer;
  88.     procedure SetStatusString(Index: Integer; Status1, Status2: String);
  89.     function GetNextCommand: String;
  90.     function Aborted: Boolean;
  91.     function AddToLog(Typ: Byte; S: String): String;
  92.     function Receive: String;
  93.     procedure Send(S: String);
  94.     procedure ShowError(ErrorMsg: String);
  95.     procedure DisplayMessage(Msg: String);
  96.     procedure SetCounter(Pos: Integer);
  97.     function GetNextSLItem: String;
  98.     function PrepareMailForSending(Filename: String): Boolean;
  99.     procedure GetPOPMailListItem(Index: Integer; var Number, Download: Integer);
  100.     constructor Create;
  101.     destructor Destroy; override;
  102.   end;
  103.  
  104. var
  105.   OnlineThread: TOnlineThread;
  106.   Abort, UsingProtPOP3, UsingProtSMTP,
  107.   UsingProtocol: Boolean;
  108.   AvailableMailCount, FetchedMailCount, SendMailCount, OnlineCounter: Integer;
  109.  
  110. implementation
  111.  
  112. uses
  113.   Main, FMOnline;
  114.  
  115. var
  116.   F: Text;
  117.  
  118. // Begin Synchronized Methods //////////////////////////////////////////////////
  119.  
  120. procedure TOnlineThread.FUpdateStatus;
  121. //Shows the Status in the Statusbar
  122. begin
  123.   MainForm.Label5.Caption := Name+': '+FStatus1;
  124.   if MainForm.StatusBar1.Panels[3].Text = '' then MainForm.StatusBar1.Panels[3].Text := 'Dummy Text';
  125. end;
  126.  
  127. procedure TOnlineThread.FSetCounter;
  128. //Sets the counter in the Statusbar of MainForm
  129. begin
  130.   if FOldCounterPos = -1 then begin
  131.     MainForm.Label4.Caption := '';
  132.   end else begin
  133.     MainForm.Label4.Caption := Format(MainForm.ListBox1.Items[88], [IntToStr(FOldCounterPos)+'%', FormatByteText(FCounterMax)]);
  134.   end;
  135. end;
  136.  
  137. procedure TOnlineThread.FGetLangString;
  138. //Get Language String by Number from ListBox1
  139. begin
  140.   FStatus2 := MainForm.ListBox1.Items[StrToInt(FStatus2)];
  141. end;
  142.  
  143. procedure TOnlineThread.FGetCommand;
  144. //Get next command from OnlineForm.CommandList and sets CommandCount
  145. begin
  146.   if OnlineForm.CommandList.Count > 0 then begin
  147.     FCommand := OnlineForm.CommandList[0];
  148.     OnlineForm.CommandList.Delete(0);
  149.   end else FCommand := '';
  150.   CommandCount := OnlineForm.CommandList.Count;
  151. end;
  152.  
  153. procedure TOnlineThread.FGetSLItem;
  154. //Get the next item of the SL-StringList
  155. begin
  156.   if SL.Count > 0 then begin
  157.     FSLItem := SL[0];
  158.     SL.Delete(0);
  159.   end else FSLItem := '';
  160.   SLItemCount := SL.Count;
  161. end;
  162.  
  163. procedure TOnlineThread.FShowError;
  164. //Shows an error message and cleans up
  165. var
  166.   S: String;
  167.   pBuff: PChar;
  168.   I: Integer;
  169. begin
  170.   if Abort then Exit;
  171.   Abort := True;
  172.   try
  173.     AddToLog(1, FErrorMsg);
  174.     if UsingProtPOP3 or UsingProtSMTP then begin
  175.       if WinSocket.Socket <> INVALID_SOCKET then begin
  176.         S := 'QUIT'+#13+#10;
  177.         pBuff := StrAlloc(Length(S)+1);
  178.         StrPCopy(pBuff, S);
  179.         Winsock.Send(WinSocket.Socket, pBuff^, Length(S), 0);
  180.         StrDispose(pBuff);
  181.       end;
  182.       UsingProtPOP3 := False;
  183.       UsingProtSMTP := False;
  184.     end;
  185.     WinSocket.Close;
  186.     try WinSocket.Free; except end;
  187.     if FFilename = sWinTempFolder+'pxrecv' then
  188.       DeleteFile(FFilename) else RenameFile(FFilename, FOldFilename);
  189.     if UsingProtocol then begin
  190.       UsingProtocol := False;
  191.       try CloseFile(FProtFile); except end;
  192.     end;
  193.     OnlineForm.SetCancelOpportunitiesFalse;
  194.     OnlineForm.Label2.Caption := FErrorMsg;
  195.     OnlineForm.Label7.Caption := MainForm.ListBox1.Items[58];
  196.     OnlineForm.Button7.Enabled := bMakeProtocol;
  197.     OnlineForm.Notebook1.ActivePage := 'Error';
  198.     Screen.Cursor := crDefault;
  199.     if bDUNNormalQuit then MainForm.DialUp1.GoOffline;
  200.     PlaySound(sSoundFile2);
  201.     if not MainForm.Terminating then begin
  202.       MainForm.ShowPhoenixMail1Click(Self);
  203.       for I := 0 to 15 do Wait;
  204.       OnlineForm.ShowModal;
  205.     end;
  206.   except end;
  207.   FShowStatusMessage;
  208. end;
  209.  
  210. procedure TOnlineThread.FShowStatusMessage;
  211. //Shows the status. MUST be called at the end of the online session
  212. begin
  213.   OnlineForm.ShowStatusMessage;
  214. end;
  215.  
  216. procedure TOnlineThread.Wait;
  217. //Waits a time span (the application is not frozen)
  218. begin
  219.   Application.HandleMessage;
  220. end;
  221.  
  222. procedure TOnlineThread.FDisplayMessage;
  223. //Displays a message - for debugging use
  224. begin
  225.   MessageDlg(FDispMessage, mtInformation, [mbOK], 0);
  226. end;
  227.  
  228. procedure TOnlineThread.FPrepareMailForSending;
  229. //Parses the mail before it will be sent
  230. var
  231.   EMail: TEMail;
  232.   NewName: String;
  233.   I: Integer;
  234. begin
  235.   FMailPrepared := False;
  236.   SL.Clear;
  237.   FFilename := LowerCase(FFilename);
  238.   FOldFilename := FFilename;
  239.   if FileExists(FFilename) = False then Exit;
  240.   FCounterPos := 0;
  241.   FOldCounterPos := -2;
  242.   NewName := MakeValidDirName(ExtractFilePath(FFilename))+'sending';
  243.   if LowerCase(MainForm.ActualMailFile) = FFilename then Exit;
  244.   SetFileAttr(FFilename, False, True, False, False);
  245.   RenameFile(FFilename, NewName);
  246.   for I := 0 to MainForm.ListView1.Items.Count-1 do
  247.     if LowerCase(MainForm.ListView1.Items[I].SubItems[4]) = FFilename then begin
  248.       MainForm.ListView1.Items.BeginUpdate;
  249.       MainForm.ListView1.Items[I].Delete;
  250.       MainForm.ListView1.Items.EndUpdate;
  251.       MainForm.ListView1.Invalidate;
  252.       Application.ProcessMessages;
  253.       Break;
  254.     end;
  255.   FCounterMax := GetFileSize(NewName);
  256.   EMail := TEMail.Create;
  257.   EMail.ParseMail(NewName, True);
  258.   for I := 0 to EMail.ToReceiver.Count-1 do
  259.     SL.Add('<'+ExtractEMailAddress(EMail.ToReceiver.Strings[I])+'>');
  260.   for I := 0 to EMail.CC.Count-1 do
  261.     SL.Add('<'+ExtractEMailAddress(EMail.CC.Strings[I])+'>');
  262.   for I := 0 to EMail.BCC.Count-1 do
  263.     SL.Add('<'+ExtractEMailAddress(EMail.BCC.Strings[I])+'>');
  264.   SLItemCount := SL.Count;
  265.   EMail.Free;
  266.   FFilename := NewName;
  267.   FMailPrepared := True;
  268. end;
  269.  
  270. procedure TOnlineThread.AskForPOPPassword;
  271. //Asks user for POP3 password if it is undefined
  272. begin
  273.   if Pass = '' then begin
  274.     SetStatusString(-1, OnlineForm.Label16.Caption+'...', '');
  275.     OnlineForm.Notebook1.ActivePage := 'Password';
  276.     OnlineForm.ActiveControl := OnlineForm.Edit1;
  277.     OnlineForm.Edit1.Text := '';
  278.     OnlineForm.Caption := Name;
  279.     MainForm.ShowPhoenixMail1Click(Self);
  280.     if OnlineForm.ShowModal = mrOK then
  281.       Pass := OnlineForm.Edit1.Text
  282.     else
  283.       ShowError(MainForm.ListBox1.Items[82]);
  284.     OnlineForm.Caption := 'Phoenix Mail - '+MainForm.ListBox1.Items[36];
  285.   end;
  286. end;
  287.  
  288. procedure TOnlineThread.AddPOPMailToList;
  289. //Add mailheader to SelectMailForm.ListView
  290. var
  291.   Item: TListItem;
  292.   I, D1, D2: Integer;
  293. begin
  294.   if FPOPMailListItem = '' then begin
  295.     SelectMailForm.ListView1.Items.Clear;
  296.     SelectMailForm.Label8.Caption := Name;
  297.     Exit;
  298.   end;
  299.   try
  300.     D1 := StrToInt(GetToken(FPOPMailListItem));
  301.     D2 := StrToInt(GetToken(FPOPMailListItem));
  302.   except
  303.     Exit;
  304.   end;
  305.   Item := SelectMailForm.ListView1.Items.Add;
  306.   Item.ImageIndex := D1; // Msg Index
  307.   Item.StateIndex := StrToInt(StandardDownload);
  308.   I := D2+5;
  309.   Item.SubItems.Add('');
  310.   Item.SubItems.Add('');
  311.   Item.SubItems.Add(FormatByteText(I)); // Size of mail
  312.   Item.SubItems.Add('');
  313.   Item.SubItems.Add('');
  314.   Item.SubItems.Add('');
  315.   Item.SubItems.Add(IntToStr(I));
  316.   Inc(AvailableMailCount);
  317. end;
  318.  
  319. procedure TOnlineThread.FGetPOPMailListItem;
  320. //Get Item of SelectMailForm.ListView
  321. begin
  322.   FDummy2 := SelectMailForm.ListView1.Items[FDummy1].ImageIndex;
  323.   FDummy3 := SelectMailForm.ListView1.Items[FDummy1].StateIndex;
  324.   FCounterPos := 0;
  325.   FCounterMax := StrToInt(SelectMailForm.ListView1.Items[FDummy1].SubItems[6]);
  326.   FOldCounterPos := -2;
  327. end;
  328.  
  329. procedure TOnlineThread.FAddSLItem;
  330. //Add Item to the SL-StringList
  331. begin
  332.   SL.Add(FSLItem);
  333. end;
  334.  
  335. procedure TOnlineThread.FParsePOPMailHeader;
  336. //Apply filters to mail header
  337. var
  338.   EMail: TEMail;
  339.   Item: TListItem;
  340.   E, G: Integer;
  341. begin
  342.   if FDummy1 = -1 then begin SL.Clear; Exit; end;
  343.   EMail := TEMail.Create;
  344.   EMail.GetMailHeader(SL);
  345.   Item := SelectMailForm.ListView1.Items[FDummy1];
  346.   Item.SubItems[0] := EMail.Subject;
  347.   Item.SubItems[1] := EMail.From;
  348.   Item.SubItems[3] := DateToStr(EMail.ADate);
  349.   Item.SubItems[4] := TimeToStr(EMail.ATime);
  350.   Item.SubItems[5] := EMail.From+EMail.Subject+EMail.Keywords;
  351.   E := 0;   G := 0;
  352.   if DeleteFilter <> '' then ApplyFilter(Item.SubItems[5], DeleteFilter, E);
  353.   if KeepFilter <> '' then ApplyFilter(Item.SubItems[5], KeepFilter, G);
  354.   if (G > 0) or (E > 0) then
  355.     if G >= E then Item.StateIndex := 2 else Item.StateIndex := 1;
  356.   EMail.Free;
  357. end;
  358.  
  359. procedure TOnlineThread.FUserChoosesPOPMail;
  360. //Show SelectMailForm
  361. var
  362.   I: Integer;
  363. begin
  364.   SelectMailForm.ListView1.Resort;
  365.   if Aborted then Exit;
  366.   if bListMailsAtDownload then begin
  367.     PlaySound(sSoundFile1);
  368.     SetStatusString(-1, SelectMailForm.Caption, '');
  369.     MainForm.ShowPhoenixMail1Click(Self);
  370.     if SelectMailForm.ShowModal <> mrOK then begin
  371.       ShowError(MainForm.ListBox1.Items[82]);
  372.       Exit;
  373.     end;
  374.   end;
  375.   CDown := 0;  CDel := 0;
  376.   for I := 0 to SelectMailForm.ListView1.Items.Count-1 do begin
  377.     if SelectMailForm.ListView1.Items[I].StateIndex in [0,3] then Inc(CDown);
  378.     if SelectMailForm.ListView1.Items[I].StateIndex in [0,1] then Inc(CDel);
  379.   end;
  380. end;
  381.  
  382. procedure TOnlineThread.FSavePOPNewMailToFolder;
  383. //Copies the downloaded mail into folder and adds it (if available) to the MainForm.ListView1
  384. var
  385.   SL, PL: TStringList;
  386.   FL: TList;
  387.   AccountPath, FilterMsg, Result: String;
  388.   I, E, K: Integer;
  389.   Folder, Node: TTreeNode;
  390.   Item: TListItem;
  391.   EMail: TEMail;
  392.  
  393.   procedure GetSubNotes(Node: TTreeNode);
  394.   var
  395.     I, P: Integer;
  396.   begin
  397.     for I := 0 to Node.Count-1 do begin
  398.       if PFolderData(Node.Item[I].Data)^.Inbox then begin
  399.         ApplyFilter(FilterMsg, PFolderData(Node.Item[I].Data)^.Filter, P);
  400.         if P >= 0 then begin
  401.           SL.Add(PFolderData(Node.Item[I].Data)^.Path);
  402.           PL.Add(IntToStr(P));
  403.           FL.Add(Node.Item[I]);
  404.         end;
  405.       end;
  406.       if Node.Count > 0 then GetSubNotes(Node.Item[I]);
  407.     end;
  408.   end;
  409.  
  410. begin
  411.   Folder := nil;
  412.   if DirectoryExists(AccPath) then begin // Does the account still exist ;-)
  413.     Node := MainForm.GetActualAccount; //You never know...
  414.     for I := 0 to MainForm.TreeView1.Items.Count-1 do
  415.       if MainForm.TreeView1.Items[I].StateIndex = 1 then
  416.         if LowerCase(PAccountData(MainForm.TreeView1.Items[I].Data)^.Path) = LowerCase(AccPath) then
  417.           Node := MainForm.TreeView1.Items[I];
  418.     if Node = nil then Node := MainForm.RepositoryNode;
  419.     FilterMsg := SelectMailForm.ListView1.Items[FDummy1].SubItems[5];
  420.     SL := TStringList.Create;
  421.     PL := TStringList.Create;
  422.     FL := TList.Create;
  423.     AccountPath := PAccountData(Node.Data)^.Path;
  424.     GetSubNotes(Node);
  425.     K := -1; E := 0;
  426.     for I := 0 to PL.Count-1 do
  427.       if StrToInt(PL.Strings[I]) >= E then begin
  428.         E := StrToInt(PL.Strings[I]);
  429.         K := I;
  430.       end;
  431.     if K = -1 then begin
  432.       Result := AccountPath + GetUniqueMailName + '.msg';
  433.       Folder := Node;
  434.     end else begin
  435.       Result := SL.Strings[K] + GetUniqueMailName + '.msg';
  436.       Folder := FL[K];
  437.     end;
  438.     SL.Free; PL.Free; FL.Free;
  439.   end else begin
  440.     Result := sRepositoryFolder + GetUniqueMailName + '.msg';
  441.   end;
  442.   FileCopy(nil, FFilename, Result);
  443.   SetFileAttr(Result, False, False, False, False);
  444.   DeleteFile(FFilename);
  445.   // add listview item
  446.   if MainForm.TreeView1.Selected = Folder then begin
  447.     EMail := TEMail.Create;
  448.     EMail.ParseMail(Result, True);
  449.     MainForm.ListView1.Items.BeginUpdate;
  450.     Item := MainForm.ListView1.Items.Add;
  451.     MainForm.ListView1.Items.EndUpdate;
  452.     MainForm.ListView1.Invalidate;
  453.     Application.ProcessMessages;
  454.     Item.ImageIndex := -1;
  455.     if FileGetAttr(Result) and faArchive = 0 then begin
  456.       if (LowerCase(EMail.Priority) = 'low') then Item.ImageIndex := 9;
  457.       if (LowerCase(EMail.Priority) = 'normal') then Item.ImageIndex := 10;
  458.       if (LowerCase(EMail.Priority) = 'high') then Item.ImageIndex := 11;
  459.     end;
  460.     Item.SubItems.Add(EMail.Subject);
  461.     Item.SubItems.Add(EMail.From);
  462.     Item.SubItems.Add(DateToStr(EMail.ADate));
  463.     Item.SubItems.Add(TimeToStr(EMail.ATime));
  464.     Item.SubItems.Add(Result);
  465.     EMail.Free;
  466.   end;
  467.   SetPXTreeNodeName(Folder);
  468.   Inc(FetchedMailCount);
  469. end;
  470.  
  471. procedure TOnlineThread.FAskToDeleteFromServer;
  472. //Ask user if he wants to delete a message from the server
  473. var
  474.   S: String;
  475. begin
  476.   S := Format(MainForm.ListBox1.Items[89], [SelectMailForm.ListView1.Items[FDummy1].SubItems[0], SelectMailForm.ListView1.Items[FDummy1].SubItems[1]]);
  477.   if MessageDlg(S, mtWarning, [mbYes, mbNo], 0) = mrNo then FDummyBol := False;
  478. end;
  479.  
  480. // End Synchronized Methods ////////////////////////////////////////////////////
  481.  
  482. function TOnlineThread.PrepareMailForSending(Filename: String): Boolean;
  483. //Parses the mail before it will be sent
  484. begin
  485.   FFilename := Filename;
  486.   Synchronize(FPrepareMailForSending);
  487.   Result := FMailPrepared;
  488. end;
  489.  
  490. procedure TOnlineThread.SetCounter(Pos: Integer);
  491. //Sets the counter in the Statusbar of MainForm
  492. begin
  493.   if Pos = -1 then begin
  494.     FOldCounterPos := Pos;
  495.     Synchronize(FSetCounter);
  496.   end else begin
  497.     Inc(FCounterPos, Pos);
  498.     Pos := Round(100 / FCounterMax * FCounterPos);
  499.     if Pos <> FOldCounterPos then begin
  500.       FOldCounterPos := Pos;
  501.       Synchronize(FSetCounter);
  502.     end;
  503.   end;
  504. end;
  505.  
  506. procedure TOnlineThread.SetStatusString(Index: Integer; Status1, Status2: String);
  507. //Shows the status in the StatusBar
  508. var
  509.   T: String;
  510.   I: Integer;
  511. begin
  512.   FStatus1 := Status1;
  513.   if Index <> -1 then begin
  514.     FStatus2 := IntToStr(Index);
  515.     Synchronize(FGetLangString);
  516.     if Status1 <> '' then begin
  517.       if Status2 <> '' then FStatus1 := Format(FStatus2, [Status1, Status2])
  518.         else FStatus1 := Format(FStatus2, [Status1]);
  519.     end else FStatus1 := FStatus2;
  520.   end;
  521.   T := '';
  522.   FStatus1 := SkipChar(FStatus1, #10);
  523.   for I := 1 to Length(FStatus1) do
  524.     if FStatus1[I] = #13 then T := T + ' | ' else T := T + FStatus1[I];
  525.   FStatus1 := T;
  526.   Synchronize(FUpdateStatus);
  527. end;
  528.  
  529. function TOnlineThread.GetNextCommand: String;
  530. //Get next command from OnlineForm.CommandList
  531. begin
  532.   Synchronize(FGetCommand);
  533.   Result := FCommand;
  534. end;
  535.  
  536. function TOnlineThread.GetNextSLItem: String;
  537. //Get the next item of the SL-StringList
  538. begin
  539.   Synchronize(FGetSLItem);
  540.   Result := FSLItem;
  541. end;
  542.  
  543. function TOnlineThread.Aborted: Boolean;
  544. //True if Abort is True or if the Thread is terminated
  545. begin
  546.   Result := False;
  547.   if Terminated then Result := True;
  548.   if Abort then Result := True;
  549. end;
  550.  
  551. function TOnlineThread.AddToLog(Typ: Byte; S: String): String;
  552. //Adds string to protocol.txt
  553. var
  554.   T: String;
  555.   I: Integer;
  556. begin
  557.   T := ''; S := SkipChar(S, #10);
  558.   for I := 1 to Length(S) do if S[I] = #13 then T := T + ' | ' else T := T + S[I];
  559.   case Typ of
  560.     1: T := 'stat: ' + T + #13 + #10;
  561.     2: T := 'send: ' + T + #13 + #10;
  562.     3: T := 'recv: ' + T + #13 + #10;
  563.   end;
  564.   if UsingProtocol then try BlockWrite(FProtFile, T[1], Length(T)); except end;
  565.   Result := S;
  566. end;
  567.  
  568. procedure TOnlineThread.Send(S: String);
  569. //Sends a string to the web
  570. begin
  571.   if Aborted then Exit;
  572.   WinSocket.Send(S + #13 + #10);
  573. end;
  574.  
  575. function TOnlineThread.Receive: String;
  576. //Receives a string from the web
  577. var
  578.   I, K: Integer;
  579. begin
  580.   if Aborted then Exit;
  581.   repeat
  582.     K := Pos(#13, FAnswerBuffer);
  583.     I := Pos(#13+#10, FAnswerBuffer);
  584.     if Aborted then Exit;
  585.     if (I = 0) and (K = 0) then FAnswerBuffer := FAnswerBuffer + WinSocket.Receive;
  586.     //if (I <= 0) and (K <= 0) then Synchronize(Wait);
  587.   until ((I > 0) or (K > 0));
  588.   if (I > 0) then begin
  589.     Result := Copy(FAnswerBuffer, 1, I-1);
  590.     Delete(FAnswerBuffer, 1, I+1);
  591.   end;
  592.   if (I = 0) and (K > 0) then begin
  593.     Result := Copy(FAnswerBuffer, 1, K-1);
  594.     Delete(FAnswerBuffer, 1, K);
  595.   end;
  596. end;
  597.  
  598. procedure TOnlineThread.ShowError(ErrorMsg: String);
  599. //Shows an error message
  600. begin
  601.   if Abort then Exit;
  602.   FErrorMsg := ErrorMsg;
  603.   Synchronize(FShowError);
  604. end;
  605.  
  606. procedure TOnlineThread.DisplayMessage(Msg: STring);
  607. //Displays a message - for debugging use
  608. begin
  609.   FDispMessage := Msg;
  610.   Synchronize(FDisplayMessage);
  611. end;
  612.  
  613. function TOnlineThread.IsSMTPOK(S: String): String;
  614. //Is the SMTP command positive?
  615. var
  616.   I: Integer;
  617. begin
  618.   Result := S;
  619.   try
  620.     I := StrToInt(Copy(S, 1, 3));
  621.     if I >= 400 then if I <> 550 then ShowError('SMTP error '+S);
  622.   except end;
  623. end;
  624.  
  625. function TOnlineThread.IsPOPOK(S: String): String;
  626. //Is the POP3 command positive?
  627. begin
  628.   Result := S;
  629.   try if UpperCase(Copy(S, 1, 3)) <> '+OK' then ShowError(Copy(S, 5, Length(S)-4)); except end;
  630. end;
  631.  
  632. procedure TOnlineThread.GetPOPMailListItem(Index: Integer; var Number, Download: Integer);
  633. //Get Item of SelectMailForm.ListView
  634. begin
  635.   FDummy1 := Index;
  636.   Synchronize(FGetPOPMailListItem);
  637.   Number := FDummy2;
  638.   Download := FDummy3;
  639. end;
  640.  
  641. procedure TOnlineThread.OnWinSocketClose(Sender: TObject);
  642. var
  643.   S: String;
  644. begin
  645.   S := Format('Lost connection on socket %s', [IntToStr(WinSocket.Socket)]);
  646.   if UsingProtPOP3 or UsingProtSMTP then ShowError(S) else AddToLog(1, S);
  647. end;
  648.  
  649. procedure TOnlineThread.OnWinSocketError(Sender: TObject; Msg: String);
  650. begin
  651.   if Abort then Exit;
  652.   ShowError(Msg);
  653. end;
  654.  
  655. // Execute /////////////////////////////////////////////////////////////////////
  656.  
  657. procedure TOnlineThread.Execute;
  658. var
  659.   ProtType, S1, S2: String;
  660.   I, Count, Nb, Dt, CIndex: Integer;
  661.   B: Boolean;
  662. begin
  663.   try
  664.     while CommandCount > 0 do begin
  665.       ProtType := GetNextCommand;
  666.       Name := GetNextCommand;
  667.       Server := GetNextCommand;
  668.       Port := GetNextCommand;
  669.       User := GetNextCommand;
  670.       Pass := GetNextCommand;
  671.       Sender := GetNextCommand;
  672.       StandardDownload := GetNextCommand;
  673.       DeleteFilter := GetNextCommand;
  674.       KeepFilter := GetNextCommand;
  675.       AccPath := GetNextCommand;
  676.       NodePtr := GetNextCommand;
  677.       //Ask for POP3 password
  678.       if ProtType = 'POP3' then Synchronize(AskForPOPPassword);
  679.       if Aborted then Exit;
  680.       //Connect to server
  681.       WinSocket := TWinSocket.Create(Application);
  682.       WinSocket.Parent := OnlineForm;
  683.       WinSocket.OnError := OnWinSocketError;
  684.       WinSocket.OnClose := OnWinSocketClose;
  685.       WinSocket.BlockTime := 0;
  686.       WinSocket.Blocking := True;
  687.       WinSocket.PortName := Port;
  688.       WinSocket.HostName := Server;
  689.       WinSocket.Open;
  690.       if Aborted then Exit;
  691.       AddToLog(1, 'Connected to '+Server+' at port '+Port);
  692.       if ProtType = 'SMTP' then begin
  693.       // Simple Mail Transfer Protocol
  694.         UsingProtSMTP := True;
  695.         IsSMTPOK(AddToLog(3, Receive));
  696.         SetStatusString(71, '', '');
  697.         if Aborted then Exit;
  698.         Send(AddToLog(2, 'HELO '+GetLocalHostName));
  699.         if Aborted then Exit;
  700.         IsSMTPOK(AddToLog(3, Receive));
  701.         Count := StrToInt(GetNextCommand);
  702.         for I := 0 to Count-1 do begin
  703.           S1 := GetNextCommand;
  704.           if Aborted then Exit;
  705.           if PrepareMailForSending(S1) then begin
  706.             SetStatusString(72, '', '');
  707.             if Aborted then Exit;
  708.             Send(AddToLog(2, 'MAIL FROM:'+Sender));
  709.             if Aborted then Exit;
  710.             IsSMTPOK(AddToLog(3, Receive));
  711.             while SLItemCount > 0 do begin
  712.               if Aborted then Exit;
  713.               Send(AddToLog(2, 'RCPT TO:'+GetNextSLItem));
  714.               if Aborted then Exit;
  715.               IsSMTPOK(AddToLog(3, Receive));
  716.             end;
  717.             SetStatusString(73, '', '');
  718.             if Aborted then Exit;
  719.             Send(AddToLog(2, 'DATA'));
  720.             if Aborted then Exit;
  721.             IsSMTPOK(AddToLog(3, Receive));
  722.             if Abort then Exit;
  723.             AssignFile(F, FFilename);
  724.             Reset(F);
  725.             while not EoF(F) do begin
  726.               if Aborted then begin
  727.                 CloseFile(F); RenameFile(FFilename, FOldFilename); Exit;
  728.               end;
  729.               ReadLn(F, S2);
  730.               if S2 = '.' then S2 := '..';
  731.               Send(AddToLog(2, S2));
  732.               SetCounter(Length(S2)+2);
  733.             end;
  734.             SetCounter(-1);
  735.             try CloseFile(F); except end;
  736.             if Aborted then Exit;
  737.             Send(AddToLog(2, ''));
  738.             Send(AddToLog(2, '.'));
  739.             SetStatusString(74, '', '');
  740.             if Aborted then Exit;
  741.             IsSMTPOK(AddToLog(3, Receive));
  742.             if Aborted then Exit;
  743.             Inc(SendMailCount);
  744.             try
  745.               CopyFile(PChar(FFilename), PChar(sRepositoryFolder+ExtractFileName(FOldFilename)), False);
  746.               DeleteFile(PChar(FFilename));
  747.             except end;
  748.           end;
  749.         end;
  750.         SetStatusString(70, '', '');
  751.         if Aborted then Exit;
  752.         UsingProtSMTP := False;
  753.         Send(AddToLog(2, 'QUIT'));
  754.         IsSMTPOK(AddToLog(3, Receive));
  755.         WinSocket.Close;
  756.       end;
  757.  
  758.       if ProtType = 'POP3' then begin
  759.       // Post Office Protocol Vers. 3
  760.         UsingProtPOP3 := True;
  761.         SetStatusString(64, Server, '');
  762.         if Aborted then Exit;
  763.         IsPOPOK(AddToLog(3, Receive));
  764.         SetStatusString(65, '', '');
  765.         if Aborted then Exit;
  766.         Send(AddToLog(2, 'USER '+User));
  767.         if Aborted then Exit;
  768.         IsPOPOK(AddToLog(3, Receive));
  769.         if Aborted then Exit;
  770.         Send('PASS '+Pass);
  771.         AddToLog(2, 'PASS ********');
  772.         if Aborted then Exit;
  773.         IsPOPOK(AddToLog(3, Receive));
  774.         SetStatusString(66, '', '');
  775.         if Aborted then Exit;
  776.         //Clear Msg List
  777.         FPOPMailListItem := '';
  778.         Synchronize(AddPOPMailToList);
  779.         //List mails
  780.         Count := 0;
  781.         B := False;
  782.         if Aborted then Exit;
  783.         Send(AddToLog(2, 'LIST'));
  784.         if Aborted then Exit;
  785.         S1 := AddToLog(3, Receive);
  786.         if UpperCase(Copy(S1, 1, 3)) = '+OK' then B := True;
  787.         if B then begin
  788.           // Get Mail Count/Size
  789.           if Aborted then Exit;
  790.           S1 := AddToLog(3, Receive);
  791.           while  S1 <> '.' do begin
  792.             FPOPMailListItem := S1;
  793.             Inc(Count);
  794.             Synchronize(AddPOPMailToList);
  795.             if Aborted then Exit;
  796.             S1 := AddToLog(3, Receive);
  797.           end;
  798.           for I := 0 to Count-1 do begin
  799.             SetStatusString(67, IntToStr(I+1), IntToStr(Count));
  800.             GetPOPMailListItem(I, Nb, Dt);
  801.             if Aborted then Exit;
  802.             Send(AddToLog(2, 'TOP '+IntToStr(Nb)+' 0'));
  803.             if Aborted then Exit;
  804.             IsPOPOK(AddToLog(3, Receive));
  805.             if Aborted then Exit;
  806.             FDummy1 := -1;  Synchronize(FParsePOPMailHeader); // Clear StringList
  807.             S1 := AddToLog(3, Receive);
  808.             while  S1 <> '.' do begin
  809.               if S1 = '..' then S1 := '.';
  810.               FSLItem := S1;
  811.               Synchronize(FAddSLItem);
  812.               if Aborted then Exit;
  813.               S1 := AddToLog(3, Receive);
  814.             end;
  815.             FDummy1 := I;
  816.             Synchronize(FParsePOPMailHeader);
  817.           end;
  818.           if Count > 0 then Synchronize(FUserChoosesPOPMail);
  819.           if Aborted then Exit;
  820.           //Download Mail
  821.           CIndex := 1;
  822.           for I := 0 to Count-1 do begin
  823.             GetPOPMailListItem(I, Nb, Dt);
  824.             if Dt in [0, 3] then begin
  825.               SetStatusString(68, IntToStr(CIndex), IntToStr(CDown));
  826.               if Aborted then Exit;
  827.               Send(AddToLog(2, 'RETR '+IntToStr(Nb)));
  828.               if Aborted then Exit;
  829.               IsPOPOK(AddToLog(3, Receive));
  830.               FFilename := sWinTempFolder+'pxrecv';
  831.               if Aborted then Exit;
  832.               AssignFile(F, FFilename);
  833.               Rewrite(F);
  834.               S1 := AddToLog(3, Receive);
  835.               while  S1 <> '.' do begin
  836.                 if S1 = '..' then S1 := '.';
  837.                 WriteLn(F, S1);
  838.                 if Aborted then begin
  839.                   CloseFile(F);
  840.                   DeleteFile(S1);
  841.                   Exit;
  842.                 end;
  843.                 S1 := AddToLog(3, Receive);
  844.                 SetCounter(Length(S1));
  845.               end;
  846.               try CloseFile(F); except end;
  847.               SetCounter(-1);
  848.               FDummy1 := I;
  849.               Synchronize(FSavePOPNewMailToFolder);
  850.               Inc(CIndex);
  851.             end;
  852.           end;
  853.           // Delete mails
  854.           CIndex := 1;
  855.           for I := 0 to Count-1 do begin
  856.             GetPOPMailListItem(I, Nb, Dt);
  857.             if Dt in [0, 1] then begin
  858.               SetStatusString(69, IntToStr(CIndex), IntToStr(CDel));
  859.               FDummyBol := True;
  860.               FDummy1 := I;
  861.               if (Dt = 1) and (bAskForDelFromServer = True) then Synchronize(FAskToDeleteFromServer);
  862.               if FDummyBol then begin
  863.                 if Aborted then Exit;
  864.                 Send(AddToLog(2, 'DELE '+IntToStr(Nb)));
  865.                 if Aborted then Exit;
  866.                 IsPOPOK(AddToLog(3, Receive));
  867.               end;
  868.               Inc(CIndex);
  869.             end;
  870.           end;
  871.         end;
  872.         SetStatusString(70, '', '');
  873.         if Aborted then Exit;
  874.         UsingProtPOP3 := False;
  875.         Send(AddToLog(2, 'QUIT'));
  876.         IsPOPOK(AddToLog(3, Receive));
  877.         WinSocket.Close;
  878.       end;
  879.  
  880.     end; //end while commandcount > 0
  881.     UsingProtocol := False;
  882.     if UsingProtocol then try CloseFile(FProtFile); except end;
  883.   except
  884.     on Error: Exception do begin Exception.Create(Error.Message); Exit; end;
  885.   end;
  886.   WinSocket.Free;
  887.   Synchronize(FShowStatusMessage);
  888. end;
  889.  
  890. constructor TOnlineThread.Create;
  891. begin
  892.   Priority := tpNormal;
  893.   UsingProtPOP3 := False;
  894.   UsingProtSMTP := False;
  895.   UsingProtocol := False;
  896.   OnlineCounter := 0;
  897.   FAnswerBuffer := '';
  898.   SL := TStringList.Create;
  899.   if bMakeProtocol then begin
  900.     try
  901.       AssignFile(FProtFile, sProtocolFile);
  902.       Rewrite(FProtFile, 1);
  903.       UsingProtocol := True;
  904.     except end;
  905.   end;
  906.   AddToLog(1, sXMailer);
  907.   AddToLog(1, 'Session started on '+DateToStr(Date)+' '+TimeToStr(Time));
  908.   AddToLog(1, 'Winsock Description: '+GetWinsockDescription);
  909.   AddToLog(1, 'System Status: '+GetWinsockSystemStatus);
  910.   inherited Create(True);
  911. end;
  912.  
  913. destructor TOnlineThread.Destroy;
  914. begin
  915.   try SL.Free; except end;
  916.   inherited Destroy;
  917. end;
  918.  
  919. initialization
  920.   OnlineThread := nil;
  921.  
  922. end.
  923.