unit AHMTAppManager;
interface
{$I AHM.INC}
uses
SysUtils, Windows, Messages, Classes,Forms,Graphics,AHMSystemClass,AHMTStoreData,Menus,
ShellApi,ShlObj,Controls{$IFDEF AHMDELPHI4},ActnList{$ENDIF},Dialogs,AHMSystemConst,Extctrls,StdCtrls,Grids,DDEMan;
type
TAHMAppManager=class;
TAHMWMDeviceChange = record
Msg : Cardinal;
Event : UINT;
dwData : Pointer;
Result : LongInt;
end;
TAHMWMPowerBroadcast = record
Msg: Cardinal;
dwPowerEvent: DWord;
dwData:DWord;
Result: Longint;
end;
TAHMAppRestore = (NoRestore,OnDoubleClick,OnSingleClick);
TAHMDeviceChangeEvent = procedure (Sender:TObject;DriveLetter : Char) of object;
TAHMOnStartParam = procedure(Sender:TObject;Pos : Integer;Param : String) of object;
TAHMOnDDEMacro = procedure(Sender:TObject;Command,Argument : String) of object;
TAHMOnFileOpen = procedure(Sender:TObject;FileName : String) of object;
TAHMGetShareExpiry= procedure (Sender:TObject;var Day,Month,Year : Word) of object;
TAHMOnMaxInstance = procedure(Sender : TObject;NoOfInstances : Integer) of Object;
TAHMOnEndWindows = procedure(Sender : TObject;var Endwindows : Boolean) of Object;
TAHMOnSysMemLow = procedure(Sender : TObject;CompactRatio : DWord) of Object;
TAHMAppDisplayChange = procedure(Sender : TObject;BitPerPixel : Integer;ScreenWidth,ScreenHeight : Word) of Object;
TAHMIAction = (aRestoreAndExit,aRestore,aExit,aNone);
TAHMAppTimer = class;
TAHMAppTimerThread = class(TThread)
OwnerTimer: TAHMAppTimer;
Procedure Execute; override;
Procedure DoTimer;
end;
TAHMAppTimer = class(TObject)
private
FEnabled: Boolean;
FInterval: Word;
FOnTimer: TNotifyEvent;
FTimerThread: TAHMAppTimerThread;
FThreadPriority: TThreadPriority;
Procedure SetEnabled(Const Value: Boolean);
Procedure SetInterval(Const Value: Word);
Procedure SetThreadPriority(Const Value: TThreadPriority);
Protected
Procedure UpdateTimer;
Procedure Timer; dynamic;
public
constructor Create; virtual;
destructor Destroy; override;
published
Property Enabled: Boolean read FEnabled write SetEnabled;
Property Interval: Word read FInterval write SetInterval;
Property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
Property Priority: TThreadPriority read FThreadPriority write SetThreadPriority;
end;
TAHMAssociations = class(TPersistent)
private
FApply: Boolean;
FExtensions: String;
FOwner : TAHMAppManager;
FHelp: THelpContext;
FDDEServerConf : TDDEServerConv;
FDDEUniqueName: String;
FIconID: Byte;
procedure SetExtensions(const Value: String);
procedure SetApply(const Value: Boolean);
procedure AssociationsMacro(Sender : TObject; Msg : TStrings);
Function ApplyAll : Boolean;
procedure SetDDEUniqueName(const Value: String);
Function DeleteAll(DelAssoc : String) : Boolean;
Function GetAll(var CurrAssoc: String): String;
protected
public
Constructor Create(AOwner : TAHMAppManager); virtual;
Destructor Destroy; override;
Property Owner : TAHMAppManager read FOwner;
published
property Extensions : String read FExtensions write SetExtensions;
property ApplyOnRun : Boolean read FApply write SetApply default false;
property Help : THelpContext read FHelp write FHelp default 0;
property DDEUniqueName : String read FDDEUniqueName write SetDDEUniqueName;
property IconID : Byte read FIconID write FIconID default 0;
end;
TAHMShareware = class(TPersistent)
private
FFixedEndYear: Word;
FFixedEndDay: Word;
FFixedEndMonth: Word;
FisShareware: Boolean;
protected
public
constructor Create; virtual;
Function Check : Boolean;
published
property IsShareware : Boolean read FisShareware write FisShareware default false;
property FixedEndDay : Word read FFixedEndDay write FFixedEndDay stored FIsShareware;
property FixedEndMonth : Word read FFixedEndMonth write FFixedEndMonth stored FIsShareware;
property FixedEndYear : Word read FFixedEndYear write FFixedEndYear stored FIsShareware;
end;
TAHMInstance = class(TPersistent)
private
FMax: Byte;
FAction: TAHMIAction;
FAHMApplication : TAHMAppManager;
function GetActiveInstances: Byte;
protected
Procedure CheckPrevInstances;
public
Constructor Create(AHMApplication : TAHMAppManager);
property Instances : Byte read GetActiveInstances;
published
property Max : Byte read FMax write FMax default 0;
property Action : TAHMIAction read FAction write FAction default aRestoreAndExit;
end;
TAHMTrayState = (tsNever,tsAlways,tsOnMinimized);
TAHMTrayIcon = class(TPersistent)
private
FWindowHandle : HWnd;
FTrayIconData:TNotifyIconData;
FHint: String;
FActive: TAHMTrayState;
FNewWindows : Boolean;
FPopupMenu: TPopupMenu;
FNoTrayIcon : Boolean;
FEnabled : Boolean;
FMinimized : Boolean;
FAHMApplication : TAHMAppManager;
FAppRestore: TAHMAppRestore;
procedure SetActive(const Value: TAHMTrayState);
procedure SetPopupMenu(const Value: TPopupMenu);
procedure SetHint(const Value: String);
procedure EmptyTray;
procedure FillTray;
procedure HandleMinimize(Sender: TObject);
procedure HandleRestore(Sender: TObject);
procedure HandleRightClick(Sender: TObject);
procedure UpdateTray;
protected
public
Constructor Create(AHMApplication : TAHMAppManager);
destructor Destroy; override;
published
property Active : TAHMTrayState read FActive write SetActive default tsNever;
property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
property Hint : String read FHint write SetHint;
property AppRestore : TAHMAppRestore read FAppRestore write FAppRestore default NoRestore;
end;
TAHMStartType = (sNever,sOnBoot);
TAHMAutoStart = class(TPersistent)
private
FUniqueName: String;
FAutoStart: TAHMStartType;
FAHMApplication : TAHMAppManager;
procedure SetAutoStart(const Value: TAHMStartType);
procedure SetUniqueName(const Value: String);
protected
function InstallApp(const Value: TAHMStartType): boolean;
public
Constructor Create(AHMApplication : TAHMAppManager);
destructor Destroy; override;
published
Property UniqueName : String read FUniqueName write SetUniqueName;
Property AutoStart : TAHMStartType read FAutoStart write SetAutoStart default sNever;
end;
TAHMAppManager=class(TAHMSystemsComponent)
private
FApplicationHandle,FOwnerhandle : Hwnd;
FOwnerForm : TWinControl;
FAppStarting : Boolean;
FParamStore : TAHMStoreData;
FIllegalAbort : TNotifyEvent;
FShowHint: Boolean;
FHintPause: Integer;
FTitle: String;
FHintColor: TColor;
FOnException: TExceptionEvent;
FOnHelp: THelpEvent;
FIcon: TIcon;
FTimer : TAHMAppTimer;
FOnIdle: TIdleEvent;
FOnMessage: TMessageEvent;
FOnDeactivate: TNotifyEvent;
FOnMinimize: TNotifyEvent;
FOnRestore: TNotifyEvent;
FOnHint: TNotifyEvent;
FOnActivate: TNotifyEvent;
FOnShowHint: TShowHintEvent;
FOnMaxInstance: TAHMOnMaxInstance;
FInstance: TAHMInstance;
FTrayIcon: TAHMTrayIcon;
FOnTrayRightClick: TNotifyEvent;
FOnTrayClick: TNotifyEvent;
FOnTrayDblClick: TNotifyEvent;
FAutoStart: TAHMAutoStart;
FHelpFile: String;
FOnIconChange : TNotifyEvent;
FAfterInsert: TAHMDeviceChangeEvent;
FAfterRemove: TAHMDeviceChangeEvent;
FTaskbar: Boolean;
FUpdateFormatSettings: Boolean;
FLongDateFormat: String;
FShortDateFormat: String;
FHintShortPause: Integer;
FHintHidePause: Integer;
FUpdateMetricSettings: Boolean;
FOnShareNoExpiry: TNotifyEvent;
FOnShareExpiry: TNotifyevent;
FShareware: TAHMShareware;
FOnShareGetDate: TAHMGetShareExpiry;
FAssociations: TAHMAssociations;
FOnStartParam: TAHMOnStartParam;
FWinTaskBar: Boolean;
FWinOfficeBar: Boolean;
FWinIcons: Boolean;
FFlashInterval: Integer;
FOnEndWindows: TAHMOnEndWindows;
FOnbatteryLow: TNotifyevent;
FOnStandBy: TNotifyevent;
FOnSuspend: TNotifyevent;
FOnResume: TNotifyevent;
FOnUserchanged: TNotifyevent;
FMainForm: Boolean;
FOnSysMemLow: TAHMOnSysMemLow;
FOnDisplayChange: TAHMAppDisplayChange;
FAsService95: Boolean;
FOnUserLogOff: TNotifyEvent;
FOnDDEMacro: TAHMOnDDEMacro;
FOnFileOpen: TAHMOnFileOpen;
FOnDDEOpen: Tnotifyevent;
FOnDDEClose: TNotifyevent;
{$IFDEF AHMDELPHI4}
FHintShortCuts: Boolean;
FCenturyWindow: Word;
FActionExecute: TActionEvent;
FActionUpdate: TActionEvent;
procedure SetHintShortCuts(const Value: Boolean);
procedure SetCenturyWindow(const Value: Word);
{$ENDIF}
procedure IconChange(Sender : TObject);
procedure SetHintColor(const Value: TColor);
procedure SetHintPause(const Value: Integer);
procedure SetIcon(aValue: TIcon);
procedure SetShowHint(const Value: Boolean);
procedure SetTitle(const Value: String);
procedure SetHelpFile(const Value: String);
procedure WMDeviceChange(var Msg: TAHMWMDeviceChange);
procedure WMPowerMsg(var Msg: TAHMWMPowerBroadcast);
procedure WndProc(var AMsg: TMessage);
function GetFirstDriveLetter(unitmask: Integer): char;
procedure SetTaskbar(const Value: Boolean);
procedure ShowInTask;
procedure SetUpdateFormatSettings(const Value: Boolean);
procedure SetLongDateFormat(const Value: String);
procedure SetShortDateFormat(const Value: String);
procedure SetHintHidePause(const Value: Integer);
procedure SetHintShortPause(const Value: Integer);
procedure SetUpdateMetricSettings(const Value: Boolean);
procedure FlashOnTimer(Sender : TObject);
procedure SetFlashInterval(const Value: Integer);
procedure SetMainForm(const Value: Boolean);
procedure SetParamStore(const Value: TAHMStoreData);
procedure SetAsService95(const Value: Boolean);
procedure UpdateService(const Value: Boolean);
procedure HookWin;
procedure UnhookWin;
procedure Hooked(var Msg: TMessage);
protected
NewWndProc,OldWndProc : Pointer;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Loaded; override;
Function ValidateShareware : Boolean;
Function ApplyAssociations : Boolean;
Function ShowAssociations : Boolean;
Function Flash : Boolean;
published
property OnDDEMacro : TAHMOnDDEMacro read FOnDDEMacro write FOnDDEMacro;
property OnDDEOpen : TNotifyevent read FOnDDEOpen write FOnDDEOpen;
property OnDDEClose : TNotifyevent read FOnDDEClose write FOnDDEClose;
property OnFileOpen : TAHMOnFileOpen read FOnFileOpen write FOnFileOpen;
property AutoStart : TAHMAutoStart read FAutoStart write FAutoStart;
property Associations : TAHMAssociations read FAssociations write FAssociations;
property TrayIcon : TAHMTrayIcon read FTrayIcon write FTrayIcon;
property FlashInterval : Integer read FFlashInterval write SetFlashInterval default 200;
property OnTaskbar : Boolean read FTaskbar write SetTaskbar default True;
property Shareware : TAHMShareware read FShareware write FShareware;
property Instances : TAHMInstance read FInstance write FInstance;
property HintColor : TColor read FHintColor write SetHintColor default clInfoBk;
property HintPause : Integer read FHintPause write SetHintPause default 500;
property Icon : TIcon read FIcon write SetIcon;
property HintHidePause : Integer read FHintHidePause write SetHintHidePause default 2500;
property HintShortPause : Integer read FHintShortPause write SetHintShortPause default 0;
property ShowHint : Boolean read FShowHint write SetShowHint default true;
property ShowMainForm : Boolean read FMainForm write SetMainForm default true;
property ApplicationTitle : String read FTitle write SetTitle;
property HelpFile : String read FHelpFile write SetHelpFile;
property ParamStore : TAHMStoreData read FParamStore write SetParamStore;
property AsService95 : Boolean read FAsService95 write SetAsService95 default False;
property UpdateFormatSettings : Boolean read FUpdateFormatSettings write SetUpdateFormatSettings default true;
property UpdateMetricSettings : Boolean read FUpdateMetricSettings write SetUpdateMetricSettings default true;
property SysShortDateFormat : String read FShortDateFormat write SetShortDateFormat;
property SysLongDateFormat : String read FLongDateFormat write SetLongDateFormat;
property OnIllegalAbort : TNotifyevent read FIllegalAbort write FIllegalAbort;
property OnActivate : TNotifyEvent read FOnActivate write FOnActivate;
property OnDeactivate : TNotifyEvent read FOnDeactivate write FOnDeactivate;
property OnException : TExceptionEvent read FOnException write FOnException;
property OnHelp : THelpEvent read FOnHelp write FOnHelp;
property OnIdle : TIdleEvent read FOnIdle write FOnIdle;
property OnMessage : TMessageEvent read FOnMessage write FOnMessage;
property OnMinimize : TNotifyEvent read FOnMinimize write FOnMinimize;
property OnHint : TNotifyEvent read FOnHint write FOnHint;
property OnRestore : TNotifyEvent read FOnRestore write FOnRestore;
property OnShowHint : TShowHintEvent read FOnShowHint write FOnShowHint;
property OnMaxInstance : TAHMOnMaxInstance read FONMaxInstance write FOnMaxInstance;
property OnTrayClick : TNotifyEvent read FOnTrayClick write FOnTrayClick;
property OnTrayDblClick : TNotifyEvent read FOnTrayDblClick write FOnTrayDblClick;
property OnTrayRightClick : TNotifyEvent read FOnTrayRightClick write FOnTrayRightClick;
property OnCDInsert : TAHMDeviceChangeEvent read FAfterInsert write FAfterInsert;
property OnCDRemove : TAHMDeviceChangeEvent read FAfterRemove write FAfterRemove;
property OnIconChange : TNotifyEvent read FOnIconChange write FOnIconChange;
property OnShareExpiry : TNotifyevent read FOnShareExpiry write FOnShareExpiry;
property OnShareNoExpiry : TNotifyEvent read FOnShareNoExpiry write FOnShareNoExpiry;
property OnShareGetDate : TAHMGetShareExpiry read FOnShareGetDate write FOnShareGetDate;
property OnStartParam : TAHMOnStartParam read FOnStartParam write FOnStartParam;
property OnAPMSuspend : TNotifyevent read FOnSuspend write FOnSuspend;
property OnAPMStandBy : TNotifyevent read FOnStandBy write FOnStandBy;
property OnAPMResume : TNotifyevent read FOnResume write FOnResume;
property OnAPMBatteryLow : TNotifyevent read FOnbatteryLow write FOnBatteryLow;
property OnEndWindows : TAHMOnEndWindows read FOnEndWindows write FOnEndWindows;
property OnUserChanged : TNotifyevent read FOnUserchanged write FOnUserChanged;
property OnUserLogoff : TNotifyEvent read FOnUserLogOff write FOnUserLogoff;
property OnSysMemLow : TAHMOnSysMemLow read FOnSysMemLow write FOnSysMemLow;
property OnDisplayChange : TAHMAppDisplayChange read FOnDisplayChange write FOnDisplayChange;
{$IFDEF AHMDELPHI4}
property SysCenturyWindow : Word read FCenturyWindow write SetCenturyWindow default 50;
property HintShortCuts : Boolean read FHintShortCuts write SetHintShortCuts default True;
property OnActionExecute : TActionEvent read FActionExecute write FActionExecute;
property OnActionUpdate : TActionEvent read FActionUpdate write FActionUpdate;
{$ENDIF}
end;
implementation
uses Registry;
const WM_CallBack_Message = WM_User + 1;
AHMDEVICEARRIVAL = $8000;
AHMDEVICEQUERYREMOVE = $8001;
AHMDEVICEQUERYREMOVEFAILED = $8002;
AHMDEVICEREMOVEPENDING = $8003;
AHMDEVICEREMOVECOMPLETE = $8004;
AHMDEVICETYPESPECIFIC = $8005;
AHMCONFIGCHANGED = $0018;
AHMDEVTYP_OEM = $00000000;
AHMDEVTYP_DEVNODE = $00000001;
AHMDEVTYP_VOLUME = $00000002;
AHMDEVTYP_PORT = $00000003;
AHMDEVTYP_NET = $00000004;
AHMPBT_APMQUERYSUSPEND=$0000;
AHMPBT_APMQUERYSTANDBY=$0001;
AHMPBT_APMQUERYSUSPENDFAILED=$0002;
AHMPBT_APMQUERYSTANDBYFAILED=$0003;
AHMPBT_APMSUSPEND =$0004;
AHMPBT_APMSTANDBY =$0005;
AHMPBT_APMRESUMECRITICAL =$0006;
AHMPBT_APMRESUMESUSPEND =$0007;
AHMPBT_APMRESUMESTANDBY =$0008;
AHMPBTF_APMRESUMEFROMFAILURE=$00000001;
AHMPBT_APMBATTERYLOW =$0009;
AHMPBT_APMPOWERSTATUSCHANGE =$000A;
AHMPBT_APMOEMEVENT =$000B;
AHMPBT_APMRESUMEAUTOMATIC =$0012;
DBTF_MEDIA = $0001;
DBTF_NET = $0002;
type
PAHMBROADCAST_HDR = ^TAHMBROADCAST_HDR;
TAHMBROADCAST_HDR = packed record
dbch_size : DWORD;
dbch_devicetype : DWORD;
dbch_reserved : DWORD;
end;
PAHMBROADCAST_VOLUME = ^TAHMBROADCAST_VOLUME;
TAHMBROADCAST_VOLUME = packed record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
PFLASHWINFO = ^TFLASHWINFO;
TFLASHWINFO = packed record
cbSize: UINT;
hwnd: HWND;
dwFlags: DWord;
uCount: UINT;
dwTimeout: DWord;
end;
FLASHWINFO = TFLASHWINFO;
type
PFNRegisterServiceProcess = ^TFNRegisterServiceProcess;
TFNRegisterServiceProcess = function(dwProcessID,dwType : Integer) : Integer; stdcall;
Var
AHMRegisterServiceProcess : TFNRegisterServiceProcess = nil;
function RegisterServiceProcess(dwProcessID,dwType : Integer) : Integer;
Var BinModule : HModule;
begin
Result := 0;
BinModule := LoadLibrary(PChar(ahmsckernel32));
if BinModule<>0 then
begin
if @AHMRegisterServiceProcess = nil then @AHMRegisterServiceProcess := GetProcAddress(BinModule,PChar(ahmscregisterserviceprocess));
if @AHMRegisterServiceProcess <> nil then
Result := AHMRegisterServiceProcess(dwProcessID,dwType);
end;
if BinModule <> 0 then FreeLibrary(BinModule);
end;
Procedure TAHMAppTimerThread.Execute;
begin
Priority := OwnerTimer.FThreadPriority;
repeat
SleepEx(OwnerTimer.FInterval, False);
Synchronize(DoTimer);
until Terminated;
end;
Procedure TAHMAppTimerThread.DoTimer;
begin
OwnerTimer.Timer;
end;
constructor TAHMAppTimer.Create;
begin
inherited Create;
FEnabled := True;
FInterval := 1000;
FThreadPriority := tpTimeCritical;
FTimerThread := TAHMAppTimerThread.Create(false);
FTimerThread.OwnerTimer := Self;
UpdateTimer;
end;
destructor TAHMAppTimer.Destroy;
begin
FEnabled := False;
UpdateTimer;
FTimerThread.Free;
inherited Destroy;
end;
Procedure TAHMAppTimer.UpdateTimer;
begin
if not(FTimerThread.Suspended) then FTimerThread.Suspend;
if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
if (FTimerThread.Suspended) then FTimerThread.Resume;
end;
Procedure TAHMAppTimer.SetEnabled(Const Value: Boolean);
begin
if Value <> FEnabled then FEnabled := Value;
UpdateTimer;
end;
Procedure TAHMAppTimer.SetInterval(Const Value: Word);
begin
if Value <> FInterval then FInterval := Value;
UpdateTimer;
end;
Procedure TAHMAppTimer.SetThreadPriority(Const Value: TThreadPriority);
begin
if Value <> FThreadPriority then FThreadPriority := Value;
UpdateTimer;
end;
Procedure TAHMAppTimer.Timer;
begin
if Assigned(FOnTimer) then FOnTimer(Self);
end;
procedure TAHMAppManager.SetIcon(aValue:TIcon);
begin
FIcon.assign(aValue);
end;
function TAHMAppManager.Flash : Boolean;
//var FWinfo : TFlashWinfo;
begin
{ Only 98 and Nt 5.0
FillChar(FWinfo, SizeOf(FWinfo), 0);
FWinfo.cbSize:=Sizeof(FWinfo);
FWinfo.hwnd:=Application.Handle;
FWinfo.dwFlags:=$1 or $2 or $C;
FWinfo.uCount:=0;
FWinfo.dwTimeout:=0;
result:=FlashWindowEx(@FWinfo);}
result:=True;
if not(Application.Active) then FTimer.Enabled:=True else result:=False;
end;
procedure TAHMAppManager.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if FParamStore<>nil then
if (AComponent=FParamStore) and (Operation=opRemove) then
begin
if not(csDesigning in Componentstate) then
FParamStore.WriteInt(ahmscillegalabort,0);
FParamStore:=nil;
end;
inherited Notification(AComponent, Operation);
if FTrayIcon<>nil then
if (AComponent = FTrayIcon.PopupMenu) and (Operation = opRemove) then FTrayIcon.PopupMenu := nil;
end;
Procedure TAHMAppManager.Loaded;
begin
inherited loaded;
UnhookWin;
HookWin;
if FInstance.Max>0 then FInstance.CheckPrevInstances;
if not(csDesigning in Componentstate) then
with Application do
begin
UpdateService(FAsService95);
ValidateShareware;
if FAssociations.FApply then FAssociations.ApplyAll;
if assigned(FParamStore) then
begin
if (FParamStore.ReadInt(ahmscillegalabort,0)=1) and (FInstance.Instances=1) then
if assigned(FIllegalAbort) then FIllegalAbort(self);
if not(csDesigning in Componentstate) then
FParamStore.WriteInt(ahmscillegalabort,1);
end;
FAutoStart.InstallApp(FAutoStart.AutoStart);
if assigned(FIcon) then Application.Icon.Assign(FIcon);
FTrayIcon.FTrayIconData.hIcon:=Application.Icon.Handle;
FTrayIcon.UpdateTray;
SetTaskbar(FTaskbar);
if assigned(FOnHint) then OnHint:=FOnHint;
if assigned(FOnShowHint) then OnShowHint:=FOnShowHint;
if assigned(FOnActivate) then OnActivate:=FOnActivate;
if assigned(FOnDeactivate) then OnDeActivate:=FOnDeactivate;
if assigned(FOnException) then OnException:=FOnException;
if assigned(FOnMessage) then OnMessage:=FOnMessage;
if assigned(FOnHelp) then OnHelp:=FOnHelp;
if assigned(FOnIdle) then OnIdle:=FOnIdle;
{$IFDEF AHMDELPHI4}
if assigned(FActionExecute) then OnActionExecute:=FActionExecute;
if assigned(FActionUpdate) then OnActionUpdate:=FActionUpdate;
{$ENDIF}
Application.OnMinimize:=FTrayIcon.HandleMinimize;
Application.OnRestore:=FTrayIcon.HandleRestore;
end;
end;
const ApplicationCounter : Integer = 0;
procedure TAHMAppManager.FlashOnTimer(Sender : TObject);
begin
FlashWindow(Application.Handle,True);
if Application.Active then
begin
FlashWindow(Application.Handle,False);
FTimer.Enabled:=False;
end;
end;
constructor TAHMAppManager.Create(aOwner:TComponent);
begin
FAppStarting:=True;
FWinTaskBar :=True;
FWinOfficeBar := True;
FWinIcons := True;
FAsService95:=False;
FHintColor:=Application.Hintcolor;
FHintPause:=Application.Hintpause;
FHintHidePause:=Application.HintHidepause;
FHintShortPause:=Application.HintShortpause;
{$IFDEF AHMDELPHI4}
FHintShortCuts:=Application.HintShortCuts;
{$ENDIF}
FShowHint:=Application.ShowHint;
FMainForm:=True;
FFlashInterval:=200;
FTaskbar:=True;
FShortDateFormat:=ShortDateFormat;
FLongDateFormat:=LongDateFormat;
{$IFDEF AHMDELPHI4}
FCenturyWindow:=TwoDigitYearCenturyWindow;
{$ENDIF}
FUpdateMetricSettings:=True;
FUpdateFormatSettings:=True;
inherited Create(aOwner);
if (AOwner is TWinControl) then
begin
FOwnerForm := (AOwner) as TWinControl;
FOwnerHandle := FOwnerForm.Handle;
end;
FApplicationHandle := Application.Handle;
FTimer:=TAHMAppTimer.Create;
FTimer.Enabled:=False;
FTimer.Interval:=200;
FTimer.OnTimer:=FlashOnTimer;
FIcon:=TIcon.Create;
FIcon.Assign(Application.Icon);
FIcon.Onchange:=IconChange;
FTrayIcon:=TAHMTrayIcon.Create(self);
FAutoStart:=TAHMAutoStart.Create(self);
FInstance:=TAHMInstance.Create(self);
FAssociations:=TAHMAssociations.Create(self);
FShareware:=TAHMShareware.Create;
HookWin;
// if not(csDesigning in Componentstate) then
Inc(ApplicationCounter);
if (ApplicationCounter > 1) or not(AOwner is TWinControl) then
raise EAHMDuplicateError.Create(ahmscsystemduplicate1+self.classname+ahmscsystemduplicate2+#13#10+ahmscsystemduplicate3);
end;
Destructor TAHMAppManager.Destroy;
begin
UnHookWin;
Dec(Applicationcounter);
FIcon.OnChange:=nil;
fIcon.free;
FInstance.Free;
FTrayIcon.Free;
FAutoStart.Free;
FShareware.Free;
FAssociations.Free;
FTimer.Free;
inherited Destroy;
end;
procedure TAHMAppManager.SetHintColor(const Value: TColor);
begin
if not(csDesigning in Componentstate) then Application.HintColor:=Value;
FHintColor := Value;
end;
procedure TAHMAppManager.SetHintPause(const Value: Integer);
begin
if not(csDesigning in Componentstate) then Application.Hintpause:=Value;
FHintPause := Value;
end;
procedure TAHMAppManager.SetShowHint(const Value: Boolean);
begin
if not(csDesigning in Componentstate) then Application.ShowHint:=Value;
FShowHint := Value;
end;
procedure TAHMAppManager.SetTitle(const Value: String);
begin
if not(csDesigning in Componentstate) then
if Value<>'' then Application.Title:=Value;
FTitle := Value;
end;
procedure TAHMAppManager.WMPowerMsg(var Msg: TAHMWMPowerBroadcast);
begin
case Msg.dwPowerEvent of
AHMPBT_APMSUSPEND : If assigned(FOnSuspend) then FOnSuspend(self);
AHMPBT_APMSTANDBY : If assigned(FOnStandBy) then FOnStandBy(self);
AHMPBT_APMRESUMEAUTOMATIC,
AHMPBT_APMRESUMECRITICAL,
AHMPBT_APMRESUMESTANDBY,
AHMPBT_APMRESUMESUSPEND: If assigned(FOnResume) then FOnResume(self);
AHMPBT_APMBATTERYLOW : If assigned(FOnBatteryLow) then FOnBatteryLow(self);
else
end;
end;
procedure TAHMAppManager.WMDeviceChange(var Msg : TAHMWMDeviceChange);
var lpdb : PAHMBROADCAST_HDR;
lpdbv : PAHMBROADCAST_VOLUME;
begin
lpdb := PAHMBROADCAST_HDR(Msg.dwData);
case Msg.Event of
AHMDEVICEARRIVAL :
begin
if lpdb^.dbch_devicetype = AHMDEVTYP_VOLUME then
begin
lpdbv := PAHMBROADCAST_VOLUME(Msg.dwData);
if (lpdbv^.dbcv_flags and DBTF_MEDIA) = 1 then
if Assigned(FAfterInsert) then
fAfterInsert(Self, GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
end;
end;
AHMDEVICEREMOVECOMPLETE :
begin
if lpdb^.dbch_devicetype = AHMDEVTYP_VOLUME then
begin
lpdbv := PAHMBROADCAST_VOLUME(Msg.dwData);
if (lpdbv^.dbcv_flags and DBTF_MEDIA) = 1 then
if Assigned(fAfterInsert) then
fAfterRemove(Self, GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
end;
end;
end;
end;
function TAHMAppManager.GetFirstDriveLetter(unitmask : longint):char;
var DriveLetter : shortint;
begin
DriveLetter :=Ord(#65);
while (unitmask and 1)=0 do begin
unitmask := unitmask shr 1;
inc(DriveLetter);
end;
Result := Char(DriveLetter);
end;
procedure TAHMAppManager.WndProc(var AMsg:TMessage);
var EndSession : Boolean;
begin
with AMsg do
begin
case msg of
WM_DEVICECHANGE : WMDeviceChange(TAHMWMDeviceChange(AMsg));
WM_POWERBROADCAST : WMPowerMsg(TAHMWMPowerBroadcast(AMsg));
WM_COMPACTING : if assigned(FOnSysMemLow) then FOnSysMemLow(self,TWMCompacting(AMsg).CompactRatio);
WM_USERCHANGED : if assigned(FOnUserchanged) then FOnUserChanged(self);
WM_DISPLAYCHANGE : if Assigned(FOnDisplayChange) then FOnDisplayChange(Self,
AMsg.wparam,
LoWord(AMsg.lparam),
HiWord(AMsg.lParam));
WM_QUERYENDSESSION :
begin
EndSession:=True;
if TWMQueryEndSession(AMsg).Source<>0 then
begin
if assigned(FOnUserLogoff) then FOnUserLogoff(self);
end;
with TWMQueryEndSession(AMsg) do
if assigned(FOnEndWindows) then FOnEndWindows(self,EndSession);
Result:=LongInt(EndSession);
end;
else
if msg=WM_CallBack_Message then
case lParam of
WM_LButtonDblClk :
begin
if FTrayIcon.FAppRestore=OnDoubleClick then Application.Restore;
if Assigned(OnTrayDblClick) then OnTrayDblClick(Self);
end;
WM_LButtonUp :
begin
if FTrayIcon.FAppRestore=OnSingleClick then Application.Restore;
if Assigned(OnTrayClick) then OnTrayClick(Self);
end;
WM_RButtonUp : FTrayIcon.HandleRightClick(Self);
end else Result:=DefWindowProc(FTrayIcon.FWindowHandle,Msg,wParam,lParam);
end;
end;
end;
{ TAHMInstance }
var
CApplicationName : Array[0..255] of Char;
CClassName : Array[0..255] of Char;
CNumberFound : Integer;
CLastFound : HWnd;
CPopup : HWnd;
constructor TAHMInstance.Create(AHMApplication: TAHMAppManager);
begin
FMax := 0;
inherited Create;
FAction := aRestoreAndExit;
FAHMApplication:=AHMApplication;
end;
function LookAtAllWindows(Handle: HWnd; Temp: Longint) : Bool; stdcall;
var WindowName : Array[0..255] of Char;
ClassName : Array[0..255] of Char;
begin
result:=true;
if GetClassName(Handle, ClassName, SizeOf(ClassName)) > 0 then
if StrComp(ClassName, CClassName) = 0 then
if GetWindowText(Handle, WindowName, SizeOf(WindowName)) > 0 then
if StrComp(WindowName, CApplicationName) = 0 then
begin
Inc(CNumberFound);
if Handle <> Application.Handle then CLastFound := Handle;
end;
end;
procedure TAHMInstance.CheckPrevInstances;
begin
CNumberFound := 0;
CLastFound := 0;
GetWindowText(Application.Handle,CApplicationName, SizeOf(CApplicationName));
GetClassName(Application.Handle, CClassName, SizeOf(CClassName));
EnumWindows(@LookAtAllWindows,0);
if (CNumberFound > FMax) then
begin
if Assigned(FAHMApplication.OnMaxInstance) then FAHMApplication.OnMaxInstance(Self,CNumberFound);
if (FAction=aRestore) or (FAction= aRestoreAndExit) then
begin
CPopup := GetLastActivePopup(CLastFound);
BringWindowToTop(CLastFound);
if IsIconic(CPopup) then ShowWindow(CPopup, SW_RESTORE)
else SetForegroundWindow(CPopup);
end;
if (FAction = aExit) or ((FAction = aRestoreAndExit) and (CPopup<>0)) then Halt(0);
end;
end;
function TAHMInstance.GetActiveInstances : Byte;
begin
CNumberFound := 0;
CLastFound := 0;
GetWindowText(Application.Handle,CApplicationName, SizeOf(CApplicationName));
GetClassName(Application.Handle, CClassName, SizeOf(CClassName));
EnumWindows(@LookAtAllWindows,0);
result:=CNumberFound;
end;
{ TAHMTrayIcon }
constructor TAHMTrayIcon.Create(AHMApplication: TAHMAppManager);
var OSVerInfo:TOSVersionInfo;
WindowPlacement:TWindowPlacement;
begin
FEnabled:=False;
inherited Create;
FillChar(OSVerInfo,SizeOf(OsVerInfo),0);
OSVerInfo.dwOSVersionInfoSize:=SizeOf(OSVerInfo);
GetVersionEx(OSVerInfo);
if OSVerInfo.dwMajorVersion>=4 then FNewWindows:=True else FNewWindows:=False;
FNoTrayIcon:=True;
FAHMApplication:=AHMApplication;
if not (csDesigning in FAHMApplication.ComponentState) then
begin
FillChar(FTrayIconData, SizeOf(FTrayIconData), 0);
FTrayIconData.cbSize:=SizeOf(FTrayIconData);
FWindowHandle:=AllocateHWnd(FAHMApplication.WndProc);
FTrayIconData.wnd:=FWindowHandle;
FTrayIconData.hIcon:=Application.Icon.Handle;
FTrayIconData.uFlags:=NIF_Icon OR NIF_Message;
FTrayIconData.uCallbackMessage:=WM_CallBack_Message;
FillChar(WindowPlacement,SizeOf(WindowPlacement),0);
WindowPlacement.length:=SizeOf(WindowPlacement);
GetWindowPlacement(Application.Handle,@WindowPlacement);
if WindowPlacement.showCmd = SW_ShowMinimized then FMinimized:=True else fMinimized:=False;
end;
end;
Destructor TAHMTrayIcon.Destroy;
begin
if FEnabled then EmptyTray;
if not (csDesigning in FAHMApplication.ComponentState) then
DeAllocateHWnd(FWindowHandle);
FPopupmenu:=nil;
inherited Destroy;
end;
procedure TAHMTrayIcon.SetActive(const Value: TAHMTrayState);
begin
if FActive<>Value then FActive := Value;
FEnabled:=((FActive=tsAlways) or (FActive=tsOnMinimized));
if not (csDesigning in FAHMApplication.ComponentState) then
case FActive of
tsAlways : FillTray;
tsOnMinimized : if FMinimized then FillTray;
else
EmptyTray;
end;
end;
procedure TAHMTrayIcon.SetHint(const Value: String);
begin
if FHint <> Value then
begin
if not(csDesigning in FAHMApplication.ComponentState) then
begin
if Value='' then FHint:=Application.Hint else FHint:=Value;
StrPLCopy(FTrayIconData.szTip,FHint,SizeOf(FTrayIconData.szTip)-1);
if FHint <> '' then FTrayIconData.uFlags:=FTrayIconData.uFlags OR NIF_Tip
else FTrayIconData.uFlags:=FTrayIconData.uFlags AND NOT NIF_Tip;
UpdateTray;
end else FHint:=Value;
end;
end;
procedure TAHMTrayIcon.SetPopupMenu(const Value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(FAHMApplication);
end;
procedure TAHMTrayIcon.FillTray;
begin
if FEnabled AND FNewWindows AND fNoTrayIcon then
if Shell_NotifyIcon(NIM_Add,@FTrayIconData) then fNoTrayIcon:=False;
// raise EOutOfResources.Create(ahmscshelliconnores)
end;
procedure TAHMTrayIcon.EmptyTray;
begin
if FNewWindows then Shell_NotifyIcon(NIM_Delete,@FTrayIconData);
fNoTrayIcon:=True;
end;
procedure TAHMTrayIcon.UpdateTray;
begin
if (FEnabled AND FNewWindows) AND not (csDesigning in FAHMApplication.ComponentState) then
Shell_NotifyIcon(NIM_Modify,@FTrayIconData);
end;
procedure TAHMTrayIcon.HandleRightClick(Sender:TObject);
var CursorPos:TPoint;
begin
if Assigned(fPopupMenu) AND ((NOT IsWindowVisible(Application.Handle)) OR
(FActive=tsAlways)) then
begin
GetCursorPos(CursorPos);
fPopupMenu.Popup(CursorPos.X,CursorPos.Y);
end;
if Assigned(FAHMApplication.OnTrayRightClick) then FAHMApplication.OnTrayRightClick(Sender);
end;
procedure TAHMTrayIcon.HandleMinimize(Sender:TObject);
begin
if FEnabled then
begin
Application.Icon.assign(FAHMApplication.Icon);
FTrayIconData.hIcon:=fAHMApplication.Icon.Handle;
ShowWindow(Application.Handle,SW_Hide);
if fNoTrayIcon then FillTray else UpdateTray;
end;
fMinimized:=True;
if Assigned(FAHMApplication.OnMinimize) then FAHMApplication.OnMinimize(Sender);
end;
procedure TAHMTrayIcon.HandleRestore(Sender:TObject);
begin
if FEnabled then
begin
ShowWindow(Application.Handle,SW_Restore);
if (FActive=tsOnMinimized) then
EmptyTray;
end;
if Assigned(FAHMApplication.OnRestore) then FAHMApplication.OnRestore(Sender);
fMinimized:=False;
end;
{ TAHMAutoStart }
constructor TAHMAutoStart.Create(AHMApplication: TAHMAppManager);
begin
inherited Create;
if not (csDesigning in AHMApplication.ComponentState) then
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(ahmscdefrunkey, True);
CloseKey
finally
Free;
end;
end;
FAHMApplication:=AHMApplication;
end;
destructor TAHMAutoStart.Destroy;
begin
inherited Destroy;
end;
function TAHMAutoStart.InstallApp(const Value: TAHMStartType): boolean;
begin
Result := False;
if FUniqueName = '' then Exit;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(ahmscdefrunkey, True);
case Value of
sOnBoot : if not ValueExists(FUniqueName) then
try
WriteString(FUniqueName,Application.ExeName);
Result := True;
except
Result := False;
end;
sNever : if ValueExists(FUniqueName) then
try
DeleteValue(FUniqueName);
Result := True;
except
Result := False;
end;
end;
CloseKey;
finally
Free;
end;
end;
procedure TAHMAutoStart.SetAutoStart(const Value: TAHMStartType);
begin
if (Value<>FAutoStart) then
begin
FAutoStart := Value;
if not(csDesigning in FAHMApplication.Componentstate) then InstallApp(FAutoStart);
end;
end;
procedure TAHMAutoStart.SetUniqueName(const Value: String);
begin
if (Value<>FUniqueName) then FUniqueName := Value;
end;
procedure TAHMAppManager.SetHelpFile(const Value: String);
begin
if not(csDesigning in Componentstate) then Application.HelpFile:=Value;
FHelpFile := Value;
end;
procedure TAHMAppManager.IconChange(Sender: TObject);
begin
if assigned(Application.Icon) and (Application.Icon<>nil) then
begin
FTrayIcon.FTrayIconData.hIcon:=Application.Icon.Handle;
FTrayIcon.UpdateTray;
if assigned(FOnIconChange) then FOnIconChange(self);
end;
end;
procedure TAHMAppManager.SetTaskbar(const Value: Boolean);
begin
FTaskbar := Value;
if not(csDesigning in Componentstate) and not(csLoading in Componentstate) then ShowInTask;
end;
procedure TAHMAppManager.ShowInTask;
Var FStyle:Integer;
begin
if (FTaskbar) or (csDesigning in Componentstate) then
begin
ShowWindow(Application.Handle,sw_show);
FStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
FStyle := FStyle or WS_EX_APPWINDOW and not WS_EX_TOOLWINDOW;
SetWindowLong(Application.Handle, GWL_EXSTYLE, FStyle);
end else
begin
ShowWindow(Application.handle,sw_hide);
FStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
FStyle := FStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW;
SetWindowLong(Application.Handle, GWL_EXSTYLE, FStyle);
end;
end;
procedure TAHMAppManager.HookWin;
begin
if FOwnerForm<>nil then
FOwnerHandle:=FOwnerForm.Handle;
if (FOwnerHandle=0) or (csDesigning in Componentstate) then exit;
NewWndProc := MakeObjectInstance(Hooked);
OldWndProc := Pointer(SetWindowLong(FOwnerHandle, GWL_WNDPROC, LongInt(NewWndProc)));
end;
procedure TAHMAppManager.UnhookWin;
begin
if (FOwnerHandle=0) or (csDesigning in Componentstate) then exit;
SetWindowLong(FOwnerHandle, GWL_WNDPROC, LongInt(OldWndProc));
if NewWndProc<>nil then FreeObjectInstance(NewWndProc);
NewWndProc := nil;
end;
procedure TAHMAppManager.Hooked(var Msg:TMessage);
Var I : Integer;
begin
if (csDestroying in Componentstate) then exit;
if (Owner=nil) then exit;
if not(csDesigning in Componentstate) then
begin
case Msg.Msg of
WM_WINDOWPOSCHANGED : ShowInTask;
WM_SHOWWINDOW : ShowInTask;
WM_ACTIVATE :
begin
ShowInTask;
if (LoWord(Msg.WParam)=WA_ACTIVE) and (FAppStarting) and
((THandle(Msg.lParam)=Application.Handle) or not(FTaskbar)) then
begin
FAppStarting:=False;
for I:=0 to ParamCount do if assigned(FOnStartParam) then FOnStartParam(self,I,Paramstr(I));
end;
end;
WM_CLOSE : if FParamStore<>nil then FParamStore.WriteInt(ahmscillegalabort,0);
end;
Msg.Result:=CallWindowProc(OldWndProc,FOwnerHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
procedure TAHMAppManager.SetUpdateFormatSettings(const Value: Boolean);
begin
if not(csDesigning in Componentstate) then
Application.UpdateFormatSettings:=Value;
FUpdateFormatSettings:=Value;
end;
procedure TAHMAppManager.SetLongDateFormat(const Value: String);
begin
FLongDateFormat := Value;
if not(csDesigning in Componentstate) then
LongDateFormat:=Value;
end;
procedure TAHMAppManager.SetShortDateFormat(const Value: String);
begin
FShortDateFormat := Value;
if not(csDesigning in Componentstate) then
ShortDateFormat:=Value;
end;
procedure TAHMAppManager.SetHintHidePause(const Value: Integer);
begin
FHintHidePause := Value;
if not(csDesigning in Componentstate) then
Application.HintHidePause:=Value;
end;
procedure TAHMAppManager.SetHintShortPause(const Value: Integer);
begin
FHintShortPause := Value;
if not(csDesigning in Componentstate) then
Application.HintShortPause:=Value;
end;
procedure TAHMAppManager.SetUpdateMetricSettings(const Value: Boolean);
begin
FUpdateMetricSettings := Value;
if not(csDesigning in Componentstate) then
Application.UpdateMetricSettings:=Value;
end;
{$IFDEF AHMDELPHI4}
procedure TAHMAppManager.SetCenturyWindow(const Value: Word);
begin
if Value<100 then
begin
FCenturyWindow := Value;
if not(csDesigning in Componentstate) then
TwoDigitYearCenturyWindow:=Value;
end;
end;
procedure TAHMAppManager.SetHintShortCuts(const Value: Boolean);
begin
FHintShortCuts := Value;
if not(csDesigning in Componentstate) then
Application.HintShortCuts:=Value;
end;
{$ENDIF}
{ TAHMShareware }
function TAHMShareware.Check: Boolean;
begin
result:=False;
try
if FisShareware then result:=(Date>=EncodeDate(FFixedEndYear,FFixedEndMonth,FFixedEndDay)) else
except
Application.HandleException(self);
end;
end;
constructor TAHMShareware.Create;
begin
FisShareware:=False;
FFixedEndYear:=2100;
FFixedEndMonth:=1;
FFixedEndDay:=1;
inherited Create;
end;
function TAHMAppManager.ValidateShareware: Boolean;
begin
if assigned(FOnShareGetDate) then
FOnShareGetDate(self,FShareware.FFixedEndDay,FShareware.FFixedEndMonth,FShareware.FFixedEndYear);
result:=FShareware.Check;
if result then
begin
if assigned(FOnShareExpiry) then FOnShareExpiry(self)
end else
if assigned(FOnShareNoExpiry) then FOnShareNoExpiry(self);
end;
{ TAHMAssociations }
constructor TAHMAssociations.Create(AOwner : TAHMAppManager);
begin
inherited Create;
FOwner:=AOwner;
FApply:=False;
FHelp:=0;
FDDEUniqueName:=ahmscappmanddeunique;
if not(csDesigning in FOwner.Componentstate) then
begin
FDDEServerConf:=TDDEServerConv.Create(nil);
FDDEServerConf.OnExecuteMacro:=AssociationsMacro;
FDDEServerConf.OnOpen:=FOwner.OnDDEOpen;
FDDEServerConf.OnClose:=FOwner.OnDDEClose;
FDDEServerConf.Name:=FDDEUniqueName;
end;
end;
destructor TAHMAssociations.Destroy;
begin
if not(csDesigning in FOwner.Componentstate) then FDDEServerConf.Free;
inherited Destroy;
end;
procedure TAHMAssociations.SetApply(const Value: Boolean);
begin
FApply := Value;
end;
Function TAHMAssociations.GetAll(Var CurrAssoc : String) : String;
var FId,FKeyName,FDescription : String;
FxA,FxAssociations : String;
begin
result:='';
if not(csDesigning in FOwner.Componentstate) then
begin
with TRegIniFile.Create('') do
try
RootKey:=HKey_classes_root;
OpenKey('',false);
FxAssociations:=CurrAssoc;
while pos('|',FxAssociations)>0 do
begin
FxA:=Copy(FxAssociations,1,Pos('|',FxAssociations)-1);
Delete(FxAssociations,1,Pos('|',FxAssociations));
FKeyName:=Copy(FxA,Pos(':',FxA)+1,Length(FxA));
if FKeyName[1]='*' then Delete(FKeyName,1,1);
FDescription:=Copy(FxA,1,Pos(':',FxA)-1);
FId:=Copy(ExtractFileName(Application.ExeName),1,Pos('.',ExtractFileName(Application.ExeName))-1)+ahmscdocument;
if (ReadString(FKeyName,'','')=FId) and
(Pos(Application.ExeName,ReadString(FId+ahmscshellopencommand,'',''))>0)
then result:=result+FDescription+':*'+FKeyName+'|';
end;
CloseKey;
finally
free;
end;
end;
end;
Function TAHMAssociations.ApplyAll : Boolean;
var FId,FKeyName,FDescription : String;
FxA,FxAssociations : String;
begin
result:=False;
if not(csDesigning in FOwner.Componentstate) then
begin
with TRegIniFile.Create('') do
try
RootKey:=HKey_classes_root;
OpenKey('',false);
FxAssociations:=FExtensions;
while pos('|',FxAssociations)>0 do
begin
FxA:=Copy(FxAssociations,1,Pos('|',FxAssociations)-1);
Delete(FxAssociations,1,Pos('|',FxAssociations));
FKeyName:=Copy(FxA,Pos(':',FxA)+1,Length(FxA));
if FKeyName[1]='*' then Delete(FKeyName,1,1);
FDescription:=Copy(FxA,1,Pos(':',FxA)-1);
FId:=Copy(ExtractFileName(Application.ExeName),1,Pos('.',ExtractFileName(Application.ExeName))-1)+ahmscdocument;
WriteString(FKeyName,'',FId);
WriteString(FId,'',Application.Title);
WriteString(FId+ahmscdefaulticon,'',Application.Exename+','+InttoStr(FIconID));
WriteString(FId+ahmscshellopencommand,'','"'+Application.Exename+'" "%1"');
WriteString(FId+ahmscshellopenddeexec,'','[open("%1")]');
WriteString(FId+ahmscshellopenddeexectopic,'',FDDEUniqueName);
end;
CloseKey;
finally
free;
end;
result:=True;
end;
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar(''));
end;
Function TAHMAssociations.DeleteAll(DelAssoc : String) : Boolean;
var FKeyName: String;
FxA,FxAssociations : String;
begin
result:=False;
if not(csDesigning in FOwner.Componentstate) then
begin
with TRegIniFile.Create('') do
try
RootKey:=HKey_classes_root;
OpenKey('',false);
FxAssociations:=DelAssoc;
while pos('|',FxAssociations)>0 do
begin
FxA:=Copy(FxAssociations,1,Pos('|',FxAssociations)-1);
Delete(FxAssociations,1,Pos('|',FxAssociations));
FKeyName:=Copy(FxA,Pos(':',FxA)+1,Length(FxA));
if FKeyName[1]='*' then Delete(FKeyName,1,1);
WriteString(FKeyName,'','');
end;
CloseKey;
finally
free;
end;
result:=True;
end;
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar(''));
end;
type
TAHMAssociationsDlg = class(TForm)
private
Panel : TPanel;
StringGrid : TStringGrid;
procedure Setup(Associations : String;HelpID:LongInt);
procedure CallHelp(Sender : TObject);
protected
public
published
end;