Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/decoder/trunk/INCLUDES/OneInst.pas
Revision: 2
Committed: Thu Nov 8 11:09:30 2018 UTC (23 months, 3 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 3161 byte(s)
Log Message:
Published revision 01 March 2007 to SVN.
Added disclaimer.
Changed the license to Apache2.

File Contents

# Content
1 // Abgeändert für (De)Coder 4.1
2
3 unit OneInst;
4
5 interface
6
7 uses
8 Windows, Messages, SysUtils, DCConst;
9
10 var
11 SecondInstMsgId: UINT = 0;
12
13 function ParamBlobToStr(lpData: Pointer): string;
14 function ParamStrToBlob(out cbData: DWORD): Pointer;
15
16 implementation
17
18 const
19 TimeoutWaitForReply = 5000;
20
21 var
22 UniqueName: array [0..MAX_PATH] of Char = 'ViaThinkSoft-DeCoder4100'#0;
23 MutexHandle: THandle = 0;
24
25 function ParamBlobToStr(lpData: Pointer): string;
26 var
27 pStr: PChar;
28 begin
29 Result := '';
30 pStr := lpData;
31 while pStr[0] <> #0 do
32 begin
33 if pStr <> '/newinstance' then
34 Result := Result + string(pStr) + #13#10;
35 pStr := @pStr[lstrlen(pStr) + 1];
36 end;
37 end;
38
39 function ParamStrToBlob(out cbData: DWORD): Pointer;
40 var
41 Loop: Integer;
42 pStr: PChar;
43 begin
44 cbData := Length(ParamStr(1)) + 3;
45 for Loop := 2 to ParamCount do
46 cbData := cbData + DWORD(Length(ParamStr(Loop)) + 1);
47 Result := GetMemory(cbData);
48 ZeroMemory(Result, cbData);
49 pStr := Result;
50 for Loop := 1 to ParamCount do
51 begin
52 lstrcpy(pStr, PChar(ParamStr(Loop)));
53 pStr := @pStr[lstrlen(pStr) + 1];
54 end;
55 end;
56
57 procedure HandleSecondInstance;
58 var
59 Run: DWORD;
60 Now: DWORD;
61 Msg: TMsg;
62 Wnd: HWND;
63 Dat: TCopyDataStruct;
64 begin
65 SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0);
66
67 Wnd := 0;
68 Run := GetTickCount;
69 while True do
70 begin
71 if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then
72 begin
73 GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId);
74 if Msg.message = SecondInstMsgId then
75 begin
76 Wnd := Msg.wParam;
77 Break;
78 end;
79 end;
80 Now := GetTickCount;
81 if Now < Run then
82 Run := Now;
83 if Now - Run > TimeoutWaitForReply then
84 Break;
85 end;
86
87 if (Wnd <> 0) and IsWindow(Wnd) then
88 begin
89 Dat.dwData := SecondInstMsgId;
90 Dat.lpData := ParamStrToBlob(Dat.cbData);
91 SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat));
92 FreeMemory(Dat.lpData);
93 end;
94 end;
95
96 procedure CheckForSecondInstance;
97 var
98 Loop: Integer;
99 begin
100 for Loop := lstrlen(UniqueName) to MAX_PATH - 1 do
101 begin
102 MutexHandle := CreateMutex(nil, False, UniqueName);
103 if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then
104 lstrcat(UniqueName, '_')
105 else
106 Break;
107 end;
108
109 case GetLastError of
110 0:
111 begin
112
113 end;
114 ERROR_ALREADY_EXISTS:
115 begin
116 try
117 HandleSecondInstance;
118 finally
119 Halt(10);
120 end;
121 end;
122 else
123
124 end;
125 end;
126
127 initialization
128
129 SecondInstMsgId := RegisterWindowMessage(UniqueName);
130
131 if (paramstr_firstposition('/newinstance') = -1) and
132 (paramstr_firstposition('/c') = -1) and
133 (paramstr_firstposition('/x') = -1) and
134 (paramstr_firstposition('/e') = -1) and
135 (paramstr_firstposition('/?') = -1) and
136 (paramstr_firstposition('/clean') = -1) then
137 CheckForSecondInstance;
138
139 finalization
140
141 if MutexHandle <> 0 then
142 begin
143 ReleaseMutex(MutexHandle);
144 MutexHandle := 0;
145 end;
146
147 end.