![]() |
-> 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:
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.
[...] 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; [...] Versuche wie Form1.memo1.lines.add sind elends fehlgeschlagen. lg ZelltoD |
Re: -> SingleInstance - Parameter an Form1 übergeben
Wird bei dem Showmessage das richtige angezeigt?
|
Re: -> SingleInstance - Parameter an Form1 übergeben
Ja, Showmessage zeigt das Korrekte an.
|
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
|
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' |
Re: -> SingleInstance - Parameter an Form1 übergeben
Zitat:
- wie ist die sichtbarkeit von dem memo? |
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 |
Re: -> SingleInstance - Parameter an Form1 übergeben
Zitat:
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; [...] |
Re: -> SingleInstance - Parameter an Form1 übergeben
[DCC Fehler] SingleInstance.pas(45): E2003 Undefinierter Bezeichner: 'ShowParams' bei
Delphi-Quellcode:
ich bin am verzweifeln...
try
Form1.ShowParams(Params); Achja -> Mein Memo1 war schon in public deklariert.. ohne Erfolg und -> Memo1.Text := Params.Text;.... gruß |
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:
|
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. |
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. |
Re: -> SingleInstance - Parameter an Form1 übergeben
Delphi-Quellcode:
Die komplette Unit 1 hat 700 Zeilen, aber das ist so eigendlich das einzige was mit den Parametern zu tun hat.
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); [...] |
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:57 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz