1 unit DebugAttachDialog;
2
3 {$mode objfpc}{$H+}
4 {$ifdef darwin}
5 {$modeswitch ObjectiveC1}
6 {$endif}
7
8 interface
9
10 uses
11 Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls, ComCtrls,
12 LCLType, LazFileUtils, DbgIntfDebuggerBase,
13 LazarusIDEStrConsts, BaseDebugManager, Debugger;
14
15 type
16 {$IFDEF darwin}
17 TMyDummyObcCClass = objcclass(NSObject)
18 // dummy class to get rid of FPC messages unit objcbase not used
19 b: BOOL;
20 end;
21 {$ENDIF}
22
23 { TDebugAttachDialogForm }
24
25 TDebugAttachDialogForm = class(TForm)
26 btnRefresh: TButton;
27 btnAttach: TButton;
28 btnCancel: TButton;
29 labelRunningProcesses: TLabel;
30 lvProcesses: TListView;
31 procedure btnRefreshClick(Sender: TObject);
32 procedure FormCreate(Sender: TObject);
33 procedure lvProcessesColumnClick(Sender: TObject; Column: TListColumn);
34 procedure lvProcessesData(Sender: TObject; Item: TListItem);
35 procedure lvProcessesDblClick(Sender: TObject);
36 procedure lvProcessesKeyDown(Sender: TObject; var Key: Word;
37 {%H-}Shift: TShiftState);
38 procedure lvProcessesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
39 private
40 FPidString: string;
41 FList: TRunningProcessInfoList;
42
43 // Must return chosen process id as string in PidString and mrOk as result
44 // on success.
ChooseProcessnull45 function ChooseProcess(AList: TRunningProcessInfoList; out PidString: string): TModalResult;
46 public
47 FSortColumn: Integer;
48 FSortBackward: Boolean;
49 end;
50
51 var
52 DebugAttachDialogForm: TDebugAttachDialogForm;
53
54 // Ask user for Process ID to attach to and returns it in a string form.
GetPidForAttachnull55 function GetPidForAttach: string;
56
57 implementation
58
59 {$ifdef windows}
60 uses
61 Windows
62 {$ifndef WIN9XPLATFORM}
63 ,JwaTlHelp32
64 {$endif};
65
66 // Enumerate running processes.
67 // Result must be always set: True if enumeration supported or False otherwise.
68 // If AList is not nil it must be filled with TRunningProcessInfo items.
EnumerateProcessesnull69 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
70 {$ifndef WIN9XPLATFORM}
71 var
72 hShot: HANDLE;
73 pe: tagPROCESSENTRY32W;
74 item: TRunningProcessInfo;
75 {$endif}
76 begin
77 {$ifdef WIN9XPLATFORM}
78 Result := False;
79 {$else}
80 Result := True; // we can enumerate processes
81 if not Assigned(AList) then
82 Exit;
83
84 hShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
85 if hShot = INVALID_HANDLE_VALUE then
86 Exit;
87
88 try
89 FillByte(pe{%H-}, SizeOf(pe), 0);
90 pe.dwSize := SizeOf(pe);
91 if Process32FirstW(hShot, pe) then
92 repeat
93 item := TRunningProcessInfo.Create(pe.th32ProcessID, pe.szExeFile);
94 AList.Add(item);
95 until not Process32NextW(hShot, pe);
96 finally
97 CloseHandle(hShot);
98 end;
99 {$endif}
100 end;
101 {$else}
102 {$ifdef linux}
103 uses
104 LazUTF8Classes;
105
EnumerateProcessesnull106 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
107
GetProcNamenull108 function GetProcName(Pid: THandle): String;
109 var
110 S: TStream;
111 Sz: Integer;
112 begin
113 S := TFileStreamUTF8.Create('/proc/' + IntToStr(Pid) + '/cmdline', fmOpenRead or fmShareDenyNone);
114 try
115 SetLength(Result, 255);
116 Sz := S.Read(Result[1], 255);
117 SetLength(Result, Sz);
118 finally
119 S.Free;
120 end;
121 end;
122
123 var
124 Rec: TSearchRec;
125 ProcName: String;
126 Pid: THandle;
127 Code: Integer;
128 item: TRunningProcessInfo;
129 begin
130 Result := True;
131
132 if not Assigned(AList) then
133 Exit;
134
135 if FindFirstUTF8('/proc/*', faDirectory, Rec) = 0 then
136 begin
137 repeat
138 Val(Rec.Name, Pid, Code);
139 if (Code = 0) then
140 begin
141 ProcName := GetProcName(Pid);
142 item := TRunningProcessInfo.Create(Pid, ProcName);
143 AList.Add(item);
144 end;
145 until FindNextUTF8(Rec) <> 0;
146 end;
147 FindCloseUTF8(Rec);
148 end;
149 {$else}
150 {$ifdef darwin}
151 uses
152 MacOSAll, CocoaAll;
153
CFStringToStrnull154 function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = kCFStringEncodingUTF8): String;
155 var
156 Str: Pointer;
157 StrSize: CFIndex;
158 StrRange: CFRange;
159 begin
160 if AString = nil then
161 begin
162 Result := '';
163 Exit;
164 end;
165
166 // Try the quick way first
167 Str := CFStringGetCStringPtr(AString, Encoding);
168 if Str <> nil then
169 Result := PChar(Str)
170 else
171 begin
172 // if that doesn't work this will
173 StrRange.location := 0;
174 StrRange.length := CFStringGetLength(AString);
175
176 StrSize:=0;
177 CFStringGetBytes(AString, StrRange, Encoding,
178 Ord('?'), False, nil, 0, StrSize);
179 SetLength(Result, StrSize);
180
181 if StrSize > 0 then
182 CFStringGetBytes(AString, StrRange, Encoding,
183 Ord('?'), False, @Result[1], StrSize, StrSize);
184 end;
185 end;
186
187 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
188 var
189 Arr: NSArray;
190 App: NSRunningApplication;
191 I: Integer;
192 item: TRunningProcessInfo;
193 begin
194 Result := True; // we can enumerate processes
195
196 if not Assigned(AList) then
197 Exit;
198
199 // If it is not possible to get the process-list from the debugger,
200 // use NSRunningApplication as fallback method. This list is not complete,
201 // though. But better then nothing.
202 Arr := NSWorkspace.sharedWorkspace.runningApplications;
203 for I := 0 to Arr.count - 1 do
204 begin
205 App := NSRunningApplication(Arr.objectAtIndex(I));
206 item := TRunningProcessInfo.Create(App.processIdentifier, CFStringToStr(CFStringRef(App.localizedName)));
207 AList.Add(item);
208 end;
209 end;
210 {$else}
211 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
212 begin
213 Result := False;
214 end;
215 {$endif}
216 {$endif}
217 {$endif}
218
219 function GetPidForAttach: string;
220 var
221 ProcessList: TRunningProcessInfoList;
222 begin
223 Result := '';
224
225 ProcessList := TRunningProcessInfoList.Create(True);
226 try
227 // Check if we can enumerate processes.
228 if not DebugBoss.FillProcessList(ProcessList) then
229 if not EnumerateProcesses(ProcessList) then
230 begin
231 // If we can't just ask PID as string.
232 InputQuery(rsAttachTo, rsEnterPID, Result);
233 Exit;
234 end;
235
236 // Enumerate.
237 DebugAttachDialogForm := TDebugAttachDialogForm.Create(nil);
238 try
239 if DebugAttachDialogForm.ChooseProcess(ProcessList, Result) <> mrOK then
240 Result := '';
241 finally
242 FreeAndNil(DebugAttachDialogForm);
243 end;
244
245 finally
246 FreeAndNil(ProcessList);
247 end;
248 end;
249
250 {$R *.lfm}
251
252 { TDebugAttachDialogForm }
253
254 procedure TDebugAttachDialogForm.lvProcessesData(Sender: TObject;
255 Item: TListItem);
256 var
257 info: TRunningProcessInfo;
258 begin
259 if Item.Index <> -1 then
260 begin
261 info := TRunningProcessInfo(FList.Items[Item.Index]);
262 Item.Caption := info.ImageName;
263 Item.SubItems.Add(IntToStr(info.PID));
264 end;
265 end;
266
267 procedure TDebugAttachDialogForm.lvProcessesDblClick(Sender: TObject);
268 begin
269 if lvProcesses.ItemIndex <> -1 then
270 ModalResult := mrOK;
271 end;
272
273 procedure TDebugAttachDialogForm.lvProcessesKeyDown(Sender: TObject;
274 var Key: Word; Shift: TShiftState);
275 begin
276 case Key of
277 VK_RETURN:
278 ModalResult := mrOK;
279 VK_ESCAPE:
280 ModalResult := mrCancel;
281 end;
282 end;
283
284 procedure TDebugAttachDialogForm.lvProcessesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
285 var
286 info: TRunningProcessInfo;
287 begin
288 if (Item.Index <> -1) And Selected then
289 begin
290 info := TRunningProcessInfo(FList.Items[Item.Index]);
291 FPidString := IntToStr(info.PID);
292 btnAttach.Enabled := True;
293 end;
294 end;
295
CompareListItemsnull296 function CompareListItems(Item1, Item2: Pointer): Integer;
297 begin
298 case DebugAttachDialogForm.FSortColumn of
299 0: Result := AnsiStrComp(pchar(TRunningProcessInfo(Item1).ImageName),
300 pchar(TRunningProcessInfo(Item2).ImageName));
301 1: Result := integer(int64(TRunningProcessInfo(Item1).PID) -
302 int64(TRunningProcessInfo(Item2).PID));
303 else Result := 0;
304 end;
305 if DebugAttachDialogForm.FSortBackward then
306 Result := -Result;
307 end;
308
309 procedure TDebugAttachDialogForm.lvProcessesColumnClick(Sender: TObject;
310 Column: TListColumn);
311 begin
312 if FSortColumn = Column.Index then
313 FSortBackward := not FSortBackward
314 else
315 FSortBackward := False;
316 FSortColumn := Column.Index;
317
318 if FSortColumn >= 0 then
319 FList.Sort(@CompareListItems);
320
321 lvProcesses.Items.Clear;
322 lvProcesses.Items.Count := FList.Count;
323 end;
324
325 procedure TDebugAttachDialogForm.btnRefreshClick(Sender: TObject);
326 begin
327 lvProcesses.Items.Clear;
328 FSortColumn := -1;
329 FList.Clear;
330 if not DebugBoss.FillProcessList(FList)
331 then
332 EnumerateProcesses(FList);
333 lvProcesses.Items.Count := FList.Count;
334 end;
335
336 procedure TDebugAttachDialogForm.FormCreate(Sender: TObject);
337 begin
338 Caption:=rsAttachTo;
339 labelRunningProcesses.Caption:=lisDADRunningProcesses;
340 lvProcesses.Column[0].Caption:=lisDADImageName;
341 lvProcesses.Column[1].Caption:=lisDADPID;
342 btnRefresh.Caption:=dlgUnitDepRefresh;
343 btnAttach.Caption:=lisDADAttach;
344 btnCancel.Caption:=lisCancel;
345 end;
346
ChooseProcessnull347 function TDebugAttachDialogForm.ChooseProcess(AList: TRunningProcessInfoList;
348 out PidString: string): TModalResult;
349 begin
350 FPidString := '';
351 FList := AList;
352 FSortColumn := -1;
353 lvProcesses.Items.Count := AList.Count;
354 Result := ShowModal;
355 if Result = mrOK then
356 PidString := FPidString;
357 end;
358
359 end.
360
361