home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / StartRight / source.zip / UnitFrmDummyRunner.pas < prev    next >
Pascal/Delphi Source File  |  2004-10-08  |  12KB  |  438 lines
  1. unit UnitFrmDummyRunner;
  2. {
  3.     Purpose:
  4.         This form controls the startup process by creating/removing
  5.         the system tray icon and running the behind the sense processes.
  6.  
  7.     Updates:
  8.         New Status/Pause/Stop dialog option
  9.  
  10.         --------------
  11.         Icon notification for new items and double click will open the Edit
  12.         form and hilight new itesm
  13. }
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  19.   Dialogs,  ShellAPI, UnitMyRegistry,
  20.   UnitStartupMover, UnitStartupRunner, ImgList, StdCtrls, ExtCtrls;
  21.  
  22. const MY_WM_TRAYICON = WM_USER + 1; // used to receive tray icon messsages
  23. type
  24.   TfrmDummyRunner = class(TForm)
  25.     ImageList1: TImageList;
  26.     bPause: TButton;
  27.     bStop: TButton;
  28.     Image2: TImage;
  29.     Memo1: TMemo;
  30.     procedure FormDestroy(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure bStopClick(Sender: TObject);
  33.     procedure bPauseClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.         messagelog : string;
  37.         sm : TStartupMover;
  38.         sr : TStartupRunner;
  39.         paused : boolean;
  40.         TrayIcon: TNotifyIconData;          {tray icon info}
  41.         procedure WMTrayIcon(var Msg: TMessage); message MY_WM_TRAYICON;
  42.  
  43.         procedure ShowIcon;
  44.  
  45.         procedure NewItemsIcon;
  46.  
  47.         //procedure DoMoveAndRun;
  48.         procedure DoRunOnceMoving;
  49.         procedure PostRunOnceExecute;
  50.  
  51.         procedure FlagRunOnceExecuted;
  52.         procedure ClearRunOnceExecutedFlag;
  53.         //function HasRunOnce : boolean;
  54.         function IsPaused : boolean;
  55.  
  56.  
  57.   public
  58.     { Public declarations }
  59.         procedure HideIcon;
  60.         procedure Callback_ShowMessage(name : string);
  61.   end;
  62.  
  63. var
  64.   frmDummyRunner: TfrmDummyRunner;
  65.  
  66. {\\\\\\\\\\\\\\\\\\\\}
  67. {\\}implementation{\\}
  68. {\\\\\\\\\\\\\\\\\\\\}
  69.  
  70. Uses UnitFormEdit, UnitItemManager, UnitFrmOptions, UnitMyKeys, UnitUtils, StrUtils,
  71.   UnitCPUUsage, UnitFrmAutoTuneError;
  72.  
  73. {$R *.dfm}
  74.  
  75. //-------------------
  76. // Public Interface
  77. //-------------------
  78. procedure TfrmDummyRunner.Callback_ShowMessage(name: string);
  79. begin
  80.     self.messagelog := self.messagelog + #13#10 + name;
  81.     
  82.     self.memo1.text := name;
  83.     Application.ProcessMessages;
  84. end;
  85.  
  86.  
  87.  
  88. //-----------------------
  89. // Private Implementation
  90. //-----------------------
  91. procedure TfrmDummyRunner.FormCreate(Sender: TObject);
  92.     procedure ShowStatusDialog;
  93.     begin
  94.         Windows.SetWindowPos(application.handle, HWND_TOPMOST, 0, 0, 0, 0,
  95.             SWP_NOMOVE Or SWP_NOSIZE);
  96.         self.Show;
  97.     end;
  98. var s  : string;
  99. begin
  100.     sm := TStartupMover.Create(self.Handle);
  101.     sr := TStartupRunner.Create(self.Handle);
  102.  
  103.     //
  104.     // -pre = RunOnce key that is run before explorer is executed
  105.     // -go = Test if "-pre" was executed and execute either new or old method
  106.     // This will be backwards compatible for systems that fail to execute
  107.     // the RunOnce method or systems that have not yet this updated code.
  108.     //
  109.  
  110.     if (ParamCount <> 0) then begin
  111.         s := paramstr(1);
  112.  
  113.         if (s = '-pre') then begin
  114.             if (not FrmOptions.cbDisableMoveDialog.Checked) then ShowStatusDialog;
  115.             if (sm.UserHasPermission(s)) then begin
  116.                 sm.SetupSelfToRun(false); while self.IsPaused do mysleep(50);
  117.                 self.DoRunOnceMoving; while self.IsPaused do mysleep(50);
  118.                 self.FlagRunOnceExecuted; while self.IsPaused do mysleep(50);
  119.             end else begin
  120.                 self.Callback_ShowMessage(
  121.                     'ERROR: Permission Denied on :' + #13#10 + s
  122.                 );
  123.                 mysleep(4000);
  124.             end;
  125.             // ensure the RUN key has the "-go" runkey set up
  126.             while self.IsPaused do mysleep(50);
  127.             Application.Terminate;
  128.  
  129.         end else if (s = '-go') then begin
  130.             // set up only RunOnce key
  131.             // make sure Run key is removed - just to be safe
  132.  
  133.             self.Callback_ShowMessage('Starting...');
  134.             if (sm.UserHasPermission(s)) then begin
  135.                 sm.SetupSelfToRunOnce;
  136.                 sm.RemoveSelfFromRun(false);
  137.                 if (FrmOptions.cbShowStartupDialog.Checked) then ShowStatusDialog;
  138.                 self.PostRunOnceExecute;
  139.                 self.ClearRunOnceExecutedFlag;
  140.                 UnitMyKeys.SaveLowHighCPUStats;
  141.                 
  142.                 if (sm.GetHasNewItemsAndClear) and
  143.                     not (FrmOptions.cbDisableSysTrayNotification.Checked)  then begin
  144.                     self.NewItemsIcon;
  145.                 end else begin
  146.                     Application.Terminate;
  147.                 end;
  148.  
  149.             end else begin
  150.                 ShowStatusDialog;
  151.                 self.Callback_ShowMessage(
  152.                     'ERROR: Permission Denied on :' + #13#10 + s
  153.                 );
  154.                 mysleep(4000);
  155.                 Application.Terminate;
  156.             end;
  157.  
  158.         end;
  159.  
  160.     end;
  161. end;
  162.  
  163. procedure TfrmDummyRunner.FormDestroy(Sender: TObject);
  164. begin
  165.     sm.Free;
  166.     sr.Free;
  167. end;
  168.  
  169.  
  170.  
  171.  
  172.  
  173. {Phase 1 of Execution}
  174. procedure TfrmDummyRunner.DoRunOnceMoving;
  175. var i : integer;
  176.     s : string;
  177.     rki : TRunKeyItem;
  178.     sfi : TStartupFolderItem;
  179. begin
  180.     //
  181.     // -- RunOnce key policy states we must continue with NO user input
  182.     // Display Progess and if any items were found
  183.     //
  184.     try
  185.         self.Callback_ShowMessage('Detecting New items.');
  186.  
  187.         s := '';
  188.         for i := 0 to (sm.GetRunkeyItemsCount - 1) do begin
  189.             rki := sm.GetRunkeyItem(i);
  190.             if not UnitMyKeys.GetIsExcludedRunkey(rki.RunKey) then begin
  191.                 s := s + 'Runkey: ' + rki.RunKey + #13#10;
  192.             end;
  193.         end;
  194.         for i := 0 to (sm.GetStartupFolderItemsCount - 1) do begin
  195.             sfi := sm.GetStartupFolderItem(i);
  196.  
  197.             if not UnitMyKeys.GetIsExcludedStartup(ExtractFilename(sfi.fullname)) then begin
  198.                 s := s + 'Startup: ' + ExtractFilename(sfi.fullname);
  199.             end;
  200.         end;
  201.  
  202.         if (s <> '') then begin
  203.             self.Callback_ShowMessage('Items Found.' + #13#10 + s);
  204.             mysleep(1500);
  205.         end else begin
  206.             Self.Callback_ShowMessage('No new items.');
  207.             mysleep(1500);
  208.         end;
  209.  
  210.         sm.MoveRunKeyItems;
  211.         sm.MoveStartupFolderItems;
  212.  
  213.     Except on E: Exception do
  214.         begin
  215.             self.Callback_ShowMessage('ERROR: ' + E.Message );
  216.             mysleep(4000);
  217.             Application.Terminate;
  218.         end;
  219.     end;
  220.  
  221.  
  222.  
  223. end;
  224.  
  225.  
  226. {Phase 2 of Execution}
  227. procedure TfrmDummyRunner.PostRunOnceExecute;
  228. var cpu : string;
  229. begin
  230.     self.ShowIcon;
  231.  
  232.     if (FrmOptions.cbShowStartupDialog.Checked) then begin
  233.         self.Show;
  234.     end;
  235.  
  236.     if (FrmOptions.cbDisableAutoTune.checked = false) then begin
  237.         cpu := IntToStr(trunc(UnitCPUUsage.GetCPUUsage));
  238.     end;
  239.     self.Callback_ShowMessage('(Pausing ' +
  240.         IntToStr(sr.GetPrerunDelaySeconds) +
  241.         ' seconds before executing)'
  242.         +#13#10'CPU% ' + cpu);
  243.     Application.ProcessMessages;
  244.     FrmAutoTuneError.CheckForError;
  245.  
  246.     sr.ExecutePrerunDelay;
  247.  
  248.  
  249.     sr.ExecuteRunkeyPrograms;
  250.     sr.ExecuteStartupFolderPrograms;
  251.     
  252.     self.Hide;
  253.     self.HideIcon;
  254. end;
  255.  
  256.  
  257.  
  258.  
  259.  
  260. {Tray Icon routines}
  261. procedure TfrmDummyRunner.ShowIcon;
  262. begin
  263.     //
  264.     // Create System Tray Icon
  265.     //
  266.     TrayIcon.cbSize := SizeOf(TrayIcon);
  267.     TrayIcon.Wnd := Self.Handle;
  268.     TrayIcon.uID := 0;
  269.     TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  270.     TrayIcon.uCallbackMessage := 0;
  271.     TrayIcon.hIcon := Application.Icon.Handle;
  272.     TrayIcon.szTip := 'StartRight';
  273.     ShellAPI.Shell_notifyIcon(NIM_ADD, @TrayIcon);
  274. end;
  275.  
  276. procedure TfrmDummyRunner.HideIcon;
  277. begin
  278.     //
  279.     // Remove tray icon
  280.     //
  281.     ShellAPI.Shell_notifyIcon(NIM_DELETE, @TrayIcon);
  282. end;
  283.  
  284. procedure TFrmDummyRunner.WMTrayIcon(var Msg: TMessage);
  285. begin
  286.     //
  287.     // show the edit form and hilight the new items
  288.     //
  289.     if (Msg.lparam = WM_LBUTTONDBLCLK) or
  290.         (Msg.lparam = WM_LBUTTONDBLCLK) then begin
  291.         //ShellAPI.Shell_notifyIcon(NIM_DELETE, @TrayIcon);
  292.  
  293.         FrmEdit.SetEndProgramOnClose(true);
  294.         FrmEdit.ShowNewItems;
  295.     end;
  296. end;
  297.  
  298. procedure TfrmDummyRunner.NewItemsIcon;
  299. var icon : TIcon;
  300. begin
  301.     icon := TIcon.Create;
  302.     ImageList1.GetIcon(1, icon);
  303.  
  304.     TrayIcon.cbSize := SizeOf(TrayIcon);
  305.     TrayIcon.Wnd := Self.Handle;
  306.     TrayIcon.uID := 0;
  307.     TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  308.     TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
  309.     TrayIcon.hIcon := Icon.Handle;
  310.     TrayIcon.szTip := 'StartRight - New Items found';
  311.     ShellAPI.Shell_notifyIcon(NIM_ADD, @TrayIcon);
  312.  
  313.     icon.Free;
  314. end;
  315.  
  316.  
  317.  
  318.  
  319. {Old Move&Run method - replaced by 2 phase method}
  320. {
  321. procedure TFrmDummyRunner.DoMoveAndRun;
  322. var CanMove : boolean;
  323. begin
  324.  
  325.     CanMove := sm.UserHasPermission;
  326.     if (not CanMove) then begin
  327.         ShowMessage('StartRight: Current user cannot alter system startup programs. Moving aborted.');
  328.     end;
  329.     self.ShowIcon;
  330.  
  331.  
  332.     if (FrmOptions.cbShowStartupDialog.Checked) then begin
  333.         self.Show;
  334.     end;
  335.     self.Callback_ProgramName('(Pausing ' +
  336.         IntToStr(sr.GetPrerunDelaySeconds) +
  337.         ' seconds before executing)');
  338.     Application.ProcessMessages;
  339.     sr.ExecutePrerunDelay;
  340.  
  341.  
  342.  
  343.     // copy new stuff, run everything
  344.     //
  345.     // NOTE: The autoexcluder will check for duplicate entries
  346.     // in my startup locations, and windows locations that may
  347.     // have occured after the last time StartRight was run.
  348.  
  349.  
  350.     self.Callback_ProgramName('(Moving new items)');
  351.     Application.ProcessMessages;
  352.  
  353.     if (CanMove) then begin
  354.         ItemManager.AutoExcludeRunkeyItems;
  355.         ItemManager.AutoExcludeStartupItems;
  356.     end;
  357.  
  358.     //
  359.     // dirty trick to get mover/runner to re-create data lists
  360.     // since the Exclude will change the mine and window's run keys
  361.     //
  362.     sm.Free;
  363.     sr.Free;
  364.     sm := TStartupMover.Create(self.Handle);
  365.     sr := TStartupRunner.Create(self.Handle);
  366.  
  367.     if (CanMove) then begin
  368.         sm.MoveRunKeyItems;
  369.         sm.MoveStartupFolderItems;
  370.     end;
  371.  
  372.     //
  373.     //
  374.  
  375.     sr.ExecuteRunkeyPrograms;
  376.     sr.ExecuteStartupFolderPrograms;
  377.     self.HideIcon;
  378. end;
  379. }
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387. {User Interations}
  388. procedure TfrmDummyRunner.bStopClick(Sender: TObject);
  389. begin
  390.     self.ModalResult := mrOk;
  391.     sr.Abort;
  392.     Application.Terminate;
  393.     Application.ProcessMessages;
  394. end;
  395.  
  396. procedure TfrmDummyRunner.bPauseClick(Sender: TObject);
  397. begin
  398.     if (bPause.Caption = 'Pause') then begin
  399.         bPause.Caption := 'Unpause';
  400.         sr.SetPaused(true);
  401.         self.paused := true;
  402.     end else begin
  403.         bPause.Caption := 'Pause';
  404.         sr.SetPaused(false);
  405.         self.paused := false;
  406.     end;
  407. end;
  408.  
  409. function TfrmDummyRunner.IsPaused: boolean;
  410. begin
  411.     result := paused;
  412. end;
  413.  
  414.  
  415.  
  416.  
  417.  
  418. procedure TfrmDummyRunner.ClearRunOnceExecutedFlag;
  419. var r : TMyRegistry;
  420. begin
  421.     r := TMyRegistry.Create();
  422.     r.DeleteDataString(SR_HOME_KEY, SR_RUNONCE_VALUE);
  423. end;
  424.  
  425. procedure TfrmDummyRunner.FlagRunOnceExecuted;
  426. var r : TMyRegistry;
  427. begin
  428.     r := TMyRegistry.Create();
  429.     r.SetDataString(SR_HOME_KEY, SR_RUNONCE_VALUE, SR_RUNONCE_VALUE);
  430. end;
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437. end.
  438.