Kun 1 program åbent af gangen

unit MaxInstance;
// Version:  1.1
//
// Purpose:  Allows the Delphi programmer to set a limit on the
//          number of open instances of a Win32 application.
//
// Compatibility:  Should work on any 32 bit version of Delphi
//                since it relies on Win32API calls.
//                Should also work with C++ Builder but not tested.
//
// Uses:  Win32API Semaphore calls.
//
//  Freeware:  No warranties express or implied. Use At Your Own Risk.
//
//  Platforms:  32 bit Windows9x/NT/2000.
//
//  Installation:  Unpack files to a folder in your Delphi library path.
//                In Delphi 5 IDE Select Component=>Install Component,
//                then select the file MaxInstance.pas. For other
//                versions of Delphi or C++ Builder see the online
//                help for component installation.
//
//  Usage:  Drop on the main form of your application to limit
//          the number of instances of your app that can be run
//          concurrently.  This maximum number can be set at
//          design time using the Object Inspector.  In the main
//          form OnCreate Handler call the method GetSem.
//
// Example:
//        procedure TForm1.FormCreate(Sender: TObject);
//        begin
//          MaxInstance1.GetSem;
//        end;
//
// Properties:
//
//  MaxInstances - Longint:  Max number of open App instances.
//
//  TimeOut - DWORD: milliseconds to wait for the Semaphore.
//            This number has 2 "magic cookie" values, 0,
//            meaning do not wait at all but just test if the
//            Semaphore is signalled, and -1L, meaning to wait
//            for the Semaphore forever.  Use this last with
//            caution as it can easily hang your app!  The
//            default is set to 250 or 1/4 second.
//
//  AutoKill - Boolean: If true(the default) TMaxInstance calls
//            Application.Terminate if too many apps are open.
//
//  SemName - String:  The name of the global Semaphore.  See
//            the Win32API Help for specifics but basically
//            it doesn't like a '\' directory separator char
//            in the name.  The Kernel Object namespace is all
//            one so try to use a unique name so that the first
//            instance of your App can create the Semaphore.
//            (If you drop the component on the form a GUID
//            string is created automatically to guarantee
//            the kernel object name for the semaphore will
//            be unique.  See Win32API help for more info
//            on GUIDs.)
//
// Events:
//
//  OnSemFailure - Triggered if API Semaphore calls fail outright.
//
//  OnTooMany - Triggered if the current App is over the limit
//              of allowed instances.
//
//  Note that by setting AutoKill to False and assigning handlers
//  to the events above you can do something besides quit if too
//  many App instances are open(like chide the user or something,
//  who knows? :) or if the Semaphore cannot be created.
//  For this reason I included the method FreeSem so that you can
//  free open Semaphore resources in your handlers if desired.

interface

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

const
  WM_ShowYourSelf = WM_USER + 402;

type
  TMaxInstance = class(TComponent)
  private
    FMaxInstances: LongInt;
    FAutoKill,
    FBringToFront: Boolean;
    FSemName,
    FTitle      : string;
    FTimeOut    : DWORD;
    FTooMany,
    FSemFailure  : TNotifyEvent;
  protected
    SemHandle: THandle;
    SemHeld: Boolean;
    ErrorCode: DWORD;

    procedure ShowYourSelf(var Msg: TMsg; var Handled: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsSemHeld: Boolean;
    function GetErrorCode: DWORD;
    function GetSem : Integer;
    procedure FreeSem;

  published
    property MaxInstances: LongInt      read FMaxInstances write FMaxInstances default 1;
    property AutoKill    : Boolean      read FAutoKill    write FAutoKill    default True;
    property SemName    : String      read FSemName      write FSemName;
    property TimeOut    : DWORD        read FTimeOut      write FTimeOut      default 250;
    property OnTooMany  : TNotifyEvent read FTooMany      write FTooMany;
    property OnSemFailure: TNotifyEvent read FSemFailure  write FSemFailure;
    property BringToFront: Boolean      read FBringToFront write FBringToFront default True;
    property Title      : String      read FTitle        write FTitle;
  end;

procedure Register;

implementation

uses ActiveX, ComObj;

procedure Register;
begin
  RegisterComponents('AK NonVisual', [TMaxInstance]);
end;

{ ---------------------------------------------------------------------------- }

constructor TMaxInstance.Create(AOwner: TComponent);
var
  MyGuid: TGUID;
begin
  inherited Create(AOwner);
  FMaxInstances := 1;
  FAutoKill := True;
  FBringToFront := True;
  FTimeOut := 250;
  FTitle := '';

  if (csDesigning in ComponentState) and (FSemName = '') then
    if CoCreateGuid(MyGuid) = S_OK then
      FSemName := GuidToString(MyGuid);

  Application.OnMessage := ShowYourSelf;
end;

{ ---------------------------------------------------------------------------- }

destructor TMaxInstance.Destroy;
begin
  if SemHeld then
    ReleaseSemaphore(SemHandle, 1, nil);
  if SemHandle <> 0 then
    CloseHandle(SemHandle);
  inherited Destroy;
end;

{ ---------------------------------------------------------------------------- }

function TMaxInstance.IsSemHeld: Boolean;
begin
  Result := SemHeld;
end;

{ ---------------------------------------------------------------------------- }

function TMaxInstance.GetErrorCode: DWORD;
begin
  Result := ErrorCode;
end;

{ ---------------------------------------------------------------------------- }

function TMaxInstance.GetSem : Integer;
var
  WaitVal: DWORD;
  WindowHandle: HWND;
begin
  SemHeld := false;
  ErrorCode := 0;
  SemHandle := CreateSemaphore(nil, MaxInstances, MaxInstances, PChar(SemName));
  if SemHandle = 0 then
  begin
    ErrorCode := GetLastError;

    if Assigned(FSemFailure) then
      OnSemFailure(Self);

    if AutoKill then
      Application.Terminate;
  end;
  WaitVal := WaitForSingleObject(SemHandle, TimeOut);

  Result := WaitVal; //JB 25032002

  case WaitVal of
    WAIT_OBJECT_0 :
                    SemHeld := True;
    WAIT_TIMEOUT  : begin
                      if Assigned(FTooMany) then
                        OnTooMany(Self);

                      if FBringToFront then
                      begin
                        WindowHandle := FindWindow('TApplication', PChar(Title));
                        if WindowHandle <> 0 then
                          PostMessage(WindowHandle, WM_ShowYourSelf, 0, 0);
                      end;

                      if AutoKill then
                        Application.Terminate;
                    end;
    WAIT_ABANDONED: begin
                      ErrorCode := GetLastError;
                      if Assigned(FSemFailure) then
                        OnSemFailure(Self);

                      if AutoKill then
                        Application.Terminate;
                    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure TMaxInstance.FreeSem;
begin
  ErrorCode := 0;
  if SemHeld then
    if not ReleaseSemaphore(SemHandle, 1, nil) then
    begin
      ErrorCode := GetLastError;
      exit;
    end
    else
      SemHeld := False;

  if SemHandle <> 0 then
    if not CloseHandle(SemHandle) then
      ErrorCode := GetLastError
    else
      SemHandle := 0;
end;

{ ---------------------------------------------------------------------------- }

procedure TMaxInstance.ShowYourSelf(var Msg: TMsg; var Handled: Boolean);
// If your application already has assigned a procedure to the "OnMessage" event,
// then copy this "if" statement to the message procedure.
begin
  Handled := False;
  if msg.message = WM_ShowYourSelf then
  begin
    if IsIconic(Application.Handle) then
      Application.Restore;
    Application.BringToFront;
    Handled := True;
  end;
end;

end.

borrisholt > Jeg tjekker det når jeg kommer hjem - Men det ser da lovende ud ;o)

Hmm... Sender den også de paramenter som bliver sendt til det åbne program? Altså så den åbner den fil, som man dobbeltklikkede på?

For at forhindre at samme program kører mere end en gang på samme tid, så plejer jeg at inkludere en multiinst-unit, så virker det !

Jeg kan sende dig filen hvis du har lyst til det !

Mvh

PigBear

pigbear >> Hvordan får jeg så åbnet filen som man dobbeltklikkede på? Jeg bruger en kommando som hedder DoOpenFile( fFileName: String );

Hej igen

Hvis du skal finde ud af hvilken fil brugeren klikkede på i stifinder, så kan du ikke bruge multiinst unit´ten.
Hvis det kun drejer sig om bestemte filtyper (fx aspx) der hører til dit program så kan det løses ved at knytte/associere aspx-filtypen til dit program.

I selve programmet bruger du så ParamStr(1) for at aflæse hvilken fil der blev dobbeltklikket på !

Hvis du laver en lille test så kan du i create af programmet fx skrive følgende:
showmessage('Bruger klikkede på følgende dokument: '+ParamStr(1));
så kan du der se filnavnet som brugeren dobbeltklikkede på !

I stifinder højreklikker du på fx. minfil.aspx mens du trykker ctrl + shift ned
og vælger menuen: "open with / åbn med" og der browser du frem til placeringen af dit program og så afkrydser du checkboksen "Always use this program to open these files, og trykker ok.

Håber ikke at jeg har misforstået opgaven ! Dette virker i hvertfald !

Mvh

Pigbear

Pigbear > Det har jeg skam lavet det der ;o) Og det var ikke det spørgsmålet gik ud på... :(
Det var at når mit program åbner, tjekker det om det allerade et åbent. Hvis ja, så sender den en besked til mit program (PostMessage), og når mit program modtager beskeden "afkoder" den beskeden, og prøver at åbne dokumentet. MEN, jeg får en streng som følgende:
P-;

Og den kan jeg jo ikke bruge til meget... ?
- Men prøv at sende mig den unit der... n.persson@mail.dk

lukker