/jcl/examples/windows/delphitools/dependencyviewer/DependViewMain.pas

https://github.com/the-Arioch/jcl · Pascal · 346 lines · 279 code · 37 blank · 30 comment · 11 complexity · f8a9c23ef7868f528d2793141f6ba7f5 MD5 · raw file

  1. {**************************************************************************************************}
  2. { }
  3. { Project JEDI Code Library (JCL) - Delphi Tools }
  4. { }
  5. { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
  6. { you may not use this file except in compliance with the License. You may obtain a copy of the }
  7. { License at http://www.mozilla.org/MPL/ }
  8. { }
  9. { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
  10. { ANY KIND, either express or implied. See the License for the specific language governing rights }
  11. { and limitations under the License. }
  12. { }
  13. { The Original Code is DependView.pas. }
  14. { }
  15. { The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are }
  16. { Copyright (C) of Petr Vones. All Rights Reserved. }
  17. { }
  18. { Contributor(s): }
  19. { }
  20. {**************************************************************************************************}
  21. { }
  22. { Last modified: $Date$ }
  23. { }
  24. {**************************************************************************************************}
  25. unit DependViewMain;
  26. {$I JCL.INC}
  27. interface
  28. uses
  29. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30. Menus, ToolWin, ComCtrls, ImgList, ActnList, StdActns, ClipBrd, Registry,
  31. ShellAPI;
  32. const
  33. UM_CHECKPARAMSTR = WM_USER + $100;
  34. type
  35. TMainForm = class(TForm)
  36. MainMenu: TMainMenu;
  37. CoolBar1: TCoolBar;
  38. ToolBar1: TToolBar;
  39. ToolButton1: TToolButton;
  40. ActionList1: TActionList;
  41. ToolbarImagesList: TImageList;
  42. OpenFileDialog: TOpenDialog;
  43. File1: TMenuItem;
  44. Exit1: TAction;
  45. Exit2: TMenuItem;
  46. Open1: TAction;
  47. Open2: TMenuItem;
  48. N1: TMenuItem;
  49. Window1: TMenuItem;
  50. WindowCascade1: TWindowCascade;
  51. WindowTileHorizontal1: TWindowTileHorizontal;
  52. WindowTileVertical1: TWindowTileVertical;
  53. Cascade1: TMenuItem;
  54. TileHorizontally1: TMenuItem;
  55. TileVertically1: TMenuItem;
  56. ToolButton3: TToolButton;
  57. ToolButton4: TToolButton;
  58. ToolButton5: TToolButton;
  59. ViewImageList: TImageList;
  60. ToolButton7: TToolButton;
  61. Copy1: TAction;
  62. Save1: TAction;
  63. Edit1: TMenuItem;
  64. Copy2: TMenuItem;
  65. Save2: TMenuItem;
  66. ToolButton8: TToolButton;
  67. ToolButton9: TToolButton;
  68. ToolButton10: TToolButton;
  69. SelectAll1: TAction;
  70. Selectall2: TMenuItem;
  71. SaveDialog: TSaveDialog;
  72. Win32Help1: TAction;
  73. ToolButton11: TToolButton;
  74. ToolButton12: TToolButton;
  75. Help1: TMenuItem;
  76. Win32helpkeyword1: TMenuItem;
  77. N2: TMenuItem;
  78. About1: TAction;
  79. About2: TMenuItem;
  80. StatusBar: TStatusBar;
  81. DumpPe1: TAction;
  82. ToolButton2: TToolButton;
  83. N3: TMenuItem;
  84. DumpPEfile1: TMenuItem;
  85. SendMail1: TAction;
  86. Sendamessage1: TMenuItem;
  87. Find1: TAction;
  88. ToolButton6: TToolButton;
  89. N4: TMenuItem;
  90. Findtext1: TMenuItem;
  91. procedure Exit1Execute(Sender: TObject);
  92. procedure Open1Execute(Sender: TObject);
  93. procedure FormCreate(Sender: TObject);
  94. procedure FormDestroy(Sender: TObject);
  95. procedure SelectAll1Update(Sender: TObject);
  96. procedure SelectAll1Execute(Sender: TObject);
  97. procedure Copy1Update(Sender: TObject);
  98. procedure Copy1Execute(Sender: TObject);
  99. procedure Win32Help1Update(Sender: TObject);
  100. procedure Win32Help1Execute(Sender: TObject);
  101. procedure About1Execute(Sender: TObject);
  102. procedure DumpPe1Update(Sender: TObject);
  103. procedure DumpPe1Execute(Sender: TObject);
  104. procedure SendMail1Execute(Sender: TObject);
  105. procedure Find1Update(Sender: TObject);
  106. procedure Find1Execute(Sender: TObject);
  107. procedure CoolBar1Resize(Sender: TObject);
  108. procedure FormShow(Sender: TObject);
  109. private
  110. FPeViewer: Variant;
  111. FPeViewerRegistred: Boolean;
  112. FWin32Help: string;
  113. procedure InvokeWin32Help(const Name: string);
  114. function IsFileViewerChildActive: Boolean;
  115. function IsWin32Help: Boolean;
  116. procedure OnActiveFormChange(Sender: TObject);
  117. procedure UMCheckParamStr(var Message: TMessage); message UM_CHECKPARAMSTR;
  118. procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
  119. public
  120. procedure OpenFile(const FileName: TFileName; CheckIfOpen: Boolean);
  121. end;
  122. var
  123. MainForm: TMainForm;
  124. implementation
  125. uses ToolsUtils, FileViewer, JclPeImage, JclRegistry, FindDlg, JclFileUtils;
  126. {$R *.DFM}
  127. resourcestring
  128. sNotValidFile = 'This is not a valid PE EXE file';
  129. procedure TMainForm.InvokeWin32Help(const Name: string);
  130. var
  131. S: string;
  132. begin
  133. S := PeStripFunctionAW(Name);
  134. WinHelp(Application.Handle, PChar(FWin32Help), HELP_KEY, {$IFDEF RTL230_UP}NativeUInt(S){$ELSE}DWORD(S){$ENDIF});
  135. end;
  136. procedure TMainForm.OpenFile(const FileName: TFileName; CheckIfOpen: Boolean);
  137. var
  138. I: Integer;
  139. begin
  140. if CheckIfOpen then
  141. begin
  142. for I := 0 to MDIChildCount - 1 do
  143. if MDIChildren[I] is TFileViewerChild and (TFileViewerChild(MDIChildren[I]).FileName = FileName) then
  144. begin
  145. MDIChildren[I].BringToFront;
  146. Exit;
  147. end;
  148. end;
  149. Screen.Cursor := crHourGlass;
  150. try
  151. { if IsPeExe(FileName) then
  152. begin}
  153. TFileViewerChild.Create(Self).FileName := FileName;
  154. OnActiveFormChange(nil);
  155. { end else
  156. MessBox(sNotValidFile, MB_ICONINFORMATION);}
  157. finally
  158. Screen.Cursor := crDefault;
  159. end;
  160. end;
  161. procedure TMainForm.Exit1Execute(Sender: TObject);
  162. begin
  163. Close;
  164. end;
  165. procedure TMainForm.Open1Execute(Sender: TObject);
  166. var
  167. I: Integer;
  168. begin
  169. with OpenFileDialog do
  170. begin
  171. FileName := '';
  172. if Execute then
  173. for I := 0 to Files.Count - 1 do OpenFile(Files[I], True);
  174. end;
  175. end;
  176. procedure TMainForm.FormCreate(Sender: TObject);
  177. begin
  178. FWin32Help := Win32HelpFileName;
  179. FPeViewerRegistred := IsPeViewerRegistred;
  180. Screen.OnActiveFormChange := OnActiveFormChange;
  181. DragAcceptFiles(Handle, True);
  182. end;
  183. procedure TMainForm.FormDestroy(Sender: TObject);
  184. begin
  185. DragAcceptFiles(Handle, False);
  186. Screen.OnActiveFormChange := nil;
  187. end;
  188. procedure TMainForm.OnActiveFormChange(Sender: TObject);
  189. begin
  190. if IsFileViewerChildActive then
  191. StatusBar.Panels[0].Text := TFileViewerChild(ActiveMDIChild).FileName
  192. else
  193. StatusBar.Panels[0].Text := '';
  194. end;
  195. procedure TMainForm.SelectAll1Update(Sender: TObject);
  196. begin
  197. TAction(Sender).Enabled := Screen.ActiveControl is TListView;
  198. end;
  199. procedure TMainForm.SelectAll1Execute(Sender: TObject);
  200. begin
  201. ListViewSelectAll(Screen.ActiveControl as TListView);
  202. end;
  203. procedure TMainForm.Copy1Update(Sender: TObject);
  204. begin
  205. TAction(Sender).Enabled := Screen.ActiveControl is TListView;
  206. end;
  207. procedure TMainForm.Copy1Execute(Sender: TObject);
  208. var
  209. SL: TStringList;
  210. begin
  211. SL := TStringList.Create;
  212. Screen.Cursor := crHourGlass;
  213. try
  214. SL.Capacity := 256;
  215. ListViewToStrings(Screen.ActiveControl as TListView, SL, True);
  216. case TAction(Sender).Tag of
  217. 0: Clipboard.AsText := SL.Text;
  218. 1: with SaveDialog do
  219. begin
  220. FileName := '';
  221. if Execute then SL.SaveToFile(FileName);
  222. end;
  223. end;
  224. finally
  225. Screen.Cursor := crDefault;
  226. SL.Free;
  227. end;
  228. end;
  229. procedure TMainForm.Win32Help1Update(Sender: TObject);
  230. begin
  231. Win32Help1.Enabled := IsWin32Help and IsFileViewerChildActive and
  232. (TFileViewerChild(ActiveMDIChild).GetWin32Function <> '');
  233. end;
  234. procedure TMainForm.Win32Help1Execute(Sender: TObject);
  235. begin
  236. InvokeWin32Help((ActiveMDIChild as TFileViewerChild).GetWin32Function);
  237. end;
  238. procedure TMainForm.About1Execute(Sender: TObject);
  239. begin
  240. ShowToolsAboutBox;
  241. end;
  242. function TMainForm.IsFileViewerChildActive: Boolean;
  243. begin
  244. Result := (ActiveMDIChild is TFileViewerChild);
  245. end;
  246. function TMainForm.IsWin32Help: Boolean;
  247. begin
  248. Result := Length(FWin32Help) > 0;
  249. end;
  250. procedure TMainForm.DumpPe1Update(Sender: TObject);
  251. begin
  252. DumpPe1.Enabled := FPeViewerRegistred and IsFileViewerChildActive and
  253. (TFileViewerChild(ActiveMDIChild).SelectedFileName <> '');
  254. end;
  255. procedure TMainForm.DumpPe1Execute(Sender: TObject);
  256. begin
  257. FPeViewer := CreateOrGetOleObject(PeViewerClassName);
  258. FPeViewer.OpenFile((ActiveMDIChild as TFileViewerChild).SelectedFileName);
  259. FPeViewer.BringToFront;
  260. end;
  261. procedure TMainForm.SendMail1Execute(Sender: TObject);
  262. begin
  263. SendEmail;
  264. end;
  265. procedure TMainForm.Find1Update(Sender: TObject);
  266. begin
  267. TAction(Sender).Enabled := TFindTextForm.CanExecuteFind;
  268. end;
  269. procedure TMainForm.Find1Execute(Sender: TObject);
  270. begin
  271. ShowFindDialog(Screen.ActiveControl as TListView);
  272. end;
  273. procedure TMainForm.CoolBar1Resize(Sender: TObject);
  274. begin
  275. D4FixCoolBarResizePaint(Sender);
  276. end;
  277. procedure TMainForm.FormShow(Sender: TObject);
  278. begin
  279. PostMessage(Handle, UM_CHECKPARAMSTR, 0, 0);
  280. end;
  281. procedure TMainForm.UMCheckParamStr(var Message: TMessage);
  282. var
  283. I: Integer;
  284. FileName: TFileName;
  285. begin
  286. for I := 1 to ParamCount do
  287. begin
  288. FileName := PathGetLongName(ParamStr(I));
  289. if (FileName <> '') and (FileName[1] <> '-') and (FileName[1] <> '/') then
  290. OpenFile(FileName, False);
  291. end;
  292. end;
  293. procedure TMainForm.WMDropFiles(var Message: TWMDropFiles);
  294. var
  295. FilesCount, I: Integer;
  296. FileName: array[0..MAX_PATH] of Char;
  297. begin
  298. FilesCount := DragQueryFile(Message.Drop, MAXDWORD, nil, 0);
  299. for I := 0 to FilesCount - 1 do
  300. begin
  301. if (DragQueryFile(Message.Drop, I, @FileName, SizeOf(FileName)) > 0) and
  302. IsValidPeFile(FileName) then
  303. OpenFile(FileName, True);
  304. end;
  305. DragFinish(Message.Drop);
  306. Message.Result := 0;
  307. Application.BringToFront;
  308. end;
  309. end.