This site uses cookies own and third. If you continue to browse consider to accept the use of cookies. OK More Info.

CloneFileInfoA [UNIT] [Fakedo0r]

  • 0 Replies
  • 2245 Views

0 Members and 1 Guest are viewing this topic.

Fakedo0r

  • *
  • Guest

CloneFileInfoA [UNIT] [Fakedo0r]

  • on: April 19, 2012, 05:06:29 pm
Permite copiar la informacion de un ejecutable a otro.

Code: (delphi) You are not allowed to view links. Register or Login
//******************************************************************************
//* 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.
« Last Edit: April 21, 2013, 01:03:04 pm by Expermicid »