home *** CD-ROM | disk | FTP | other *** search
- ////////////////////////////////////////////////////////////////////////////////
- // Jazarsoft AppEx //
- ////////////////////////////////////////////////////////////////////////////////
- // //
- // VERSION : 2.2 //
- // AUTHOR : James Azarja //
- // CREATED : 10 July 2000 //
- // MODIFIED : 19 May 2001 //
- // WEBSITE : http://www.jazarsoft.com //
- // SUPPORT : support@jazarsoft.com //
- // BUG-REPORT : bugreport@jazarsoft.com //
- // COMMENT : comment@jazarsoft.com //
- // LEGAL : Copyright (C) 2000-2001 Jazarsoft. //
- // //
- ////////////////////////////////////////////////////////////////////////////////
- // //
- // This code may be used and modified by anyone so long as this header and //
- // copyright information remains intact. //
- // //
- // The code is provided "as-is" and without warranty of any kind, //
- // expressed, implied or otherwise, including and without limitation, any //
- // warranty of merchantability or fitness for a particular purpose.á //
- // //
- // In no event shall the author be liable for any special, incidental, //
- // indirect or consequential damages whatsoever (including, without //
- // limitation, damages for loss of profits, business interruption, loss //
- // of information, or any other loss), whether or not advised of the //
- // possibility of damage, and on any theory of liability, arising out of //
- // or in connection with the use or inability to use this software.áá //
- // //
- ////////////////////////////////////////////////////////////////////////////////
- // //
- // HISTORY : //
- // //
- // 1.0 : //
- // Initial development //
- // 1.1 : //
- // + Last Compile Date, Last design date //
- // + Parameter List //
- // ╗ Parameter search routine //
- // 1.2 : //
- // + RunAsSecondCopy Event //
- // + ExportResource Feature //
- // + FileAssociation Feature //
- // 1.3 : //
- // ╗ Hide & Show on Task Bar Bug //
- // 2.0 : //
- // Major Code Reconstruction //
- // + InfoRun Feature //
- // + OnUserChanged Event //
- // + OnDisplayChangedEvent //
- // + Paramter..Found Event //
- // 2.1 : //
- // + Version Information //
- // 2.2 : //
- // + Hot Key Feature //
- // //
- // //
- ////////////////////////////////////////////////////////////////////////////////
-
- {$WARNINGS OFF}
- {$HINTS OFF}
- unit AppEx;
-
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Registry, IniFiles, DsgnIntf;
-
- Type
- THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
- THKModifiers = set of THKModifier;
-
- TVirtKey = (vkNone, vkCancel, vkBack, vkTab, vkClear, vkReturn, vkPause, vkCapital, vkEscape,
- vkSpace, vkPrior, vkNext, vkEnd, vkHome, vkLeft, vkUp, vkRight, vkDown,
- vkSelect, vkExecute, vkSnapshot, vkInsert, vkDelete, vkHelp,
- vk0, vk1, vk2, vk3, vk4, vk5, vk6, vk7, vk8, vk9,
- vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH, vkI, vkJ, vkK, vkL, vkM,
- vkN, vkO, vkP, vkQ, vkR, vkS, vkT, vkU, vkV, vkW, vkX, vkY, vkZ,
- vkNumpad0, vkNumpad1, vkNumpad2, vkNumpad3, vkNumpad4,
- vkNumpad5, vkNumpad6, vkNumpad7, vkNumpad8, vkNumpad9,
- vkMultiply, vkAdd, vkSeparator, vkSubtract, vkDecimal, vkDivide,
- vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
- vkF13, vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21, vkF22, vkF23, vkF24,
- vkNumlock, vkScroll, vkApps,
- vkSemiColon, vkEqual, vkComma, vkDash, vkDot, vkSlash, vkBackQuote,
- vkBlockLeft, vkBackSlash, vkBlockRight, vkQuote);
-
- Type
- tAutoRunStyle = (arsLogin, arsStart, arsWarmBoot, arsFirstStart);
- tPriorityClass = (pcNormal, pcIdle, pcHigh, pcRealtime);
-
- TOnParameterFounded = procedure (Sender: TObject;Parameter:ShortString) of object;
- TOnParameterValueFounded = procedure (Sender: TObject;Parameter,Ident,Value:ShortString) of object;
-
- TOnDisplayChanged = Procedure (Sender: TObject;HorzRes,VertRes,ColorDepth : Integer) of object;
-
- TOnEndSessionQuery = Procedure (Sender: TObject;Var EndSession:Boolean) of Object;
-
- TOnHotKey = Procedure(Sender: TObject; Index: Integer) of object;
-
- tFileExtInfo = Record
- Extension : String;
- ContentType : String;
- HandlerName : String;
- End;
-
- tFileHandlerInfo = Record
- HandlerName : String;
- Description : String;
- Icon : String;
- End;
-
- tFileShellInfo = Record
- HandlerName : String;
- Action : String; { Open, Print, Install, etc }
- MenuCaption : String; { &Open, &Print, &Install, etc }
- Command : String; { yourapp.exe %1 }
- DDEString : String; { DDE Command }
- DDEApp : String; { YOURAPPDDEID }
- DDETopic : String; { YOUROWNTOPIC }
- End;
-
-
- PHotKeyItem = ^THotKeyItem;
- THotKeyItem = record
- Modifiers : THKModifiers;
- VirtKey : TVirtKey;
- Registered: Boolean;
- end;
-
- tExportResourceResult = (errOK,errNotFound,errLoadError,errFileExists);
-
- THotKey = class (TPersistent)
- private
- FActive : Boolean;
- FList : TList;
- FParent : Hwnd;
- procedure SetActive(Value : Boolean);
- function GetCount: Integer;
- protected
- function ModifiersToFlag(Modifiers : THKModifiers): UInt;
- procedure RegisterHotKeyNr(Index : Integer);
- procedure UnregisterHotKeyNr(Index : Integer);
- procedure RegisterHotKeys;
- procedure UnregisterHotKeys;
- public
- Constructor Create(Parent:Hwnd);
- Destructor Destroy;Override;
-
- procedure Add(Item: THotKeyItem);
- function AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotkeyItem;
- procedure Clear;
- procedure Delete(Index : Integer);
- function Get(Index: Integer): THotKeyItem;
- procedure Put(Index: Integer; Item: THotKeyItem);
- { runtime only properties }
- property HotKeys[Index: Integer]: THotKeyItem read Get write Put; default;
- property HotKeyCount: integer read GetCount;
- published
- property Enabled: Boolean read FActive write SetActive;
- end;
-
- TVerInfo = class (TPersistent)
- private
- FFileDescription : String;
- FFileVersion : String;
- FCompanyName : String;
- FCopyright : String;
- FTrademark : String;
- FProductName : String;
- FProductVersion : String;
-
- protected
- public
- published
- property FileDescription : String Read FFileDescription Write FFileDescription;
- property FileVersion : String Read FFileVersion Write FFileVersion;
- property CompanyName : String Read FCompanyName Write FCompanyName;
- property Copyright : String Read FCopyright Write FCopyright;
- property Trademark : String Read FTrademark Write FTrademark;
- property ProductName : String Read FProductName Write FProductName;
- property ProductVersion : String Read FProductVersion Write FProductVersion;
- end;
-
- TInfoRunInformation = class (TPersistent)
- private
- FStart : Integer;
- FFinish : Integer;
- FError : Integer;
- FLastStart : TDateTime;
- FLastFinish : TDateTime;
- protected
- public
- published
- property Start : Integer Read FStart Write FStart;
- property Finish : Integer Read FFinish Write FFinish;
- property Error : Integer Read FError Write FError;
- property LastStart : tDateTime Read FLastStart Write FLastStart;
- property LastFinish : tDateTime Read FLastFinish Write FLastFinish;
- end;
-
- TInfoRun = class (TPersistent)
- private
- FEnabled : Boolean;
- FINIFilename : TFilename;
- FInformation : TInfoRunInformation;
- protected
- public
- Constructor Create;
- Destructor Destroy;Override;
-
- Procedure Start;
- Procedure Finish;
- Procedure Refresh;
- published
- property Enabled : Boolean Read FEnabled Write FEnabled;
- property INIFilename : TFilename Read FIniFilename Write FIniFilename;
- property Information : TInfoRunInformation Read FInformation Write FInformation;
- end;
-
- TAutoRun = class (TPersistent)
- private
- FAutoRunStyle : tAutoRunStyle;
- FDescription : ShortString;
- FExecutable : ShortString;
- FGlobalAutoRun : Boolean;
-
- Procedure SetDescription(Value:ShortString);
- Procedure SetAutoRunStyle(Value:tAutoRunStyle);
- Procedure SetExecutable(Value:ShortString);
- Procedure SetAutoRun(Value:Boolean);
- Function GetAutoRun:Boolean;
- protected
- public
- Constructor Create;
- Destructor Destroy;Override;
- published
- property Description : ShortString Read FDescription Write SetDescription;
- property Style : tAutoRunStyle read FAutoRunStyle Write SetAutoRunStyle;
- property Executable : ShortString Read FExecutable Write SetExecutable;
- property Enabled : Boolean Read GetAutoRun Write SetAutoRun;
- property Global : Boolean Read FGlobalAutoRun Write FGlobalAutoRun;
- end;
-
- TProcess = class (TPersistent)
- private
- FServiceProcess : Boolean;
- FPriorityClass : tPriorityClass;
-
- Procedure SetServiceProcess(Value:Boolean);
-
- Function GetPriorityClass : tPriorityClass;
- Procedure SetPriorityClass(Value:tPriorityClass);
- protected
- procedure ServiceProcessAction;
- public
- Constructor Create;
- Destructor Destroy;Override;
- published
- property ServiceProcess : Boolean read FServiceProcess Write SetServiceProcess;
- property PriorityClass : tPriorityClass Read GetPriorityClass Write SetPriorityClass;
- end;
-
- TSecurity = class (TPersistent)
- private
- FAntiSoftIce : Boolean;
- protected
- Function SoftIce95Loaded: boolean;
- Function SoftIceNTLoaded: boolean;
- public
- Constructor Create;
- Destructor Destroy;Override;
- published
- property AntiSoftIce : Boolean Read FAntiSoftIce Write FAntiSoftIce;
- end;
-
- TOnceRun = class (TPersistent)
- private
- FOnlyOnceRun : Boolean;
- FAtomID : String;
- AtomIndex : Word;
- Procedure SetOnlyOnceRun(Value:Boolean);
- protected
- public
- Constructor Create;
- Destructor Destroy;Override;
- published
- property Enabled : Boolean Read FOnlyOncerun Write SetOnlyOnceRun;
- property AtomID : String Read FAtomID write FAtomID;
- end;
-
- TAppEx = class(TComponent)
- private
- ParentHwnd : Hwnd;
- PrevParentWndProc : Pointer;
- SeekAndDestroy : Boolean;
-
- FOnSoftIceRun : tNotifyEvent;
-
- FShowTaskBar : Boolean;
-
- FLastDesign : tDateTime;
- FLastCompile : tDateTime;
-
- FParameters : tStrings;
- FOnParameterFounded : TOnParameterFounded;
- FOnParameterValueFounded : TOnParameterValueFounded;
-
- FOnRunAsSecondCopy : tNotifyEvent;
-
- FAutoRun : TAutoRun;
- FProcess : TProcess;
- FSecurity : TSecurity;
- FOnceRun : TOnceRun;
- FInfoRun : TInfoRun;
- FVerInfo : TVerInfo;
- FHotKey : THotKey;
-
- { Events }
- FOnUserChanged : tNotifyEvent;
- FOnDisplayChanged : tOnDisplayChanged;
- FOnEndSession : tOnEndSessionQuery;
-
- { HotKey }
- FOnHotkey : tOnHotKey;
-
- Procedure SetShowTaskbar(Value:Boolean);
-
- Function GetLastDesign : tDateTime;
- Function GetLastCompile: tDateTime;
- protected
- Procedure TaskAction;
- Procedure ProcessParameters;
- Procedure ReadVerInfo;
- procedure NewParentWndProc(var Message:Tmessage);
- public
- constructor Create(AOwner:TComponent);override;
- destructor Destroy;override;
- procedure Loaded;override;
-
- Procedure UnInstall;
- Procedure Flash(Flash,Time: Integer);
- Function ExportResource(Name, Category, TargetFilename : String; Overwrite:Boolean):tExportResourceResult;
- Procedure RegisterFileType(Ext, Description,Icon : String);
- { Your program must handler first parameter !, look for the code below }
- published
- property AutoRun : TAutoRun Read FAutoRun Write FAutoRun;
- property Process : TProcess Read FProcess Write FProcess;
- property Security : TSecurity Read FSecurity Write FSecurity;
- property OnceRun : TOnceRun Read FOnceRun Write FOnceRun;
- property InfoRun : TInfoRun Read FInfoRun Write FInfoRun;
- property VersionInfo : TVerInfo Read FVerInfo Write FVerInfo;
- property HotKey : THotKey Read FHotKey Write FHotKey;
-
- property Parameters : tStrings Read FParameters Write FParameters;
- property ShowOnTaskBar : Boolean read FShowTaskBar Write SetShowTaskBar;
- property LastCompileDate : tDateTime read GetLastCompile write FLastCompile;
- property LastDesignDate : tDateTime read GetLastDesign write FLastDesign;
-
- Property OnSoftIceRun : TNotifyEvent Read FOnSoftIceRun Write FOnSoftIceRun;
-
- property OnRunAsSecondCopy : tNotifyEvent Read FOnRunAsSecondCopy Write FOnRunAsSecondCopy;
-
- property OnParameterFounded : TOnParameterFounded Read FOnParameterFounded Write FOnParameterFounded;
- property OnParameterValueFounded : TOnParameterValueFounded Read FOnParameterValueFounded Write FOnParameterValueFounded;
-
- property OnUserChanged : TNotifyEvent Read FOnUserChanged Write FOnUserChanged;
- property OnDisplayChanged : TOnDisplayChanged Read FOnDisplayChanged Write FOnDisplayChanged;
- property OnEndSession : TOnEndSessionQuery Read FOnEndSession Write FOnEndSession;
-
- property OnHotKey : TOnHotKey Read FOnHotKey Write FOnHotKey;
- End;
-
- function KeyToVirtKey(const Key: Char): TVirtKey;
- function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
-
- procedure Register;
-
- implementation
-
- Var
- VirtKeys : array[TVirtKey] of UInt =
- ($00, $03, $08, $09, $0C, $0D, $13, $14, $1B,
- $20, $21, $22, $23, $24, $25, $26, $27, $28,
- $29, $2B, $2C, $2D, $2E, $2F,
- $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
- $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A,
- $4B, $4C, $4D, $4E, $4F, $50, $51, $52, $53, $54,
- $55, $56, $57, $58, $59, $5A,
- $60, $61, $62, $63, $64, $65, $66, $67, $68, $69,
- $6A, $6B, $6C, $6D, $6E, $6F,
- $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B,
- $7C, $7D, $7E, $7F, $80, $81, $82, $83, $84, $85, $86, $87,
- $90, $91, $5D,
- 186, 187, 188, 189, 190, 191, 192, 219, 220, 221, 222);
-
- Const
- Run = 'Run'; { Run Every Login }
- RunService = 'RunService'; { Run Every Windows Start }
- RunServiceOnce = 'RunServiceOnce'; { Run Every Warm boot }
- RunOnce = 'RunOnce'; { Run Every Windows First Start }
- RunOnceEx = 'RunOnceEx'; { Run Every ? }
-
- Var
- Designing : Boolean;
-
- function KeyToVirtKey(const Key: Char): TVirtKey;
- var
- i : TVirtKey;
- KeyVal: UInt;
- begin
- Result := TVirtKey(0);
- KeyVal := Ord(UpperCase(Key)[1]);
- for i:= Low(TVirtKey) to High(TVirtKey) do
- if KeyVal = VirtKeys[i] then
- begin
- Result := TVirtKey(i);
- Exit;
- end;
- end;
-
- function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
- begin
- Result.VirtKey := VirtKey;
- Result.Modifiers := Modifiers;
- Result.Registered := False;
- end;
-
- { Miscellaneous Routines }
- function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
-
- { **** File Associate **** }
-
-
- Procedure GetFileExtInfo(Var Info:tFileExtInfo);
- Begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
- If OpenKey(Info.Extension,False) then
- Begin
- Info.ContentType := ReadString('Content Type');
- Info.HandlerName := ReadString('');
- CloseKey;
- End;
- Finally
- Free;
- End;
- End;
-
- Procedure SetFileExtInfo(Info:tFileExtInfo);
- begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
- If OpenKey(Info.Extension,True) then
- Begin
- If Info.ContentType<>'' then WriteString('Content Type',Info.ContentType);
- WriteString('',Info.HandlerName);
- CloseKey;
- End;
- Finally
- Free;
- End;
- End;
-
- Procedure GetFileHandlerInfo(Var Info:tFileHandlerInfo);
- Begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
-
- If OpenKey(Info.HandlerName,False) then
- Begin
- Info.Description := ReadString('');
- CloseKey;
- End;
-
- If OpenKey(Info.HandlerName+'\DefaultIcon',False) then
- Begin
- Info.Icon := ReadString('');
- CloseKey;
- End;
-
- Finally
- Free;
- End;
- End;
-
- Procedure SetFileHandlerInfo(Info:tFileHandlerInfo);
- Begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
-
- If OpenKey(Info.HandlerName,True) then
- Begin
- WriteString('',Info.Description);
- CloseKey;
- End;
-
- { *** Optional *** }
- If (Info.Icon<>'') and OpenKey(Info.HandlerName+'\DefaultIcon',True) then
- Begin
- WriteString('',Info.Icon);
- CloseKey;
- End;
-
-
- Finally
- Free;
- End;
- End;
-
- Procedure GetFileShellInfo(Var Info:tFileShellInfo);
- Begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
-
- If OpenKey(Info.HandlerName+'\shell\'+Info.Action,False) then
- Begin
- Info.MenuCaption := ReadString('');
- CloseKey;
- End;
-
- If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\command',False) then
- Begin
- Info.Command := ReadString('');
- CloseKey;
- End;
-
- If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec',False) then
- Begin
- Info.DDEString := ReadString('');
- CloseKey;
- End;
-
- If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Application',False) then
- Begin
- Info.DDEApp := ReadString('');
- CloseKey;
- End;
-
- If OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Topic',False) then
- Begin
- Info.DDETopic := ReadString('');
- CloseKey;
- End;
-
- Finally
- Free;
- End;
- End;
-
- Procedure SetFileShellInfo(Info:tFileShellInfo);
- Begin
- With TRegistry.Create do
- Try
- RootKey:=HKEY_CLASSES_ROOT;
-
- If (Info.MenuCaption<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action,True) then
- Begin
- WriteString('',Info.MenuCaption);
- CloseKey;
- End;
-
- If (Info.Command<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\command',True) then
- Begin
- WriteString('',Info.Command);
- CloseKey;
- End;
-
- If (Info.DDEString<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec',True) then
- Begin
- WriteString('',Info.DDEString);
- CloseKey;
- End;
-
- If (Info.DDEApp<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Application',True) then
- Begin
- WriteString('',Info.DDEApp);
- CloseKey;
- End;
-
- If (Info.DDETopic<>'') and OpenKey(Info.HandlerName+'\shell\'+Info.Action+'\ddeexec\Topic',True) then
- Begin
- WriteString('',Info.DDETopic);
- CloseKey;
- End;
-
- Finally
- Free;
- End;
- End;
-
- { **** End of File Associate **** }
-
- Procedure AddToAutoRun(Root:HKEY;Flag:String;AppDesc,Executable:String);
- var reg:tregistry;
- begin
- Reg:=tRegistry.create;
- With Reg do
- Begin
- RootKey:=Root;
- Openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
- WriteString(AppDesc,Executable);
- Closekey;
- Free;
- End;
- End;
-
- Function CheckFromAutoRun(Root:HKEY;Flag:String;AppDesc:String):Boolean;
- var reg:tregistry;
- begin
- reg:=tregistry.create;
- with reg do
- begin
- rootkey:=Root;
- openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
- Result:=ValueExists(ApPDesc);
- Closekey;
- Free;
- end;
- end;
-
- Procedure RemovefromAutoRun(Root:HKEY;Flag:String;AppDesc:String);
- var reg:tregistry;
- begin
- reg:=tregistry.create;
- with reg do
- begin
- Rootkey:=Root;
- openkey('Software\Microsoft\Windows\CurrentVersion\'+Flag,true);
- DeleteValue(AppDesc);
- Closekey;
- free;
- end;
- end;
-
-
- { Ext--> .txt, .bmp, .jpg }
-
- Procedure tAutoRun.SetDescription(Value:ShortString);
- Begin
- If (Value<>FDescription) then
- FDescription:=Value;
- End;
-
- function THotKey.ModifiersToFlag(Modifiers : THKModifiers): UInt;
- begin
- Result := 0;
- if hkShift in Modifiers then Result := Result or MOD_SHIFT;
- if hkCtrl in Modifiers then Result := Result or MOD_CONTROL;
- if hkAlt in Modifiers then Result := Result or MOD_ALT;
- if hkExt in Modifiers then Result := Result or MOD_WIN;
- end;
-
- procedure THotKey.RegisterHotKeyNr(Index : Integer);
- begin
- with PHotKeyItem(FList.Items[Index])^ do
- Registered :=
- WordBool(RegisterHotKey(FParent, Index,
- ModifiersToFlag(Modifiers), VirtKeys[VirtKey]));
- end;
-
- procedure THotKey.UnRegisterHotKeyNr(Index : Integer);
- begin
- with PHotKeyItem(FList.Items[Index])^ do
- if Registered then
- begin
- UnregisterHotKey(FParent, Index);
- Registered := False;
- end;
- end;
-
- procedure THotKey.RegisterHotKeys;
- var
- I : integer;
- begin
- for I:=0 to FList.Count-1 do
- RegisterHotKeyNr(I);
- end;
-
- procedure THotKey.UnregisterHotKeys;
- var
- I : integer;
- begin
- for I:=0 to FList.Count-1 do
- UnregisterHotKeyNr(I);
- end;
-
- procedure THotKey.SetActive(Value : Boolean);
- begin
- if FActive<>Value then
- begin
- FActive := Value;
- if FActive then RegisterHotKeys else UnregisterHotKeys;
- end;
- end;
-
- procedure THotKey.Add(Item: THotKeyItem);
- begin
- AddHotKey(Item.VirtKey, Item.Modifiers);
- end;
-
- function THotKey.AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
- var
- pItem : PHotKeyItem;
- iItem : Integer;
- begin
- pItem := PHotKeyItem(AllocMem(sizeof(THotKeyItem)));
- pItem^.VirtKey := VirtKey;
- pItem^.Modifiers := Modifiers;
- iItem := FList.Add(pItem);
- if FActive then RegisterHotKeyNr(iItem);
- Result := pItem^;
- end;
-
- procedure THotKey.Clear;
- var
- I : integer;
- begin
- if FActive then UnregisterHotKeys;
- for I:=0 to FList.Count-1 do
- FreeMem(FList.Items[I]);
- FList.Clear;
- end;
-
- procedure THotKey.Delete(Index : Integer);
- begin
- if FActive then UnregisterHotKeys;
- FreeMem(FList.Items[Index]);
- FList.Delete(Index);
- FList.Pack;
- if FActive then RegisterHotKeys;
- end;
-
- function THotKey.Get(Index: Integer): THotKeyItem;
- begin
- Result := THotKeyItem(FList.Items[Index]^);
- end;
-
- procedure THotKey.Put(Index: Integer; Item: THotKeyItem);
- begin
- if FActive then UnregisterHotKeyNr(Index);
- with THotKeyItem(FList.Items[Index]^) do
- begin
- VirtKey := Item.VirtKey;
- Modifiers := Item.Modifiers;
- end;
- if FActive then RegisterHotKeyNr(Index);
- end;
-
- function THotKey.GetCount: integer;
- begin
- Result := FList.Count;
- end;
-
- destructor THotKey.Destroy;
- begin
- inherited Destroy;
- Clear;
- FList.Free;
- end;
-
- constructor THotKey.Create(Parent:Hwnd);
- begin
- inherited Create;
- FParent:=Parent;
- FList := tList.Create;
- end;
-
-
- Procedure tAutoRun.SetAutoRunStyle(Value:tAutoRunStyle);
- Begin
- If (Value<>FAutoRunStyle) then
- FAutoRunStyle:=Value;
- End;
-
- Procedure tAutoRun.SetExecutable(Value:ShortString);
- Begin
- If Not FileExists(Value) then
- Begin
- raise exception.create('Executable File not Found!');
- End;
- if not Designing then
- If (Value<>FExecutable) then
- FExecutable:=Value;
- End;
-
- Function TAutoRun.GetAutoRun:Boolean;
- var Root : HKEY;
- Flag : String;
- Begin
- Result:=False;
- if Designing then exit;
- If Global then Root:=HKEY_LOCAL_MACHINE else Root:=HKEY_CURRENT_USER;
-
- If Style=arsLogin then Flag:=Run else
- If Style=arsStart then Flag:=RunService else
- If Style=arsWarmBoot then Flag:=RunServiceOnce else
- If Style=arsFirstStart then Flag:=RunOnce;
- Result:=CheckFromAutoRun(Root,Flag,Description);
- End;
-
- procedure TAutoRun.SetAutoRun(Value:Boolean);
- var Root : HKEY;
- Flag : String;
- Begin
- if Designing then exit;
- If Global then Root:=HKEY_LOCAL_MACHINE else Root:=HKEY_CURRENT_USER;
-
- If Style=arsLogin then Flag:=Run else
- If Style=arsStart then Flag:=RunService else
- If Style=arsWarmBoot then Flag:=RunServiceOnce else
- If Style=arsFirstStart then Flag:=RunOnce;
- If Value then
- Begin
- AddToAutoRun(Root,Flag,Description,Executable);
- End else
- RemoveFromAutoRun(Root,Flag,Description);
- End;
-
- destructor TAutoRun.Destroy;
- begin
- inherited Destroy;
- end;
-
- constructor TAutoRun.Create;
- begin
- inherited Create;
- Style := arsLogin;
- Global := True;
- Enabled := False;
- If Not Designing then
- Begin
- Description := (ExtractFilename(Application.ExeName));
- Executable := Application.ExeName;
- End;
- end;
-
- destructor TProcess.Destroy;
- begin
- inherited Destroy;
- end;
-
- constructor TProcess.Create;
- begin
- inherited Create;
- ServiceProcess :=False;
- PriorityClass :=pcNormal;
- end;
-
- Function TProcess.GetPriorityClass : tPriorityClass;
- var PC : Integer;
- Begin
- Result:=pcNormal;
- If Not Designing then
- Begin
- PC:=Windows.GetPriorityClass(GetCurrentProcess());
- Case PC of
- NORMAL_PRIORITY_CLASS : Result:=pcNormal;
- IDLE_PRIORITY_CLASS : Result:=pcIdle;
- HIGH_PRIORITY_CLASS : Result:=pcHigh;
- REALTIME_PRIORITY_CLASS : Result:=pcRealTime;
- End;
- End;
- End;
-
- Procedure TProcess.SetPriorityClass(Value:tPriorityClass);
- var PC : Integer;
- Begin
- If (Value<>FPriorityClass) then
- Begin
- FPriorityClass:=Value;
- If Not Designing then
- Begin
- If FPriorityClass=pcNormal then PC:=NORMAL_PRIORITY_CLASS else
- If FPriorityClass=pcIdle then PC:=IDLE_PRIORITY_CLASS else
- If FPriorityClass=pcHigh then PC:=HIGH_PRIORITY_CLASS else
- If FPriorityClass=pcRealTime then PC:=REALTIME_PRIORITY_CLASS;
- Windows.SetPriorityClass(GetCurrentProcess,PC);
- End;
- End;
- End;
-
- Procedure TProcess.ServiceProcessAction;
- Begin
- if Designing then exit;
- if FServiceProcess Then
- RegisterServiceProcess(GetCurrentProcessID, 1)
- else
- RegisterServiceProcess(GetCurrentProcessID, 0);
- End;
-
- Procedure TProcess.SetServiceProcess(Value:Boolean);
- begin
- if (Value<>FServiceProcess) then
- Begin
- FServiceProcess := Value;
- If Not Designing then
- ServiceProcessAction;
- End;
- end;
-
- destructor TSecurity.Destroy;
- begin
- inherited Destroy;
- end;
-
- constructor TSecurity.Create;
- begin
- inherited Create;
- end;
-
- Function TSecurity.SoftIce95Loaded: boolean;
- Var hFile: Thandle;
- Begin
- Result := false;
- hFile := CreateFileA('\\.\SICE', GENERIC_READ or GENERIC_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0);
- if( hFile <> INVALID_HANDLE_VALUE ) then begin
- CloseHandle(hFile);
- result := TRUE;
- end;
- End;
-
- Function TSecurity.SoftIceNTLoaded: boolean;
- Var hFile: Thandle;
- Begin
- result := false;
- hFile := CreateFileA('\\.\NTICE', GENERIC_READ or GENERIC_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0);
- if( hFile <> INVALID_HANDLE_VALUE ) then begin
- CloseHandle(hFile);
- result := TRUE;
- end;
- End;
-
- destructor TOnceRun.Destroy;
- begin
- If FOnlyOnceRun then
- GlobalDeleteAtom(AtomIndex);
- inherited Destroy;
- end;
-
- constructor TOnceRun.Create;
- begin
- inherited Create;
- Enabled := False;
- If Not Designing then
- AtomId := ExtractFilename(Application.ExeName);
- end;
-
- Procedure TOnceRun.SetOnlyOnceRun(Value:Boolean);
- Begin
- If (Value<>FOnlyOnceRun) then
- FOnlyOnceRun:=Value;
- End;
-
- constructor TInfoRun.Create;
- begin
- inherited Create;
- FInformation:=TInfoRunInformation.Create;
- If Not Designing then
- Begin
- FIniFilename := ChangeFileExt(Application.ExeName,'.AEX');
- End;
- end;
-
- destructor TInfoRun.Destroy;
- begin
- FInformation.Free;
- inherited Destroy;
- end;
-
- Procedure TInfoRun.Start;
- Begin
- If FIniFilename='' then Exit;
- With TIniFile.Create(FIniFilename) do
- Try
- WriteInteger('InfoRun','Start',ReadInteger('InfoRun','Start',0)+1);
- WriteDateTime('InfoRun','Last Start',Now);
- Finally
- Free;
- End;
- End;
-
- Procedure TInfoRun.Finish;
- Begin
- If FIniFilename='' then Exit;
- With TIniFile.Create(FIniFilename) do
- Try
- WriteInteger('InfoRun','Finish',ReadInteger('InfoRun','Finish',0)+1);
- WriteDateTime('InfoRun','Last Finish',Now);
- Finally
- Free;
- End;
- End;
-
- Procedure TInfoRun.Refresh;
- Begin
- If FIniFilename='' then Exit;
- With TIniFile.Create(FIniFilename) do
- Try
- FInformation.Start:= ReadInteger('InfoRun','Start',0);
- FInformation.Finish:=ReadInteger('InfoRun','Finish',0);
- FInformation.LastStart:=ReadDateTime('InfoRun','Last Start',Now);
- FInformation.LastStart:=ReadDateTime('InfoRun','Last Finish',Now);
- If FInformation.Start > FInformation.Finish then
- FInformation.Error:= FInformation.Start-FInformation.Finish else
- FInformation.Error:=0;
- Finally
- Free;
- End;
- End;
-
- Procedure TAppEx.RegisterFileType(Ext, Description, Icon : String);
- var FileExtI : tFileExtInfo;
- FileHandlerI : tFileHandlerInfo;
- FileShellI : tFileShellInfo;
-
- Begin
- FileExtI.Extension:=Ext;
- FileExtI.HandlerName:=Copy(Ext,Pos('.',Ext)+1, 3)+'file'; { .txt -> txtfile }
- SetFileExtInfo(FileExtI);
-
- FileHandlerI.HandlerName:=FileExtI.HandlerName;
- FileHandlerI.Description:=Description;
- FileHandlerI.Icon:=Icon;
- SetFileHandlerInfo(FileHandlerI);
-
- FileShellI.HandlerName:=FileExtI.HandlerName;
- FileShellI.Action:='open'; { Open / Install / Print, etc }
- FileShellI.Command:=Paramstr(0)+' %1';
- SetFileShellInfo(FileShellI);
- End;
-
- Procedure tAppEx.SetShowTaskBar(Value:Boolean);
- Begin
- If Value<>FShowTaskBar then
- Begin
- FShowTaskBar:=Value;
- If Not Designing then
- TaskAction;
- End;
- End;
-
- Constructor tAppEx.create(AOwner:TComponent);
- var P : Pointer;
- Begin
- inherited Create(AOwner);
- Designing := (csDesigning in ComponentState);
-
- FShowTaskBar := true;
- FParameters := tStringList.Create;
- ParentHwnd := (AOwner as tForm).Handle;
-
- FAutoRun := TAutoRun.Create;
- FProcess := TProcess.Create;
- FSecurity := TSecurity.Create;
- FOnceRun := TOnceRun.Create;
- FInfoRun := TInfoRun.Create;
- FVerInfo := TVerInfo.Create;
- FHotKey := THotKey.Create(ParentHwnd);
-
- if not Designing then
- Begin
- PrevParentWndProc := Pointer(GetWindowLong(ParentHWnd, GWL_WNDPROC));
- P := MakeObjectInstance(NewParentWndProc);
- SetWindowLong(ParentHWnd, GWL_WNDPROC, LongInt(p));
- ReadVerInfo;
- End;
- End;
-
- Destructor tAppEx.destroy;
- Begin
- inherited destroy;
- FAutoRun.Free;
- FProcess.Free;
- FSecurity.Free;
- FOnceRun.Free;
- FInfoRun.Free;
- FVerInfo.Free;
- FHotkey.Free;
-
- if not Designing then
- Begin
- if not SeekAndDestroy then
- begin
- SetWindowLong(ParentHWnd, GWL_WNDPROC, LongInt(PrevParentWndProc));
- end;
- End;
- FParameters.Free;
- End;
-
- procedure TAppEx.ReadVerInfo;
- Var
- VersionHandle,
- VersionSize : Dword;
- PItem,
- PVersionInfo : Pointer;
- FixedFileInfo :PVSFixedFileInfo;
- Il : Uint;
- Filename : String;
- P : Array [0..MAX_PATH - 1] of char;
- Begin
- Filename:=Paramstr(0);
- if Filename<>'' then
- Begin
- StrPCopy(P,Filename);
- VersionSize:=GetFileVersionInfoSize(P,VersionHandle);
-
- If VersionSize=0 Then Exit;
-
- GetMem(PVersionInfo,VersionSize);
- Try
- If GetFileVersionInfo(P,VersionHandle,VersionSize,PVersionInfo) then
- Begin
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\FileDescription'),pitem,il) then
- FVerInfo.FileDescription:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\FileVersion'),pitem,il) then
- FVerInfo.FileVersion:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\CompanyName'),pitem,il) then
- FVerInfo.CompanyName:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\LegalCopyright'),pitem,il) then
- FVerInfo.Copyright:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\LegalTrademark'),pitem,il) then
- FVerInfo.Trademark:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\ProductName'),pitem,il) then
- FVerInfo.ProductName:=Pchar(pitem);
- if VerQueryValue(PVersionInfo,Pchar('\StringFileInfo\040904E4\ProductVersion'),pitem,il) then
- FVerInfo.ProductVersion:=Pchar(pitem);
- end;
- Finally
- FreeMem(pversioninfo,versionsize);
- End;
- End;
- End;
-
- Procedure tAppEx.ProcessParameters;
- Var I : Integer;
- Param : String;
- Begin
- For I:=1 to ParamCount do
- Begin
-
- Param:=ParamStr(I);
- FParameters.Add(Param);
-
- If Pos(':',Param)=0 then
- Begin
- If Assigned(FOnParameterFounded) then FOnParameterFounded(Self,Param);
- end else
- Begin
-
- If Assigned(FOnParameterValueFounded) then
- FOnParameterValueFounded(Self,Param, Copy(Param,1,Pos(':',Param)-1), Copy(Param,Pos(':',Param)+1,Length(Param)-Pos(':',Param)+1) ) else
- End;
-
- End;
- End;
-
-
- Procedure tAppEx.Loaded;
- Begin
- inherited Loaded;
- if not Designing then
- Begin
- ProcessParameters;
- // TaskAction;
- if FOnceRun.Enabled then
- begin
- If (GlobalFindAtom(Pchar(FOnceRun.AtomID))=0) then
- Begin
- FOnceRun.AtomIndex:=GlobalAddAtom(Pchar(FOnceRun.AtomID));
- End else
- Begin
- If Assigned(FOnRunAsSecondCopy) then
- FOnRunAsSecondCopy(Self);
- End;
- end;
-
- If FSecurity.AntiSoftIce then
- Begin
- if FSecurity.SoftIce95Loaded or FSecurity.SoftIceNTLoaded then
- begin
- If Assigned(FOnSoftICeRun) then FOnSoftIceRun(Self);
- end;
- End;
-
- if FHotKey.Enabled then
- Begin
- FHotKey.RegisterHotKeys;
- End;
-
- End else
- Begin
- If FileExists(FInfoRun.INIFilename) then FInfoRun.Refresh;
- End;
- End;
-
- Procedure tAppEx.Uninstall;
- Var Tmp : Array[0..1024] of Char;
- AppShortName,
- Windir,
- Buffer : String;
- F : Textfile;
- BackupFile : tStringList;
- C : Word;
- DoIt:Boolean;
- Begin
- If Not Designing Then
- Begin
- GetShortPathname(Pchar(Application.Exename),Tmp,1025);
- AppShortName:=String(Tmp);
- GetWindowsDirectory(Tmp,1025);
- Windir:=String(Tmp);
- If Length(Windir)>3 Then Windir:=Windir+'\';
- Assignfile(F,Windir+'Wininit.Ini');
- If Fileexists(Windir+'Wininit.Ini')=False Then
- Begin
- Rewrite(F);
- Writeln(F,'[Rename]');
- Writeln(F,'Nul='+Appshortname);
- End Else
- Begin
- Backupfile:=Tstringlist.Create;
- Reset(F);
- While Not Eof(F) Do
- Begin
- Readln(F,Buffer);
- Backupfile.Add(Buffer);
- End;
- Closefile(F);
- Doit:=False;
- For C:=0 To Backupfile.Count-1 Do
- If Uppercase(Backupfile.Strings[C])='[Rename]' Then
- Begin
- Backupfile.Insert(C+1,'Nul='+Appshortname);
- Doit:=True;
- Break;
- End;
- Rewrite(F);
- For C:=0 To Backupfile.Count-1 Do Writeln(F,Backupfile.Strings[C]);
- If Doit=False Then
- Begin
- Writeln(F,'[Rename]');
- Writeln(F,'Nul='+Appshortname);
- End;
- Backupfile.Free;
- End;
- Closefile(F);
- End;
- End;
-
- Procedure TAppEx.TaskAction;
- begin
- if Not FShowTaskBar then
- ShowWindow(FindWindow(nil,@Application.Title[1]),SW_HIDE) else
- ShowWindow(FindWindow(nil,@Application.Title[1]),SW_RESTORE);
- End;
-
- procedure TAppEx.NewParentWndProc(var Message:Tmessage);
- Var EndSession : Boolean;
- SkipOldWndProc : Boolean;
-
- Begin
- SkipOldWndProc:=False;
- With Message do
- Begin
- If (Msg=WM_HOTKEY) then
- Begin
- If Assigned(FOnHotKey) then FOnHotKey(Self,wParam);
- end else
-
- if (Msg = WM_CLOSE) or (Msg = WM_DESTROY) then
- Begin
- SeekAndDestroy := True;
- End else
-
- If (Msg=WM_SIZE) then
- Begin
- If (WParam=SIZE_MINIMIZED) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- End;
- end else
-
- If (Msg=WM_ACTIVATEAPP) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- end else
-
- If (Msg=WM_WINDOWPOSCHANGED) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- end else
-
- If (Msg=WM_NCACTIVATE) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- end else
-
- If (Integer(MSG)>WM_USER) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- end else
-
- If (Msg=WM_USERCHANGED) then
- Begin
- If Assigned(FOnUserChanged) then FOnUserChanged(Self);
- end else
-
- If (Msg=WM_DISPLAYCHANGE) then
- Begin
- If Assigned(FOnDisplayChanged) then FOnDisplayChanged(Self,lParamLo,lParamHi,wParam);
- end else
-
- If (Msg=WM_QUERYENDSESSION) then
- Begin
- If Assigned(FOnEndSession) then
- Begin
- EndSession:=True;
- FOnEndSession(Self,EndSession);
- Result:=Integer(EndSession);
- SkipOldWndProc:=True;
- End;
- end else
-
- If (Msg=WM_SHOWWINDOW) then
- Begin
- If Not FShowTaskBar then
- Begin
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- TaskAction;
- SkipOldWndProc:=True;
- End;
- end;
-
- If Not SkipOldWndProc then
- Result := CallWindowProc(PrevParentWndProc, ParentHWnd, Msg, WParam, LParam);
- End;
- End;
-
- procedure TAppEx.Flash(Flash,Time:Integer);
- var count:Integer;
- begin
- For Count:=1 to Flash do
- Begin
- FlashWindow(FindWindow(nil,@Application.Title[1]),true);
- Sleep(Time);
- End;
- end;
-
-
- Function TAppEx.GetLastDesign : tDateTime;
- Begin
- if Designing then Result := Now else Result:=FLastDesign;
- End;
-
- Function TAppEx.GetLastCompile: tDateTime;
- Begin
- if (csWriting in ComponentState) then Result := Now else Result:=FLastCompile;
- End;
-
-
- Function TAppEx.ExportResource(Name, Category, TargetFilename : String; Overwrite:Boolean):tExportResourceResult;
- var
- Res ,
- ResHandle : THandle;
- P : ^Char ;
- N : Integer ;
- FS : TFileStream ;
- begin
- Result := errOK ;
-
- Res := FindResource (HInstance,PChar (Name),PChar(Category));
- If Res <> 0 then
- Begin
- ResHandle := LoadResource (HInstance,Res);
- If ResHandle <> 0 then
- Begin
- N := SizeOfResource (HInstance,Res);
- P := LockResource (ResHandle);
- If Not(FileExists (TargetFileName)) or Overwrite then
- Begin
- DeleteFile (Pchar(TargetFileName));
- FS := TFileStream.Create (TargetFileName,fmCreate);
- FS.Write (P^,N);
- FS.Free;
- UnLockResource(resHandle);
- FreeResource(resHandle);
- P := nil ;
- end else
- Begin
- Result := errFileExists;
- end;
- end else
- Begin
- Result := errLoadError;
- End;
- end else
- Begin
- Result := errNotFound;
- end ;
- end;
-
-
-
- procedure Register;
- begin
- RegisterComponents('Jazarsoft', [TAppEx]);
- end;
-
- end.
-
-