Subversion Repositories decoder

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 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.