⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 timeclock.dpr

📁 一个Delphi写的跟考勤机门禁机收款机的接品软件源码
💻 DPR
字号:
program TimeClock;

uses
  PrjConst in 'PrjConst.pas',
  Functions in 'Functions.pas',
  GB2Big5 in 'GB2Big5.pas',
  Forms,
  SysUtils,
  Windows,
  Messages,
  Main in 'Main.pas' {frmMain},
  ChDevPwd in 'ChDevPwd.pas' {frmChDevPwd},
  ListCard in 'ListCard.pas' {dlgListCard},
  ClockTime in 'ClockTime.pas' {dlgClockTime},
  RingTime in 'RingTime.pas' {dlgRingTime},
  CardNo in 'CardNo.pas' {dlgCardNo},
  Hints in 'Hints.pas' {dlgHints},
  SearchPort in 'SearchPort.pas' {dlgSearchPort},
  ClockOptions in 'ClockOptions.pas' {dlgOptions},
  EastRiver in 'EastRiver.pas',
  Progress in 'Progress.pas' {dlgProgress},
  RealControl in 'RealControl.pas' {frmRealControl},
  GateCard in 'GateCard.pas' {dlgGateCard},
  DoorPeriods in 'DoorPeriods.pas' {dlgDoorPeriods},
  SuperUserDialog in 'SuperUserDialog.pas' {dlgSuperUser},
  Periods in 'Periods.pas' {dlgPeriods},
  FindListItem in 'FindListItem.pas' {dlgFindListItem};

type
  TMyMutex=class(TObject)
  private
    MutHandle: THandle;
    MessageId: Cardinal;
    SaveOnMessage: TMessageEvent;
  protected
    procedure BroadCastFocusMessage;
    procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
  public
    PrevMutexExists: Boolean;
    constructor Create(const UniqueAppStr: string);
    destructor Destory;
  end;

{$R *.RES}

const
  MI_QUERYWINDOWHANDLE=1;
  MI_RESPONDWINDOWHANDLE=2;
  MI_ERROR_NONE=0;
  MI_ERROR_FAILSUBCLASS=1;
  MI_ERROR_CREATINGMUTEX=2;

constructor TMyMutex.Create(const UniqueAppStr: string);
begin
  SaveOnMessage:=Application.OnMessage;
  Application.OnMessage:=OnAppMessage;
  MessageId := RegisterWindowMessage(PChar(UniqueAppStr));
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(UniqueAppStr));
  if MutHandle=0 then
  begin
    PrevMutexExists:=False;
    MutHandle := CreateMutex(nil, False, PChar(UniqueAppStr));
  end
  else
  begin
    PrevMutexExists:=True;
    BroadCastFocusMessage;
  end;
end;

destructor TMyMutex.Destory;
begin
  if MutHandle<>0 then CloseHandle(MutHandle);
  Application.OnMessage:=SaveOnMessage;
end;

procedure TMyMutex.OnAppMessage(var Msg: TMsg;var Handled: Boolean);
begin
  if Msg.message=MessageId then
  begin
    case Msg.wParam of
      MI_QUERYWINDOWHANDLE:
        begin
          if IsIconic(Application.Handle) or
             (Assigned(Application.MainForm) and not IsWindowVisible(Application.MainForm.Handle)) then
          begin
            ShowWindow(Application.Handle, SW_MINIMIZE);
            ShowWindow(Application.Handle, SW_RESTORE);
          end;
          SetActiveWindow(Application.Handle);
          SetForegroundWindow(Application.Handle);
          if Msg.lParam<>0 then
            PostMessage(HWND(Msg.lParam), MessageId, MI_RESPONDWINDOWHANDLE, Application.Handle);
        end;
      MI_RESPONDWINDOWHANDLE:
        begin
          SetForegroundWindow(HWND(Msg.lParam));
          if Assigned(Application) then
            Application.Terminate;
        end;
    end;
  end
  else
    if Assigned(SaveOnMessage) then SaveOnMessage(Msg, Handled);
end;

procedure TMyMutex.BroadCastFocusMessage;
var
  BSMRecipients: DWORD;
begin
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageId, MI_QUERYWINDOWHANDLE, Application.Handle);
end;

var
  MyMutex: TMyMutex;
begin
  Application.Initialize;
  MyMutex:=TMyMutex.Create(UniqueAppStr);
  if not MyMutex.PrevMutexExists then
  begin
    Application.CreateForm(TfrmMain, frmMain);
    Application.Run;
  end;
  MyMutex.Free;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -