Programm nur 1x starten

[Christian Seehase]

Moin Zusammen,

zum übergeben der weiteren Dateipfade an die laufende Instanz ist mir auch noch etwas eingefallen.
Die Lösung gefällt mir selber noch nicht so ganz, aber sie funktioniert. Das Problem ist, das Pfade 260 Zeichen lang sein, hier aber maximal 255 Zeichen übergeben werden können.
Die Dateitypen des Programmes werden dazu "ganz normal" in der Registry eingetragen. (also auch "%1" als Parameter).

Als Beispiel habe ich eine MDI Anwendung vorgesehen, die einen festen Fenstertitel des Hauptfensters hat, und bei denen die MDI Childs die geladenen Dateien in einem Memo anzeigen sollen.

Die Projektdatei:

Delphi-Quellcode:

program Multifileload;

uses
  windows,
  Sysutils,
  Forms,
  MAIN in 'MAIN.pas' {frmMAIN},
  MDIPart in 'MDIPart.pas' {frmSUB};

{$R *.RES}
var
  dwMutex : DWORD;
  hWindow : DWORD;
  dwAtom  : DWORD;

begin
  // Eine eindeutige eigene Message erzeugen
  // ACHTUNG: In der IDE mit Strg-Shift-G selber generieren nicht diesen Wert übernehmen!
  //          (Es wird einfach eine GUID generiert. Eindeutiger wird ein String nicht
  //           so leicht sein können)
  // Die Variable dwMessage ist in der Unit MAIN deklariert, da sie dort noch
  // gebraucht wird
  dwMessage := RegisterWindowMessage('{06007663-C0F6-4069-A835-D85AD31B5011}');
  // Mutex erzeugen
  dwMutex   := CreateMutex(nil,true,'MultiFileLoad');
  try
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin // Mutex wurde das erste Mal erzeugt, Programm normal starten
      Application.Initialize;
      Application.CreateForm(TfrmMAIN, frmMAIN);
      Application.Run;
    end
    else
    begin
      // Den Fenstertitel des Programmes abfragen
      hWindow := FindWindow(nil,'Multifiledemo');
      if hWindow <> 0 then
      begin // gefunden, dann ggf. den übergebenen Pfad in einem Systemglobalen
            // Bereich ablegen (die Atom Table)
            // Nicht ganz sauber, da die Strings in dieser Tabelle maximal 255
            // Zeichen lang sein dürfen, die Pfade aber 260 Zeichen
        if (paramcount > 0) and FileExists(paramstr(1)) then
        begin
          dwAtom := GlobalAddAtom(PChar(paramstr(1)));
          // die eigene Message an das eigene Programmfenster senden,
          // dabei den Atomwert (ist Systemweit eindeutig) übergeben
          SendMessage(hWindow,dwMessage,0,dwAtom);
        end;
      end;
    end;
  finally
    if dwMutex <> 0 then
    begin
      CloseHandle(dwMutex);
    end;
  end;
end.

und die Unit des MDI Hauptformulares:

Delphi-Quellcode:

unit MAIN;

interface

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

type
  TfrmMAIN = class(TForm)
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  protected
    // WndProc für eigene Message überschreiben
    procedure WndProc(var msg : TMessage); override;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmMAIN: TfrmMAIN;
  dwMessage : DWORD;


implementation
uses MDIPart;

{$R *.DFM}

procedure TfrmMAIN.WndProc(var msg : TMessage);

var
  frmWork   : TfrmSub;
  pFileName : PChar;
  dwLen     : DWORD;

begin
  // Wurde die eigenen Message geschickt?
  if msg.Msg = dwMessage then
  begin
    // Neues Unterfenster genenrieren
    frmWork   := TfrmSub.Create(self);
    // Speicher für den Dateinamen reservieren
    dwLen     := MAX_PATH+1;
    pFileName := StrAlloc(dwLen);
    try
      // Pfad der Datei aus globalen Atom Table auslesen
      GlobalGetAtomName(msg.lParam,pFileName,dwLen);
      // und die Datei in das Memo laden
      frmWork.Memo1.Lines.LoadFromFile(pFileName);
      // jetzt MUSS der Dateiname wieder gelöscht werden.
      GlobalDeleteAtom(msg.lParam);
    finally
      // Speicher wieder freigeben
      StrDispose(pFileName);
    end;
  end
  else
  begin
    // Jede andere Message an die ursprüngliche Prozedure weiterreichen
    inherited WndProc(msg);
  end;
end;

procedure TfrmMAIN.FormShow(Sender: TObject);
var
  frmWork : TfrmSub;

begin
  // Wurde das Programm mit einem Parameter aufgerufen, dann
  // MDI Child erzeugen und Datei laden
  if (paramcount > 0) and FileExists(paramstr(1)) then
  begin
    frmWork := TfrmSub.Create(self);
    frmWork.Memo1.Lines.LoadFromFile(paramstr(1));
  end;
end;

end.

[Christian Seehase]

Moin Zusammen,

und so wäre man dann auf der sicheren Seite:
Diesmal über die Message WM_COPYDATA
(gekürzt, der Rest steht oben)

Delphi-Quellcode:

program Multifileload;

uses
  //...
  messages, // wg. WM_COPYDATA
  //...

var
  //...
  cdWork  : TcsCopyDataStruct;

begin
    //...
    else
    begin
      // Den Fenstertitel des Programmes abfragen
      hWindow := FindWindow(nil,'Multifiledemo');
      if hWindow <> 0 then
      begin // gefunden, dann den Dateinamen an die laufende Instanz senden
        if (paramcount > 0) and FileExists(paramstr(1)) then
        begin
          // CopyData Struktur füllen
          cdWork.dwData := dwMessage; // Message, das eine zu ladende Datei da ist
          cdWork.cbData := Length(paramstr(1))+1;
          cdWork.lpData := AllocMem(cdWork.cbData); // Speicher reservieren
          try
            // Und Dateinamen eintragen
            CopyMemory(cdWork.lpData,@paramstr(1)[1],cdWork.cbData-1);
            // Fertig, Daten kopieren
            SendMessage(hWindow,WM_COPYDATA,0,lParam(@cdWork));
          finally
            // Speicher wieder freigeben
            FreeMem(cdWork.lpData,cdWork.cbData);
          end;
        end;
      end;
    end;
  //...
end.

Delphi-Quellcode:

//...
// Deklaration für die CopyData Strutur
type
  PcsCopyDataStruct = ^TcsCopyDataStruct;
  TcsCopyDataStruct =
  packed record
    dwData : DWORD;
    cbData : DWORD;
    lpData : Pointer;
  end;

var
  frmMAIN: TfrmMAIN;
  dwMessage : DWORD;

implementation
uses MDIPart;

{$R *.DFM}

procedure TfrmMAIN.WndProc(var msg : TMessage);

var
  frmWork   : TfrmSub;
  pFileName : PChar;
  dwLen     : DWORD;
  cdWork    : PcsCopyDataStruct;

begin
  if msg.Msg = WM_COPYDATA then
  begin
    // Adresse der übergebenen Daten laden
    cdWork := PcsCopyDataStruct(msg.lParam);
    // Message prüfen
    if cdWork.dwData = dwMessage then
    begin
      // Neues Unterfenster generieren
      frmWork := TfrmSub.Create(self);
      // Datei aus übergebenem Namen laden
      frmWork.Memo1.Lines.LoadFromFile(PChar(cdWork.lpData));
    end;
  end
  else
  begin
    // Jede andere Message an die ursprüngliche Prozedure weiterreichen
    inherited WndProc(msg);
  end;
end;

//...
end.

[jbg]

Zitat:

Hab selbst einen anderen Link gefunden:
http://www.blueorbsoft.com/CodeTips/OneInstance.zip

Die Parameter werden aber auch damit nicht übergeben.

Das liegt ja wohl daran, dass das nicht die selbe Zip-Datei ist, die ich gepostet habe. Wenn der Link bei dir nicht funktionieren sollte, dann kannst du die von Daniel B angehängte Zip-Datei nehmen.