onlyone.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

unit OnlyOne;

interface
uses
  Windows, Messages, SysUtils, Classes, Forms, Dialogs,
  IniFiles, Sounds32, FormUtilities, Controls, ClipBrd,
  D_Str32;

type
  TOnlyOne = class(TComponent)
  private
    SemaphoreString : String;
    H : LongInt;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    Constructor Create(AOwner: TComponent); override;
    Function DoIExist:Boolean;
  end;

  TFormEnh = class(TComponent)
  private
    FEnabled    : boolean;
    FSaveValues : boolean;
    FSaveState  : boolean;
    FReLoadOnClose : boolean;
  protected
    { Protected declarations }
    OnDestroyOrigin:TNotifyEvent;
    OnCloseOrigin:TCloseEvent;
    procedure OnClose(Sender: TObject; var Action: TCloseAction);
    procedure OnDestroy(Sender: TObject);
    procedure Loaded; override;
  public
    { Public declarations }
    procedure ReLoadFormState;
  published
    Constructor Create(AOwner: TComponent); override;
    property Enabled : Boolean read FEnabled write FEnabled default True;
    property SaveValues : Boolean read FSaveValues write FSaveValues default True;
    property SaveState  : Boolean read FSaveState write FSaveState default True;
    property ReLoadOnClose  : Boolean read FReLoadOnClose write FReLoadOnClose default True;
  end;

procedure Register;

const 
  WM_ONLYONE = WM_USER + 2000;

implementation

Const
  TempFile : string = '';
  DeleteTempFile : boolean = TRUE;

constructor TFormEnh.Create(AOwner: TComponent);
begin
  INHERITED CREATE(Aowner);
  FEnabled    := TRUE;
  FSaveValues := TRUE;
  FSaveState  := TRUE;
  FReLoadOnClose  := TRUE;
  if (not (csDesigning in ComponentState)) AND (Owner is TForm) then begin
    OnDestroyOrigin := TForm(Owner).OnDestroy;
    OnCloseOrigin := TForm(Owner).OnClose;
    TForm(Owner).OnDestroy := OnDestroy;
    TForm(Owner).OnClose := OnClose;
  end;
end;

procedure TFormEnh.OnClose(Sender: TObject; var Action: TCloseAction);
begin
  if (not (csDesigning in ComponentState)) AND (Owner is TForm) then begin
    if Assigned(OnCloseOrigin) then
      OnCloseOrigin(Sender,Action);
    if FEnabled AND FReLoadOnClose then begin
      if TForm(Owner).ModalResult <> mrOk then
        LoadFormValues(TForm(Owner))
      else
        SaveFormValues(TForm(Owner));
    end;
  end;
end;

procedure TFormEnh.OnDestroy(Sender: TObject);
begin
  if (not (csDesigning in ComponentState)) AND (Owner is TForm) then begin
    if Assigned(OnDestroyOrigin) then
      OnDestroyOrigin(Sender);
    if FEnabled then begin
      if FSaveValues then
        SaveFormValues(TForm(Owner));
      if FSaveState then begin
        if TForm(Owner).BorderStyle = bsSizeable then
          SaveFormState(TForm(Owner))
        else
          SaveFormState(TForm(Owner))
      end;
    end;
    TForm(Owner).OnClose := OnCloseOrigin;
    TForm(Owner).OnDestroy := OnDestroyOrigin;
  end;
end;

procedure TFormEnh.ReLoadFormState;
begin
  if (not (csDesigning in ComponentState)) AND (Owner is TForm) then begin
    if FEnabled then begin
      if FSaveState then begin
        if TForm(Owner).BorderStyle = bsSizeable then
          LoadFormState(TForm(Owner))
        else
          LoadFormPos(TForm(Owner))
      end;
    end;
  end;
end;

procedure TFormEnh.Loaded;
begin
  if (not (csDesigning in ComponentState)) AND (Owner is TForm) then begin
    if FEnabled then begin
      if FSaveValues then
        LoadFormValues(TForm(Owner));
      if FSaveState then begin
        if TForm(Owner).BorderStyle = bsSizeable then
          LoadFormState(TForm(Owner))
        else
          LoadFormPos(TForm(Owner))
      end;
    end;
  end;
end;

function SysDir: string;
var
  SystemDir: Array[0..255] of char;
Begin
  GetSystemDirectory(@SystemDir, 255);
  Result := StrPas(SystemDir)+'\';
end;

function TOnlyOne.DoIExist:Boolean;
var
  hSem : THandle;
  aSem : Array[0..256] of Char;
begin
  DoIExist := False;
  StrPCopy(aSem, SemaphoreString);
// Create a Semaphore in memory - If this is the first instance, then it should be 0
  hSem := CreateSemaphore(nil, 0, 1, aSem);
// Check if the semaphore exists
  if ((hSem <> 0) AND (GetLastError() = ERROR_ALREADY_EXISTS)) then begin
    CloseHandle(hSem);
    DoIExist := True;
  end;
end;


constructor TOnlyOne.Create(AOwner: TComponent);
var
  s : string;
begin
  INHERITED CREATE(Aowner);
  if NOT (csDesigning in ComponentState) then begin  // don't run if in design state
    SemaphoreString := 'Only One ' + ExtractFileName(Application.Exename);
    TempFile := ChangeFileExt(SysDir+SemaphoreString,'.h');
    with TIniFile.Create(TempFile) do begin
      if DoIExist then begin
        with TClipBoard.Create do begin
          if NOT FileExists(ParamStr(1)) then
            ShowMessage(ExtractFileName(Application.ExeName) + ' is allready running.');
          H := ReadInteger('settings','Handle',0);
          if H <> 0 then begin
            if IsIconic(H) then
              ShowWindow(H, SW_RESTORE);
            SetForeGroundWindow(H);
            s := ParamStr(1);
            if FileExists(ParamStr(1)) then begin
              s := ExpandFileName(ShortToLongFileName(ParamStr(1)));
              AsText := s;
            end
            else
              AsText := '';
            PostMessage(H,WM_ONLYONE,0,0);
            Free;
          end;
        end;
        Free;
        DeleteTempFile := FALSE;
        HALT(0);  // stop all executing
      end;
      WriteInteger('settings','Handle',Application.Handle);
    end;          // write the current application handle
  end;            // to s temporary file in the system directory
end;

procedure Register;
begin
  RegisterComponents('Utils', [TOnlyOne, TFormEnh]);
end;

Initialization

finalization
begin  // delete the temporary file
  if DeleteTempFile AND FileExists(TempFile) then begin
    DeleteFile(TempFile);
  end;
end;

end.