Delphi-PRAXiS
Seite 2 von 2     12   

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 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 21:15 Uhr.
Seite 2 von 2     12   

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