/jcl/examples/windows/delphitools/dependencyviewer/DependViewMain.pas
Pascal | 346 lines | 279 code | 37 blank | 30 comment | 11 complexity | f8a9c23ef7868f528d2793141f6ba7f5 MD5 | raw file
Possible License(s): BSD-3-Clause
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 26unit DependViewMain; 27 28{$I JCL.INC} 29 30interface 31 32uses 33 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 34 Menus, ToolWin, ComCtrls, ImgList, ActnList, StdActns, ClipBrd, Registry, 35 ShellAPI; 36 37const 38 UM_CHECKPARAMSTR = WM_USER + $100; 39 40type 41 TMainForm = class(TForm) 42 MainMenu: TMainMenu; 43 CoolBar1: TCoolBar; 44 ToolBar1: TToolBar; 45 ToolButton1: TToolButton; 46 ActionList1: TActionList; 47 ToolbarImagesList: TImageList; 48 OpenFileDialog: TOpenDialog; 49 File1: TMenuItem; 50 Exit1: TAction; 51 Exit2: TMenuItem; 52 Open1: TAction; 53 Open2: TMenuItem; 54 N1: TMenuItem; 55 Window1: TMenuItem; 56 WindowCascade1: TWindowCascade; 57 WindowTileHorizontal1: TWindowTileHorizontal; 58 WindowTileVertical1: TWindowTileVertical; 59 Cascade1: TMenuItem; 60 TileHorizontally1: TMenuItem; 61 TileVertically1: TMenuItem; 62 ToolButton3: TToolButton; 63 ToolButton4: TToolButton; 64 ToolButton5: TToolButton; 65 ViewImageList: TImageList; 66 ToolButton7: TToolButton; 67 Copy1: TAction; 68 Save1: TAction; 69 Edit1: TMenuItem; 70 Copy2: TMenuItem; 71 Save2: TMenuItem; 72 ToolButton8: TToolButton; 73 ToolButton9: TToolButton; 74 ToolButton10: TToolButton; 75 SelectAll1: TAction; 76 Selectall2: TMenuItem; 77 SaveDialog: TSaveDialog; 78 Win32Help1: TAction; 79 ToolButton11: TToolButton; 80 ToolButton12: TToolButton; 81 Help1: TMenuItem; 82 Win32helpkeyword1: TMenuItem; 83 N2: TMenuItem; 84 About1: TAction; 85 About2: TMenuItem; 86 StatusBar: TStatusBar; 87 DumpPe1: TAction; 88 ToolButton2: TToolButton; 89 N3: TMenuItem; 90 DumpPEfile1: TMenuItem; 91 SendMail1: TAction; 92 Sendamessage1: TMenuItem; 93 Find1: TAction; 94 ToolButton6: TToolButton; 95 N4: TMenuItem; 96 Findtext1: TMenuItem; 97 procedure Exit1Execute(Sender: TObject); 98 procedure Open1Execute(Sender: TObject); 99 procedure FormCreate(Sender: TObject); 100 procedure FormDestroy(Sender: TObject); 101 procedure SelectAll1Update(Sender: TObject); 102 procedure SelectAll1Execute(Sender: TObject); 103 procedure Copy1Update(Sender: TObject); 104 procedure Copy1Execute(Sender: TObject); 105 procedure Win32Help1Update(Sender: TObject); 106 procedure Win32Help1Execute(Sender: TObject); 107 procedure About1Execute(Sender: TObject); 108 procedure DumpPe1Update(Sender: TObject); 109 procedure DumpPe1Execute(Sender: TObject); 110 procedure SendMail1Execute(Sender: TObject); 111 procedure Find1Update(Sender: TObject); 112 procedure Find1Execute(Sender: TObject); 113 procedure CoolBar1Resize(Sender: TObject); 114 procedure FormShow(Sender: TObject); 115 private 116 FPeViewer: Variant; 117 FPeViewerRegistred: Boolean; 118 FWin32Help: string; 119 procedure InvokeWin32Help(const Name: string); 120 function IsFileViewerChildActive: Boolean; 121 function IsWin32Help: Boolean; 122 procedure OnActiveFormChange(Sender: TObject); 123 procedure UMCheckParamStr(var Message: TMessage); message UM_CHECKPARAMSTR; 124 procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; 125 public 126 procedure OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); 127 end; 128 129var 130 MainForm: TMainForm; 131 132implementation 133 134uses ToolsUtils, FileViewer, JclPeImage, JclRegistry, FindDlg, JclFileUtils; 135 136{$R *.DFM} 137 138resourcestring 139 sNotValidFile = 'This is not a valid PE EXE file'; 140 141procedure TMainForm.InvokeWin32Help(const Name: string); 142var 143 S: string; 144begin 145 S := PeStripFunctionAW(Name); 146 WinHelp(Application.Handle, PChar(FWin32Help), HELP_KEY, {$IFDEF RTL230_UP}NativeUInt(S){$ELSE}DWORD(S){$ENDIF}); 147end; 148 149procedure TMainForm.OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); 150var 151 I: Integer; 152begin 153 if CheckIfOpen then 154 begin 155 for I := 0 to MDIChildCount - 1 do 156 if MDIChildren[I] is TFileViewerChild and (TFileViewerChild(MDIChildren[I]).FileName = FileName) then 157 begin 158 MDIChildren[I].BringToFront; 159 Exit; 160 end; 161 end; 162 Screen.Cursor := crHourGlass; 163 try 164{ if IsPeExe(FileName) then 165 begin} 166 TFileViewerChild.Create(Self).FileName := FileName; 167 OnActiveFormChange(nil); 168{ end else 169 MessBox(sNotValidFile, MB_ICONINFORMATION);} 170 finally 171 Screen.Cursor := crDefault; 172 end; 173end; 174 175procedure TMainForm.Exit1Execute(Sender: TObject); 176begin 177 Close; 178end; 179 180procedure TMainForm.Open1Execute(Sender: TObject); 181var 182 I: Integer; 183begin 184 with OpenFileDialog do 185 begin 186 FileName := ''; 187 if Execute then 188 for I := 0 to Files.Count - 1 do OpenFile(Files[I], True); 189 end; 190end; 191 192procedure TMainForm.FormCreate(Sender: TObject); 193begin 194 FWin32Help := Win32HelpFileName; 195 FPeViewerRegistred := IsPeViewerRegistred; 196 Screen.OnActiveFormChange := OnActiveFormChange; 197 DragAcceptFiles(Handle, True); 198end; 199 200procedure TMainForm.FormDestroy(Sender: TObject); 201begin 202 DragAcceptFiles(Handle, False); 203 Screen.OnActiveFormChange := nil; 204end; 205 206procedure TMainForm.OnActiveFormChange(Sender: TObject); 207begin 208 if IsFileViewerChildActive then 209 StatusBar.Panels[0].Text := TFileViewerChild(ActiveMDIChild).FileName 210 else 211 StatusBar.Panels[0].Text := ''; 212end; 213 214procedure TMainForm.SelectAll1Update(Sender: TObject); 215begin 216 TAction(Sender).Enabled := Screen.ActiveControl is TListView; 217end; 218 219procedure TMainForm.SelectAll1Execute(Sender: TObject); 220begin 221 ListViewSelectAll(Screen.ActiveControl as TListView); 222end; 223 224procedure TMainForm.Copy1Update(Sender: TObject); 225begin 226 TAction(Sender).Enabled := Screen.ActiveControl is TListView; 227end; 228 229procedure TMainForm.Copy1Execute(Sender: TObject); 230var 231 SL: TStringList; 232begin 233 SL := TStringList.Create; 234 Screen.Cursor := crHourGlass; 235 try 236 SL.Capacity := 256; 237 ListViewToStrings(Screen.ActiveControl as TListView, SL, True); 238 case TAction(Sender).Tag of 239 0: Clipboard.AsText := SL.Text; 240 1: with SaveDialog do 241 begin 242 FileName := ''; 243 if Execute then SL.SaveToFile(FileName); 244 end; 245 end; 246 finally 247 Screen.Cursor := crDefault; 248 SL.Free; 249 end; 250end; 251 252procedure TMainForm.Win32Help1Update(Sender: TObject); 253begin 254 Win32Help1.Enabled := IsWin32Help and IsFileViewerChildActive and 255 (TFileViewerChild(ActiveMDIChild).GetWin32Function <> ''); 256end; 257 258procedure TMainForm.Win32Help1Execute(Sender: TObject); 259begin 260 InvokeWin32Help((ActiveMDIChild as TFileViewerChild).GetWin32Function); 261end; 262 263procedure TMainForm.About1Execute(Sender: TObject); 264begin 265 ShowToolsAboutBox; 266end; 267 268function TMainForm.IsFileViewerChildActive: Boolean; 269begin 270 Result := (ActiveMDIChild is TFileViewerChild); 271end; 272 273function TMainForm.IsWin32Help: Boolean; 274begin 275 Result := Length(FWin32Help) > 0; 276end; 277 278procedure TMainForm.DumpPe1Update(Sender: TObject); 279begin 280 DumpPe1.Enabled := FPeViewerRegistred and IsFileViewerChildActive and 281 (TFileViewerChild(ActiveMDIChild).SelectedFileName <> ''); 282end; 283 284procedure TMainForm.DumpPe1Execute(Sender: TObject); 285begin 286 FPeViewer := CreateOrGetOleObject(PeViewerClassName); 287 FPeViewer.OpenFile((ActiveMDIChild as TFileViewerChild).SelectedFileName); 288 FPeViewer.BringToFront; 289end; 290 291procedure TMainForm.SendMail1Execute(Sender: TObject); 292begin 293 SendEmail; 294end; 295 296procedure TMainForm.Find1Update(Sender: TObject); 297begin 298 TAction(Sender).Enabled := TFindTextForm.CanExecuteFind; 299end; 300 301procedure TMainForm.Find1Execute(Sender: TObject); 302begin 303 ShowFindDialog(Screen.ActiveControl as TListView); 304end; 305 306procedure TMainForm.CoolBar1Resize(Sender: TObject); 307begin 308 D4FixCoolBarResizePaint(Sender); 309end; 310 311procedure TMainForm.FormShow(Sender: TObject); 312begin 313 PostMessage(Handle, UM_CHECKPARAMSTR, 0, 0); 314end; 315 316procedure TMainForm.UMCheckParamStr(var Message: TMessage); 317var 318 I: Integer; 319 FileName: TFileName; 320begin 321 for I := 1 to ParamCount do 322 begin 323 FileName := PathGetLongName(ParamStr(I)); 324 if (FileName <> '') and (FileName[1] <> '-') and (FileName[1] <> '/') then 325 OpenFile(FileName, False); 326 end; 327end; 328 329procedure TMainForm.WMDropFiles(var Message: TWMDropFiles); 330var 331 FilesCount, I: Integer; 332 FileName: array[0..MAX_PATH] of Char; 333begin 334 FilesCount := DragQueryFile(Message.Drop, MAXDWORD, nil, 0); 335 for I := 0 to FilesCount - 1 do 336 begin 337 if (DragQueryFile(Message.Drop, I, @FileName, SizeOf(FileName)) > 0) and 338 IsValidPeFile(FileName) then 339 OpenFile(FileName, True); 340 end; 341 DragFinish(Message.Drop); 342 Message.Result := 0; 343 Application.BringToFront; 344end; 345 346end.