source: oup/releases/0.34a/ImportedStuff/OneInst.pas@ 333

Last change on this file since 333 was 200, checked in by alloc, 18 years ago
File size: 7.7 KB
RevLine 
[200]1{ Downloaded from: http://www.michael-puff.de/Developer/Delphi/Importe/Nico/oneinst.zip }
2
3unit OneInst;
4interface
5uses
6 Windows, Messages;
7
8var
9 { Mit dieser MessageId meldet sich dann eine zweite Instanz }
10 SecondInstMsgId: UINT = 0;
11
12function ParamBlobToStr(lpData: Pointer): string;
13function ParamStrToBlob(out cbData: DWORD): Pointer;
14
15implementation
16
17const
18 { Maximale Zeit, die auf die Antwort der ersten Instanz gewartet wird (ms) }
19 TimeoutWaitForReply = 5000;
20
21var
22 { Der Text den diese Variable hat sollte bei jedem neuen Programm geändert }
23 { werden und möglichst eindeutig (und nicht zu kurz) sein. }
24 UniqueName: array [0..MAX_PATH] of Char = 'Oni Un/Packer'#0;
25 MutexHandle: THandle = 0;
26
27{ kleine Hilfsfunktion die uns die Kommandozeilenparameter entpackt }
28function ParamBlobToStr(lpData: Pointer): string;
29var
30 pStr: PChar;
31begin
32 Result := '';
33 pStr := lpData;
34 while pStr[0] <> #0 do
35 begin
36 Result := Result + string(pStr) + #13#10;
37 pStr := @pStr[lstrlen(pStr) + 1];
38 end;
39end;
40
41{ kleine Hilfsfunktion die uns die Kommandozeilenparameter einpackt }
42function ParamStrToBlob(out cbData: DWORD): Pointer;
43var
44 Loop: Integer;
45 pStr: PChar;
46begin
47 cbData := Length(ParamStr(1)) + 3; { gleich inklusive #0#0 }
48 for Loop := 2 to ParamCount do
49 cbData := cbData + DWORD(Length(ParamStr(Loop)) + 1);
50 Result := GetMemory(cbData);
51 ZeroMemory(Result, cbData);
52 pStr := Result;
53 for Loop := 1 to ParamCount do
54 begin
55 lstrcpy(pStr, PChar(ParamStr(Loop)));
56 pStr := @pStr[lstrlen(pStr) + 1];
57 end;
58end;
59
60procedure HandleSecondInstance;
61var
62 Run: DWORD;
63 Now: DWORD;
64 Msg: TMsg;
65 Wnd: HWND;
66 Dat: TCopyDataStruct;
67begin
68 // MessageBox(0, 'läuft schon', nil, MB_ICONINFORMATION);
69 {----------------------------------------------------------------------------}
70 { Wir versenden eine Nachricht an alle Hauptfenster (HWND_BROADCAST) mit der }
71 { eindeutigen Message-Id, die wir zuvor registriert haben. Da nur eine }
72 { Instanz unseres Programms läuft sollte auch nur eine Anwendung antworten. }
73 { }
74 { (Broadcast sollten _NUR_ mit registrierten Nachrichten-Ids erfolgen!) }
75 {----------------------------------------------------------------------------}
76
77 SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0);
78
79 { Wir warten auf die Antwort der ersten Instanz }
80 { Für die, die es nicht wußten - auch Threads haben Message-Queues ;o) }
81 Wnd := 0;
82 Run := GetTickCount;
83 while True do
84 begin
85 if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then
86 begin
87 GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId);
88 if Msg.message = SecondInstMsgId then
89 begin
90 Wnd := Msg.wParam;
91 Break;
92 end;
93 end;
94 Now := GetTickCount;
95 if Now < Run then
96 Run := Now; { Überlaufschutz - passiert nur alle 48 Tage, aber naja }
97 if Now - Run > TimeoutWaitForReply then
98 Break;
99 end;
100
101 if (Wnd <> 0) and IsWindow(Wnd) then
102 begin
103 { Als Antwort haben wir das Handle bekommen, an das wir die Daten senden. }
104
105 {-------------------------------------------------------------------------}
106 { Wir verschicken nun eine Message mit WM_COPYDATA. Dabei handelt es sich }
107 { eine der wenigen Nachrichten, bei der Windows Daten aus einem Prozeß in }
108 { einen anderen einblendet. Nach Behandlung der Nachricht werden diese }
109 { wieder aus dem Adreßraum des Empfängers ausgeblendet, sodaß derjenige, }
110 { der die Nachricht erhält und die Daten weiter verwenden will, sich die }
111 { Daten kopieren muß. }
112 {-------------------------------------------------------------------------}
113
114 { Zur Absicherung schreiben wir nochmal die eindeutige Nachrichten-Id in }
115 { das Tag-Feld, das uns die Nachricht bietet. }
116 { Ansonsten schreiben wir die Kommandozeilenparameter als }
117 { durch #0 getrennte und durch #0#0 beendete Liste in den Datenblock }
118 Dat.dwData := SecondInstMsgId;
119 Dat.lpData := ParamStrToBlob(Dat.cbData);
120 SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat));
121 FreeMemory(Dat.lpData);
122 end;
123end;
124
125procedure CheckForSecondInstance;
126var
127 Loop: Integer;
128begin
129 {-----------------------------------------------------------------------------}
130 { Wir versuchen ein systemweit eindeutiges benanntes Kernelobjekt, ein Mutex }
131 { anzulegen und prüfen, ob dieses Objekt schon existiert. }
132 { Der Name zum Anlegen eines Mutex darf nicht länger als MAX_PATH (260) sein }
133 { und darf alle Zeichen außer '\' enthalten. }
134 { }
135 { (Einzige Ausnahme sind die beiden Schlüsselwörter 'Global\' und 'Local\' }
136 { mit denen ein Mutexname auf einem Terminalserver beginnen darf, damit der }
137 { Mutex nicht nur oder expliziet für eine Session dient. Das wird aber nur }
138 { sehr selten benötigt, wenn, dann meist bei Diensten auf Terminalservern.) }
139 { }
140 { Windows kennt nur einen Namensraum für Events, Semaphoren und andere }
141 { benannte Kernelobjekte. Das heißt es kommt zum Beispiel zu einem Fehler bei }
142 { dem Versuch mit dem Namen eines existierenden benannten Events einen Mutex }
143 { zu erzeugen. (da gewinnt das Wort 'Sonderfall' fast eine neue Bedeutung ;o) }
144 {-----------------------------------------------------------------------------}
145
146 for Loop := lstrlen(UniqueName) to MAX_PATH - 1 do
147 begin
148 MutexHandle := CreateMutex(nil, False, UniqueName);
149 if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then
150 { Es scheint schon ein Kernelobjekt mit diesem Namen zu geben. }
151 { Wir versuchen das Problem durch Anhängen von '_' zu lösen. }
152 lstrcat(UniqueName, '_')
153 else
154 { es gibt zumindest keinen Konflikt durch den geteilten Namensraum }
155 Break;
156 end;
157
158 case GetLastError of
159 0:
160 begin
161 { Wir haben den Mutex angelegt; sind also die erste Instanz. }
162 end;
163 ERROR_ALREADY_EXISTS:
164 begin
165 { Es gibt also schon eine Instanz - beginnen wir mit dem Prozedere. }
166 try
167 HandleSecondInstance;
168 finally
169 { was auch immer passiert, alles endet hier ;o) }
170 { Die 183 ist nicht ganz zufällig, kleiner Spaß }
171 Halt(183);
172 end;
173 end;
174 else
175 { Keine Ahnung warum wir hier landen sollten, }
176 { außer Microsoft hat wiedermal die Regeln geändert. }
177 { Wie auch immer - wir lassen das Programm starten. }
178 end;
179end;
180
181initialization
182
183 { Wir holen uns gleich zu Beginn eine eindeutige Nachrichten-Id die wir im }
184 { Programm zur eindeutigen Kommunikation zwischen den Instanzen brauchen. }
185 { Jedes Programm bekommt, wenn es den gleichen Text benutzt, die gleiche }
186 { Id zurück (zumindest innerhalb einer Windows Sitzung) }
187 SecondInstMsgId := RegisterWindowMessage(UniqueName);
188
189 { Auf eine schon laufende Instanz überprüfen. }
190 CheckForSecondInstance;
191
192finalization
193
194 { Den Mutex wieder freigeben, was eigentlich nicht nötig wäre, da Windows NT }
195 { Alle angeforderten Kernel-Objekte zum Prozeßende freigibt. Aber sicher ist }
196 { sicher (Windows 95/98 kann nur 65535 Objekte verwalten - jaja 32-Bit ;o). }
197 if MutexHandle <> 0 then
198 begin
199 ReleaseMutex(MutexHandle);
200 MutexHandle := 0; { hilft beim Debuggen }
201 end;
202
203end.
Note: See TracBrowser for help on using the repository browser.