Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project ONECOPY

Project Structure


ONECOPY.DPR

program OneCopy;

uses
  Forms, Windows, Messages, SysUtils,
  OneF in 'OneF.pas' {Form1};

{$R *.RES}

var
  hMutex: THandle;
  FoundWnd: THandle;
  ModuleName: string;

function EnumWndProc (hwnd: THandle;
  Param: Cardinal): Bool; stdcall;
var
  ClassName, WinModuleName: string;
  WinInstance: THandle;
begin
  Result := True;
  SetLength (ClassName, 100);
  GetClassName (hwnd, PChar (ClassName), Length (ClassName));
  ClassName := PChar (ClassName);
  if ClassName = TForm1.ClassName then
  begin
    // get the module name of the target window
    SetLength (WinModuleName, 200);
    WinInstance := GetWindowLong (hwnd, GWL_HINSTANCE);
    GetModuleFileName (WinInstance,
      PChar (WinModuleName), Length (WinModuleName));
    WinModuleName := PChar(WinModuleName); // adjust length

    // compare module names
    if WinModuleName = ModuleName then
    begin
      FoundWnd := Hwnd;
      Result := False; // stop enumeration
    end;
  end;
end;

begin
  // check if mutex already exists
  HMutex := CreateMutex (nil, False, 'OneCopyMutex');
  if WaitForSingleObject (hMutex, 0) <> wait_TimeOut then
  begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end
  else
  begin
    // get the current module name
    SetLength (ModuleName, 200);
    GetModuleFileName (HInstance,
      PChar (ModuleName), Length (ModuleName));
    ModuleName := PChar (ModuleName); // adjust length

    // find window of previous instance
    EnumWindows (@EnumWndProc, 0);
    if FoundWnd <> 0 then
    begin
      // show the window, eventually
      if not IsWindowVisible (FoundWnd) then
        PostMessage (FoundWnd, wm_User, 0, 0);
      SetForegroundWindow (FoundWnd);
    end;
  end;
end.

ONEF.PAS

unit OneF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
  private
  public
    procedure User (var msg: TMessage); message wm_User;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.User(var msg: TMessage);
begin
  Application.Restore;
end;

end.

ONEF.DFM

object Form1: TForm1
  Left = 241
  Top = 125
  Width = 253
  Height = 108
  Caption = 'OneCopy'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 15
    Top = 13
    Width = 215
    Height = 54
    Alignment = taCenter
    Caption = 'Run a second copy of this application'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -24
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    WordWrap = True
  end
end