Permite copiar la informacion de un ejecutable a otro.
//******************************************************************************
//* 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.