home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / JSAPPEX.ZIP / src / AppEx.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-05-19  |  42.6 KB  |  1,449 lines
  1. ////////////////////////////////////////////////////////////////////////////////
  2. // Jazarsoft AppEx                                                            //
  3. ////////////////////////////////////////////////////////////////////////////////
  4. //                                                                            //
  5. // VERSION      : 2.2                                                         //
  6. // AUTHOR       : James Azarja                                                //
  7. // CREATED      : 10 July 2000                                                //
  8. // MODIFIED     : 19 May 2001                                                 //
  9. // WEBSITE      : http://www.jazarsoft.com                                    //
  10. // SUPPORT      : support@jazarsoft.com                                       //
  11. // BUG-REPORT   : bugreport@jazarsoft.com                                     //
  12. // COMMENT      : comment@jazarsoft.com                                       //
  13. // LEGAL        : Copyright (C) 2000-2001 Jazarsoft.                          //
  14. //                                                                            //
  15. ////////////////////////////////////////////////////////////////////////////////
  16. //                                                                            //
  17. // This code may be used and modified by anyone so long as  this header and   //
  18. // copyright  information remains intact.                                     //
  19. //                                                                            //
  20. // The code is provided "as-is" and without warranty of any kind,             //
  21. // expressed, implied or otherwise, including and without limitation, any     //
  22. // warranty of merchantability or fitness for a  particular purpose.á         //
  23. //                                                                            //
  24. // In no event shall the author be liable for any special, incidental,        //
  25. // indirect or consequential damages whatsoever (including, without           //
  26. // limitation, damages for loss of profits, business interruption, loss       //
  27. // of information, or any other loss), whether or not advised of the          //
  28. // possibility of damage, and on any theory of liability, arising out of      //
  29. // or in connection with the use or inability to use this software.áá         //
  30. //                                                                            //
  31. ////////////////////////////////////////////////////////////////////////////////
  32. //                                                                            //
  33. // HISTORY :                                                                  //
  34. //                                                                            //
  35. // 1.0 :                                                                      //
  36. //   Initial development                                                      //
  37. // 1.1 :                                                                      //
  38. // + Last Compile Date, Last design date                                      //
  39. // + Parameter List                                                           //
  40. // ╗ Parameter search routine                                                 //
  41. // 1.2 :                                                                      //
  42. // + RunAsSecondCopy Event                                                    //
  43. // + ExportResource Feature                                                   //
  44. // + FileAssociation Feature                                                  //
  45. // 1.3 :                                                                      //
  46. // ╗ Hide & Show on Task Bar Bug                                              //
  47. // 2.0 :                                                                      //
  48. //   Major Code Reconstruction                                                //
  49. // + InfoRun Feature                                                          //
  50. // + OnUserChanged Event                                                      //
  51. // + OnDisplayChangedEvent                                                    // 
  52. // + Paramter..Found Event                                                    //
  53. // 2.1 :                                                                      //
  54. // + Version Information                                                      //
  55. // 2.2 :                                                                      //
  56. // + Hot Key Feature                                                          //
  57. //                                                                            //
  58. //                                                                            //
  59. ////////////////////////////////////////////////////////////////////////////////
  60.  
  61. {$WARNINGS OFF}
  62. {$HINTS OFF}
  63. unit AppEx;
  64.  
  65.  
  66. interface
  67.  
  68. uses
  69.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  70.   Registry, IniFiles, DsgnIntf;
  71.  
  72. Type
  73.   THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
  74.   THKModifiers = set of THKModifier;
  75.  
  76.   TVirtKey =  (vkNone, vkCancel, vkBack, vkTab, vkClear, vkReturn, vkPause, vkCapital, vkEscape,
  77.                vkSpace, vkPrior, vkNext, vkEnd, vkHome, vkLeft, vkUp, vkRight, vkDown,
  78.                vkSelect, vkExecute, vkSnapshot, vkInsert, vkDelete, vkHelp,
  79.                vk0, vk1, vk2, vk3, vk4, vk5, vk6, vk7, vk8, vk9,
  80.                vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH, vkI, vkJ, vkK, vkL, vkM,
  81.                vkN, vkO, vkP, vkQ, vkR, vkS, vkT, vkU, vkV, vkW, vkX, vkY, vkZ,
  82.                vkNumpad0, vkNumpad1, vkNumpad2, vkNumpad3, vkNumpad4,
  83.                vkNumpad5, vkNumpad6, vkNumpad7, vkNumpad8, vkNumpad9,
  84.                vkMultiply, vkAdd, vkSeparator, vkSubtract, vkDecimal, vkDivide,
  85.                vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
  86.                vkF13, vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21, vkF22, vkF23, vkF24,
  87.                vkNumlock, vkScroll, vkApps,
  88.                vkSemiColon, vkEqual, vkComma, vkDash, vkDot, vkSlash, vkBackQuote,
  89.                vkBlockLeft, vkBackSlash, vkBlockRight, vkQuote);
  90.  
  91. Type
  92.   tAutoRunStyle   = (arsLogin, arsStart, arsWarmBoot, arsFirstStart);
  93.   tPriorityClass  = (pcNormal, pcIdle, pcHigh, pcRealtime);
  94.  
  95.   TOnParameterFounded       = procedure (Sender: TObject;Parameter:ShortString) of object;
  96.   TOnParameterValueFounded  = procedure (Sender: TObject;Parameter,Ident,Value:ShortString) of object;
  97.  
  98.   TOnDisplayChanged         = Procedure (Sender: TObject;HorzRes,VertRes,ColorDepth : Integer) of object;
  99.  
  100.   TOnEndSessionQuery        = Procedure (Sender: TObject;Var EndSession:Boolean) of Object;
  101.   
  102.   TOnHotKey                 = Procedure(Sender: TObject; Index: Integer) of object;
  103.  
  104.   tFileExtInfo =  Record
  105.                    Extension    : String;
  106.                    ContentType  : String;
  107.                    HandlerName  : String;
  108.                   End;
  109.  
  110.   tFileHandlerInfo = Record
  111.                       HandlerName  : String;
  112.                       Description  : String;
  113.                       Icon         : String;
  114.                      End;
  115.  
  116.   tFileShellInfo   = Record
  117.                       HandlerName  : String;
  118.                       Action       : String; { Open, Print, Install, etc }
  119.                       MenuCaption  : String; { &Open, &Print, &Install, etc }
  120.                       Command      : String; { yourapp.exe %1 }
  121.                       DDEString    : String; { DDE Command }
  122.                       DDEApp       : String; { YOURAPPDDEID }
  123.                       DDETopic     : String; { YOUROWNTOPIC }
  124.                      End;
  125.  
  126.  
  127.   PHotKeyItem = ^THotKeyItem;
  128.   THotKeyItem = record
  129.     Modifiers : THKModifiers;
  130.     VirtKey   : TVirtKey;
  131.     Registered: Boolean;
  132.   end;
  133.  
  134.   tExportResourceResult  = (errOK,errNotFound,errLoadError,errFileExists);
  135.  
  136.   THotKey   = class (TPersistent)
  137.   private
  138.     FActive  : Boolean;
  139.     FList    : TList;
  140.     FParent  : Hwnd;
  141.    procedure SetActive(Value : Boolean);
  142.     function  GetCount: Integer;
  143.   protected
  144.     function  ModifiersToFlag(Modifiers : THKModifiers): UInt;
  145.     procedure RegisterHotKeyNr(Index : Integer);
  146.     procedure UnregisterHotKeyNr(Index : Integer);
  147.     procedure RegisterHotKeys;
  148.     procedure UnregisterHotKeys;
  149.   public
  150.     Constructor Create(Parent:Hwnd);
  151.     Destructor Destroy;Override;
  152.  
  153.     procedure Add(Item: THotKeyItem);
  154.     function  AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotkeyItem;
  155.     procedure Clear;
  156.     procedure Delete(Index : Integer);
  157.     function  Get(Index: Integer): THotKeyItem;
  158.     procedure Put(Index: Integer; Item: THotKeyItem);
  159.     { runtime only properties }
  160.     property  HotKeys[Index: Integer]: THotKeyItem read Get write Put; default;
  161.     property  HotKeyCount: integer read GetCount;
  162.   published
  163.     property  Enabled: Boolean read FActive write SetActive;
  164.   end;
  165.  
  166.   TVerInfo = class (TPersistent)
  167.   private
  168.     FFileDescription  : String;
  169.     FFileVersion      : String;
  170.     FCompanyName      : String;
  171.     FCopyright        : String;
  172.     FTrademark        : String;
  173.     FProductName      : String;
  174.     FProductVersion   : String;
  175.  
  176.   protected
  177.   public
  178.   published
  179.     property FileDescription    : String Read FFileDescription          Write FFileDescription;
  180.     property FileVersion        : String Read FFileVersion              Write FFileVersion;
  181.     property CompanyName        : String Read FCompanyName              Write FCompanyName;
  182.     property Copyright          : String Read FCopyright                Write FCopyright;
  183.     property Trademark          : String Read FTrademark                Write FTrademark;
  184.     property ProductName        : String Read FProductName              Write FProductName;
  185.     property ProductVersion     : String Read FProductVersion           Write FProductVersion;
  186.   end;
  187.   
  188.   TInfoRunInformation = class (TPersistent)
  189.   private
  190.     FStart        : Integer;
  191.     FFinish       : Integer;
  192.     FError        : Integer;
  193.     FLastStart    : TDateTime;
  194.     FLastFinish   : TDateTime;
  195.   protected
  196.   public
  197.   published
  198.     property Start         : Integer Read FStart          Write FStart;
  199.     property Finish        : Integer Read FFinish         Write FFinish;
  200.     property Error         : Integer Read FError          Write FError;
  201.     property LastStart     : tDateTime Read FLastStart    Write FLastStart;
  202.     property LastFinish    : tDateTime Read FLastFinish   Write FLastFinish;
  203.   end;
  204.  
  205.   TInfoRun = class (TPersistent)
  206.   private
  207.     FEnabled           : Boolean;
  208.     FINIFilename       : TFilename;
  209.     FInformation       : TInfoRunInformation;
  210.   protected
  211.   public
  212.     Constructor Create;
  213.     Destructor Destroy;Override;
  214.  
  215.     Procedure Start;
  216.     Procedure Finish;
  217.     Procedure Refresh;
  218.   published
  219.     property Enabled            : Boolean   Read FEnabled     Write FEnabled;    
  220.     property INIFilename        : TFilename Read FIniFilename Write FIniFilename;
  221.     property Information        : TInfoRunInformation Read FInformation Write FInformation;
  222.   end;
  223.  
  224.   TAutoRun = class (TPersistent)
  225.   private
  226.     FAutoRunStyle             : tAutoRunStyle;
  227.     FDescription              : ShortString;
  228.     FExecutable               : ShortString;
  229.     FGlobalAutoRun            : Boolean;
  230.  
  231.     Procedure SetDescription(Value:ShortString);
  232.     Procedure SetAutoRunStyle(Value:tAutoRunStyle);
  233.     Procedure SetExecutable(Value:ShortString);
  234.     Procedure SetAutoRun(Value:Boolean);
  235.     Function  GetAutoRun:Boolean;
  236.   protected
  237.   public
  238.     Constructor Create;
  239.     Destructor Destroy;Override;
  240.   published
  241.     property Description          : ShortString   Read FDescription   Write SetDescription;
  242.     property Style                : tAutoRunStyle read FAutoRunStyle  Write SetAutoRunStyle;
  243.     property Executable           : ShortString   Read FExecutable    Write SetExecutable;
  244.     property Enabled              : Boolean       Read GetAutoRun     Write SetAutoRun;
  245.     property Global               : Boolean       Read FGlobalAutoRun Write FGlobalAutoRun;
  246.   end;
  247.  
  248.   TProcess = class (TPersistent)
  249.   private
  250.     FServiceProcess           : Boolean;
  251.     FPriorityClass            : tPriorityClass;
  252.  
  253.     Procedure SetServiceProcess(Value:Boolean);
  254.  
  255.     Function  GetPriorityClass : tPriorityClass;
  256.     Procedure SetPriorityClass(Value:tPriorityClass);
  257.   protected
  258.     procedure ServiceProcessAction;
  259.   public
  260.     Constructor Create;
  261.     Destructor Destroy;Override;
  262.   published
  263.     property ServiceProcess       : Boolean read FServiceProcess Write SetServiceProcess;
  264.     property PriorityClass        : tPriorityClass Read GetPriorityClass Write SetPriorityClass;
  265.   end;
  266.   
  267.   TSecurity = class (TPersistent)
  268.   private
  269.     FAntiSoftIce              : Boolean;
  270.   protected
  271.     Function SoftIce95Loaded: boolean;
  272.     Function SoftIceNTLoaded: boolean;
  273.   public
  274.     Constructor Create;
  275.     Destructor Destroy;Override;
  276.   published
  277.     property AntiSoftIce          : Boolean Read FAntiSoftIce Write FAntiSoftIce;
  278.   end;
  279.  
  280.   TOnceRun = class (TPersistent)
  281.   private
  282.     FOnlyOnceRun              : Boolean;
  283.     FAtomID                   : String;
  284.     AtomIndex                 : Word;
  285.     Procedure SetOnlyOnceRun(Value:Boolean);
  286.   protected
  287.   public
  288.     Constructor Create;
  289.     Destructor Destroy;Override;
  290.   published
  291.     property Enabled          : Boolean Read FOnlyOncerun Write SetOnlyOnceRun;
  292.     property AtomID           : String  Read FAtomID write FAtomID;
  293.   end;
  294.  
  295.   TAppEx = class(TComponent)
  296.   private
  297.    ParentHwnd                : Hwnd;
  298.    PrevParentWndProc         : Pointer;
  299.    SeekAndDestroy            : Boolean;
  300.  
  301.    FOnSoftIceRun             : tNotifyEvent;
  302.  
  303.    FShowTaskBar              : Boolean;
  304.  
  305.    FLastDesign               : tDateTime;
  306.    FLastCompile              : tDateTime;
  307.  
  308.    FParameters               : tStrings;
  309.    FOnParameterFounded       : TOnParameterFounded;
  310.    FOnParameterValueFounded  : TOnParameterValueFounded;
  311.  
  312.    FOnRunAsSecondCopy        : tNotifyEvent;
  313.  
  314.    FAutoRun                  : TAutoRun;
  315.    FProcess                  : TProcess;
  316.    FSecurity                 : TSecurity;
  317.    FOnceRun                  : TOnceRun;
  318.    FInfoRun                  : TInfoRun;
  319.    FVerInfo                  : TVerInfo;
  320.    FHotKey                   : THotKey;
  321.    
  322.    { Events }
  323.    FOnUserChanged            : tNotifyEvent;
  324.    FOnDisplayChanged         : tOnDisplayChanged;
  325.    FOnEndSession             : tOnEndSessionQuery;
  326.  
  327.    { HotKey }
  328.    FOnHotkey                 : tOnHotKey;
  329.  
  330.    Procedure SetShowTaskbar(Value:Boolean);
  331.  
  332.    Function  GetLastDesign : tDateTime;
  333.    Function  GetLastCompile: tDateTime;
  334.   protected
  335.    Procedure TaskAction;
  336.    Procedure ProcessParameters;
  337.    Procedure ReadVerInfo;
  338.    procedure NewParentWndProc(var Message:Tmessage);
  339.   public
  340.    constructor Create(AOwner:TComponent);override;
  341.    destructor  Destroy;override;
  342.    procedure   Loaded;override;
  343.  
  344.    Procedure   UnInstall;
  345.    Procedure   Flash(Flash,Time: Integer);
  346.    Function    ExportResource(Name, Category, TargetFilename : String; Overwrite:Boolean):tExportResourceResult;
  347.    Procedure   RegisterFileType(Ext, Description,Icon : String);
  348.    { Your program must handler first parameter !, look for the code below }
  349.   published
  350.    property AutoRun                   : TAutoRun             Read FAutoRun           Write FAutoRun;
  351.    property Process                   : TProcess             Read FProcess           Write FProcess;
  352.    property Security                  : TSecurity            Read FSecurity          Write FSecurity;
  353.    property OnceRun                   : TOnceRun             Read FOnceRun           Write FOnceRun;
  354.    property InfoRun                   : TInfoRun             Read FInfoRun           Write FInfoRun;
  355.    property VersionInfo               : TVerInfo             Read FVerInfo           Write FVerInfo;
  356.    property HotKey                    : THotKey              Read FHotKey            Write FHotKey;   
  357.  
  358.    property Parameters                : tStrings Read FParameters Write FParameters;
  359.    property ShowOnTaskBar             : Boolean read FShowTaskBar Write SetShowTaskBar;
  360.    property LastCompileDate           : tDateTime read GetLastCompile write FLastCompile;
  361.    property LastDesignDate            : tDateTime read GetLastDesign  write FLastDesign;
  362.  
  363.    Property OnSoftIceRun              : TNotifyEvent Read FOnSoftIceRun Write FOnSoftIceRun;
  364.  
  365.    property OnRunAsSecondCopy         : tNotifyEvent Read  FOnRunAsSecondCopy  Write FOnRunAsSecondCopy;
  366.  
  367.    property OnParameterFounded        : TOnParameterFounded Read FOnParameterFounded   Write FOnParameterFounded;
  368.    property OnParameterValueFounded   : TOnParameterValueFounded Read FOnParameterValueFounded   Write FOnParameterValueFounded;
  369.  
  370.    property OnUserChanged             : TNotifyEvent Read FOnUserChanged Write FOnUserChanged;
  371.    property OnDisplayChanged          : TOnDisplayChanged Read FOnDisplayChanged Write FOnDisplayChanged;
  372.    property OnEndSession              : TOnEndSessionQuery Read FOnEndSession Write FOnEndSession;
  373.  
  374.    property OnHotKey                  : TOnHotKey Read FOnHotKey Write FOnHotKey;
  375.   End;
  376.  
  377. function KeyToVirtKey(const Key: Char): TVirtKey;
  378. function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  379.   
  380. procedure Register;
  381.  
  382. implementation
  383.  
  384. Var
  385.   VirtKeys : array[TVirtKey] of UInt =
  386.              ($00, $03, $08, $09, $0C, $0D, $13, $14, $1B,
  387.               $20, $21, $22, $23, $24, $25, $26, $27, $28,
  388.               $29, $2B, $2C, $2D, $2E, $2F,
  389.               $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
  390.               $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A,
  391.               $4B, $4C, $4D, $4E, $4F, $50, $51, $52, $53, $54,
  392.               $55, $56, $57, $58, $59, $5A,
  393.               $60, $61, $62, $63, $64, $65, $66, $67, $68, $69,
  394.               $6A, $6B, $6C, $6D, $6E, $6F,
  395.               $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B,
  396.               $7C, $7D, $7E, $7F, $80, $81, $82, $83, $84, $85, $86, $87,
  397.               $90, $91, $5D,
  398.               186, 187, 188, 189, 190, 191, 192, 219, 220, 221, 222);
  399.  
  400. Const
  401.  Run              = 'Run';             { Run Every Login }
  402.  RunService       = 'RunService';      { Run Every Windows Start }
  403.  RunServiceOnce   = 'RunServiceOnce';  { Run Every Warm boot }
  404.  RunOnce          = 'RunOnce';         { Run Every Windows First Start }
  405.  RunOnceEx        = 'RunOnceEx';       { Run Every ? }
  406.  
  407. Var
  408.   Designing : Boolean;
  409.  
  410. function KeyToVirtKey(const Key: Char): TVirtKey;
  411. var
  412.   i     : TVirtKey;
  413.   KeyVal: UInt;
  414. begin
  415.   Result := TVirtKey(0);
  416.   KeyVal := Ord(UpperCase(Key)[1]);
  417.   for i:= Low(TVirtKey) to High(TVirtKey) do
  418.    if KeyVal = VirtKeys[i] then
  419.     begin
  420.       Result := TVirtKey(i);
  421.       Exit;
  422.     end;
  423. end;
  424.  
  425. function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  426. begin
  427.   Result.VirtKey := VirtKey;
  428.   Result.Modifiers := Modifiers;
  429.   Result.Registered := False;
  430. end;
  431.   
  432. { Miscellaneous Routines }
  433. function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
  434.  
  435. { **** File Associate **** }
  436.  
  437.  
  438. Procedure GetFileExtInfo(Var Info:tFileExtInfo);
  439. Begin
  440.  With TRegistry.Create do
  441.  Try
  442.   RootKey:=HKEY_CLASSES_ROOT;
  443.   If OpenKey(Info.Extension,False) then
  444.   Begin
  445.    Info.ContentType := ReadString('Content Type');
  446.    Info.HandlerName := ReadString('');
  447.    CloseKey;
  448.   End;
  449.  Finally
  450.   Free;
  451.  End;
  452. End;
  453.  
  454. Procedure SetFileExtInfo(Info:tFileExtInfo);
  455. begin
  456.  With TRegistry.Create do
  457.  Try
  458.   RootKey:=HKEY_CLASSES_ROOT;
  459.   If OpenKey(Info.Extension,True) then
  460.   Begin
  461.    If Info.ContentType<>'' then WriteString('Content Type',Info.ContentType);
  462.    WriteString('',Info.HandlerName);
  463.    CloseKey;
  464.   End;
  465.  Finally
  466.   Free;
  467.  End;
  468. End;
  469.  
  470. Procedure GetFileHandlerInfo(Var Info:tFileHandlerInfo);
  471. Begin
  472.  With TRegistry.Create do
  473.  Try
  474.   RootKey:=HKEY_CLASSES_ROOT;
  475.  
  476.   If OpenKey(Info.HandlerName,False) then
  477.   Begin
  478.    Info.Description := ReadString('');
  479.    CloseKey;
  480.   End;
  481.  
  482.   If OpenKey(Info.HandlerName+'\DefaultIcon',False) then
  483.   Begin
  484.    Info.Icon := ReadString('');
  485.    CloseKey;
  486.   End;
  487.  
  488.  Finally
  489.   Free;
  490.  End;
  491. End;
  492.  
  493. Procedure SetFileHandlerInfo(Info:tFileHandlerInfo);
  494. Begin
  495.  With TRegistry.Create do
  496.  Try
  497.   RootKey:=HKEY_CLASSES_ROOT;
  498.  
  499.   If OpenKey(Info.HandlerName,True) then
  500.   Begin
  501.    WriteString('',Info.Description);
  502.    CloseKey;
  503.   End;
  504.  
  505.   { *** Optional *** }
  506.   If (Info.Icon<>'') and OpenKey(Info.HandlerName+'\DefaultIcon',True) then
  507.   Begin
  508.    WriteString('',Info.Icon);
  509.    CloseKey;
  510.   End;
  511.  
  512.  
  513.  Finally
  514.   Free;
  515.  End;
  516. End;
  517.  
  518. Procedure GetFileShellInfo(Var Info:tFileShellInfo);
  519. Begin
  520.  With TRegistry.Create do
  521.  Try
  522.   RootKey:=HKEY_CLASSES_ROOT;
  523.  
  524.   If OpenKey(Info.HandlerName+'\shell\'+Info.Action,False) then
  525.   Begin
  526.    Info.MenuCaption := ReadString('');
  527.    CloseKey;
  528.   End;
  529.  
  530.   If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\command',False) then
  531.   Begin
  532.    Info.Command := ReadString('');
  533.    CloseKey;
  534.   End;
  535.  
  536.   If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec',False) then
  537.   Begin
  538.    Info.DDEString := ReadString('');
  539.    CloseKey;
  540.   End;
  541.  
  542.   If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Application',False) then
  543.   Begin
  544.    Info.DDEApp := ReadString('');
  545.    CloseKey;
  546.   End;
  547.  
  548.   If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Topic',False) then
  549.   Begin
  550.    Info.DDETopic := ReadString('');
  551.    CloseKey;
  552.   End;
  553.  
  554.  Finally
  555.   Free;
  556.  End;
  557. End;
  558.  
  559. Procedure SetFileShellInfo(Info:tFileShellInfo);
  560. Begin
  561.  With TRegistry.Create do
  562.  Try
  563.   RootKey:=HKEY_CLASSES_ROOT;
  564.  
  565.   If (Info.MenuCaption<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action,True) then
  566.   Begin
  567.    WriteString('',Info.MenuCaption);
  568.    CloseKey;
  569.   End;
  570.  
  571.   If (Info.Command<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\command',True) then
  572.   Begin
  573.    WriteString('',Info.Command);
  574.    CloseKey;
  575.   End;
  576.  
  577.   If (Info.DDEString<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec',True) then
  578.   Begin
  579.    WriteString('',Info.DDEString);
  580.    CloseKey;
  581.   End;
  582.  
  583.   If (Info.DDEApp<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Application',True) then
  584.   Begin
  585.    WriteString('',Info.DDEApp);
  586.    CloseKey;
  587.   End;
  588.  
  589.   If (Info.DDETopic<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Topic',True) then
  590.   Begin
  591.    WriteString('',Info.DDETopic);
  592.    CloseKey;
  593.   End;
  594.  
  595.  Finally
  596.   Free;
  597.  End;
  598. End;
  599.  
  600. { **** End of File Associate **** }
  601.  
  602. Procedure AddToAutoRun(Root:HKEY;Flag:String;AppDesc,Executable:String);
  603. var reg:tregistry;
  604. begin
  605.  Reg:=tRegistry.create;
  606.  With Reg do
  607.  Begin
  608.   RootKey:=Root;
  609.   Openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
  610.   WriteString(AppDesc,Executable);
  611.   Closekey;
  612.   Free;
  613.  End;
  614. End;
  615.  
  616. Function CheckFromAutoRun(Root:HKEY;Flag:String;AppDesc:String):Boolean;
  617. var reg:tregistry;
  618. begin
  619.  reg:=tregistry.create;
  620.  with reg do
  621.  begin
  622.   rootkey:=Root;
  623.   openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
  624.   Result:=ValueExists(ApPDesc);
  625.   Closekey;
  626.   Free;
  627.  end;
  628. end;
  629.  
  630. Procedure RemovefromAutoRun(Root:HKEY;Flag:String;AppDesc:String);
  631. var reg:tregistry;
  632. begin
  633.  reg:=tregistry.create;
  634.  with reg do
  635.  begin
  636.   Rootkey:=Root;
  637.   openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
  638.   DeleteValue(AppDesc);
  639.   Closekey;
  640.   free;
  641.  end;
  642. end;
  643.  
  644.  
  645. { Ext--> .txt, .bmp, .jpg }
  646.  
  647. Procedure tAutoRun.SetDescription(Value:ShortString);
  648. Begin
  649.   If (Value<>FDescription) then
  650.     FDescription:=Value;
  651. End;
  652.  
  653. function THotKey.ModifiersToFlag(Modifiers : THKModifiers): UInt;
  654. begin
  655.   Result := 0;
  656.   if hkShift in Modifiers then Result := Result or MOD_SHIFT;
  657.   if hkCtrl  in Modifiers then Result := Result or MOD_CONTROL;
  658.   if hkAlt   in Modifiers then Result := Result or MOD_ALT;
  659.   if hkExt   in Modifiers then Result := Result or MOD_WIN;
  660. end;
  661.  
  662. procedure THotKey.RegisterHotKeyNr(Index : Integer);
  663. begin
  664.   with PHotKeyItem(FList.Items[Index])^ do
  665.    Registered :=
  666.    WordBool(RegisterHotKey(FParent, Index,
  667.             ModifiersToFlag(Modifiers), VirtKeys[VirtKey]));
  668. end;
  669.  
  670. procedure THotKey.UnRegisterHotKeyNr(Index : Integer);
  671. begin
  672.   with PHotKeyItem(FList.Items[Index])^ do
  673.    if Registered then
  674.     begin
  675.       UnregisterHotKey(FParent, Index);
  676.       Registered := False;
  677.     end;
  678. end;
  679.  
  680. procedure THotKey.RegisterHotKeys;
  681. var
  682.   I : integer;
  683. begin
  684.   for I:=0 to FList.Count-1 do
  685.    RegisterHotKeyNr(I);
  686. end;
  687.  
  688. procedure THotKey.UnregisterHotKeys;
  689. var
  690.   I : integer;
  691. begin
  692.   for I:=0 to FList.Count-1 do
  693.    UnregisterHotKeyNr(I);
  694. end;
  695.  
  696. procedure THotKey.SetActive(Value : Boolean);
  697. begin
  698.   if FActive<>Value then
  699.    begin
  700.      FActive := Value;
  701.      if FActive then RegisterHotKeys else UnregisterHotKeys;
  702.    end;
  703. end;
  704.  
  705. procedure THotKey.Add(Item: THotKeyItem);
  706. begin
  707.   AddHotKey(Item.VirtKey, Item.Modifiers);
  708. end;
  709.  
  710. function THotKey.AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  711. var
  712.   pItem : PHotKeyItem;
  713.   iItem : Integer;
  714. begin
  715.   pItem := PHotKeyItem(AllocMem(sizeof(THotKeyItem)));
  716.   pItem^.VirtKey := VirtKey;
  717.   pItem^.Modifiers := Modifiers;
  718.   iItem := FList.Add(pItem);
  719.   if FActive then RegisterHotKeyNr(iItem);
  720.   Result := pItem^;
  721. end;
  722.  
  723. procedure THotKey.Clear;
  724. var
  725.   I : integer;
  726. begin
  727.   if FActive then UnregisterHotKeys;
  728.   for I:=0 to FList.Count-1 do
  729.    FreeMem(FList.Items[I]);
  730.   FList.Clear;
  731. end;
  732.  
  733. procedure THotKey.Delete(Index : Integer);
  734. begin
  735.   if FActive then UnregisterHotKeys;
  736.   FreeMem(FList.Items[Index]);
  737.   FList.Delete(Index);
  738.   FList.Pack;
  739.   if FActive then RegisterHotKeys;
  740. end;
  741.  
  742. function THotKey.Get(Index: Integer): THotKeyItem;
  743. begin
  744.   Result := THotKeyItem(FList.Items[Index]^);
  745. end;
  746.  
  747. procedure THotKey.Put(Index: Integer; Item: THotKeyItem);
  748. begin
  749.   if FActive then UnregisterHotKeyNr(Index);
  750.   with THotKeyItem(FList.Items[Index]^) do
  751.    begin
  752.      VirtKey := Item.VirtKey;
  753.      Modifiers := Item.Modifiers;
  754.    end;
  755.   if FActive then RegisterHotKeyNr(Index);
  756. end;
  757.  
  758. function THotKey.GetCount: integer;
  759. begin
  760.   Result := FList.Count;
  761. end;
  762.  
  763. destructor THotKey.Destroy;
  764. begin
  765.   inherited Destroy;
  766.   Clear;
  767.   FList.Free;
  768. end;
  769.  
  770. constructor THotKey.Create(Parent:Hwnd);
  771. begin
  772.   inherited Create;
  773.   FParent:=Parent;
  774.   FList     := tList.Create;
  775. end;
  776.  
  777.  
  778. Procedure tAutoRun.SetAutoRunStyle(Value:tAutoRunStyle);
  779. Begin
  780.   If (Value<>FAutoRunStyle) then
  781.     FAutoRunStyle:=Value;
  782. End;
  783.  
  784. Procedure tAutoRun.SetExecutable(Value:ShortString);
  785. Begin
  786.   If Not FileExists(Value) then
  787.   Begin
  788.     raise exception.create('Executable File not Found!');
  789.   End;
  790.   if not Designing then
  791.     If (Value<>FExecutable) then
  792.       FExecutable:=Value;
  793. End;
  794.  
  795. Function  TAutoRun.GetAutoRun:Boolean;
  796. var Root : HKEY;
  797.     Flag : String;
  798. Begin
  799.  Result:=False;
  800.  if Designing then exit;
  801.  If Global then Root:=HKEY_LOCAL_MACHINE else Root:=HKEY_CURRENT_USER;
  802.  
  803.  If Style=arsLogin then Flag:=Run else
  804.  If Style=arsStart then Flag:=RunService else
  805.  If Style=arsWarmBoot then Flag:=RunServiceOnce else
  806.  If Style=arsFirstStart then Flag:=RunOnce;
  807.  Result:=CheckFromAutoRun(Root,Flag,Description);
  808. End;
  809.  
  810. procedure TAutoRun.SetAutoRun(Value:Boolean);
  811. var Root : HKEY;
  812.     Flag : String;
  813. Begin
  814.  if Designing then exit;
  815.  If Global then Root:=HKEY_LOCAL_MACHINE else Root:=HKEY_CURRENT_USER;
  816.  
  817.  If Style=arsLogin then Flag:=Run else
  818.  If Style=arsStart then Flag:=RunService else
  819.  If Style=arsWarmBoot then Flag:=RunServiceOnce else
  820.  If Style=arsFirstStart then Flag:=RunOnce;
  821.  If Value then
  822.  Begin
  823.   AddToAutoRun(Root,Flag,Description,Executable);
  824.  End else
  825.   RemoveFromAutoRun(Root,Flag,Description);
  826. End;
  827.  
  828. destructor TAutoRun.Destroy;
  829. begin
  830.   inherited Destroy;
  831. end;
  832.  
  833. constructor TAutoRun.Create;
  834. begin
  835.   inherited Create;
  836.   Style           := arsLogin;
  837.   Global          := True;
  838.   Enabled         := False;
  839.   If Not Designing then
  840.   Begin
  841.    Description     := (ExtractFilename(Application.ExeName));
  842.    Executable      := Application.ExeName;
  843.   End;
  844. end;
  845.  
  846. destructor TProcess.Destroy;
  847. begin
  848.   inherited Destroy;
  849. end;
  850.  
  851. constructor TProcess.Create;
  852. begin
  853.   inherited Create;
  854.   ServiceProcess  :=False;
  855.   PriorityClass   :=pcNormal;
  856. end;
  857.  
  858. Function  TProcess.GetPriorityClass : tPriorityClass;
  859. var PC : Integer;
  860. Begin
  861.  Result:=pcNormal;
  862.  If Not Designing then
  863.  Begin
  864.   PC:=Windows.GetPriorityClass(GetCurrentProcess());
  865.   Case PC  of
  866.   NORMAL_PRIORITY_CLASS           : Result:=pcNormal;
  867.   IDLE_PRIORITY_CLASS             : Result:=pcIdle;
  868.   HIGH_PRIORITY_CLASS             : Result:=pcHigh;
  869.   REALTIME_PRIORITY_CLASS         : Result:=pcRealTime;
  870.   End;
  871.  End;
  872. End;
  873.  
  874. Procedure TProcess.SetPriorityClass(Value:tPriorityClass);
  875. var PC : Integer;
  876. Begin
  877.  If (Value<>FPriorityClass) then
  878.  Begin
  879.   FPriorityClass:=Value;
  880.   If Not Designing then
  881.   Begin
  882.    If FPriorityClass=pcNormal   then PC:=NORMAL_PRIORITY_CLASS   else
  883.    If FPriorityClass=pcIdle     then PC:=IDLE_PRIORITY_CLASS     else
  884.    If FPriorityClass=pcHigh     then PC:=HIGH_PRIORITY_CLASS     else
  885.    If FPriorityClass=pcRealTime then PC:=REALTIME_PRIORITY_CLASS;
  886.    Windows.SetPriorityClass(GetCurrentProcess,PC);
  887.   End;
  888.  End;
  889. End;
  890.  
  891. Procedure TProcess.ServiceProcessAction;
  892. Begin
  893.  if Designing then exit;
  894.  if FServiceProcess Then
  895.   RegisterServiceProcess(GetCurrentProcessID, 1)
  896.  else
  897.   RegisterServiceProcess(GetCurrentProcessID, 0);
  898. End;
  899.  
  900. Procedure TProcess.SetServiceProcess(Value:Boolean);
  901. begin
  902.  if (Value<>FServiceProcess) then
  903.  Begin
  904.   FServiceProcess := Value;
  905.  If Not Designing then
  906.   ServiceProcessAction;
  907.  End;
  908. end;
  909.  
  910. destructor TSecurity.Destroy;
  911. begin
  912.   inherited Destroy;
  913. end;
  914.  
  915. constructor TSecurity.Create;
  916. begin
  917.   inherited Create;
  918. end;
  919.  
  920. Function TSecurity.SoftIce95Loaded: boolean;
  921. Var hFile: Thandle;
  922. Begin
  923.   Result := false;
  924.   hFile := CreateFileA('\\.\SICE', GENERIC_READ or GENERIC_WRITE,
  925.     FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
  926.     FILE_ATTRIBUTE_NORMAL, 0);
  927.   if( hFile <> INVALID_HANDLE_VALUE ) then begin
  928.     CloseHandle(hFile);
  929.     result := TRUE;
  930.   end;
  931. End;
  932.  
  933. Function TSecurity.SoftIceNTLoaded: boolean;
  934. Var hFile: Thandle;
  935. Begin
  936.   result := false;
  937.   hFile := CreateFileA('\\.\NTICE', GENERIC_READ or GENERIC_WRITE,
  938.     FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
  939.     FILE_ATTRIBUTE_NORMAL, 0);
  940.   if( hFile <> INVALID_HANDLE_VALUE ) then begin
  941.     CloseHandle(hFile);
  942.     result := TRUE;
  943.   end;
  944. End;
  945.  
  946. destructor TOnceRun.Destroy;
  947. begin
  948.   If FOnlyOnceRun then
  949.     GlobalDeleteAtom(AtomIndex);
  950.   inherited Destroy;
  951. end;
  952.  
  953. constructor TOnceRun.Create;
  954. begin
  955.   inherited Create;
  956.   Enabled      := False;
  957.   If Not Designing then
  958.     AtomId       := ExtractFilename(Application.ExeName);
  959. end;
  960.  
  961. Procedure TOnceRun.SetOnlyOnceRun(Value:Boolean);
  962. Begin
  963.   If (Value<>FOnlyOnceRun) then
  964.     FOnlyOnceRun:=Value;
  965. End;
  966.  
  967. constructor TInfoRun.Create;
  968. begin
  969.   inherited Create;
  970.   FInformation:=TInfoRunInformation.Create;
  971.   If Not Designing then
  972.   Begin
  973.     FIniFilename := ChangeFileExt(Application.ExeName,'.AEX');
  974.   End;
  975. end;
  976.  
  977. destructor TInfoRun.Destroy;
  978. begin
  979.   FInformation.Free;
  980.   inherited Destroy;
  981. end;
  982.  
  983. Procedure TInfoRun.Start;
  984. Begin
  985.   If FIniFilename='' then Exit;
  986.   With TIniFile.Create(FIniFilename) do
  987.   Try
  988.     WriteInteger('InfoRun','Start',ReadInteger('InfoRun','Start',0)+1);
  989.     WriteDateTime('InfoRun','Last Start',Now);
  990.   Finally
  991.     Free;
  992.   End;
  993. End;
  994.  
  995. Procedure TInfoRun.Finish;
  996. Begin
  997.   If FIniFilename='' then Exit;
  998.   With TIniFile.Create(FIniFilename) do
  999.   Try
  1000.     WriteInteger('InfoRun','Finish',ReadInteger('InfoRun','Finish',0)+1);
  1001.     WriteDateTime('InfoRun','Last Finish',Now);
  1002.   Finally
  1003.     Free;
  1004.   End;
  1005. End;
  1006.  
  1007. Procedure TInfoRun.Refresh;
  1008. Begin
  1009.   If FIniFilename='' then Exit;
  1010.   With TIniFile.Create(FIniFilename) do
  1011.   Try
  1012.     FInformation.Start:= ReadInteger('InfoRun','Start',0);
  1013.     FInformation.Finish:=ReadInteger('InfoRun','Finish',0);
  1014.     FInformation.LastStart:=ReadDateTime('InfoRun','Last Start',Now);
  1015.     FInformation.LastStart:=ReadDateTime('InfoRun','Last Finish',Now);
  1016.     If FInformation.Start > FInformation.Finish then
  1017.      FInformation.Error:= FInformation.Start-FInformation.Finish else
  1018.      FInformation.Error:=0;
  1019.   Finally
  1020.     Free;
  1021.   End;
  1022. End;
  1023.  
  1024. Procedure  TAppEx.RegisterFileType(Ext, Description, Icon : String);
  1025. var FileExtI     : tFileExtInfo;
  1026.     FileHandlerI : tFileHandlerInfo;
  1027.     FileShellI   : tFileShellInfo;
  1028.  
  1029. Begin
  1030.  FileExtI.Extension:=Ext;
  1031.  FileExtI.HandlerName:=Copy(Ext,Pos('.',Ext)+1, 3)+'file'; { .txt -> txtfile }
  1032.  SetFileExtInfo(FileExtI);
  1033.  
  1034.  FileHandlerI.HandlerName:=FileExtI.HandlerName;
  1035.  FileHandlerI.Description:=Description;
  1036.  FileHandlerI.Icon:=Icon;
  1037.  SetFileHandlerInfo(FileHandlerI);
  1038.  
  1039.  FileShellI.HandlerName:=FileExtI.HandlerName;
  1040.  FileShellI.Action:='open'; { Open / Install / Print, etc }
  1041.  FileShellI.Command:=Paramstr(0)+' %1';
  1042.  SetFileShellInfo(FileShellI);
  1043. End;
  1044.  
  1045. Procedure tAppEx.SetShowTaskBar(Value:Boolean);
  1046. Begin
  1047.  If Value<>FShowTaskBar then
  1048.  Begin
  1049.   FShowTaskBar:=Value;
  1050.  If Not Designing then
  1051.   TaskAction;
  1052.  End;
  1053. End;
  1054.  
  1055. Constructor tAppEx.create(AOwner:TComponent);
  1056. var P : Pointer;
  1057. Begin
  1058.  inherited Create(AOwner);
  1059.  Designing       := (csDesigning in ComponentState);
  1060.  
  1061.  FShowTaskBar    := true;
  1062.  FParameters     := tStringList.Create;
  1063.  ParentHwnd      := (AOwner as tForm).Handle;
  1064.  
  1065.  FAutoRun        := TAutoRun.Create;
  1066.  FProcess        := TProcess.Create;
  1067.  FSecurity       := TSecurity.Create;
  1068.  FOnceRun        := TOnceRun.Create;
  1069.  FInfoRun        := TInfoRun.Create;
  1070.  FVerInfo        := TVerInfo.Create;
  1071.  FHotKey         := THotKey.Create(ParentHwnd);
  1072.  
  1073.  if not Designing then
  1074.  Begin
  1075.   PrevParentWndProc := Pointer(GetWindowLong(ParentHWnd, GWL_WNDPROC));
  1076.   P := MakeObjectInstance(NewParentWndProc);
  1077.   SetWindowLong(ParentHWnd, GWL_WNDPROC, LongInt(p));
  1078.   ReadVerInfo;
  1079.  End;
  1080. End;
  1081.  
  1082. Destructor tAppEx.destroy;
  1083. Begin
  1084.  inherited destroy;
  1085.  FAutoRun.Free;
  1086.  FProcess.Free;
  1087.  FSecurity.Free;
  1088.  FOnceRun.Free;
  1089.  FInfoRun.Free;
  1090.  FVerInfo.Free;
  1091.  FHotkey.Free;
  1092.  
  1093.  if not Designing then
  1094.  Begin
  1095.    if not SeekAndDestroy then
  1096.    begin
  1097.     SetWindowLong(ParentHWnd, GWL_WNDPROC, LongInt(PrevParentWndProc));
  1098.    end;
  1099.  End;
  1100.  FParameters.Free;
  1101. End;
  1102.  
  1103. procedure TAppEx.ReadVerInfo;
  1104. Var
  1105.   VersionHandle,
  1106.   VersionSize        : Dword;
  1107.   PItem,
  1108.   PVersionInfo       : Pointer;
  1109.   FixedFileInfo      :PVSFixedFileInfo;
  1110.   Il                 : Uint;
  1111.   Filename           : String;
  1112.   P                  : Array [0..MAX_PATH - 1] of char;
  1113. Begin
  1114.  Filename:=Paramstr(0);
  1115.  if Filename<>'' then
  1116.  Begin
  1117.   StrPCopy(P,Filename);
  1118.   VersionSize:=GetFileVersionInfoSize(P,VersionHandle);
  1119.  
  1120.   If VersionSize=0 Then Exit;
  1121.  
  1122.   GetMem(PVersionInfo,VersionSize);
  1123.   Try
  1124.    If GetFileVersionInfo(P,VersionHandle,VersionSize,PVersionInfo) then
  1125.    Begin
  1126.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\FileDescription'),pitem,il) then
  1127.      FVerInfo.FileDescription:=Pchar(pitem);
  1128.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\FileVersion'),pitem,il) then
  1129.      FVerInfo.FileVersion:=Pchar(pitem);
  1130.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\CompanyName'),pitem,il) then
  1131.      FVerInfo.CompanyName:=Pchar(pitem);
  1132.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\LegalCopyright'),pitem,il) then
  1133.      FVerInfo.Copyright:=Pchar(pitem);
  1134.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\LegalTrademark'),pitem,il) then
  1135.      FVerInfo.Trademark:=Pchar(pitem);
  1136.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\ProductName'),pitem,il) then
  1137.      FVerInfo.ProductName:=Pchar(pitem);
  1138.     if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\ProductVersion'),pitem,il) then
  1139.      FVerInfo.ProductVersion:=Pchar(pitem);
  1140.    end;
  1141.   Finally
  1142.    FreeMem(pversioninfo,versionsize);
  1143.   End;
  1144.  End;
  1145. End;
  1146.  
  1147. Procedure tAppEx.ProcessParameters;
  1148. Var I : Integer;
  1149.     Param : String;
  1150. Begin
  1151.   For I:=1 to ParamCount do
  1152.   Begin
  1153.  
  1154.     Param:=ParamStr(I);
  1155.     FParameters.Add(Param);
  1156.  
  1157.     If Pos(':',Param)=0 then
  1158.     Begin
  1159.       If Assigned(FOnParameterFounded) then FOnParameterFounded(Self,Param);
  1160.     end else
  1161.     Begin
  1162.  
  1163.       If Assigned(FOnParameterValueFounded) then
  1164.        FOnParameterValueFounded(Self,Param, Copy(Param,1,Pos(':',Param)-1), Copy(Param,Pos(':',Param)+1,Length(Param)-Pos(':',Param)+1) ) else
  1165.     End;
  1166.  
  1167.   End;
  1168. End;
  1169.  
  1170.  
  1171. Procedure tAppEx.Loaded;
  1172. Begin
  1173.  inherited Loaded;
  1174.  if not Designing then
  1175.  Begin
  1176.   ProcessParameters;
  1177. //  TaskAction;
  1178.   if FOnceRun.Enabled then
  1179.   begin
  1180.    If (GlobalFindAtom(Pchar(FOnceRun.AtomID))=0) then
  1181.    Begin
  1182.     FOnceRun.AtomIndex:=GlobalAddAtom(Pchar(FOnceRun.AtomID));
  1183.    End else
  1184.    Begin
  1185.     If Assigned(FOnRunAsSecondCopy) then
  1186.       FOnRunAsSecondCopy(Self);
  1187.    End;
  1188.   end;
  1189.  
  1190.   If FSecurity.AntiSoftIce then
  1191.   Begin
  1192.    if FSecurity.SoftIce95Loaded or FSecurity.SoftIceNTLoaded then
  1193.    begin
  1194.     If Assigned(FOnSoftICeRun) then FOnSoftIceRun(Self);
  1195.    end;
  1196.   End;
  1197.  
  1198.   if FHotKey.Enabled then
  1199.   Begin
  1200.    FHotKey.RegisterHotKeys;
  1201.   End;
  1202.   
  1203.  End else
  1204.  Begin
  1205.   If FileExists(FInfoRun.INIFilename) then FInfoRun.Refresh;
  1206.  End;
  1207. End;
  1208.  
  1209. Procedure tAppEx.Uninstall;
  1210. Var Tmp : Array[0..1024] of Char;
  1211.     AppShortName,
  1212.     Windir,
  1213.     Buffer : String;
  1214.     F : Textfile;
  1215.     BackupFile : tStringList;
  1216.     C : Word;
  1217.     DoIt:Boolean;
  1218. Begin
  1219.   If Not Designing Then
  1220.   Begin
  1221.     GetShortPathname(Pchar(Application.Exename),Tmp,1025);
  1222.     AppShortName:=String(Tmp);
  1223.     GetWindowsDirectory(Tmp,1025);
  1224.     Windir:=String(Tmp);
  1225.     If Length(Windir)>3 Then Windir:=Windir+'\';
  1226.     Assignfile(F,Windir+'Wininit.Ini');
  1227.     If Fileexists(Windir+'Wininit.Ini')=False Then
  1228.     Begin
  1229.       Rewrite(F);
  1230.       Writeln(F,'[Rename]');
  1231.       Writeln(F,'Nul='+Appshortname);
  1232.     End Else
  1233.     Begin
  1234.       Backupfile:=Tstringlist.Create;
  1235.       Reset(F);
  1236.       While Not Eof(F) Do
  1237.       Begin
  1238.         Readln(F,Buffer);
  1239.         Backupfile.Add(Buffer);
  1240.       End;
  1241.       Closefile(F);
  1242.       Doit:=False;
  1243.       For C:=0 To Backupfile.Count-1 Do
  1244.       If Uppercase(Backupfile.Strings[C])='[Rename]' Then
  1245.       Begin
  1246.         Backupfile.Insert(C+1,'Nul='+Appshortname);
  1247.         Doit:=True;
  1248.         Break;
  1249.       End;
  1250.       Rewrite(F);
  1251.       For C:=0 To Backupfile.Count-1 Do Writeln(F,Backupfile.Strings[C]);
  1252.       If Doit=False Then
  1253.       Begin
  1254.         Writeln(F,'[Rename]');
  1255.         Writeln(F,'Nul='+Appshortname);
  1256.       End;
  1257.       Backupfile.Free;
  1258.     End;
  1259.     Closefile(F);
  1260.   End;
  1261. End;
  1262.  
  1263. Procedure TAppEx.TaskAction;
  1264. begin
  1265.   if Not FShowTaskBar then
  1266.    ShowWindow(FindWindow(nil,@Application.Title[1]),SW_HIDE) else
  1267.    ShowWindow(FindWindow(nil,@Application.Title[1]),SW_RESTORE);
  1268. End;
  1269.  
  1270. procedure TAppEx.NewParentWndProc(var Message:Tmessage);
  1271. Var EndSession     : Boolean;
  1272.     SkipOldWndProc : Boolean;
  1273.  
  1274. Begin
  1275.  SkipOldWndProc:=False;
  1276.  With Message do
  1277.  Begin
  1278.    If (Msg=WM_HOTKEY) then
  1279.    Begin
  1280.      If Assigned(FOnHotKey) then FOnHotKey(Self,wParam);
  1281.    end else
  1282.  
  1283.    if (Msg = WM_CLOSE) or (Msg = WM_DESTROY) then
  1284.    Begin
  1285.      SeekAndDestroy := True;
  1286.    End else
  1287.  
  1288.    If (Msg=WM_SIZE) then
  1289.    Begin
  1290.     If (WParam=SIZE_MINIMIZED) then
  1291.     Begin
  1292.       If Not FShowTaskBar then
  1293.       Begin
  1294.         Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1295.         TaskAction;
  1296.         SkipOldWndProc:=True;
  1297.       End;
  1298.     End;
  1299.    end else
  1300.  
  1301.    If (Msg=WM_ACTIVATEAPP) then
  1302.    Begin
  1303.     If Not FShowTaskBar then
  1304.      Begin
  1305.        Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1306.        TaskAction;
  1307.        SkipOldWndProc:=True;
  1308.      End;
  1309.    end else
  1310.  
  1311.    If (Msg=WM_WINDOWPOSCHANGED) then
  1312.    Begin
  1313.      If Not FShowTaskBar then
  1314.      Begin
  1315.        Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1316.        TaskAction;
  1317.        SkipOldWndProc:=True;
  1318.      End;
  1319.    end else
  1320.  
  1321.    If (Msg=WM_NCACTIVATE) then
  1322.    Begin
  1323.      If Not FShowTaskBar then
  1324.      Begin
  1325.        Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1326.        TaskAction;
  1327.        SkipOldWndProc:=True;
  1328.      End;
  1329.    end else
  1330.  
  1331.    If (Integer(MSG)>WM_USER) then
  1332.    Begin
  1333.     If Not FShowTaskBar then
  1334.      Begin
  1335.        Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1336.        TaskAction;
  1337.        SkipOldWndProc:=True;
  1338.      End;
  1339.    end else
  1340.  
  1341.    If (Msg=WM_USERCHANGED) then
  1342.    Begin
  1343.      If Assigned(FOnUserChanged) then FOnUserChanged(Self);
  1344.    end else
  1345.  
  1346.    If (Msg=WM_DISPLAYCHANGE) then
  1347.    Begin
  1348.      If Assigned(FOnDisplayChanged) then FOnDisplayChanged(Self,lParamLo,lParamHi,wParam);
  1349.    end else
  1350.  
  1351.    If (Msg=WM_QUERYENDSESSION) then
  1352.    Begin
  1353.      If Assigned(FOnEndSession) then
  1354.      Begin
  1355.       EndSession:=True;
  1356.       FOnEndSession(Self,EndSession);
  1357.       Result:=Integer(EndSession);
  1358.       SkipOldWndProc:=True;
  1359.      End;
  1360.    end else
  1361.  
  1362.    If (Msg=WM_SHOWWINDOW) then
  1363.    Begin
  1364.     If Not FShowTaskBar then
  1365.      Begin
  1366.        Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1367.        TaskAction;
  1368.        SkipOldWndProc:=True;
  1369.      End;
  1370.    end;
  1371.  
  1372.    If Not SkipOldWndProc then
  1373.     Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
  1374.  End;
  1375. End;
  1376.  
  1377. procedure TAppEx.Flash(Flash,Time:Integer);
  1378. var count:Integer;
  1379. begin
  1380.  For Count:=1 to Flash do
  1381.  Begin
  1382.   FlashWindow(FindWindow(nil,@Application.Title[1]),true);
  1383.   Sleep(Time);
  1384.  End;
  1385. end;
  1386.  
  1387.  
  1388. Function  TAppEx.GetLastDesign : tDateTime;
  1389. Begin
  1390.  if Designing then Result := Now else Result:=FLastDesign;
  1391. End;
  1392.  
  1393. Function  TAppEx.GetLastCompile: tDateTime;
  1394. Begin
  1395.  if (csWriting in ComponentState) then Result := Now else Result:=FLastCompile;
  1396. End;
  1397.  
  1398.  
  1399. Function TAppEx.ExportResource(Name, Category, TargetFilename : String; Overwrite:Boolean):tExportResourceResult;
  1400. var
  1401.  Res       ,
  1402.  ResHandle : THandle;
  1403.  P         : ^Char ;
  1404.  N         : Integer ;
  1405.  FS        : TFileStream ;
  1406. begin
  1407.  Result := errOK ;
  1408.  
  1409.  Res := FindResource (HInstance,PChar (Name),PChar(Category));
  1410.  If Res <> 0 then
  1411.  Begin
  1412.   ResHandle := LoadResource (HInstance,Res);
  1413.   If ResHandle <> 0 then
  1414.   Begin
  1415.     N := SizeOfResource (HInstance,Res);
  1416.     P := LockResource (ResHandle);
  1417.     If Not(FileExists (TargetFileName)) or Overwrite then
  1418.     Begin
  1419.      DeleteFile (Pchar(TargetFileName));
  1420.      FS := TFileStream.Create (TargetFileName,fmCreate);
  1421.      FS.Write (P^,N);
  1422.      FS.Free;
  1423.      UnLockResource(resHandle);
  1424.      FreeResource(resHandle);
  1425.      P := nil ;
  1426.     end else
  1427.     Begin
  1428.      Result := errFileExists;
  1429.     end;
  1430.   end else
  1431.   Begin
  1432.     Result := errLoadError;
  1433.   End;
  1434.  end else
  1435.  Begin
  1436.   Result := errNotFound;
  1437.  end ;
  1438. end;
  1439.  
  1440.  
  1441.  
  1442. procedure Register;
  1443. begin
  1444.   RegisterComponents('Jazarsoft', [TAppEx]);
  1445. end;
  1446.  
  1447. end.
  1448.  
  1449.