CloneFileInfoA [UNIT] [Fakedo0r]

Iniciado por Fakedo0r, Abril 19, 2012, 05:06:29 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Abril 19, 2012, 05:06:29 PM Ultima modificación: Abril 21, 2013, 01:03:04 PM por Expermicid
Permite copiar la informacion de un ejecutable a otro.

Código: delphi

//******************************************************************************
//* UNIT:         UNT_CloneFileInfo
//* AUTOR:        Fakedo0r
//* FECHA:        10.04.2012
//* CORREO:       [email protected]
//* BLOG:         Sub-Soul.blogspot.com
//* REFERENCIA:   MSDN
//* USO:          CloneFileInfoA('Ruta\Origen.exe', 'Ruta\Destino.exe');
//******************************************************************************
unit UNT_CloneFileInfo;
//******************************************************************************
//DECLARACION DE LIBRERIAS / CLASES
//******************************************************************************
interface

uses
  Windows, Messages, Dialogs, SysUtils, ShlObj;
//******************************************************************************
//DECLARACION DE FUNCIONES / METODOS
//******************************************************************************
function CloneFileInfoA(sSource: String; sDestin: String): Bool;
//******************************************************************************
implementation
//******************************************************************************
//<--- CLONA LA INFORMACION DEL EJECUTABLE --->
//******************************************************************************
function CloneFileInfoA(sSource: String; sDestin: String): Bool;
var
  dwRes:        DWORD;
  dwFile:       DWORD;
  dwSize:       DWORD;
  dwLangID:     DWORD;
  dwSrcSize:    DWORD;
  dwDestSize:   DWORD;
  bSrcData:     TBytes;
  bDestData:    TBytes;
  ptrBuffer:    Pointer;
begin
  Result := True;
  dwRes:= 0;
  dwLangID := 0;
  dwSrcSize := 0;
  dwDestSize := 0;

  dwSrcSize := GetFileVersionInfoSize(PChar(sSource), dwFile);

  if dwSrcSize = 0 then
  begin
    Result := False;
    Exit;
  end;

  SetLength(bSrcData, dwSrcSize);
  GetFileVersionInfo(PChar(sSource), dwFile, dwSrcSize, @bSrcData[0]);

  dwDestSize := GetFileVersionInfoSize(PChar(sSource), dwFile);

  if dwDestSize = 0 then
  begin
    Result := False;
    Exit;
  end;

  SetLength(bDestData, dwDestSize);
  GetFileVersionInfo(PChar(sDestin), dwFile, dwDestSize, @bDestData[0]);

  VerQueryValue(@bDestData[0], PChar('\VarFileInfo\Translation'), ptrBuffer, dwSize);
  dwRes := BeginUpdateResource(PChar(sDestin), False);

  CopyMemory(@dwLangID, ptrBuffer, 2);
  UpdateResource(dwRes, RT_VERSION, PChar(VS_VERSION_INFO), dwLangID, @bSrcData[0], dwSrcSize);
  EndUpdateResource(dwRes, False);
end;

end.


Saludo.