Programalama > DELPHI

Etiketler: open, source, ahmtappmanager

Ort. 0
Puan ver:
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;



Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.