reg.bas

来自「网络编程]拨号上网密码查看器」· BAS 代码 · 共 69 行

Attribute VB_Name = "Module1"
Option Explicit
Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal Reserved As String, _
                                    ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, _
                                    lpcEntries As Long) As Long

Declare Function WNetEnumCachedPasswords Lib "mpr.dll" (ByVal s As String, ByVal i As Integer, _
                                         ByVal b As Byte, ByVal proc As Long, ByVal l As Long) As Long

Const RAS95_MaxEntryName = 256
Type RASENTRYNAME95
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type

Type PASSWORD_CACHE_ENTRY
    cbEntry As Integer
    cbResource As Integer
    cbPassword As Integer
    iEntry As Byte
    nType As Byte
    abResource(1 To 1024) As Byte
End Type

Public Function callback(X As PASSWORD_CACHE_ENTRY, ByVal lSomething As Long) As Integer
    Dim nLoop As Integer, StartPos As Integer
    Dim cString, Resource, ResType, Password As String
    
    For nLoop = 1 To X.cbResource
        If X.abResource(nLoop) <> 0 Then
            cString = cString & Chr(X.abResource(nLoop))
        Else
            cString = cString & " "
        End If
    Next
    
    Resource = cString
    cString = ""
    
    For nLoop = X.cbResource + 1 To (X.cbResource + X.cbPassword)
        If X.abResource(nLoop) <> 0 Then
            cString = cString & Chr(X.abResource(nLoop))
        Else
            cString = cString & " "
        End If
    Next
    
    Password = cString
    cString = ""
    If InStr(1, Resource, Form1.List1.Text) Then
        Form1.TxtPassWord.Text = Password
        StartPos = InStr(6, Resource, "\")
        Form1.TxtUserName.Text = Mid(Resource, StartPos + 1)
    End If
    callback = True
End Function

Public Sub GetPasswords()
    Dim nLoop As Integer
    Dim cString As String
    Dim lLong As Long
    Dim bByte As Byte
    bByte = &HFF
    nLoop = 0
    lLong = 0
    cString = ""
    Call WNetEnumCachedPasswords(cString, nLoop, bByte, AddressOf callback, lLong)
End Sub