Ir al contenido


Foto

[TRUCO DELPHI] Modulos usados por el Sistema.


  • Por favor identifícate para responder
3 respuestas en este tema

#1 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 10 diciembre 2016 - 04:42

[TRUCO DELPHI] Modulos usados por el Sistema.


delphi
  1. Uses
  2. TLHelp32,
  3.  
  4. procedure ShowUsedSystemModules(lvw: TListView);
  5. Var
  6. SnapShotHandle: THandle;
  7. Module : TModuleEntry32;
  8. VInfo : TVerInfoRes;
  9. lit : TListItem;
  10. begin
  11. SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  12. If SnapShotHandle = INVALID_HANDLE_VALUE Then
  13. Abort;
  14.  
  15. Module.dwSize := SizeOf(Module);
  16.  
  17. If Module32First(SnapShotHandle, Module) Then
  18. Repeat
  19. VInfo := TVerInfoRes.Create(Module.szModule);
  20. try
  21. lit := lvw.Items.Add;
  22. lit.Caption := String(Module.szModule);
  23. lit.SubItems.Add(VInfo.FileVersion);
  24. lit.SubItems.Add(String(Module.szExePath));
  25. lit.SubItems.Add(IntToStr(Module.ModBaseSize));
  26. lit.SubItems.Add(VInfo.GetPreDefKeyString(viCompanyName));
  27. lit.SubItems.Add(VInfo.GetPreDefKeyString(viProductName));
  28. lit.SubItems.Add(IntToStr(Module.ProcCntUsage));
  29. finally
  30. VInfo.Free;
  31. end;
  32. Until Not Module32Next(SnapShotHandle, Module);
  33. end;

Saludos!


  • 1

#2 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 10 diciembre 2016 - 08:26

¿TVerInfoRes? Te ha fallado el copy-paste ¿esa clase de donde sale?

 

http://www.diicode.c...myfhpzv-1112915

http://www.delphipag...ead.php?t=23168

https://github.com/d...ter/VerInfo.pas

 

Deberías publicar código completo, funcionante y con ejemplos de uso. ¿De que sirve un "truco"  incompleto que nadie va a usar?

 

 

Saludos.


  • 0

#3 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 10 diciembre 2016 - 08:45


delphi
  1. unit VerInfo;
  2. interface
  3. uses SysUtils, WinTypes, Dialogs, Classes;
  4. type
  5. { define a generic exception class for version info, and an exception
  6. to indicate that no version info is available. }
  7. EVerInfoError = class(Exception);
  8. ENoVerInfoError = class(Exception);
  9. eNoFixeVerInfo = class(Exception);
  10. // define enum type representing different types of version info
  11. TVerInfoType =
  12. (viCompanyName,
  13. viFileDescription,
  14. viFileVersion,
  15. viInternalName,
  16. viLegalCopyright,
  17. viLegalTrademarks,
  18. viOriginalFilename,
  19. viProductName,
  20. viProductVersion,
  21. viComments);
  22. const
  23. // define an array constant of strings representing the pre-defined
  24. // version information keys.
  25. VerNameArray: array[viCompanyName..viComments] of String[20] =
  26. ('CompanyName',
  27. 'FileDescription',
  28. 'FileVersion',
  29. 'InternalName',
  30. 'LegalCopyright',
  31. 'LegalTrademarks',
  32. 'OriginalFilename',
  33. 'ProductName',
  34. 'ProductVersion',
  35. 'Comments');
  36. type
  37. // Define the version info class
  38. TVerInfoRes = class
  39. private
  40. Handle : DWord;
  41. Size : Integer;
  42. RezBuffer : String;
  43. TransTable : PLongint;
  44. FixedFileInfoBuf : PVSFixedFileInfo;
  45. FFileFlags : TStringList;
  46. FFileName : String;
  47. procedure FillFixedFileInfoBuf;
  48. procedure FillFileVersionInfo;
  49. procedure FillFileMaskInfo;
  50. protected
  51. function GetFileVersion : String;
  52. function GetProductVersion: String;
  53. function GetFileOS : String;
  54. public
  55. constructor Create(AFileName: String);
  56. destructor Destroy; override;
  57. function GetPreDefKeyString(AVerKind: TVerInfoType): String;
  58. function GetUserDefKeyString(AKey: String): String;
  59. property FileVersion : String read GetFileVersion;
  60. property ProductVersion : String read GetProductVersion;
  61. property FileFlags : TStringList read FFileFlags;
  62. property FileOS : String read GetFileOS;
  63. end;
  64. implementation
  65. uses Windows;
  66. const
  67. // strings that must be fed to VerQueryValue() function
  68. SFInfo = '\StringFileInfo\';
  69. VerTranslation: PChar = '\VarFileInfo\Translation';
  70. FormatStr = '%s%.4x%.4x\%s%s';
  71.  
  72. constructor TVerInfoRes.Create(AFileName: String);
  73. begin
  74. FFileName := aFileName;
  75. FFileFlags := TStringList.Create;
  76. // Get the file version information
  77. FillFileVersionInfo;
  78. //Get the fixed file info
  79. FillFixedFileInfoBuf;
  80. // Get the file mask values
  81. FillFileMaskInfo;
  82. end;
  83.  
  84. destructor TVerInfoRes.Destroy;
  85. begin
  86. FFileFlags.Free;
  87. end;
  88. procedure TVerInfoRes.FillFileVersionInfo;
  89. var
  90. SBSize: UInt;
  91. begin
  92. // Determine size of version information
  93. Size := GetFileVersionInfoSize(PChar(FFileName), Handle);
  94. if Size <= 0 then { raise exception if size <= 0 }
  95. raise ENoVerInfoError.Create('No Version Info Available.');
  96. // Set the length accordingly
  97. SetLength(RezBuffer, Size);
  98. // Fill the buffer with version information, raise exception on error
  99. if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then
  100. raise EVerInfoError.Create('Cannot obtain version info.');
  101. // Get translation info, raise exception on error
  102. if not VerQueryValue(PChar(RezBuffer), VerTranslation, pointer(TransTable),
  103. SBSize) then
  104. raise EVerInfoError.Create('No language info.');
  105. end;
  106. procedure TVerInfoRes.FillFixedFileInfoBuf;
  107. var
  108. Size: Cardinal;
  109. begin
  110. if VerQueryValue(PChar(RezBuffer), '\', Pointer(FixedFileInfoBuf), Size) then begin
  111. if Size < SizeOf(TVSFixedFileInfo) then
  112. raise eNoFixeVerInfo.Create('No fixed file info');
  113. end
  114. else
  115. raise eNoFixeVerInfo.Create('No fixed file info')
  116. end;
  117. procedure TVerInfoRes.FillFileMaskInfo;
  118. begin
  119. with FixedFileInfoBuf^ do begin
  120. if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0then
  121. FFileFlags.Add('Pre-release');
  122. if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
  123. FFileFlags.Add('Private build');
  124. if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
  125. FFileFlags.Add('Special build');
  126. if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then
  127. FFileFlags.Add('Debug');
  128. end;
  129. end;
  130. function TVerInfoRes.GetPreDefKeyString(AVerKind: TVerInfoType): String;
  131. var
  132. P: PChar;
  133. S: UInt;
  134. begin
  135. Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
  136. VerNameArray[aVerKind], #0]);
  137. // get and return version query info, return empty string on error
  138. if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  139. Result := StrPas(P)
  140. else
  141. Result := '';
  142. end;
  143. function TVerInfoRes.GetUserDefKeyString(AKey: String): String;
  144. var
  145. P: Pchar;
  146. S: UInt;
  147. begin
  148. Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
  149. aKey, #0]);
  150. // get and return version query info, return empty string on error
  151. if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  152. Result := StrPas(P)
  153. else
  154. Result := '';
  155. end;
  156.  
  157. function VersionString(Ms, Ls: Longint): String;
  158. begin
  159. Result := Format('%d.%d.%d.%d', [HIWORD(Ms), LOWORD(Ms),
  160. HIWORD(Ls), LOWORD(Ls)]);
  161. end;
  162. function TVerInfoRes.GetFileVersion: String;
  163. begin
  164. with FixedFileInfoBuf^ do
  165. Result := VersionString(dwFileVersionMS, dwFileVersionLS);
  166. end;
  167. function TVerInfoRes.GetProductVersion: String;
  168. begin
  169. with FixedFileInfoBuf^ do
  170. Result := VersionString(dwProductVersionMS, dwProductVersionLS);
  171. end;
  172. function TVerInfoRes.GetFileOS: String;
  173. begin
  174. with FixedFileInfoBuf^ do
  175. case dwFileOS of
  176. VOS_UNKNOWN: // Same as VOS__BASE
  177. Result := 'Unknown';
  178. VOS_DOS:
  179. Result := 'Designed for MS-DOS';
  180. VOS_OS216:
  181. Result := 'Designed for 16-bit OS/2';
  182. VOS_OS232:
  183. Result := 'Designed for 32-bit OS/2';
  184. VOS_NT:
  185. Result := 'Designed for Windows NT';
  186.  
  187. VOS__WINDOWS16:
  188. Result := 'Designed for 16-bit Windows';
  189. VOS__PM16:
  190. Result := 'Designed for 16-bit PM';
  191. VOS__PM32:
  192. Result := 'Designed for 32-bit PM';
  193. VOS__WINDOWS32:
  194. Result := 'Designed for 32-bit Windows';
  195. VOS_DOS_WINDOWS16:
  196. Result := 'Designed for 16-bit Windows, running on MS-DOS';
  197. VOS_DOS_WINDOWS32:
  198. Result := 'Designed for Win32 API, running on MS-DOS';
  199. VOS_OS216_PM16:
  200. Result := 'Designed for 16-bit PM, running on 16-bit OS/2';
  201. VOS_OS232_PM32:
  202. Result := 'Designed for 32-bit PM, running on 32-bit OS/2';
  203. VOS_NT_WINDOWS32:
  204. Result := 'Designed for Win32 API, running on Windows/NT';
  205. else
  206. Result := 'Unknown';
  207. end;
  208. end;
  209.  
  210. end.


  • 1

#4 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 11 diciembre 2016 - 07:09

El copy-paste volvió a fallar. Cuida tus publicaciones, si el código no es tuyo es buena costumbre enlazar el origen. También conviene indentarlo, en los enlaces que te pasé, no en todos, está indentado. Recuerda que la indentación facilita enormemente su lectura. ;)

 

Saludos.


  • 0




IP.Board spam blocked by CleanTalk.