ダイヤルアップの情報を表示するサンプル(VB6)

＜このサンプルの概要＞
ダイヤルアップのパスワードを表示する方法を探してRasapi32.dllのRasGetEntryDialParamsを使用
する方法は？と思い試してみました。結論は、未確認ですがWin95、98、Me、NT4.0では表示出来る
ようです。WinXPではパスワードが16個のアスタリスクになってしまい表示出来ませんでした。
WinXPでもパスワード以外のダイヤルアップ情報は取得出来るようです。

このサンプルでは使用していませんが、Winows2000やWindowsXPのダイヤルアップのパスワード
を表示するためには、Advapi32.dllを使用する必要があるようです。

ダイヤルアップ以外のパスワードを表示するサンプルは以下のURLです。
PasswordChar(*)に隠れた実際のパスワードを表示するサンプル(VB.NET)

また、関連ツールがありますのでご紹介します。
パスワード表示＆管理ツールはダイヤルアップのパスワードも表示するツールです。
使用方法は パスワードを表示する方法 ダイヤルアップのパスワードを表示する方法です。

Option Explicit

' RASENTRYNAME構造体とRASDIALPARAMS構造体メンバの長さの定義
Private Const RAS_MaxEntryName = 256
Private Const RAS_MaxPhoneNumber = 128
Private Const RAS_MaxCallbackNumber = 128
Private Const UNLEN = 256
Private Const PWLEN = 256
Private Const DNLEN = 12

' RASENTRYNAME構造体の定義
Private Type RASENTRYNAME
   dwSize As Long
   szEntryName(RAS_MaxEntryName + 3) As Byte
End Type

' RASDIALPARAMS構造体の定義
Private Type RASDIALPARAMS
   dwSize As Long
   szEntryName(RAS_MaxEntryName) As Byte
   szPhoneNumber(RAS_MaxPhoneNumber) As Byte
   szCallbackNumber(RAS_MaxCallbackNumber) As Byte
   szUserName(UNLEN) As Byte
   szPassword(PWLEN) As Byte
   szDomain(DNLEN) As Byte
End Type

' APIの定義
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal Reserved As Long, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long

Private Sub Form_Load()
    Dim lngRtn As Long
    
    ' ダイヤルアップの全エントリを取得
    Dim EntryCnt As Long
    Dim Entry(255) As RASENTRYNAME
    Entry(0).dwSize = 264
    lngRtn = RasEnumEntries(0, vbNullString, Entry(0), Entry(0).dwSize * 255, EntryCnt)
    Dim i As Long
    For i = 0 To EntryCnt - 1
        ' ダイヤルアップの各エントリ毎の処理
        ' ダイヤルアップの各エントリ名を取得
        Dim entryName As String
        entryName = StrConv(Entry(i).szEntryName, vbUnicode)
        entryName = StripNulls(entryName)
        
        ' ダイヤルアップの各エントリのパラメタを取得
        Dim rasPara As RASDIALPARAMS
        rasPara.dwSize = 1052
        Dim j As Long
        For j = 0 To RAS_MaxEntryName - 1
            rasPara.szEntryName(j) = Entry(i).szEntryName(j)
        Next j
        lngRtn = RasGetEntryDialParams(vbNullString, rasPara, 0)
    
        ' ダイヤルアップの各エントリのユーザ名を取得
        Dim userName As String
        userName = StrConv(rasPara.szUserName, vbUnicode)
        userName = StripNulls(userName)
        
        ' ダイヤルアップの各エントリのパスワードを取得
        Dim passwd As String
        passwd = StrConv(rasPara.szPassword, vbUnicode)
        passwd = StripNulls(passwd)
        
        Debug.Print (i + 1) & ":" & entryName & ":" & userName & ":" & passwd
        ' [WinXPでの実行結果]
        ' 1:test:usertest:****************
        ' 2:あああ:aaa:****************
        ' 3:ABC:userabc:****************
        ' [考察]この方法ではWin95、98、Me、NT4.0までしかパスワードが確認出来ないようです。(未確認)
    Next i
End Sub

Public Function StripNulls(ByVal strOrg As String) As String
    On Error Resume Next
    If (InStr(strOrg, Chr(0)) > 0) Then
        strOrg = Left(strOrg, InStr(strOrg, Chr(0)) - 1)
    End If
    StripNulls = strOrg
End Function