Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 28-02-2017
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Cómo determinar el tamaño original de un archivo ejecutable

Hola a todos,

A ver si podéis echarme una mano con el siguiente problema. En uno de mis proyectos necesito adjuntar ciertos datos en un archivo ejecutable, esto es, en realidad adjunto un archivo a otro archivo, este último un ejecutable generado también con Delphi. Todo funciona bien, excepto si además cambio el icono de dicho archivo ejecutable. Para conseguir el tamaño original de un archivo ejecutable, me baso en el siguiente código de Angus Johnson:

Código Delphi [-]
{$IFDEF VER100}
{TImageDosHeader isn't defined in Delphi 3 so here's an an abbreviated structure definition...}
type

  PImageDosHeader = ^TImageDosHeader;
  TImageDosHeader = packed record
    e_magic         : WORD;
    e_ignore        : packed array [0..28] of WORD;
    _lfanew        : Longint;
  end;
{$ENDIF}

function GetExeSize: cardinal;
var
  p: pchar;
  i, NumSections: integer;
begin
  result := 0; // if error then result = 0
  p := pointer(hinstance);
  inc(p, PImageDosHeader(p)._lfanew + sizeof(dword));
  NumSections := PImageFileHeader(p).NumberOfSections;
  inc(p,sizeof(TImageFileHeader)+ sizeof(TImageOptionalHeader));
  for i := 1 to NumSections do
  begin
    with PImageSectionHeader(p)^ do
      if PointerToRawData+SizeOfRawData > result then
        result := PointerToRawData+SizeOfRawData;
    inc(p, sizeof(TImageSectionHeader));
  end;
end;

La idea del anterior código es determinar el tamaño original de un archivo ejecutable, sin contar con el archivo que hemos adjuntado al mismo, puesto que este se "añade" al ejecutable, pero, no forma parte de sus "cabeceras" (no sé si me explico, porque, aquí me pierdo un poco, tengo que reconocerlo). Pues bien, en teoría esto ha de funcionar, sin embargo, el anterior código siempre retorna "0" en Windows NT (Windows 10, por ejemplo). Como se trata un código para Delphi 3, yo lo he "sabido" modificar un poco de este modo:

Código Delphi [-]
function GetExeSize(): Int64;
var
  P: pchar;
  I, NumSections: Integer;
begin
  Result := 0;
  P := pointer(HInstance);
  Inc(P, SizeOf(DWORD));
  NumSections := PImageFileHeader(P).NumberOfSections;
  Inc(P, SizeOf(TImageNtHeaders));
  for I := 1 to NumSections do
  begin
    if PImageSectionHeader(P)^.PointerToRawData > Result then
    begin
      Result := PImageSectionHeader(P)^.PointerToRawData +
                 PImageSectionHeader(P)^.SizeOfRawData;
    end;
    Inc(P, SizeOf(TImageSectionHeader));
  end;
end;

En efecto, el código modificado que muestro arriba no retorna "0", sin embargo, no tiene en cuenta el cambio del icono del ejecutable. Es decir, supongamos que el archivo ejecutable original tiene un tamaño de 100 bits. Ahora pueden darse dos casos: que el tamaño del icono a usar sea mayor o menor que el del ejecutable original: sea como sea, la función anterior retornará 100, es decir, no tendrá en cuenta que se ha cambiado el icono del ejecutable.

Como para saber la cantidad de datos a leer del archivo ejecutable se determina por la fórmula: Tamaño Actual - Tamaño Original, dicha fórmula falla, en el sentido de que, por ejemplo, si se usado un icono de menor tamaño que el original, es posible que "Tamaño Actual" sea menor que "Tamaño Original", de modo que estaríamos leyendo una cantidad de datos negativa, o sea, que no podremos leer correctamente dichos datos.

¿Qué es lo que necesito?

Tengo dudas sobre si los cambios que he introducido a la función de Angus Johnson son del todo correctos o no, de modo que esta función, o sea, la que determina el tamaño original del archivo ejecutable, la que esté causando los problemas: puesto que no tenga en cuenta el posioble cambio del icono. Hay que decir, que, si no se cambia el icono, todo funciona como se espera, pero, el cambio del icono es una opción para el usuario y no se puede simplemente eliminar.

He probado varias cosas, por ejemplo, en la función original tenemos esta línea:

Código Delphi [-]
inc(p,sizeof(TImageFileHeader)+ sizeof(TImageOptionalHeader));

Como puede verse, en la modificación que yo he hecho dicha línea se ha transformado en esta otra:

Código Delphi [-]
Inc(P, SizeOf(TImageNtHeaders));

Ahora bien, si trato de hacer lo siguiente, para tratar de ajustar más:

Código Delphi [-]
Inc(P, SizeOf(TImageNtHeaders) + SizeOf(TImageOptionalHeader));

... dicha cambio implica que la función retorne de nuevo siempre "0".

¿Otras posibles causas del problema?

Creo que el problema está determinado porque la función anterior no es capaz de tener en cuenta el cambio de icono en el archivo ejecutable. Pareciera que sigue "leyendo" el tamaño original del icono y así el resultado que ofrece está equivocado, tanto en el caso de que el icono a cambiar sea mayor o menor que el original.

Pero, por otro lado, me queda también la duda de que pueda ser, precisamente, la función encargada de cambiar el icono, la que esté causando el problema, porque, de alguna forma no "actualize" el tamaño al del nuevo "icono/recurso". Sin embargo, la función encargada de cambiar el icono, originalmente escrita por Jordan Russell para Inno Setup, funciona por lo demás correctamente.

Código Delphi [-]
procedure TExeUtils.ChangeIcon(const FileName, IcoFileName: string);

  procedure Error(const Msg: String);
  begin
    raise Exception.Create('Resource update error: ' + Msg);
  end;

  procedure ErrorWithLastError(const Msg: String);
  begin
    Error(Msg + ' (' + IntToStr(GetLastError) + ')');
  end;

  function EnumLangsFunc(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): BOOL; stdcall;
  begin
    PWord(lParam)^ := wLanguage;
    Result := False;
  end;

  function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PChar; var wLanguage: Word): Boolean;
  begin
    wLanguage := 0;
    EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc, Integer(@wLanguage));
    Result := True;
  end;

type
  PIcoItemHeader = ^TIcoItemHeader;
  TIcoItemHeader = packed record
    Width: Byte;
    Height: Byte;
    Colors: Byte;
    Reserved: Byte;
    Planes: Word;
    BitCount: Word;
    ImageSize: DWORD;
  end;
  PIcoItem = ^TIcoItem;
  TIcoItem = packed record
    Header: TIcoItemHeader;
    Offset: DWORD;
  end;
  PIcoHeader = ^TIcoHeader;
  TIcoHeader = packed record
    Reserved: Word;
    Typ: Word;
    ItemCount: Word;
    Items: array [0..MaxInt shr 4 - 1] of TIcoItem;
  end;
  PGroupIconDirItem = ^TGroupIconDirItem;
  TGroupIconDirItem = packed record
    Header: TIcoItemHeader;
    Id: Word;
  end;
  PGroupIconDir = ^TGroupIconDir;
  TGroupIconDir = packed record
    Reserved: Word;
    Typ: Word;
    ItemCount: Word;
    Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;
  end;

  function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
  var
    ItemCount: Cardinal;
  begin
    Result := False;
    if Size < Cardinal(SizeOf(Word) * 3) then
      Exit;
    if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then
      Exit;
    ItemCount := PIcoHeader(P).ItemCount;
    if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then
      Exit;
    P := @PIcoHeader(P).Items;
    while ItemCount > Cardinal(0) do begin
      if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or
         (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then
        Exit;
      Inc(PIcoItem(P));
      Dec(ItemCount);
    end;
    Result := True;
  end;

var
  H: THandle;
  M: HMODULE;
  R: HRSRC;
  Res: HGLOBAL;
  GroupIconDir, NewGroupIconDir: PGroupIconDir;
  I: Integer;
  wLanguage: Word;
  F: TFileStream;
  Ico: PIcoHeader;
  N: Cardinal;
  NewGroupIconDirSize: LongInt;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    Error('Only supported on Windows NT and above');

  Ico := nil;

  try
    { Load the icons }
    F := TFileStream.Create( IcoFileName, fmOpenRead or fmShareDenyWrite );
    try
      N := F.Size;
      if Cardinal(N) > Cardinal($100000) then  { sanity check }
        Error('Icon file is too large');
      GetMem(Ico, N);
      F.ReadBuffer(Ico^, N);
    finally
      F.Free;
    end;

    { Ensure the icon is valid }
    if not IsValidIcon(Ico, N) then
      Error('Icon file is invalid');

    { Update the resources }
    H := BeginUpdateResource(PChar(FileName), False);
    if H = 0 then
      ErrorWithLastError('BeginUpdateResource failed (1)');
    try
      M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
      if M = 0 then
        ErrorWithLastError('LoadLibraryEx failed (1)');
      try
        { Load the 'MAINICON' group icon resource }
        R := FindResource(M, 'MAINICON', RT_GROUP_ICON);
        if R = 0 then
          ErrorWithLastError('FindResource failed (1)');
        Res := LoadResource(M, R);
        if Res = 0 then
          ErrorWithLastError('LoadResource failed (1)');
        GroupIconDir := LockResource(Res);
        if GroupIconDir = nil then
          ErrorWithLastError('LockResource failed (1)');

        { Delete 'MAINICON' }
        if not GetResourceLanguage(M, RT_GROUP_ICON, 'MAINICON', wLanguage) then
          Error('GetResourceLanguage failed (1)');
        if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then
          ErrorWithLastError('UpdateResource failed (1)');

        { Delete the RT_ICON icon resources that belonged to 'MAINICON' }
        for I := 0 to GroupIconDir.ItemCount-1 do begin
          if not GetResourceLanguage(M, RT_ICON, MakeIntResource(GroupIconDir.Items[i].Id), wLanguage) then
            Error('GetResourceLanguage failed (2)');
          if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[i].Id), wLanguage, nil, 0) then
            ErrorWithLastError('UpdateResource failed (2)');
        end;

        { Build the new group icon resource }
        NewGroupIconDirSize := 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
        GetMem(NewGroupIconDir, NewGroupIconDirSize);
        try
          { Build the new group icon resource }
          NewGroupIconDir.Reserved := GroupIconDir.Reserved;
          NewGroupIconDir.Typ := GroupIconDir.Typ;
          NewGroupIconDir.ItemCount := Ico.ItemCount;
          for I := 0 to NewGroupIconDir.ItemCount-1 do begin
            NewGroupIconDir.Items[i].Header := Ico.Items[i].Header;
            NewGroupIconDir.Items[i].Id := I+1; //assumes that there aren't any icons left
          end;

          { Update 'MAINICON' }
          for I := 0 to NewGroupIconDir.ItemCount-1 do
            if not UpdateResource(H, RT_ICON, MakeIntResource(NewGroupIconDir.Items[i].Id), 1033, Pointer(DWORD(Ico) + Ico.Items[i].Offset), Ico.Items[i].Header.ImageSize) then
              ErrorWithLastError('UpdateResource failed (3)');

          { Update the icons }
          if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
            ErrorWithLastError('UpdateResource failed (4)');
        finally
          FreeMem(NewGroupIconDir);
        end;
      finally
        FreeLibrary(M);
      end;
    except
      EndUpdateResource(H, True);  { discard changes }
      raise;
    end;
    if not EndUpdateResource(H, False) then
      ErrorWithLastError('EndUpdateResource failed');
  finally
    FreeMem(Ico);
  end;
end;

¿Alguna conclusión?

Quiero pensar que, puesto que estoy tratando de traducir un código escrito en Delphi 3, que, además no comprendo muy bien, la función problemática no es la encargada de cambiar el icono, sino "GetExeSize", que, no consigue determinar bien el tamaño original del archivo ejecutable, es decir, no tiene en cuenta el posible cambio del icono.

Pero la verdad es que no puedo concluir que ahí esté el problema... y por eso necesito de vuestra ayuda, puesto que tal vez alguno de vosotros esté más puesto que yo en estos asuntos y pueda ofrecer algo de luz al respecto. Por favor, si necesitáis cualquier otra información que se me haya olvidado, decídmelo y trataré de proporcionarla.

¡Muchas gracias a tod@s!
__________________
David Esperalta
www.decsoftutils.com

Última edición por dec fecha: 28-02-2017 a las 10:45:51.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
determinar el tamaño de una fichero lmpadron C++ Builder 5 14-11-2011 23:04:27
Determinar el tamaño óptimo de un datafile SMTZ Oracle 2 03-02-2007 13:04:45
Form Vuelve al Tamaño original Enan0 Varios 5 15-08-2006 18:53:14
como achicar el tamaño de mi Ejecutable Patricio Varios 2 22-11-2005 13:48:45
Como determinar el tamaño de una base de dato ? Raptor Varios 4 06-08-2004 02:17:56


La franja horaria es GMT +2. Ahora son las 05:38:36.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi