Ir al contenido


Foto

Obtener Información de un Archivo (Aporte)


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

#1 monchito_elroro

monchito_elroro

    Advanced Member

  • Miembros
  • PipPipPip
  • 259 mensajes

Escrito 14 septiembre 2016 - 03:01

Buen día hermanos :) , en este ocación quisiera compartirles un aporte mío, bueno más que todo es un proyecto que me baje de la web, exactamente de:
http://www.ajpdsoft....article&sid=121
 
Es un software para poder obtener casi todos las propiedades de un archivo (especialmente los EXE), el proyecto original venía para delphi, así que me puse a tratar de pasarlo para lazarus, tuve mucho inconvenientes en la operación (especialmente en los carácteres especiales ñ y tildes) también tuve que cambiar algunas cosas, pero al final después de tanto batallar logré obtener un buen resultado, logré pasar el programa para usarlo en lazarus y les quiero compartir el código fuente para que me ayuden a perfeccionarlo y que nos pueda servir a todos nosotros, también quisiera que me ayuden a  arreglar unos pequeñisimos detalles, pero como les comente el programa ya esta listo para usar y soporta arrastrar archivos encima también.
 
sin más preambulos aquí esta todo el código fuente para lazarus:

delphi
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, LazUTF8, LCLIntf;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button2: TButton;
  16.     Button5: TButton;
  17.     Button6: TButton;
  18.     Edit1: TEdit;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     Label3: TLabel;
  22.     Label4: TLabel;
  23.     Memo1: TMemo;
  24.     OpenDialog1: TOpenDialog;
  25.     SaveDialog1: TSaveDialog;
  26.     procedure Button1Click(Sender: TObject);
  27.     procedure Button2Click(Sender: TObject);
  28.     procedure Button3Click(Sender: TObject);
  29.     procedure Button4Click(Sender: TObject);
  30.     procedure Button5Click(Sender: TObject);
  31.     procedure Button6Click(Sender: TObject);
  32.     procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
  33.     procedure Label3Click(Sender: TObject);
  34.   private
  35.     { private declarations }
  36.   public
  37.     { public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. { TForm1 }
  48.  
  49. function quitarExtension (nombreFichero : string) : string;
  50. begin
  51.   result := copy(ExtractFileName(nombreFichero), 1,
  52.       pos(ExtractFileExt(nombreFichero), ExtractFileName(nombreFichero)) - 1);
  53. end;
  54.  
  55. function tamanoFichero (sFileToExamine: string) : Integer;
  56. var
  57.   SearchRec: TSearchRec;
  58.   sgPath: string;
  59.   inRetval, I1: Integer;
  60. begin
  61.   sgPath := ExpandFileName(sFileToExamine);
  62.   try
  63.     inRetval := FindFirst(ExpandFileName(sFileToExamine), faAnyFile, SearchRec);
  64.     if inRetval = 0 then
  65.       I1 := SearchRec.Size
  66.     else
  67.       I1 := -1;
  68.   finally
  69.     SysUtils.FindClose(SearchRec);
  70.   end;
  71.   Result := I1;
  72. end;
  73.  
  74. function FileVersion(const FileName: TFileName): String;
  75. var
  76.   VerInfoSize: Cardinal;
  77.   VerValueSize: Cardinal;
  78.   Dummy: Cardinal;
  79.   PVerInfo: Pointer;
  80.   PVerValue: PVSFixedFileInfo;
  81.   iLastError: DWord;
  82. begin
  83.  
  84.   Result := '';
  85.   VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  86.  
  87.   if VerInfoSize > 0 then
  88.   begin
  89.  
  90.     GetMem(PVerInfo, VerInfoSize);
  91.     try
  92.       if GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, PVerInfo) then
  93.       begin
  94.         if VerQueryValue(PVerInfo, '\', Pointer(PVerValue), VerValueSize) then
  95.           with PVerValue^ do
  96.             //Result := Format('v%d.%d.%d build %d', [    // original, devuelve ejem:     v8.7.0.0 build 0
  97.             Result := Format('%d.%d.%d', [    // modificado para mi uso, Ericksystem, devuelve ejm:      8.7
  98.               HiWord(dwFileVersionMS), //Major
  99.               LoWord(dwFileVersionMS), //Minor
  100.               HiWord(dwFileVersionLS), //Release
  101.               LoWord(dwFileVersionLS)]); //Build
  102.       end
  103.       else
  104.       begin
  105.         iLastError := GetLastError;
  106.         Result := Format('GetFileVersionInfo failed: (%d) %s',
  107.                       [iLastError, SysErrorMessage(iLastError)]);
  108.       end;
  109.     finally
  110.       FreeMem(PVerInfo, VerInfoSize);
  111.     end;
  112.   end
  113.   else
  114.   begin
  115.  
  116.     iLastError := GetLastError;
  117.     Result := Format('GetFileVersionInfo failed: (%d) %s',
  118.                      [iLastError, SysErrorMessage(iLastError)]);
  119.   end;
  120. End;
  121.  
  122. function obtenerAtributos (fichero : string) : DWORD;
  123. begin
  124.   result := GetFileAttributes(pchar(fichero));
  125. end;
  126.  
  127. function obtenerInfoFichero (info : string; fichero : string) : string;
  128. type
  129.   PaLeerBuffer = array [0..MAX_PATH] of char;
  130. var
  131.   Size, Size2 : DWord;
  132.   Pt, Pt2 : Pointer;
  133.   Idioma : string;
  134. begin
  135.   Result := '';
  136.   Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  137.   if Size > 0 then
  138.   begin
  139.     GetMem (Pt, Size);
  140.     if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
  141.     begin
  142.       VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
  143.       Idioma:=IntToHex( DWord(Pt2^) ,8 );
  144.       Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
  145.       VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
  146.       if Size2 > 0 then
  147.       begin
  148.        Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);
  149.       end
  150.       else
  151.         result := '';
  152.       FreeMem (Pt);
  153.     end;
  154.   end
  155.   else
  156.     result := '';
  157. end;
  158.  
  159. function obtenerFechasFichero (const FileName: string; var Created: TDateTime;
  160.          var Accessed: TDateTime; var Modified: TDateTime): Boolean;
  161. var
  162.   h: THandle;
  163.   Info1, Info2, Info3: TFileTime;
  164.   SysTimeStruct: SYSTEMTIME;
  165.   TimeZoneInfo: TTimeZoneInformation;
  166.   Bias: Double;
  167. begin
  168.   Result := False;
  169.   Bias   := 0;
  170.   h      := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  171.   if h > 0 then
  172.   begin
  173.     try
  174.       if GetTimeZoneInformation(TimeZoneInfo) <> $FFFFFFFF then
  175.         Bias := TimeZoneInfo.Bias / 1440; // 60x24
  176.       GetFileTime(h, @Info1, @Info2, @Info3);
  177.       if FileTimeToSystemTime(Info1, SysTimeStruct) then
  178.         Created := SystemTimeToDateTime(SysTimeStruct) - Bias;
  179.       if FileTimeToSystemTime(Info2, SysTimeStruct) then
  180.         Accessed := SystemTimeToDateTime(SysTimeStruct) - Bias;
  181.       if FileTimeToSystemTime(Info3, SysTimeStruct) then
  182.         Modified := SystemTimeToDateTime(SysTimeStruct) - Bias;
  183.       Result := True;
  184.     finally
  185.       FileClose(h);
  186.     end;
  187.   end;
  188. end;
  189.  
  190. procedure TForm1.Button1Click(Sender: TObject);
  191. begin
  192.  
  193. end;
  194.  
  195. procedure TForm1.Button2Click(Sender: TObject);
  196. begin
  197.   SaveDialog1.Title := 'Guardar información de fichero...';
  198.   SaveDialog1.FileName := ChangeFileExt(ExtractFileName('e:\virtualprinter.exe'), '.txt');
  199.   if SaveDialog1.Execute then
  200.     memo1.Lines.SaveToFile (SaveDialog1.FileName);
  201. end;
  202.  
  203. procedure TForm1.Button3Click(Sender: TObject);
  204. begin
  205.  
  206. end;
  207.  
  208. procedure TForm1.Button4Click(Sender: TObject);
  209. begin
  210.  
  211. end;
  212.  
  213. procedure TForm1.Button5Click(Sender: TObject);
  214. begin
  215.   OpenDialog1.Title := 'Seleccione el fichero...';
  216.   OpenDialog1.Filter := 'Aplicación (*.exe)|*.exe|Librería (*.dll)|*.dll|Com (*.com)|*.com|Todos los archivos (*.*)|*.*';
  217.   if OpenDialog1.Execute then
  218.   begin
  219.     edit1.Text := OpenDialog1.FileName;
  220.     Button6Click(nil);
  221.   end;
  222. end;
  223.  
  224. procedure TForm1.Button6Click(Sender: TObject);
  225. var
  226.   sizeFichero : Longint;
  227.   fechaCreacion, ultimoAcceso, ultimaModificacion : TDateTime;
  228.   atributos : word;
  229. begin
  230.   if FileExists(edit1.Text) then
  231.   begin
  232.     //tabInfo.Show;
  233.     {if versionFichero(txtFichero.Text,major,minor,release, build) then
  234.       version := Format('Versión: %d.%d.%d.%d', [Major, Minor, Release, Build])
  235.     else
  236.       version := 'Versión no disponible';}
  237.     Memo1.Clear;
  238.     Memo1.Lines.Add('Nombre: ' + ExtractFileName(edit1.Text));
  239.     Memo1.Lines.Add('Extensión: ' + ExtractFileExt(edit1.Text));
  240.     Memo1.Lines.Add('Ubicación (carpeta): ' + ExtractFilePath(edit1.Text));
  241.     Memo1.Lines.Add('Nombre sin extensión: ' + quitarExtension (extractfilename(edit1.text)));
  242.     Memo1.Lines.Add('Unidad: ' + ExtractFileDrive(edit1.text));
  243.     //Memo1.Lines.Add(version);
  244.     Memo1.Lines.Add('Version: '+FileVersion(UTF8ToWinCP(edit1.text)));
  245.     Memo1.Lines.Add('Compañía: ' + obtenerInfoFichero ('CompanyName', UTF8ToWinCP(edit1.Text)));
  246.     Memo1.Lines.Add('Descripción: ' + obtenerInfoFichero ('FileDescription', UTF8ToWinCP(edit1.Text)));
  247.     Memo1.Lines.Add('Nombre interno: ' + obtenerInfoFichero ('InternalName', UTF8ToWinCP(edit1.Text)));
  248.     Memo1.Lines.Add('Derechos de copia: ' + obtenerInfoFichero ('LegalCopyright', UTF8ToWinCP(edit1.Text)));
  249.     Memo1.Lines.Add('Nombre original: ' + obtenerInfoFichero ('OriginalFilename', UTF8ToWinCP(edit1.Text)));
  250.     Memo1.Lines.Add('Nombre producto: ' + obtenerInfoFichero ('ProductName', UTF8ToWinCP(edit1.Text)));
  251.     Memo1.Lines.Add('Versión producto: ' + obtenerInfoFichero ('ProductVersion', UTF8ToWinCP(edit1.Text)));
  252.     Memo1.Lines.Add('Versión fichero: ' + obtenerInfoFichero ('FileVersion', UTF8ToWinCP(edit1.Text)));
  253.     Memo1.Lines.Add('Comentarios: ' + obtenerInfoFichero ('Comments', UTF8ToWinCP(edit1.Text)));
  254.     sizeFichero := tamanoFichero(edit1.Text);
  255.     if sizeFichero = 0 then
  256.       Memo1.Lines.Add('Tamaño (Bytes): Para obtener el tamaño el fichero debe estar cerrado.')
  257.     else
  258.       Memo1.Lines.Add('Tamaño (Bytes): ' + IntToStr(tamanoFichero(edit1.Text)));
  259.  
  260.     //fechas
  261.     if obtenerFechasFichero (edit1.Text, fechaCreacion, ultimoAcceso, ultimaModificacion) then
  262.     begin
  263.       Memo1.Lines.Add('Fecha creación: ' + DateToStr (fechaCreacion));
  264.       Memo1.Lines.Add('Fecha último acceso: ' + DateToStr(ultimoAcceso));
  265.       Memo1.Lines.Add('Fecha modificación: ' + DateToStr(ultimaModificacion));
  266.     end;
  267.  
  268.     //atributos
  269.     atributos := obtenerAtributos (PChar(edit1.Text));
  270.     if (atributos and FILE_ATTRIBUTE_ARCHIVE) > 0 then
  271.       Memo1.lines.Add('Atributo listo para archivar: Sí')
  272.     else
  273.       Memo1.lines.Add('Atributo listo para archivar: No');
  274.  
  275.     if (atributos and FILE_ATTRIBUTE_DIRECTORY > 0) then
  276.       Memo1.lines.Add('Atributo directorio: Sí')
  277.     else
  278.       Memo1.lines.Add('Atributo directorio: No');
  279.  
  280.     if (atributos and FILE_ATTRIBUTE_HIDDEN > 0) then
  281.       Memo1.lines.Add('Atributo oculto: Sí')
  282.     else
  283.       Memo1.lines.Add('Atributo oculto: No');
  284.  
  285.     if (atributos and FILE_ATTRIBUTE_OFFLINE > 0)  then
  286.       Memo1.lines.Add('Atributo fuera de línea: Sí')
  287.     else
  288.       Memo1.lines.Add('Atributo fuera de línea: No');
  289.  
  290.     if (atributos and FILE_ATTRIBUTE_TEMPORARY > 0)  then
  291.       Memo1.lines.Add('Atributo temporal: Sí')
  292.     else
  293.       Memo1.lines.Add('Atributo temporal: No');
  294.  
  295.     if (atributos and FILE_ATTRIBUTE_READONLY > 0)  then
  296.       Memo1.lines.Add('Atributo sólo lectura: Sí')
  297.     else
  298.       Memo1.lines.Add('Atributo sólo lectura: No');
  299.  
  300.     if (atributos and FILE_ATTRIBUTE_SYSTEM > 0)  then
  301.       Memo1.lines.Add('Atributo sistema: Sí')
  302.     else
  303.       Memo1.lines.Add('Atributo sistema: No');
  304.  
  305.     if (atributos and FILE_ATTRIBUTE_NORMAL > 0)  then
  306.       Memo1.lines.Add('Atributo normal: Sí')
  307.     else
  308.       Memo1.lines.Add('Atributo normal: No');
  309.  
  310.     if (atributos and FILE_ATTRIBUTE_COMPRESSED) > 0 then
  311.       Memo1.lines.Add('Atributo comprimido: Sí')
  312.     else
  313.       Memo1.lines.Add('Atributo comprimido: No');
  314.  
  315.     if (atributos and $00004000) > 0 then
  316.       Memo1.lines.Add('Atributo encriptado: Sí')
  317.     else
  318.       Memo1.lines.Add('Atributo encriptado: No');
  319.  
  320.     if (atributos and $00002000) > 0 then
  321.       Memo1.lines.Add('Atributo permitir indexar: No')
  322.     else
  323.       Memo1.lines.Add('Atributo permitir indexar: Sí');
  324.  
  325.     Button2.SetFocus;
  326.   end
  327.   else
  328.     MessageDlg('El fichero seleccionado no existe.', mtWarning, [mbok], 0);
  329. end;
  330.  
  331. procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String
  332.   );
  333. var
  334.   i: Integer;
  335. begin
  336.     for i := Low(FileNames) to High(FileNames) do
  337.     Edit1.Text := FileNames[i];
  338.     Button6Click(nil);
  339. end;
  340.  
  341. procedure TForm1.Label3Click(Sender: TObject);
  342. begin
  343.   OpenURL('http://www.ajpdsoft.com/modules.php?name=News&file=article&sid=121');
  344. end;
  345.  
  346. end.

También les comparto el proyecto traducido a lazarus y una imagen del software.
http://www.mediafire...rchivo 2.zip   (proyecto)
http://subefotos.com...834bed31beo.png
(Disculpen por subirlo a mediafire es que por este medio no me dejaba)
 
Sin más me despido queridos amigos esperando sus sugerencias y me puedan ayudar a perfeccionarlo, buen día. :)
  • 2

#2 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 14 septiembre 2016 - 09:29

(Disculpen por subirlo a mediafire es que por este medio no me dejaba)

 

 

Voy a revisar porque no te dejó,

 

Saludos


  • 0

#3 monchito_elroro

monchito_elroro

    Advanced Member

  • Miembros
  • PipPipPip
  • 259 mensajes

Escrito 14 septiembre 2016 - 10:21

Gracias amigo egostar :)


  • 1

#4 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 14 septiembre 2016 - 11:26

Gracias amigo egostar :)

 

Que tal amigo, lo más probable es que se exceda el tamaño del limite de "upload" que es de 500 kB por subida,. no puedo ver los archivos ya que no tengo acceso aquí en mi trabajo.

 

Saludos


  • 0

#5 monchito_elroro

monchito_elroro

    Advanced Member

  • Miembros
  • PipPipPip
  • 259 mensajes

Escrito 14 septiembre 2016 - 10:39

Buscando más opciones encontre uno bueno que puede funcionar multicross, es decir para Win, Linux y Mac aunque aún no lo confirmo de momento me funciona perfecto en windows. :) :)

 

También recalcar que al parecer solo funciona para los archivos:

.exe/.dll/.ocx

 

aquí esta el code:

Obtener información de un achivo.


php
  1. Uses
  2.   fileinfo,
  3.   winpeimagereader,
  4.   elfreader,
  5.   Machoreader;   
  6.  
  7. procedure TForm1.Button2Click(Sender: TObject);
  8. var info:TFileVersionInfo;
  9. begin
  10.   memo1.clear;
  11.   info := TFileVersionInfo.Create(nil);
  12.   info.fileName:='E:\ñoñito acción\iTunes64Setup.exe';
  13.   info.ReadFileInfo;
  14.   //showmessage(info.VersionStrings.Text);  // muestra toda la info
  15.   memo1.lines.add('CompanyName: '+info.VersionStrings.Values['CompanyName']);
  16.   memo1.lines.add('FileDescription: '+info.VersionStrings.Values['FileDescription']);
  17.   memo1.lines.add('FileVersion: '+info.VersionStrings.Values['FileVersion']);
  18.   memo1.lines.add('InternalName: '+info.VersionStrings.Values['InternalName']);
  19.   memo1.lines.add('LegalCopyright: '+info.VersionStrings.Values['LegalCopyright']);
  20.   memo1.lines.add('OriginalFilename: '+info.VersionStrings.Values['OriginalFilename']);
  21.   memo1.lines.add('ProductName: '+info.VersionStrings.Values['ProductName']);
  22.   memo1.lines.add('ProductVersion: '+info.VersionStrings.Values['ProductVersion']);
  23.   info.Free;

La fuente de donde me guíe es este:

http://wiki.freepasc...on,_and_Company

 

Lo Genial de este código es que me reconoce automáticamente las "ñ" las tildes y los caracteres assci, como en el ejemplo el logo © que lleva el itunes en "LegalCopyright" espero les pueda ser útil hermanos, saludos con todos :)


  • 0




IP.Board spam blocked by CleanTalk.