home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / phoenix / PXStuff.pas < prev    next >
Pascal/Delphi Source File  |  1999-02-20  |  31KB  |  875 lines
  1. {*****************************************************************************
  2.  *
  3.  *  PXStuff.pas - Phoenix common routines (22-July-1998)
  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 PXStuff;
  34.  
  35. interface
  36.  
  37. uses
  38.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  39.   ComCtrls, FileCtrl, Base64sup, Registry, ShellAPI, ActiveX, ShlObj,
  40.   IniFiles, MMSystem, MailParser, Buttons;
  41.  
  42. type
  43.   PAccountData = ^TAccountData;
  44.   TAccountData = record
  45.     Path, Name: String;
  46.     FromMail, FromDesc, ReplyMail, ReplyDesc: String;
  47.     POPServer, POPPort, POPUser, POPPass: String;
  48.     SMTPServer, SMTPPort, KeepFilter, DeleteFilter: String;
  49.     Organization: String;
  50.     DoSMTP, DoPOP, StandardDownload, PromptPassword: Byte;
  51.   end;
  52.  
  53.   PFolderData = ^TFolderData;
  54.   TFolderData = record
  55.     Path, Name: String;
  56.     Filter: String;
  57.     Outbox, Inbox: Boolean;
  58.   end;
  59.  
  60. const
  61.   StandardMsgType: TMsgType = mtText;
  62.   crHandCursor = 5;
  63.   sRegKey = 'Software\Michael Haller\Phoenix Mail';
  64.   sMailerVer1 = '0.92.08 Standard Edition';
  65.   sMailerVer2 = '0.92.08 Developer Edition';
  66.   sInfoVersion = 'Version 0.92.08';
  67.   sVersion = '0.92';
  68.   sAppTitle = 'Phoenix Mail 0.92';
  69.   sMHHomepage = 'http://www.discountdrive.com/sunrise/';
  70.   sOfficeFontName = 'Tahoma';
  71.  
  72.   WM_TASKICON = WM_USER + 521;
  73.   WM_PREVINSTRUN = WM_USER + 522;
  74.   WM_GETFORMHANDLES = WM_USER + 523;
  75.   WM_SPELLCHECKFINISHED = WM_USER + 524;
  76.  
  77. var
  78.   CurrentEMail: TEMail;
  79.  
  80.   sTemporaryFolder: String;
  81.   sTempMessageFile: String;
  82.   sAccountRootFolder: String;
  83.   sSignatureFolder: String;
  84.   sRepositoryFolder: String;
  85.   sTrashFolder: String;
  86.   sProtocolFile: String;
  87.   sAddressBookFolder: String;
  88.   sLanguageFolder: String;
  89.   sTempLanguageFile: String;
  90.   sTempNewMessageFile: String;
  91.   sTempSpellCheckFile: String;
  92.   sSpellCheckerFile: String;
  93.   sSettingsFile: String;
  94.   sBannerDLLFileName: String;
  95.   sStandardAccountDataFile: String;
  96.   sWriteNewMessage1, sWriteNewMessage2: String;
  97.   sWinTempFolder: String;
  98.  
  99.   sVirusProg, sVirusParams, sLastFolder, sMessageFont: String;
  100.   bVirusMin, bSmallToolbarButtons: Boolean;
  101.   bMakeProtocol, bShowTips, bAskToGoOffline: Boolean;
  102.   bAskForDelFromServer, bFriendlyPrinter: Boolean;
  103.   bAskForLanguage, bGoOnlineAtStart, bStartAtWindowsStart: Boolean;
  104.   bScheduleC1, bScheduleC2, bScheduleC3, bScheduleC4, bScheduleC5: Boolean;
  105.   bCheckForStdEMail, bListMailsAtDownload, bOfficeFonts, bFlatButtons: Boolean;
  106.   sScheduleS2, sScheduleS3: String;
  107.   sLastAttSaveDir, sLastAttOpenDir, sLanguage, sCustAddressBook: String;
  108.   iActualTip, iFontSize, iFontColor, iMarkAsReadSec, iFontCharSet: Integer;
  109.   sDUNConnection, sDUNUsername, sDUNPassword, sToolbarBKBitmap: String;
  110.   bDUNAskForPassword, bDUNAutoQuit, bViewStatusAtEnd, bDUNNormalQuit: Boolean;
  111.   iDUNAutoQuitTime, sScheduleS1: Integer;
  112.   sSoundFile1, sSoundFile2, sSoundFile3, sToolbarButtons: String;
  113.   sAccountsCaption, sTrashBagCaption, sRepositoryCaption: String;
  114.   bShowCntInBrackets, bHideAnimations: Boolean;
  115.  
  116.   bLanguageLoaded: Boolean;
  117.   SaveMessage: Boolean;
  118.   sXMailer, sHomepage: String;
  119.  
  120.   ColorScheme, LowColor, bDrawBK: Boolean;
  121.   iColorDepth: Integer;
  122.  
  123. // general
  124. function BolToInt(B: Boolean): Byte;
  125. function BrowseForFolder(Title: String; StartMenu: Boolean): String;
  126. function FormatByteText(I: Integer): String;
  127. function FileCopy(Progress: TProgressBar; SourceName, DestName: String): String;
  128. procedure MoveTreeViewNode(const TreeView: TTreeView; Source, Target: TTreeNode);
  129. function MakeValidDirName(Dir: String): String;
  130. procedure CreateFolder(Dir: String);
  131. procedure MoveFolder(OldDir, NewDir: String);
  132. function GetParentFolder(Dir: String): String;
  133. procedure DeleteFolder(Dir, TrashFileFolder: String);
  134. function SetFileAttr(Filename: String; faReadOnly, faArchive, faHidden, faSystem: Boolean): Boolean;
  135. function HexToInt(S: String): Integer;
  136. function MHEncrypt(S: String): String;
  137. function MHDecrypt(S: String): String;
  138. procedure ClearFolder(S: String);
  139. function GetFileSize(Filename: String): Integer;
  140. procedure Set3DButtons(ThreeD: Boolean; Owner: TForm);
  141. procedure PlaySound(Filename: String);
  142. // more concrete
  143. function CheckVersion: Boolean;
  144. function CheckForPrevInstance: Boolean;
  145. procedure ClearUpCheckForPrevInstance;
  146. function CheckColorDepth: Boolean;
  147. function CheckCDROMStart: Boolean;
  148. procedure CheckForStandardEMailProgram;
  149. procedure InitializePX;
  150. procedure ClearUpPX;
  151.  
  152. implementation
  153.  
  154. {$R PXStuff.res}
  155.  
  156. uses
  157.   LangSup, FMLanguage, Main, FMStdMail, ParserSup;
  158.  
  159. var
  160.   Mutex: THandle;
  161.   TextFile: Text;
  162.  
  163. function GetFileSize(Filename: String): Integer;
  164. var
  165.   H: HFile;
  166. begin
  167.   Result := 0;
  168.   try
  169.     H := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0);
  170.     if H <> 0 then begin
  171.       Result := Windows.GetFileSize(H, nil);
  172.       CloseHandle(H);
  173.     end;
  174.     if Result < 0 then Result := 0;
  175.   except end;
  176. end;
  177.  
  178. function BolToInt(B: Boolean): Byte;
  179. begin
  180.   if B then Result := 1 else Result := 0;
  181. end;
  182.  
  183. function FormatByteText(I: Integer): String;
  184. var
  185.   R: Real;
  186. begin
  187.   Result := 'n.a.';
  188.   try
  189.     R := I / 1024;
  190.     if I = 0 then
  191.       Result := '0 Byte'
  192.     else
  193.       if I < 1048576 then
  194.         Result := FloatToStrF(R, ffNumber, 18, 1)+' KB'
  195.       else
  196.         if I < 1073741824 then begin
  197.           R := R / 1024;
  198.           I := Round(R);
  199.           if I < 10 then
  200.             Result := FloatToStrF(R, ffNumber, 18, 1)+' MB'
  201.           else
  202.             Result := IntToStr(I)+' MB';
  203.         end else begin
  204.           I := Round(R / 1024 / 1024);
  205.           Result := IntToStr(I)+' GB';
  206.         end;
  207.     if (Result[Length(Result)-3] = '0') and (Result[Length(Result)-4] = ',') then
  208.       Delete(Result, Length(Result)-4, 2);
  209.   except end;
  210. end;
  211.  
  212. function BrowseForFolder(Title: String; StartMenu: Boolean): String;
  213. var
  214.   BrowseInfo: TBrowseInfo;
  215.   pszName: array [0..MAX_PATH] of Char;
  216.   IDL: PITEMIDLIST;
  217. begin
  218.   Result := '';
  219.   try
  220.     if SHGetSpecialFolderLocation(Application.Handle, CSIDL_PROGRAMS, IDL)<> NOERROR then IDL := nil;
  221.     if not StartMenu then IDL := nil;
  222.     with BrowseInfo do begin
  223.       hwndOwner := Application.Handle;
  224.       pidlRoot := IDL;
  225.       pszDisplayName := @pszName;
  226.       lpszTitle := PChar(Title);
  227.       ulFlags := BIF_RETURNONLYFSDIRS;
  228.       lpfn := nil;
  229.     end;
  230.     IDL := SHBrowseForFolder(BrowseInfo);
  231.     if IDL <> nil then
  232.       if SHGetPathFromIDList(IDL, @pszName) then Result := MakeValidDirName(pszName);
  233.   except end;
  234. end;
  235.  
  236. function FileCopy(Progress: TProgressBar; SourceName, DestName: String): String;
  237. var
  238.   S, D: File;
  239.   Buffer: array[1..4096] of Byte;
  240.   Counter: Integer;
  241.   OrgFileMode: Byte;
  242.   Attributes: Cardinal;
  243. begin
  244.   Result := '';
  245.   Attributes := GetFileAttributes(PChar(SourceName));
  246.   try
  247.     OrgFileMode := FileMode;
  248.     FileMode := 0;
  249.     try
  250.       AssignFile(S, SourceName);
  251.       Reset(S, 1);
  252.       AssignFile(D, DestName);
  253.       Rewrite(D, 1);
  254.       while not EoF(S) do begin
  255.         BlockRead(S, Buffer, SizeOf(Buffer), Counter);
  256.         BlockWrite(D, Buffer, Counter);
  257.         if Assigned(Progress) then Progress.StepIt;
  258.         Application.ProcessMessages;
  259.       end;
  260.     finally
  261.       FileMode := OrgFileMode;
  262.       try
  263.         CloseFile(S);
  264.         CloseFile(D);
  265.       except end;
  266.     end;
  267.     SetFileAttributes(PChar(DestName), Attributes);
  268.   except
  269.     Result := 'An error occured while trying to copy '+SourceName+' to '+DestName+'!';
  270.   end;
  271. end;
  272.  
  273. procedure MoveTreeViewNode(const TreeView: TTreeView; Source, Target: TTreeNode);
  274. var
  275.   Data: PFolderData;
  276.   Node: TTreeNode;
  277.  
  278.   procedure CopySubNotes(Source, Target: TTreeNode);
  279.   var
  280.     I: Integer;
  281.     Node: TTreeNode;
  282.   begin
  283.     for I := 0 to Source.Count-1 do begin
  284.       Node := TreeView.Items.AddChild(Target, GetPXTreeNodeName(Source.Item[I]));
  285.       New(Data);
  286.       Data^.Path := PFolderData(Target.Data)^.Path+GetPXTreeNodeName(Source.Item[I])+'\';
  287.       //Data^.Path := PFolderData(Source.Item[I].Data)^.Path;
  288.       Data^.Name := PFolderData(Source.Item[I].Data)^.Name;
  289.       Data^.Filter := PFolderData(Source.Item[I].Data)^.Filter;
  290.       Data^.Inbox := PFolderData(Source.Item[I].Data)^.Inbox;
  291.       Data^.Outbox := PFolderData(Source.Item[I].Data)^.Outbox;
  292.       Node.Data := Data;
  293.       Node.ImageIndex := Source.Item[I].ImageIndex;
  294.       Node.StateIndex := Source.Item[I].StateIndex;
  295.       Node.SelectedIndex := Source.Item[I].SelectedIndex;
  296.       if Source.Count > 0 then CopySubNotes(Source.Item[I], Node);
  297.     end;
  298.   end;
  299.  
  300. begin
  301.   //TreeView1.Selected.MoveTo(Node, naAddChildFirst);
  302.   Node := TreeView.Items.AddChild(Target, GetPXTreeNodeName(Source));
  303.   New(Data);
  304.   Data^.Path := PFolderData(Source.Data)^.Path;
  305.   Data^.Name := PFolderData(Source.Data)^.Name;
  306.   Data^.Filter := PFolderData(Source.Data)^.Filter;
  307.   Data^.Inbox := PFolderData(Source.Data)^.Inbox;
  308.   Data^.Outbox := PFolderData(Source.Data)^.Outbox;
  309.   Node.Data := Data;
  310.   Node.ImageIndex := Source.ImageIndex;
  311.   Node.StateIndex := Source.StateIndex;
  312.   Node.SelectedIndex := Source.SelectedIndex;
  313.   CopySubNotes(Source, Node);
  314.   Source.Delete;
  315.   Node.Expand(True);
  316.   Node.Selected := True;
  317.   TreeView.AlphaSort;
  318. end;
  319.  
  320. function HexToInt(S: String): Integer;
  321. var
  322.   I, E, F, G: Integer;
  323.  
  324.   function DigitValue(C: Char): Integer;
  325.   begin
  326.     Result := 0;
  327.     try
  328.       case C of
  329.         'A': Result := 10;
  330.         'B': Result := 11;
  331.         'C': Result := 12;
  332.         'D': Result := 13;
  333.         'E': Result := 14;
  334.         'F': Result := 15;
  335.       else
  336.         Result := StrToInt(C);
  337.       end;
  338.     except end;
  339.   end;
  340.  
  341. begin
  342.   S := UpperCase(S);
  343.   if S[1] = '$' then Delete(S, 1, 1);
  344.   if S[2] = 'X' then Delete(S, 1, 2);
  345.   E := -1; Result := 0;
  346.   for I := Length(S) downto 1 do begin
  347.     G := 1; for F := 0 to E do G := G*16;
  348.     Result := Result+(DigitValue(S[I])*G);
  349.     Inc(E);
  350.   end;
  351. end;
  352.  
  353. function MHEncrypt(S: String): String;
  354. var
  355.   I: Integer;
  356.   T: String;
  357. begin
  358.   Result := '';
  359.   if S = '' then Exit;
  360.   T := IntToHex(Random(15)+1, 1);
  361.   T := T + IntToHex(Length(S), 2);
  362.   for I := 1 to Length(S) do
  363.     T := T + IntToHex(Ord(S[I]), 2);
  364.   for I := 1 to Random(8)+2 do
  365.     T := T + IntToHex(Random(256), 2);
  366.   T := T + IntToHex(Random(15)+1, 1);
  367.   S := '';
  368.   for I := 1 to (Length(T) div 2) do
  369.     S := S + Chr(HexToInt(T[I*2-1]+T[I*2]));
  370.   S := Chr(Random(26)+65) + StringToBase64(S);
  371.   Result := '';
  372.   for I := Length(S) downto 1 do
  373.     Result := Result + S[I];
  374. end;
  375.  
  376. function MHDecrypt(S: String): String;
  377. var
  378.   I, E: Integer;
  379.   T: String;
  380. begin
  381.   Result := '';
  382.   if S = '' then Exit;
  383.   T := '';
  384.   for I := Length(S) downto 1 do
  385.     T := T + S[I];
  386.   Delete(T, 1, 1);
  387.   S := Base64ToString(T);
  388.   T := '';
  389.   for I := 1 to Length(S) do
  390.     T := T + IntToHex(Ord(S[I]), 2);
  391.   E := HexToInt(T[2]+T[3]);
  392.   Delete(T, 1, 3);
  393.   S := '';
  394.   for I := 1 to E do
  395.     S := S + Chr(HexToInt(T[I*2-1]+T[I*2]));
  396.   Result := S;
  397. end;
  398.  
  399. function MakeValidDirName(Dir: String): String;
  400. begin
  401.   if Dir[Length(Dir)] <> '\' then Dir := Dir+'\';
  402.   Result := Dir;
  403. end;
  404.  
  405. procedure CreateFolder(Dir: String);
  406. begin
  407.   ForceDirectories(Dir);
  408.   if DirectoryExists(Dir) = False then begin
  409.     ShowMessage('Error creating folder '+Dir);
  410.     Halt;
  411.   end;
  412. end;
  413.  
  414. procedure MoveFolder(OldDir, NewDir: String);
  415. begin
  416.   if OldDir[Length(OldDir)] = '\' then Delete(OldDir, Length(OldDir), 1);
  417.   if NewDir[Length(NewDir)] = '\' then Delete(NewDir, Length(NewDir), 1);
  418.   RenameFile(OldDir, NewDir);
  419. end;
  420.  
  421. function GetParentFolder(Dir: String): String;
  422. var
  423.   I: Integer;
  424. begin
  425.   if Dir[Length(Dir)] = '\' then Delete(Dir, Length(Dir), 1);
  426.   I := Length(Dir);
  427.   while Dir[I] <> '\' do Dec(I);
  428.   Delete(Dir, I+1, Length(Dir)-I);
  429.   if Pos('\', Dir) = 0 then Dir := Dir+'\';
  430.   Result := Dir;
  431. end;
  432.  
  433. procedure DeleteFolder(Dir, TrashFileFolder: String);
  434. var
  435.   SL: TStringList;
  436.   I: Integer;
  437.  
  438.   procedure DeleteAllFiles(Dir: String);
  439.   var
  440.     SearchRec: TSearchRec;
  441.     Found: Integer;
  442.   begin
  443.     Found := FindFirst(Dir+'*.*', faAnyFile, SearchRec);
  444.     while Found = 0 do begin
  445.       SetFileAttr(Dir+SearchRec.Name, False, True, False, False);
  446.       if TrashFileFolder <> '' then
  447.         CopyFile(PChar(Dir+SearchRec.Name), PChar(TrashFileFolder+SearchRec.Name), False);
  448.       DeleteFile(Dir+SearchRec.Name);
  449.       Found := FindNext(SearchRec);
  450.     end;
  451.     FindClose(SearchRec);
  452.   end;
  453.  
  454.   procedure RecurseDirs(Dir: String);
  455.   var
  456.     SearchRec: TSearchRec;
  457.     Found: Integer;
  458.   begin
  459.      Found := FindFirst(Dir+'*.*', $37, SearchRec);
  460.      while Found = 0 do begin
  461.        if (SearchRec.Attr and $10 = $10) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
  462.          SL.Add(Dir+SearchRec.Name+'\');
  463.          DeleteAllFiles(Dir+SearchRec.Name+'\');
  464.          RecurseDirs(Dir+SearchRec.Name+'\');
  465.        end;
  466.        Found := FindNext(SearchRec);
  467.      end;
  468.      FindClose(SearchRec);
  469.   end;
  470.  
  471. begin
  472.   SL := TStringList.Create;
  473.   SL.Add(Dir);
  474.   DeleteAllFiles(Dir);
  475.   RecurseDirs(Dir);
  476.   for I := SL.Count-1 downto 0 do
  477.     RemoveDir(SL.Strings[I]);
  478.   SL.Free;
  479. end;
  480.  
  481. function SetFileAttr(Filename: String; faReadOnly, faArchive, faHidden, faSystem: Boolean): Boolean;
  482. var
  483.   I: Integer;
  484. begin
  485.   I := 0;
  486.   if faReadOnly then I := I or FILE_ATTRIBUTE_READONLY;
  487.   if faArchive then I := I or FILE_ATTRIBUTE_ARCHIVE;
  488.   if faHidden then I := I or FILE_ATTRIBUTE_HIDDEN;
  489.   if faSystem then I := I or FILE_ATTRIBUTE_SYSTEM;
  490.   Result := SetFileAttributes(PChar(Filename), I);
  491. end;
  492.  
  493. procedure ClearFolder(S: String);
  494. var
  495.   Found: Integer;
  496.   SearchRec: TSearchRec;
  497. begin
  498.   Found := FindFirst(S+'*.*', faAnyFile, SearchRec);
  499.   while Found = 0 do begin
  500.     SetFileAttr(S+SearchRec.Name, False, True, False, False);
  501.     DeleteFile(S+SearchRec.Name);
  502.     Found := FindNext(SearchRec);
  503.   end;
  504.   FindClose(SearchRec);
  505. end;
  506.  
  507. procedure Set3DButtons(ThreeD: Boolean; Owner: TForm);
  508.  
  509.   procedure ControlRecursive(Component: TComponent);
  510.   var
  511.     I: Integer;
  512.   begin
  513.     for I := 0 to Component.ComponentCount-1 do begin
  514.       if Component.Components[I] is TSpeedButton then
  515.         TSpeedButton(Component.Components[I]).Flat := ThreeD;
  516.       if Component.Components[I].ComponentCount > 0 then
  517.         ControlRecursive(Component.Components[I]);
  518.     end;
  519.   end;
  520.  
  521. begin
  522.   ControlRecursive(TComponent(Owner));
  523. end;
  524.  
  525. procedure PlaySound(Filename: String);
  526. begin
  527.   if FileExists(Filename) then
  528.     SndPlaySound(PChar(Filename), SND_ASYNC or SND_NODEFAULT);
  529. end;
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538. function CheckVersion: Boolean;
  539. var
  540.   Reg: TRegIniFile;
  541. begin
  542.   Result := True;
  543.   {if Reg.ReadString('', 'Version', sVersion) <> sVersion then begin
  544.     if MessageDlg('There is already another version of Phoenix Mail on this system!'+#13+
  545.                 'Continue?', mtWarning, [mbYes, mbNo], 0) = mrNo then
  546.       Result := False;
  547.   end;}
  548.   Reg := TRegIniFile.Create(sRegKey);
  549.   if Result = True then Reg.WriteString('', 'Version', sVersion);
  550.   Reg.WriteString('', 'Path', MakeValidDirName(ExtractFilePath(Application.ExeName)));
  551.   Reg.Free;
  552. end;
  553.  
  554. function CheckForPrevInstance: Boolean;
  555. var
  556.   S: String;
  557.   H: HWnd;
  558.   I: Integer;
  559. begin
  560.   Result := False;
  561.   sTempNewMessageFile := MakeValidDirName(ExtractFilePath(Application.ExeName)) + '\tmpmsgad.tmp';
  562.   sWriteNewMessage1 := '';
  563.   sWriteNewMessage2 := '';
  564.   if (ParamCount >= 2) and (ParamStr(1) = '-newmail') then begin
  565.     S := ParamStr(2);
  566.     if Pos('mailto:', LowerCase(S)) > 0 then Delete(S, 1, 7);
  567.     for I := 1 to Length(S) do begin
  568.       if S[I] <> '?' then
  569.         sWriteNewMessage1 := sWriteNewMessage1 + S[I]
  570.       else begin
  571.         Delete(S, 1, I);
  572.         if Pos('subject=', LowerCase(S)) > 0 then Delete(S, 1, 8);
  573.         sWriteNewMessage2 := S;
  574.         Break;
  575.       end;
  576.     end;
  577.   end;
  578.   S := 'Phoenix Mail Previous Instance';
  579.   Mutex := CreateMutex(nil, True, PChar(S));
  580.   if (Mutex <> 0) and (GetLastError = 0) then begin
  581.     Result := True;
  582.   end else begin
  583.     H := FindWindow(nil, PChar(sAppTitle));
  584.     if H <> 0 then begin
  585.       if sWriteNewMessage1 = '' then
  586.         SendMessage(H, WM_PREVINSTRUN, 0, 0)
  587.       else begin
  588.         try
  589.           AssignFile(TextFile, sTempNewMessageFile);
  590.           Rewrite(TextFile);
  591.           WriteLn(TextFile, sWriteNewMessage1);
  592.           WriteLn(TextFile, sWriteNewMessage2);
  593.           CloseFile(TextFile);
  594.         except end;
  595.         sWriteNewMessage1 := '';
  596.         sWriteNewMessage2 := '';
  597.         SendMessage(H, WM_PREVINSTRUN, 1, 0);
  598.       end;
  599.     end;
  600.   end;
  601. end;
  602.  
  603. procedure ClearUpCheckForPrevInstance;
  604. begin
  605.   if Mutex <> 0 then CloseHandle(Mutex);
  606.   Mutex := 0;
  607. end;
  608.  
  609. function CheckColorDepth: Boolean;
  610. var
  611.   DC: HDC;
  612. begin
  613.   Result := True;
  614.   DC := GetDC(GetDesktopWindow);
  615.   iColorDepth := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
  616.   if iColorDepth < 8 then LowColor := True else LowColor := False;
  617.   if ColorToRGB(clBtnFace) = clSilver then ColorScheme := False else ColorScheme := True;
  618. end;
  619.  
  620. procedure CheckForStandardEMailProgram;
  621. const
  622.   DummyArray: array[1..4] of Byte = (2, 0, 0, 0);
  623. var
  624.   NativeReg: TRegistry;
  625.   S: String;
  626. begin
  627.   if bCheckForStdEMail = False then Exit;
  628.   S := '"'+Application.ExeName+'" -newmail "%1"';
  629.   NativeReg := TRegistry.Create;
  630.   NativeReg.RootKey := HKEY_CLASSES_ROOT;
  631.   NativeReg.OpenKey('mailto\shell\open\command', True);
  632.   if NativeReg.ReadString('') <> S then begin
  633.     StdMailForm := TStdMailForm.Create(Application);
  634.     if StdMailForm.ShowModal = mrYes then begin
  635.       NativeReg.WriteString('', S);
  636.       NativeReg.CloseKey;
  637.       NativeReg.OpenKey('mailto\DefaultIcon', True);
  638.       NativeReg.WriteString('', '"'+Application.ExeName+'",0');
  639.       NativeReg.CloseKey;
  640.       NativeReg.RootKey := HKEY_LOCAL_MACHINE;
  641.       NativeReg.OpenKey('SOFTWARE\Clients\Mail', True);
  642.       NativeReg.WriteString('', 'Phoenix Mail');
  643.       NativeReg.CloseKey;
  644.       NativeReg.OpenKey('SOFTWARE\Clients\Mail\Phoenix Mail', True);
  645.       NativeReg.WriteString('', 'Phoenix Mail');
  646.       NativeReg.CloseKey;
  647.       NativeReg.OpenKey('SOFTWARE\Clients\Mail\Phoenix Mail\Protocols\mailto', True);
  648.       NativeReg.WriteString('', 'URL:MailTo Protocol');
  649.       NativeReg.WriteBinaryData('Edit Flags', DummyArray, 4);
  650.       NativeReg.WriteString('URL Protocol', '');
  651.       NativeReg.CloseKey;
  652.       NativeReg.OpenKey('SOFTWARE\Clients\Mail\Phoenix Mail\Protocols\mailto\DefaultIcon', True);
  653.       NativeReg.WriteString('', '"'+Application.ExeName+'",0');
  654.       NativeReg.CloseKey;
  655.       NativeReg.OpenKey('SOFTWARE\Clients\Mail\Phoenix Mail\Protocols\mailto\shell\open\command', True);
  656.       NativeReg.WriteString('', S);
  657.       NativeReg.CloseKey;
  658.       NativeReg.OpenKey('SOFTWARE\Clients\Mail\Phoenix Mail\shell\open\command', True);
  659.       NativeReg.WriteString('', '"'+Application.ExeName+'"');
  660.     end;
  661.     StdMailForm.Free;
  662.   end;
  663.   NativeReg.CloseKey;
  664.   NativeReg.Free;
  665.   Application.ProcessMessages;
  666. end;
  667.  
  668. function CheckCDROMStart: Boolean;
  669. begin
  670.   Result := True;
  671.   if GetDriveType(PChar(Application.ExeName[1]+':\')) = DRIVE_CDROM then begin
  672.     MessageDlg(MainForm.ListBox1.Items[77], mtError, [mbOK], 0);
  673.     Result := False;
  674.   end;
  675. end;
  676.  
  677. procedure InitializePX;
  678. var
  679.   S: String;
  680.   NativeReg: TRegistry;
  681.   IniFile: TIniFile;
  682.   A: array[0..MAX_PATH] of Char;
  683. begin
  684.   Application.Title := sAppTitle;
  685.   Randomize;
  686.   PrepareBase64Support;
  687.   // Folders and Files
  688.   S := LowerCase(MakeValidDirName(ExtractFilePath(Application.ExeName)));
  689.   sTemporaryFolder := S+'Temp\';
  690.   CreateFolder(sTemporaryFolder);
  691.   sTempMessageFile := sTemporaryFolder+'PXMsg598.rtf';
  692.   sTempLanguageFile := S+'templang.tmp';
  693.   sAddressBookFolder := S+'Address\';
  694.   CreateFolder(sAddressBookFolder);
  695.   sSpellCheckerFile := S+'pxspell.exe';
  696.   sTempSpellCheckFile := S+'tmpspell.tmp';
  697.   if FileExists(sSpellCheckerFile) = False then sSpellCheckerFile := '';
  698.   sAccountRootFolder := S+'Accounts\';
  699.   CreateFolder(sAccountRootFolder);
  700.   sTrashFolder := S+'Trash\';
  701.   CreateFolder(sTrashFolder);
  702.   sLanguageFolder := S+'Lang\';
  703.   CreateFolder(sLanguageFolder);
  704.   sRepositoryFolder := S+'Reposit\';
  705.   CreateFolder(sRepositoryFolder);
  706.   sSignatureFolder := S+'Signat\';
  707.   CreateFolder(sSignatureFolder);
  708.   sBannerDLLFileName := S+'pxadvert.dll';
  709.   sProtocolFile := S+'Protocol.txt';
  710.   sSettingsFile := S+'Settings.ini';
  711.   Application.HelpFile := S+'Phoenix.hlp';
  712.   sStandardAccountDataFile := S+'Default.ini';
  713.   GetTempPath(MAX_PATH, A);
  714.   sWinTempFolder := A;
  715.   sWinTempFolder := MakeValidDirName(sWinTempFolder);
  716.   // Registry
  717.   IniFile := TIniFile.Create(sSettingsFile);
  718.   bMakeProtocol := IniFile.ReadBool('Settings', 'Protocol', True);
  719.   bShowTips := IniFile.ReadBool('Settings', 'ShowTipsOnStartUp', True);
  720.   iActualTip := IniFile.ReadInteger('Settings', 'ActualTip', 0);
  721.   iFontCharSet := IniFile.ReadInteger('Settings', 'FontCharSet', 0);
  722.   bAskToGoOffline := IniFile.ReadBool('Settings', 'AskToGoOffline', False);
  723.   sVirusProg := IniFile.ReadString('Settings', 'VirusScanner', '');
  724.   sVirusParams := IniFile.ReadString('Settings', 'ScannerParameter', '');
  725.   sCustAddressBook := IniFile.ReadString('Settings', 'CustAddressBook', '');
  726.   if DirectoryExists(sCustAddressBook) then sAddressBookFolder := sCustAddressBook else sCustAddressBook := '';
  727.   bVirusMin := IniFile.ReadBool('Settings', 'RunScannerMinimized', True);
  728.   sLastFolder := IniFile.ReadString('Settings', 'LastFolder', '');
  729.   bAskForDelFromServer := IniFile.ReadBool('Settings', 'AskForDelFromServer', False);
  730.   bGoOnlineAtStart := IniFile.ReadBool('Settings', 'GoOnlineAtStart', False);
  731.   sMessageFont := IniFile.ReadString('Settings', 'MessageFont', 'Courier New');
  732.   iFontSize := IniFile.ReadInteger('Settings', 'FontSize', 9);
  733.   iFontColor := IniFile.ReadInteger('Settings', 'FontColor', clWindowText);
  734.   iMarkAsReadSec := IniFile.ReadInteger('Settings', 'MarkAsReadSec', 3);
  735.   sLastAttSaveDir := IniFile.ReadString('Settings', 'LastAttSaveDir', '');
  736.   sLastAttOpenDir := IniFile.ReadString('Settings', 'LastAttOpenDir', '');
  737.   bFriendlyPrinter := IniFile.ReadBool('Settings', 'FriendlyPrinter', True);
  738.   bListMailsAtDownload := IniFile.ReadBool('Settings', 'ListMailsAtDownload', True);
  739.   bCheckForStdEMail := IniFile.ReadBool('Settings', 'CheckForStdEMail', True);
  740.   sLanguage := IniFile.ReadString('Settings', 'Language', '');
  741.   bAskForLanguage := IniFile.ReadBool('Settings', 'AskForLanguage', False);
  742.   bScheduleC1 := IniFile.ReadBool('Settings', 'ScheduleC1', False);
  743.   bScheduleC2 := IniFile.ReadBool('Settings', 'ScheduleC2', False);
  744.   bScheduleC3 := IniFile.ReadBool('Settings', 'ScheduleC3', False);
  745.   bScheduleC4 := IniFile.ReadBool('Settings', 'ScheduleC4', False);
  746.   bScheduleC5 := IniFile.ReadBool('Settings', 'ScheduleC5', False);
  747.   sScheduleS1 := IniFile.ReadInteger('Settings', 'ScheduleS1', 60);
  748.   sScheduleS2 := IniFile.ReadString('Settings', 'ScheduleS2', '03:20');
  749.   sScheduleS3 := IniFile.ReadString('Settings', 'ScheduleS3', '24:00');
  750.   iDUNAutoQuitTime := IniFile.ReadInteger('DUN', 'AutoQuitTime', 15);
  751.   bDUNAutoQuit := IniFile.ReadBool('DUN', 'AutoQuit', False);
  752.   sDUNConnection := IniFile.ReadString('DUN', 'Connection', '');
  753.   sDUNUsername := IniFile.ReadString('DUN', 'Username', '');
  754.   sDUNPassword := MHDecrypt(IniFile.ReadString('DUN', 'Password', ''));
  755.   bDUNAskForPassword := IniFile.ReadBool('DUN', 'AskForPassword', False);
  756.   bDUNNormalQuit := IniFile.ReadBool('DUN', 'DUNNormalQuit', False);
  757.   bViewStatusAtEnd := IniFile.ReadBool('Settings', 'ViewStatusAtEnd', True);
  758.   sSoundFile1 := IniFile.ReadString('Sound', 'SoundFile1', S+'newmail.wav');
  759.   sSoundFile2 := IniFile.ReadString('Sound', 'SoundFile2', S+'error.wav');
  760.   sSoundFile3 := IniFile.ReadString('Sound', 'SoundFile3', S+'status.wav');
  761.   sToolbarButtons := IniFile.ReadString('Style', 'ToolbarButtons', '1, 0, 2, 3, 0, 4, 5, 6, 7, 8, 0, 9, 10');
  762.   sToolbarBKBitmap := IniFile.ReadString('Style', 'Background', '');
  763.   bFlatButtons := IniFile.ReadBool('Style', 'FlatButtons', True);
  764.   bOfficeFonts := IniFile.ReadBool('Style', 'UseOfficeFonts', False);
  765.   bSmallToolbarButtons := IniFile.ReadBool('Style', 'SmallToolbarButtons', False);
  766.   bShowCntInBrackets := IniFile.ReadBool('Settings', 'ShowCountInBrackets', False);
  767.   bHideAnimations := IniFile.ReadBool('Style', 'HideAnimations', False);
  768.   IniFile.Free;
  769.   //Stuff
  770.   Screen.Cursors[crHandCursor] := LoadCursor(hInstance, 'PX400');
  771.   NativeReg := TRegistry.Create;
  772.   NativeReg.RootKey := HKEY_LOCAL_MACHINE;
  773.   NativeReg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
  774.   bStartAtWindowsStart := NativeReg.ValueExists('PhoenixMail');
  775.   NativeReg.CloseKey;
  776.   NativeReg.Free;
  777.   sHomepage := sMHHomepage;
  778.   //TEMail
  779.   CurrentEMail := TEMail.Create;
  780.   // Language
  781.   if (sLanguage <> 'English') or (bAskForLanguage) then begin
  782.     S := sLanguageFolder+sLanguage+'.lng';
  783.     if (bAskForLanguage) or (FileExists(S)= False) then begin
  784.       LanguageForm := TLanguageForm.Create(Application);
  785.       if LanguageForm.Filename = '' then LanguageForm.ShowModal;
  786.       Application.ProcessMessages;
  787.       S := LanguageForm.Filename;
  788.       sLanguage := Copy(ExtractFileName(S), 1, Length(ExtractFileName(S))-4);
  789.       LanguageForm.Free;
  790.     end;
  791.     if FileExists(S) then begin
  792.       LoadLanguageFile(S);
  793.       bLanguageLoaded := True;
  794.     end;
  795.   end;
  796.   SaveMessage := False;
  797. end;
  798.  
  799. procedure ClearUpPX;
  800. var
  801.   NativeReg: TRegistry;
  802.   IniFile: TIniFile;
  803. begin
  804.   IniFile := TIniFile.Create(sSettingsFile);
  805.   IniFile.WriteBool('Settings', 'Protocol', bMakeProtocol);
  806.   IniFile.WriteBool('Settings', 'ShowTipsOnStartUp', bShowTips);
  807.   IniFile.WriteInteger('Settings', 'ActualTip', iActualTip);
  808.   IniFile.WriteBool('Settings', 'AskToGoOffline', bAskToGoOffline);
  809.   IniFile.WriteString('Settings', 'VirusScanner', sVirusProg);
  810.   IniFile.WriteString('Settings', 'ScannerParameter', sVirusParams);
  811.   IniFile.WriteString('Settings', 'LastFolder', sLastFolder);
  812.   IniFile.WriteBool('Settings', 'RunScannerMinimized', bVirusMin);
  813.   IniFile.WriteBool('Settings', 'AskForDelFromServer', bAskForDelFromServer);
  814.   IniFile.WriteBool('Settings', 'CheckForStdEMail', bCheckForStdEMail);
  815.   IniFile.WriteBool('Settings', 'ListMailsAtDownload', bListMailsAtDownload);
  816.   IniFile.WriteString('Settings', 'MessageFont', sMessageFont);
  817.   IniFile.WriteInteger('Settings', 'FontSize', iFontSize);
  818.   IniFile.WriteInteger('Settings', 'FontColor', iFontColor);
  819.   IniFile.WriteInteger('Settings', 'MarkAsReadSec', iMarkAsReadSec);
  820.   IniFile.WriteString('Settings', 'LastAttSaveDir', sLastAttSaveDir);
  821.   IniFile.WriteString('Settings', 'LastAttOpenDir', sLastAttOpenDir);
  822.   IniFile.WriteString('Settings', 'CustAddressBook', sCustAddressBook);
  823.   IniFile.WriteBool('Settings', 'FriendlyPrinter', bFriendlyPrinter);
  824.   IniFile.WriteBool('Settings', 'AskForLanguage', bAskForLanguage);
  825.   IniFile.WriteString('Settings', 'Language', sLanguage);
  826.   IniFile.WriteBool('Settings', 'GoOnlineAtStart', bGoOnlineAtStart);
  827.   IniFile.WriteBool('Settings', 'ScheduleC1', bScheduleC1);
  828.   IniFile.WriteBool('Settings', 'ScheduleC2', bScheduleC2);
  829.   IniFile.WriteBool('Settings', 'ScheduleC3', bScheduleC3);
  830.   IniFile.WriteBool('Settings', 'ScheduleC4', bScheduleC4);
  831.   IniFile.WriteBool('Settings', 'ScheduleC5', bScheduleC5);
  832.   IniFile.WriteInteger('Settings', 'ScheduleS1', sScheduleS1);
  833.   IniFile.WriteString('Settings', 'ScheduleS2', sScheduleS2);
  834.   IniFile.WriteString('Settings', 'ScheduleS3', sScheduleS3);
  835.   IniFile.WriteInteger('Settings', 'FontCharSet', iFontCharSet);
  836.   IniFile.WriteInteger('DUN', 'AutoQuitTime', iDUNAutoQuitTime);
  837.   IniFile.WriteBool('DUN', 'AutoQuit', bDUNAutoQuit);
  838.   IniFile.WriteString('DUN', 'Connection', sDUNConnection);
  839.   IniFile.WriteString('DUN', 'Username', sDUNUsername);
  840.   IniFile.WriteString('DUN', 'Password', MHEncrypt(sDUNPassword));
  841.   IniFile.WriteBool('DUN', 'AskForPassword', bDUNAskForPassword);
  842.   IniFile.WriteBool('Settings', 'ViewStatusAtEnd', bViewStatusAtEnd);
  843.   IniFile.WriteString('Sound', 'SoundFile1', sSoundFile1);
  844.   IniFile.WriteString('Sound', 'SoundFile2', sSoundFile2);
  845.   IniFile.WriteString('Sound', 'SoundFile3', sSoundFile3);
  846.   IniFile.WriteBool('DUN', 'DUNNormalQuit', bDUNNormalQuit);
  847.   IniFile.WriteString('Captions', 'Accounts', sAccountsCaption);
  848.   IniFile.WriteString('Captions', 'TrashBag', sTrashBagCaption);
  849.   IniFile.WriteString('Captions', 'Repository', sRepositoryCaption);
  850.   IniFile.WriteString('Style', 'ToolbarButtons', sToolbarButtons);
  851.   IniFile.WriteString('Style', 'Background', sToolbarBKBitmap);
  852.   IniFile.WriteBool('Style', 'FlatButtons', bFlatButtons);
  853.   IniFile.WriteBool('Style', 'UseOfficeFonts', bOfficeFonts);
  854.   IniFile.WriteBool('Style', 'SmallToolbarButtons', bSmallToolbarButtons);
  855.   IniFile.WriteBool('Settings', 'ShowCountInBrackets', bShowCntInBrackets);
  856.   IniFile.WriteBool('Style', 'HideAnimations', bHideAnimations);
  857.   IniFile.Free;
  858.   NativeReg := TRegistry.Create;
  859.   NativeReg.RootKey := HKEY_LOCAL_MACHINE;
  860.   NativeReg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
  861.   if bStartAtWindowsStart then begin
  862.     NativeReg.WriteString('PhoenixMail', '"'+Application.ExeName+'" -min');
  863.   end else begin
  864.     NativeReg.DeleteValue('PhoenixMail');
  865.   end;
  866.   NativeReg.CloseKey;
  867.   NativeReg.Free;
  868.   CurrentEMail.Free;
  869.   ClearUpLangFile;
  870.   ClearFolder(sTemporaryFolder);
  871.   ClearUpCheckForPrevInstance;
  872. end;
  873.  
  874. end.
  875.