如何取得預設連線PPPOE撥接帳號
<< VB.Net >> 寫法 1
' 匯入名稱空間
Imports System
Imports System.Text
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Button1_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button1.Click
Dim ras As New RAS_API
MessageBox.Show(ras.GetDefDialAcc) ' 取得預設撥接帳號
End Sub
End Class
Public Class RAS_API
' API 宣告
Private Declare Function RasGetEntryDialParamsA Lib "RasAPI32.dll" _
(ByVal PB As String, ByRef DialPara As Byte, ByRef Pswd As Integer) As Integer
' 由登錄檔取得預設連線名稱
Public Function GetDefDialAcc() As String
Dim k As String = "Software\Microsoft\RAS AutoDial\Default"
GetDefDialAcc = Registry.LocalMachine.OpenSubKey(k).GetValue("DefaultInternet")
Return IIf(GetDefDialAcc.Length > 0, GetDialAcc(GetDefDialAcc), "")
End Function
' 根據預設連線取得撥接帳號名稱
Public Function GetDialAcc(ByVal Entry As String) As String
GetDialAcc = ""
Dim b(1060) As Byte
CpMm(1060, b, 0, 4)
CpMm(Encoding.Default.GetBytes(Entry), b, 4, 256)
If RasGetEntryDialParamsA(vbNullString, b(0), 1) = 0 Then
Return Encoding.Default.GetString(b, 519, 257).TrimEnd(Chr(0))
End If
End Function
' CopyMemory
Private Sub CpMm(ByRef s As Object, ByRef d As Object, ByVal b As Integer, ByVal l As Integer)
Marshal.Copy(GCHandle.Alloc(s, GCHandleType.Pinned).AddrOfPinnedObject, d, b, l)
End Sub
End Class
' ================================================================
<< VB.Net >> 寫法 2
' 匯入名稱空間
Imports System
Imports System.Text
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Public Class Form2
Private Sub Button1_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button1.Click
Dim r As New RAS
MessageBox.Show(r.GetDefDialAcc) ' 取得預設撥接帳號
End Sub
End Class
Public Class RAS
' 宣告結構
<StructLayout(LayoutKind.Sequential)> _
Public Structure RasDialParas
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> Public EntryName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> Public PhoneNumber As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> Public CallbackNumber As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> Public UserName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> Public Password As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=16)> Public Domain As String
Public dwSubEntry As UInt32
Public dwCallbackId As IntPtr
End Structure
' API 宣告
Private Declare Function RasGetEntryDialParamsA Lib "RasAPI32.dll" _
(ByVal Phonebook As String, ByRef RasDialPara As RasDialParas, ByRef PswdR As Integer) As Integer
' 由登錄檔取得預設連線名稱
Public Function GetDefDialAcc() As String
Dim k As String = "Software\Microsoft\RAS AutoDial\Default"
GetDefDialAcc = Registry.LocalMachine.OpenSubKey(k).GetValue("DefaultInternet")
Return IIf(GetDefDialAcc.Length > 0, GetDialAcc(GetDefDialAcc), "")
End Function
' 根據預設連線取得撥接帳號名稱
Public Function GetDialAcc(ByVal Entry As String) As String
GetDialAcc = ""
Dim rdp As New RasDialParas
rdp.dwSize = 1060
rdp.EntryName = Entry & New String(Chr(0), 257 - Entry.Length)
If RasGetEntryDialParamsA(vbNullString, rdp, 1) = 0 Then Return rdp.UserName
End Function
End Class
' ================================================================
<< VB6 >> 寫法 1
' API 宣告
Private Declare Function RasGetEntryDialParamsA Lib "RasAPI32.dll" _
(ByVal Phonebook As String, RasDialPara As Byte, _
PswdRet As Long) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Command1_Click()
MsgBox GetDefDialAcc ' 取得預設撥接帳號
End Sub
' 由登錄檔取得預設連線名稱
Private Function GetDefDialAcc() As String
Dim k As String
k = "HKLM\SOFTWARE\Microsoft\RAS AutoDial\Default\DefaultInternet"
GetDefDialAcc = CreateObject("WScript.Shell").RegRead(k)
If GetDefDialAcc <> "" Then GetDefDialAcc = GetDialAcc(GetDefDialAcc)
End Function
' 根據預設連線取得撥接帳號名稱
Private Function GetDialAcc(Entry As String) As String
Dim bytAry(1059) As Byte
RtlMoveMemory bytAry(0), 1060&, 4&
Str2Byt bytAry(4), Entry, 256
If RasGetEntryDialParamsA(vbNullString, bytAry(0), 0&) = 0 Then
Byt2Str GetDialAcc, bytAry(519), 257
End If
End Function
' 位元陣列轉字串
Private Sub Byt2Str(ByRef C2S As String, ByRef Byt As Byte, ByRef MxL As Long)
C2S = String(MxL + 1, 0)
RtlMoveMemory ByVal C2S, Byt, MxL
C2S = Left(C2S, InStr(C2S, Chr(0)) - 1)
End Sub
' 字串轉位元陣列
Private Sub Str2Byt(ByRef Byt As Byte, ByRef S2C As String, ByRef MxL As Long)
Dim lngLen As Long
lngLen = Len(S2C)
If lngLen > 0 Then RtlMoveMemory Byt, ByVal S2C, IIf(lngLen > MxL, MxL, lngLen)
End Sub
' ================================================================
<< VB6 >> 寫法 2
' 宣告自訂型態
Private Type RasDialPara
dwSize As Long
EntryName(256) As Byte
PhoneNumber(128) As Byte
CallbackNumber(128) As Byte
UserName(256) As Byte
Password(256) As Byte
Domain(12) As Byte
End Type
' API 宣告
Private Declare Function RasGetEntryDialParamsA Lib "rasapi32.dll" _
(ByVal Phonebook As String, ByRef RasDialPara As RasDialPara, _
ByRef PswdRet As Long) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Command1_Click()
MsgBox GetDefDialAcc ' 取得預設撥接帳號
End Sub
' 由登錄檔取得預設連線名稱
Private Function GetDefDialAcc() As String
Dim k As String
k = "HKLM\SOFTWARE\Microsoft\RAS AutoDial\Default\DefaultInternet"
GetDefDialAcc = CreateObject("WScript.Shell").RegRead(k)
If GetDefDialAcc <> "" Then GetDefDialAcc = GetDialAcc(GetDefDialAcc)
End Function
' 根據預設連線取得撥接帳號名稱
Private Function GetDialAcc(Entry As String) As String
Dim EntryName(256) As Byte
Dim rdp As RasDialPara
rdp.dwSize = 1060
Str2Byt rdp.EntryName(0), Entry, Len(Entry)
If RasGetEntryDialParamsA(vbNullString, rdp, 0) = 0 Then
GetDialAcc = Chg2Unicode(rdp.UserName)
End If
End Function
' 位元陣列轉字串
Private Function Chg2Unicode(byt() As Byte) As String
Chg2Unicode = StrConv(byt, vbUnicode)
Chg2Unicode = Left(Chg2Unicode, InStr(Chg2Unicode, Chr(0)) - 1)
End Function
' 字串轉位元陣列
Private Sub Str2Byt(ByRef byt As Byte, ByRef S2C As String, ByRef MxL As Long)
Dim lngLen As Long
lngLen = Len(S2C)
If lngLen > 0 Then RtlMoveMemory byt, ByVal S2C, IIf(lngLen > MxL, MxL, lngLen)
End Sub