asked on

Running one instance, depending on the parameter

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

aflarin

You have to add all running paths to the global list. Something like this:

something like this:

TParamForm = class(TForm)
private
FPathGlobalIndex: Integer;
....
end;

procedure TParamForm.FormShow(Sender: TObject);
var i:integer;
Pram:string;
begin
Pram:=FMyParam;
i:=pos(':',Pram);
delete(Pram,i+1,1);
FPathGlobalIndex:= ParamFormList.AddPath(Pram); // trying to add path to global list
if FPathGlobalIndex >=0 then
startscan(Pram,true)
else
Self.Release; // path already exists, closing form
end;

procedure TParamForm.FormDestroy(Sender: TObject);
begin
if FPathGlobalIndex >= 0 then
ParamFormList.RemovePath(FPathGlobalIndex); // remove path from global list
end;

unit ParamFormList;

interface

uses
  SysUtils, Classes, SyncObjs;

// returns Index of added path, or -1 if it already exists
function AddPath(const aPath: string): Integer;

procedure RemovePath(anIndex: Integer);
function PathExists(const aPath: string): Boolean;

implementation

var
  ParamList: TStringList;
  csParamList: TCriticalSection;

function AddPath(const aPath: string): Integer;
begin
  if PathExists(aPath) then
    Result:= -1
  else
  begin
    csParamList.Enter;
    try
      Result:= ParamList.Add( AnsiUpperCase(aPath) );
    finally
      csParamList.Leave;
    end;
  end;
end;

procedure RemovePath(anIndex: Integer);
begin
  csParamList.Enter;
  try
    ParamList.Delete( anIndex );
  finally
    csParamList.Leave;
  end;
end;

function PathExists(const aPath: string): Boolean;
begin
  csParamList.Enter;
  try
    Result:= ParamList.IndexOf( AnsiUpperCase(aPath) ) >= 0;
  finally
    csParamList.Leave;
  end;
end;


initialization
  ParamList:= TStringList.Create;
  csParamList:= TCriticalSection.Create;

finalization
  FreeAndNil(csParamList);
  FreeAndNil(ParamList);

end.

Open in new window

Ferruccio Accalai

In your code I cannot see nothing related mutex, anyway you should create a MutexString for the parameter if it exists and then check if the Mutex is already available.

So other than creating a standard mutex you should also create a mutex using the param, then if the mutex for that param already exists don't open the ParamForm

I mean:
1st - StandardMutex := CreateMutex (nil, False, PChar('MyStandardMutex));
2nd - If ParamCount > 0 then ParamMutex := CreateMutex (nil, False, PChar(ParamStr(0));

well, now for the StandardMutex go as usual, then if paramcount > 0 and ParamMutex don't exists open ParamForm else it means that ParamForm (for this param) already exists.

systan

ASKER

Thanks Aflarin;
I'll try the code later, But is there any short way of doing this? Do I have to make another file for ParamFormList?

Ferruccio68;
Oh, I'm sorry, I forgot to attach the code for the muteX; (so 3 files are in now)
Please correct it if there is a bug; because sometimes after the mainform runs, the paramform does not run; I have to quit the mainform and run it again to run the paramform with parameter.

Aflarin; maybe you can look at also.

program MutexProject;

uses
  Windows,
  Messages,
  Forms,
  fmMain in 'fmMain.pas' {MainForm},
  ParamUnit in 'ParamUnit.pas' {ParamForm};

{$R *.res}

var
  Mutex : THandle;
  MainWindowOfPreviosInstance: THandle;
  CopyStruct: TCopyDataStruct;

begin
  Mutex := CreateMutex(nil, True, 'myapp');
  if (Mutex <> 0) and (GetLastError = 0) then
  begin
    Application.Initialize;
    Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TParamForm, ParamForm);
  Application.Run;
  end
  else
  begin
    if ParamCount > 0 then
    begin
      MainWindowOfPreviosInstance:= FindWindow('TMainForm', nil);
      if MainWindowOfPreviosInstance <> 0 then
      begin
        CopyStruct.dwData:= msg_ShowParamForm;
        CopyStruct.cbData:= Length(ParamStr(1));
        CopyStruct.lpData:= PChar(ParamStr(1));
        SendMessage( MainWindowOfPreviosInstance, WM_COPYDATA, 0, LPARAM(@CopyStruct) );
      end;
    end;
  end;

  if Mutex <> 0 then CloseHandle(Mutex);

end.

Open in new window

systan

ASKER

Oh, I'm sorry again, that muteX dpr is only a sample from aflarin(but with the 2 files I attached).
But this is the muteX code I am using, Please see it if there's something wrong with it.
Because sometimes after the mainform runs, the paramform does not run; I have to quit the mainform and run it again to run the paramform with parameter.

program Project1;

uses
  Forms,
  windows,
  messages,
  fFwall in 'fFwall.pas' {fMainform},
  uSplash in 'uSplash.pas' {fSplashform},
  fusbscan in 'fusbscan.pas' {usbform},
  dbupdater in 'dbupdater.pas' {dbUpdateForm},
  ParamUnit in 'ParamUnit.pas' {ParamForm};

var
Mutex : THandle;
MainWindowOfPreviosInstance: THandle;
CopyStruct: TCopyDataStruct;


{$R *.res}

begin
Mutex := CreateMutex(nil, True, 'myrealapp');
  if (Mutex <> 0) and (GetLastError = 0) then
  begin
   Application.Initialize;

   //SHOW a splash form 
   fSplashForm:=TfSplashForm.Create(Application);
   fSplashForm.Show;

  //hide mainform 
  Application.ShowMainForm := False;

  Application.CreateForm(TfMainform, fMainform);
  Application.CreateForm(Tusbform, usbform);
  Application.CreateForm(TdbUpdateForm, dbUpdateForm);
  Application.CreateForm(TParamForm, ParamForm);

  Application.Run;

end

else

begin
    if ParamCount > 0 then
    begin
      MainWindowOfPreviosInstance:= FindWindow('TfMainForm', nil);

      if MainWindowOfPreviosInstance <> 0 then
      begin
        CopyStruct.dwData:= msg_ShowParamForm;
        CopyStruct.cbData:= Length(ParamStr(1));
        CopyStruct.lpData:= PChar(ParamStr(1));
        SendMessage( MainWindowOfPreviosInstance, WM_COPYDATA, 0, LPARAM(@CopyStruct) );
      end;

    end;
  end;

    if Mutex <> 0 then CloseHandle(Mutex);

end.

Open in new window

aflarin

> I'll try the code later, But is there any short way of doing this?

I don't think so. There must be a global list with all current searches and a critical section to access it from threads.

> Do I have to make another file for ParamFormList?

Yes. And you should include it in uses statement of ParamForm

systan

ASKER

Ferruccio68;
I hope you have read my comments;

Aflarin;
I test your code "ParamFormList".
I open parameter c:, d:, and e:
When paramstr c finishes to scan, and paramstr e finished also, I close paramForm with paramstr c:
So, 2 paramForm are only active, with paramstr d: is still scanning, paramstr e: which is finished
When I tried to run again paramForm paramstr c:, no form won't open.

And when I close/quit the mainform that is hidding, error's "List Index Out of Bounds (2)", And if there is no open paramForm the error message is "List Index Out of Bounds (0)". Probably of the TParamForm.FormDestroy.

I hope you catch my story

aflarin

1. About errors: try the improved ParamFormList

2. It seems you never destroy ParamForm after closing. Create this handler:

procedure TParamForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
end;

The above suggestions should fix all errors.

unit ParamFormList;

interface

uses
  SysUtils, Classes, SyncObjs;

// returns Index of added path, or -1 if it already exists
function AddPath(const aPath: string): Integer;

procedure RemovePath(aCookie: Integer);
function PathExists(const aPath: string): Boolean;

implementation

var
  CurIndex: Integer;
  ParamList: TStringList;
  csParamList: TCriticalSection;

function AddPath(const aPath: string): Integer;
begin
  Result:= -1;
  if not PathExists(aPath) then
  begin
    csParamList.Enter;
    try
      if Assigned(ParamList) then
      begin
        Inc(CurIndex);
        Result:= ParamList.AddObject( AnsiUpperCase(aPath), TObject(CurIndex) );
      end
      else
        raise Exception.Create('There''s something strange here. ParamList is nil, but it should be assigned' );
    finally
      csParamList.Leave;
    end;
  end;
end;

procedure RemovePath(aCookie: Integer);
var
  Index: Integer;
begin
  csParamList.Enter;
  try
    if Assigned(ParamList) then
    begin
      Index:= ParamList.IndexOfObject( TObject(aCookie) );
      if Index >= 0 then
        ParamList.Delete( Index );
    end;
  finally
    csParamList.Leave;
  end;
end;

function PathExists(const aPath: string): Boolean;
begin
  csParamList.Enter;
  try
    Result:= Assigned(ParamList) and (ParamList.IndexOf( AnsiUpperCase(aPath) ) >= 0);
  finally
    csParamList.Leave;
  end;
end;


initialization
  ParamList:= TStringList.Create;
  csParamList:= TCriticalSection.Create;

finalization
  csParamList.Enter;
  try
    FreeAndNil(ParamList);
  finally
    csParamList.Leave;
  end;
  FreeAndNil(csParamList);

end.

Open in new window

systan

ASKER

Aflarin;
I run the mainform;
I run the paramForm paramstr c:
I run the paramForm paramstr d:
I run the paramForm paramstr e:

3 paramForm finished, I closed paramstr d:

2 paramForm is only Active;
I run again the paramForm paramstr d: (because it is closed already)
paramstr d: is not opening (even it was closed already)

But, no error's now when I terminate/close/quit the mainform.

ASKER CERTIFIED SOLUTION

aflarin

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

systan

ASKER

Perfect;
Thank you
Congrat's to your Delphi's programming Master's Rank
What a brain?!