Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi -> SingleInstance - Parameter an Form1 übergeben (https://www.delphipraxis.net/122259-singleinstance-parameter-form1-uebergeben.html)

ZelltoD 12. Okt 2008 12:20


-> SingleInstance - Parameter an Form1 übergeben
 
Servus,

Um zu erreichen, dass mein Programm nur einmal Startet und die Parameter an die erste Instanz des Programms weitergegeben werden, hab ich die Unit "Single instance" von Hagen benutzt:
Delphi-Quellcode:
unit SingleInstance;

interface

implementation

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

type
  TSingleInstance = class
    class procedure WndProc(var Msg: TMessage);
    class procedure Start;
    class procedure Stop;
    class function GetParamStr(P: PChar; var Param: string): PChar;
    class function ParamCount: Integer;
    class function ParamStr(Index: Integer): string;

    class procedure OnStartup;
  end;

const
  sTitle = 'TESTPROGRAMM'; // dieser Wert MUSS individuell angepasst werden

class procedure TSingleInstance.OnStartup;
// diese Methode muß mit eigenen Inhalt gefüllt werden,
// als Beispiel wird hier die 1. Instance sichtbar gemacht
// und der ParamStr() der 2. Instance angezeigt.
var
  S: String;
  I: Integer;
begin
  Application.Minimize;
  Application.Restore;

  S := '';
  for I := 0 to ParamCount do
    S := S + ParamStr(I) + #10;
  ShowMessage(S);
end;

// ab hier Implementierung

const
  cMagic = $BADF00D; // dient zur Idententifizierung der Message wm_CopyData
  cResult = $DAED;

var
  WndHandle: hWnd = 0; // die 1. Instance erzeugt ein Fensterhandle
  CmdLine: PChar = nil; // ParamStr() der 2. Instance per wm_CopyData transportiert

class function TSingleInstance.GetParamStr(P: PChar; var Param: string): PChar;
// diese funktion musste aus System.pas kopiert werden für unser
// ParamStr() udn ParamCount() nötig
var
  Len: Integer;
  Buffer: array[0..4095] of Char;
begin
  while True do
  begin
    while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Len := 0;
  while (P[0] > ' ') and (Len < SizeOf(Buffer)) do
    if P[0] = '"' then
    begin
      Inc(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Buffer[Len] := P[0];
        Inc(Len);
        Inc(P);
      end;
      if P[0] <> #0 then Inc(P);
    end else
    begin
      Buffer[Len] := P[0];
      Inc(Len);
      Inc(P);
    end;
  SetString(Param, Buffer, Len);
  Result := P;
end;

class function TSingleInstance.ParamCount: Integer;
// diese Funktion musste aus System.pas kopiert werden für unser
// ParamStr() und ParamCount() nötig da System.pas NICHT auf die
// globale Variable System.CmdLine zugreift sondern per Funktion GetCommandLine() arbeitet.
var
  P: PChar;
  S: string;
begin
  P := GetParamStr(CmdLine, S); // CmdLine statt GetCommandLine
  Result := 0;
  while True do
  begin
    P := GetParamStr(P, S);
    if S = '' then Break;
    Inc(Result);
  end;
end;

class function TSingleInstance.ParamStr(Index: Integer): string;
// siehe ParamCount
var
  P: PChar;
  Buffer: array[0..260] of Char;
begin
  if Index = 0 then
    SetString(Result, Buffer, GetModuleFileName(0, Buffer, SizeOf(Buffer)))
  else
  begin
    P := CmdLine; // CmdLine statt GetCommandLine
    while True do
    begin
      P := GetParamStr(P, Result);
      if (Index = 0) or (Result = '') then Break;
      Dec(Index);
    end;
  end;
end;

class procedure TSingleInstance.WndProc(var Msg: TMessage);
// das ist die Fensterprocedure von WndHandle, sie empfängt innerhalb
// der 1. Instance die wm_CopyData Message mit der CommandLine der
// 2. Instance
begin
  with Msg do
    if (Msg = wm_CopyData) and (PCopyDataStruct(lParam).dwData = cMagic) then
    begin
      Result := cResult;
      CmdLine := PCopyDataStruct(lParam).lpData;
      OnStartup;
    end else Result := DefWindowProc(WndHandle, Msg, wParam, lParam);
end;

class procedure TSingleInstance.Start;
var
  PrevWnd: hWnd;
  Data: TCopyDataStruct;
begin
  if MainInstance = GetModuleHandle(nil) then // nur in EXE's möglich, nicht in DLL's oder packages
  begin
    PrevWnd := FindWindow('TPUtilWindow', sTitle); // suche unser Fenster
    if IsWindow(PrevWnd) then
    begin
    // 1. Instance läuft also schon, sende CommandLine an diese
      Data.dwData := cMagic;
      Data.cbData := StrLen(GetCommandLine) +1;
      Data.lpData := GetCommandLine;
      if SendMessage(PrevWnd, wm_CopyData, 0, Integer(@Data)) = cResult then Halt;
    end;
   // keine 1. Instance gefunden, wir sind also die 1. Instance
    WndHandle := AllocateHWnd(WndProc);
    SetWindowText(WndHandle, sTitle);

// falls auch bei der 1. Instance OnStartup aufgerufen werden soll
//    CmdLine := System.CmdLine;
//    OnStartup;
  end;
end;

class procedure TSingleInstance.Stop;
begin
  if IsWindow(WndHandle) then DeallocateHWnd(WndHandle);
end;

initialization
  TSingleInstance.Start;
finalization
  TSingleInstance.Stop;
end.



Doch mit dem weiter geben der Parameter hab ich so meine Probleme...

Delphi-Quellcode:
[...] class procedure TSingleInstance.OnStartup;
// diese Methode muß mit eigenen Inhalt gefüllt werden,
// als Beispiel wird hier die 1. Instance sichtbar gemacht
// und der ParamStr() der 2. Instance angezeigt.
var
  S: String;
  I: Integer;
begin
  Application.Minimize;
  Application.Restore;

  S := '';
  for I := 0 to ParamCount do
    S := S + ParamStr(I) + #10;
  ShowMessage(S); //ANSTATT SCHOWMESSAGE WÜRDE ICH DIE PARAMETER GERN IN EIN MEMOFELD ÜBERTRAGEN
end; [...]
Auf dem Hauptformular (Bei mir noch Form1), hab ich ein Memo-Feld und selbst nach stundenlangen Versuchen, hab ich es nicht, hinbekommen, dass die Parameter, die eigendlich die zweite Instanz bekommen sollte in das Memo-Feld der Form1 transportiert werden.

Versuche wie Form1.memo1.lines.add sind elends fehlgeschlagen.

lg ZelltoD

dominikkv 12. Okt 2008 13:16

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Wird bei dem Showmessage das richtige angezeigt?

ZelltoD 12. Okt 2008 13:32

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Ja, Showmessage zeigt das Korrekte an.

dominikkv 12. Okt 2008 13:40

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Dann musst du unter den uses in SingleInstance deine Unit 1 angeben (oder wie du die halt genannt hast) und dann kannst du einfach über Form1.Memo1.lines.Add(S) deine parameter übergeben

ZelltoD 12. Okt 2008 13:49

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Das hab ich scon versucht -> die einzige Resonanz die ich dadurch bekomme:

[DCC Fehler] SingleInstance.pas(41): E2003 Undefinierter Bezeichner: 'Memo1'

dominikkv 12. Okt 2008 14:03

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Zitat:

Zitat von ZelltoD
Das hab ich scon versucht -> die einzige Resonanz die ich dadurch bekomme:

[DCC Fehler] SingleInstance.pas(41): E2003 Undefinierter Bezeichner: 'Memo1'

- gibt es ein memo mit dem namen mome1memo1?
- wie ist die sichtbarkeit von dem memo?

ZelltoD 12. Okt 2008 14:53

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Memo ist sichtba und enabled, und es ist das einzige mit dem Namen Memo1.
Das Andere Memo-Feld, heißt log_31 und hat mit diesem nichts zu tun.

g

dominikkv 12. Okt 2008 15:16

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Zitat:

Zitat von ZelltoD
Memo ist sichtba und enabled, und es ist das einzige mit dem Namen Memo1.

Ich meinte damit eigendlich unter welcher Sichtbarkeit das Memo deklariert ist ;) also private oder public etc

ansonsten probiere mal das:
Delphi-Quellcode:
// in unit1:

type
  TForm1 = class(TForm)
  public
    procedure ShowParams(Params: TStringList); // diese zeile hinzufügen
  end;

//

procedure TForm1.ShowParams(Params: TStringList);
begin
  Application.Minimize;
  Application.Restore;

  Memo1.Lines := Params.Text;

  // Damit man direkt auf den n-ten Parameter zugreifen kann hab ich das als TStringList deklariert
end;



// in SingleInstance:

uses
  Unit1;

[...] class procedure TSingleInstance.OnStartup;
// diese Methode muß mit eigenen Inhalt gefüllt werden,
// als Beispiel wird hier die 1. Instance sichtbar gemacht
// und der ParamStr() der 2. Instance angezeigt.
var
  I: Integer;
  Params: TStringList;
begin
  Params := TStringList.Create;

  for I := 0 to ParamCount do
    Params.Add(ParamStr(I));

  try
    Form1.ShowParams(Params);
  finally
    Params.free;
  end;
end; [...]

ZelltoD 12. Okt 2008 15:33

Re: -> SingleInstance - Parameter an Form1 übergeben
 
[DCC Fehler] SingleInstance.pas(45): E2003 Undefinierter Bezeichner: 'ShowParams' bei
Delphi-Quellcode:
try
    Form1.ShowParams(Params);
ich bin am verzweifeln...

Achja -> Mein Memo1 war schon in public deklariert.. ohne Erfolg

und -> Memo1.Text := Params.Text;....


gruß

dominikkv 12. Okt 2008 15:54

Re: -> SingleInstance - Parameter an Form1 übergeben
 
sicher das du in der SingleInstance uses Unit1; stehen hast? Wobei wenn das fehlen würde müsste die Fehlermeldung so lauten:
Zitat:

[DCC Fehler] SingleInstance.pas(45): E2003 Undeklarierter Bezeichner: 'Form1'
Zeig einfach mal die gesammte SingleInstance, so wie du sie momentan verwendest.

ZelltoD 12. Okt 2008 16:08

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Delphi-Quellcode:
unit SingleInstance;

interface

implementation

uses Windows, SysUtils, Controls, Messages, Dialogs, Forms,
  StdCtrls, ExtCtrls, Unit1, Variants, Classes, Graphics,
  ComCtrls;

type
  TSingleInstance = class

    class procedure WndProc(var Msg: TMessage);
    class procedure Start;
    class procedure Stop;
    class function GetParamStr(P: PChar; var Param: string): PChar;
    class function ParamCount: Integer;
    class function ParamStr(Index: Integer): string;

    class procedure OnStartup;
  end;

const
  sTitle = 'OTRFM'; // dieser Wert MUSS individuell angepasst werden

class procedure TSingleInstance.OnStartup;
// diese Methode muß mit eigenen Inhalt gefüllt werden,
// als Beispiel wird hier die 1. Instance sichtbar gemacht
// und der ParamStr() der 2. Instance angezeigt.

var
  S: String;
  I: Integer;
  Params: TStringList;
  begin
  Params := TStringList.Create;
  S := '';
  for I := 1 to ParamCount do Params.Add(ParamStr(I));
   //S := S + ParamStr(I) + #10;
  //ShowMessage(S);
   Params.Add(ParamStr(I));
    try
    Form1.ShowParams(Params);
  finally
    Params.free;
  end;
  end;

// ab hier Implementierung

const
  cMagic = $BADF00D; // dient zur Idententifizierung der Message wm_CopyData
  cResult = $DAED;

var
  WndHandle: hWnd = 0; // die 1. Instance erzeugt ein Fensterhandle
  CmdLine: PChar = nil; // ParamStr() der 2. Instance per wm_CopyData transportiert

class function TSingleInstance.GetParamStr(P: PChar; var Param: string): PChar;
// diese funktion musste aus System.pas kopiert werden für unser
// ParamStr() udn ParamCount() nötig
var
  Len: Integer;
  Buffer: array[0..4095] of Char;
begin
  while True do
  begin
    while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Len := 0;
  while (P[0] > ' ') and (Len < SizeOf(Buffer)) do
    if P[0] = '"' then
    begin
      Inc(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Buffer[Len] := P[0];
        Inc(Len);
        Inc(P);
      end;
      if P[0] <> #0 then Inc(P);
    end else
    begin
      Buffer[Len] := P[0];
      Inc(Len);
      Inc(P);
    end;
  SetString(Param, Buffer, Len);
  Result := P;
end;

class function TSingleInstance.ParamCount: Integer;
// diese Funktion musste aus System.pas kopiert werden für unser
// ParamStr() und ParamCount() nötig da System.pas NICHT auf die
// globale Variable System.CmdLine zugreift sondern per Funktion GetCommandLine() arbeitet.
var
  P: PChar;
  S: string;
begin
  P := GetParamStr(CmdLine, S); // CmdLine statt GetCommandLine
  Result := 0;
  while True do
  begin
    P := GetParamStr(P, S);
    if S = '' then Break;
    Inc(Result);
  end;
end;

class function TSingleInstance.ParamStr(Index: Integer): string;
// siehe ParamCount
var
  P: PChar;
  Buffer: array[0..260] of Char;
begin
  if Index = 0 then
    SetString(Result, Buffer, GetModuleFileName(0, Buffer, SizeOf(Buffer)))
  else
  begin
    P := CmdLine; // CmdLine statt GetCommandLine
    while True do
    begin
      P := GetParamStr(P, Result);
      if (Index = 0) or (Result = '') then Break;
      Dec(Index);
    end;
  end;
end;

class procedure TSingleInstance.WndProc(var Msg: TMessage);
// das ist die Fensterprocedure von WndHandle, sie empfängt innerhalb
// der 1. Instance die wm_CopyData Message mit der CommandLine der
// 2. Instance
begin
  with Msg do
    if (Msg = wm_CopyData) and (PCopyDataStruct(lParam).dwData = cMagic) then
    begin
      Result := cResult;
      CmdLine := PCopyDataStruct(lParam).lpData;
      OnStartup;
    end else Result := DefWindowProc(WndHandle, Msg, wParam, lParam);
end;

class procedure TSingleInstance.Start;
var
  PrevWnd: hWnd;
  Data: TCopyDataStruct;
begin
  if MainInstance = GetModuleHandle(nil) then // nur in EXE's möglich, nicht in DLL's oder packages
  begin
    PrevWnd := FindWindow('TPUtilWindow', sTitle); // suche unser Fenster
    if IsWindow(PrevWnd) then
    begin
    // 1. Instance läuft also schon, sende CommandLine an diese
      Data.dwData := cMagic;
      Data.cbData := StrLen(GetCommandLine) +1;
      Data.lpData := GetCommandLine;
      if SendMessage(PrevWnd, wm_CopyData, 0, Integer(@Data)) = cResult then Halt;
    end;
   // keine 1. Instance gefunden, wir sind also die 1. Instance
    WndHandle := AllocateHWnd(WndProc);
    SetWindowText(WndHandle, sTitle);

// falls auch bei der 1. Instance OnStartup aufgerufen werden soll
//   CmdLine := System.CmdLine;
  //  OnStartup;
  end;
end;

class procedure TSingleInstance.Stop;
begin
  if IsWindow(WndHandle) then DeallocateHWnd(WndHandle);
end;

initialization
  TSingleInstance.Start;
finalization
  TSingleInstance.Stop;
end.

dominikkv 12. Okt 2008 17:51

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Sieht soweit ganz gut aus, nur das S nur überflüssig ist und du einmal Params.Add(ParamStr(I)); zuviel hast.
Willst du nochmal die unit1 posten? also nur das was in diesem zusammenhang wichtig ist.

ZelltoD 12. Okt 2008 18:18

Re: -> SingleInstance - Parameter an Form1 übergeben
 
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, ComCtrls, LMDCustomComponent, SingleInstance, FileCtrl, FunktionReaddir,
  ShellAPI, Menus, CoolTrayIcon, Clipbrd, Printers;

type
  TForm1 = class(TForm)

    Button1: TButton;
    SaveDialog1: TSaveDialog;
    Suchfeld: TEdit;
    Hauptliste: TListBox;
    Button2: TButton;
    Benutzerliste: TListBox;
    Testimage: TImage;
    BildControlLogo: TImage;
    BildSteuerleiste: TImage;
    BildLeiste1: TImage;
    Button3: TButton;
    Eingabefeld: TEdit;
    BildLinkAnnehmen: TImage;
    BildLinkAbbrechen: TImage;
    StatusBar: TStatusBar;
    Button4: TButton;
    ColorDialog1: TColorDialog;
    Button6: TButton;
    Zusatzliste: TListBox;
    OrdnerListe: TListBox;
    Button7: TButton;
    Button8: TButton;
    OpenDialog1: TOpenDialog;
    Button9: TButton;
    mmoClipbrdContents: TMemo;
    Button5: TButton;
    Button10: TButton;
    Button11: TButton;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    Eintrag1: TMenuItem;
    Programmwiederherstellen1: TMenuItem;
    Programmminimieren1: TMenuItem;
    Beenden1: TMenuItem;
    CheckBox1: TCheckBox;
    Button12: TButton;
    PrintDialog1: TPrintDialog;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;

procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SuchfeldKeyPress(Sender: TObject; var Key: Char);
    procedure BenutzerlisteDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure SuchfeldClick(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Button3Click(Sender: TObject);
    procedure BildLinkAbbrechenMouseEnter(Sender: TObject);
    procedure BildLinkAbbrechenMouseLeave(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure EingabefeldClick(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
   procedure Programmbeenden1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure CoolTrayIcon1Click(Sender: TObject);
    procedure CoolTrayIcon1DblClick(Sender: TObject);
    procedure mmoClipbrdContentsChange(Sender: TObject);
    procedure Programmwiederherstellen1Click(Sender: TObject);
    procedure Programmminimieren1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Eintrag1Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);

 private
  FNextViewer: THandle;
  FClpBrd: TClipboard;
   function LastErrorMsgStr: String;
   procedure WMDROPFILES(var Msg: TMessage); Message WM_DROPFILES;
   procedure AttachToClipboard;
   procedure DetachFromClipboard;
 procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
       { Private-Deklarationen }

   protected
    {geschützte-Deklarationen}
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD;
  public
      Memo1: TMemo;
    procedure ShowParams(Params: TStringList);
   
 { Public-Deklarationen }

 end;
var
  Form1: TForm;
  minimiert:boolean;
implementation

{$R *.dfm}

procedure TForm1.ShowParams(Params: TStringList);
begin
  Application.Minimize;
  Application.Restore;

  Memo1.Text := Params.Text;

end;

//  [...]

Im OnCreate-ereignis der Form is dann noch
parametername:=(extractfilename(ParamStr(1))); //Parametername ermitteln und in String schreiben...
memo1.lines.add(parametername);

[...]
Die komplette Unit 1 hat 700 Zeilen, aber das ist so eigendlich das einzige was mit den Parametern zu tun hat.


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:54 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz