source: oup/_old_/ImportedStuff/OneInst.pas @ 108

Last change on this file since 108 was 92, checked in by alloc, 15 years ago

Rev86 was first after multi-cons

File size: 7.7 KB
Line 
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.