We help IT Professionals succeed at work.
Get Started

Running one instance, depending on the parameter

systan
systan asked
on
430 Views
Last Modified: 2013-11-23
Hi
I have 2 Forms (MainForm and ParamForm)
I have this code, it is running once instance using muteX
eq.;
program1 (enter)
program1 (enter again) it does not open (good, muteX applied)

program1 c: (enter) paramForm opens (good)
program1 c: (enter again) paramForm opens again (NOT good, bad)

I would like (program1 c:) paramForm to open if there is no program1 c: running

But the rest of (program1 d: and program1 e:) will open,   But if they will be open that they are already open (not good, bad)

So, in short, I'd like paramForm to be openned if there is no parameter already running.

Here is the code, with some experts helped;
//======================================//
//MAINFORM
//======================================//
unit fmMain;

interface

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

type
  TMainForm = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  msg_ShowParamForm: UINT;

implementation
uses ParamUnit;

{$R *.dfm}

{ TMainForm }
var
  LastPos: TPoint = (x:100; y:100);

procedure TMainForm.WndProc(var Message: TMessage);
var
  param: string;
  NewParamForm:  TParamForm;
begin
  if (Message.Msg = WM_COPYDATA) then
  begin
    with PCopyDataStruct(Message.LParam)^ do
      if dwData = msg_ShowParamForm then
      begin
        param:= Copy(PChar(lpData), 0, cbData);
        NewParamForm:= TParamForm.Create(Self);
        NewParamForm.Myparam := param;
        NewParamForm.Show;
      end;
  end
  else
    inherited;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
Caption:='Close ME to Hide ME';
if ParamCount > 0 then PostMessage(Handle, msg_ShowParamForm, 0, 0);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
end;

initialization
  msg_ShowParamForm:= RegisterWindowMessage('msg_ShowParamForm');
end.

//
//
//
//
//

//======================================//
//PARAMFORM
//======================================//
unit ParamUnit;

interface

uses  Registry,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ExtCtrls, ComCtrls, Gauges;

type
    THandleFileFound = procedure(AFile: string) of object;
    THandleProgress  = procedure(Progress: integer) of object;
    TWorkerThread = class(TThread)

   private
    FGpath : String;
    FPath : String;
    FLastFoundFile: string;
    FRecursive : Boolean;
    FFinished : Boolean;
    FProgressValue: integer;
    FFileFilters : TStringList;
    FLock : TMultiReadExclusiveWriteSynchronizer;
    FOnFileFound: THandleFileFound;
    FdoProgress: THandleProgress;
    procedure DoHandleFileFound;
    procedure doProgress;

  protected

    Constructor Create;
    Destructor Destroy; Override;
    Procedure Execute; Override;
    Function GetFinished : Boolean;
    Procedure SetFinished(Value : Boolean);
    Property FileFilters : TStringList read FFileFilters;
    Property Lock : TMultiReadExclusiveWriteSynchronizer read FLock;
    Property Recursive : Boolean read FRecursive write FRecursive;
    Property Finished : Boolean read GetFinished;
    Property Path : String read FPath write FPath;
    Property GPath: String read FGpath;
    Property PGuageBar : THandleProgress read fDoProgress write fDoProgress;
    property OnFileFound: THandleFileFound read FOnFileFound write FOnFileFound;
    Procedure ListFiles(APath : String; AFileFilters : TStrings; ALock : TMultiReadExclusiveWriteSynchronizer; ARecursive : Boolean = True);
end;

type
  TParamForm = class(TForm)
    Label1: TLabel;
    StatusBar1: TStatusBar;
    Gauge1: TGauge;
    Timer1: TTimer;

    ListBox1: TListBox;
    Label2: TLabel;
    Button2: TButton;

    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);

    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);

    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
    FMyParam: string;
    procedure StartScan(const param:string; recurs: boolean);
    procedure HandleFileFound(AFile: string);
    procedure doProgressBar(Value: integer);
    function RootDirCount( Directory:String ):integer;

  protected
    { Protected declarations }
     AThread : TWorkerThread;

  public
    { Public declarations }
    property MyParam: string read FMyParam write FMyParam;
end;

Threadvar
  ParamForm: TParamForm;
  clikidpat : TStringList;
  finisi: boolean;
  cc, counted: integer;
  start, stop: cardinal;

implementation

{$R *.dfm}

{ TWorkerThread }
procedure TWorkerThread.Execute;
begin
  SetFinished(False);
  ListFiles(FPath, FFileFilters, FLock, FRecursive);
  SetFinished(True);
end;

constructor TWorkerThread.Create;
begin
  inherited Create(True);
  FFileFilters := TStringList.Create;
  FLock := TMultiReadExclusiveWriteSynchronizer.Create;
end;

destructor TWorkerThread.Destroy;
begin
  FLock.Free;
  FFileFilters.Free;
  inherited;
end;

function TWorkerThread.GetFinished: Boolean;
begin
  FLock.BeginRead;
  Result := FFinished;
  FLock.EndRead;
end;

procedure TWorkerThread.SetFinished(Value: Boolean);
begin
  FLock.BeginWrite;
  FFinished := Value;
  FLock.EndWrite;
end;

procedure TWorkerThread.DoHandleFileFound;
begin
  FOnFileFound(FLastFoundFile);
end;

procedure TWorkerThread.doProgress;
begin
  FdoProgress(FProgressValue);
end;

procedure TWorkerThread.ListFiles(APath: String; AFileFilters: TStrings; ALock: TMultiReadExclusiveWriteSynchronizer;
  ARecursive: Boolean);
var
    hFind:THandle;
    fileInfo:TWin32FindData;
    fileName:String;
    fileAttrib:DWORD;
begin
ALock.BeginRead;
    hFind := FindFirstFile(PChar( APath+'\*.*' ), fileInfo );
    if ( hFind <> INVALID_HANDLE_VALUE ) then
    begin
        repeat
            fileName := fileInfo.cFileName;
            fileAttrib := fileInfo.dwFileAttributes;
            if ( (fileAttrib and FILE_ATTRIBUTE_DIRECTORY) > 0 ) then
            begin
            	if  ARecursive and (FileName <> '.') and (FileName <> '..')  then
            	begin
            	if uppercase(APath+'\') = uppercase(GPath + '\') then inc(cc);
            	FProgressValue := cc;
              Synchronize(doProgress);
	            ListFiles(IncludeTrailingPathDelimiter(APath)+filename, AFileFilters, ALock, ARecursive);
           	  end;
            end
            else
            begin
	            if AFileFilters.IndexOf('*'+lowercase(ExtractFileExt(filename))) <> -1
	            then
              begin
              FLastFoundFile:= APath + '\'+ filename;
              Synchronize(DoHandleFileFound);
              end;
      	    end;
        until Terminated OR ( FindNextFile( hFind, fileInfo ) = false );
    Windows.FindClose( hFind );
 end;
ALock.EndRead;
end;


{ Form1 }
procedure TParamForm.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = StatusBar.Panels[1] then
  with Gauge1 do begin
    Top := Rect.Top;
    Left := Rect.Left;
    Width := Rect.Right - Rect.Left - 15;
    Height := Rect.Bottom - Rect.Top;
  end;
end;

function TParamForm.RootDirCount( Directory:String ):integer;
var
    hFind:THandle;
    fileInfo:TWin32FindData;
    dirCount:Integer;
    fileName:String;
    fileAttrib:DWORD;
begin
    dirCount := 0;
    hFind := FindFirstFile(PChar( Directory + '\*' ), fileInfo );
    if ( hFind <> INVALID_HANDLE_VALUE ) then
    begin
        repeat
            fileName := fileInfo.cFileName;
            fileAttrib := fileInfo.dwFileAttributes;
            if ( (fileAttrib and FILE_ATTRIBUTE_DIRECTORY) > 0 )
            and (FileName <> '.')
            and (FileName <> '..')
            then
            inc( dirCount );
        until ( FindNextFile( hFind, fileInfo ) = false );
    Windows.FindClose( hFind );
    end;
    Result := dirCount;
end;

procedure TParamForm.HandleFileFound(AFile: string);
begin
  Label1.Caption := AFile;
end;

procedure TParamForm.doProgressBar(Value: integer);
begin
    Gauge1.Progress  := Value;
end;

procedure TParamForm.Timer1Timer(Sender: TObject);
begin
  if AThread.Finished then
  begin
    stop:= GetTickCount;
    Label2.Caption := 'Duration: ' + FormatFloat('#,##0', stop-start);
    Button2.Enabled := false;
    AThread.Terminate;
    AThread.Free;
    Timer1.Enabled := False;
  end;
end;

procedure TParamForm.StartScan(const param:string; recurs: boolean);
var i : byte;
begin
start:= GetTickCount;

Gauge1.Minvalue := 0;
Gauge1.Progress := 0;
Gauge1.Maxvalue := RootDirCount(param);
cc:=0;

  Timer1.Enabled := True;
  Timer1.Interval := 1;

  AThread := TWorkerThread.Create;

  AThread.OnFileFound := HandleFileFound;
  AThread.PGuageBar := doProgressBar;

  AThread.Path := param;
  AThread.FRecursive := recurs;
  AThread.FGPath := param;

  for i := 0 to (Listbox1.Items.Count-1) do
  begin
  AThread.FileFilters.Add(Listbox1.Items.Strings[i]);
  end;
  AThread.Resume;
end;

procedure TParamForm.FormShow(Sender: TObject);
var i:integer;
    Pram:string;
begin
Pram:=FMyParam;
i:=pos(':',Pram);
delete(Pram,i+1,1);
startscan(Pram,true);
end;

procedure TParamForm.FormCreate(Sender: TObject);
var
  ProgressBarStyle: integer;
begin

  StatusBar1.Panels[1].Style := psOwnerDraw;
  Gauge1.Parent := StatusBar1;
  ProgressBarStyle := GetWindowLong(Gauge1.Parent.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(Gauge1.parent.Handle, GWL_EXSTYLE, ProgressBarStyle);

  Listbox1.Items.add('*.exe');
  Listbox1.Items.add('*.dll');
  Listbox1.Items.add('*.txt');

end;

procedure TParamForm.Button2Click(Sender: TObject);
begin
if Button2.Caption ='Paus&e' then
begin
AThread.Suspend;
Button2.Caption:='Resum&e';
end
else
begin
AThread.Resume;
Button2.Caption:='Paus&e';
end;
end;

end.

Open in new window

Comment
Watch Question
Top Expert 2010
Commented:
This problem has been solved!
Unlock 1 Answer and 10 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE