Const RAS95_MaxEntryName = 256
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private 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
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim s As Long, l As Long, ln As Long, a$
ReDim R(255) As RASENTRYNAME95
Me.AutoRedraw = True
R(0).dwSize = Len(R(0))
s = 256 * R(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, R(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(R(l).szEntryName(), vbUnicode)
Me.Print Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If ln = 0 Then
Me.Print "No Dial-Up connections found!"
End If
End Sub
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private 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
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim s As Long, l As Long, ln As Long, a$
ReDim R(255) As RASENTRYNAME95
Me.AutoRedraw = True
R(0).dwSize = Len(R(0))
s = 256 * R(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, R(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(R(l).szEntryName(), vbUnicode)
Me.Print Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If ln = 0 Then
Me.Print "No Dial-Up connections found!"
End If
End Sub
解决方案 »
- vb操作access速度慢!!不同的数据量一样的慢
- 如何用GDI+创建多边形窗体
- 关于vbscribe网页中“对象不支持此属性或方法”的问题
- 我又来了,接着上一个问题。如何得到除文件名以外的所有字符(盘符和路径)?
- 怎样用vb代码在TextBox文本框中的光标处插入字符串?
- {问!!!』如何让一个EXE程序在运行时把自己扶植到指定的地方?回帖有分!!
- 求VB合并WORD文档?
- SQL数据库用Select语句导出为文本文件!急!!!!
- 程序用wise打包,安装完成后无法运行,出现"方法'~'作用于对象'~'失败",是怎么回事啊
- ******出"大洋"急寻VB编程高手!!!!! 高手请进!!!!1!!
- vb中生成excel报表,打开马上内存溢出,退出程序!
- ************ 阿甘大哥及熟悉API的大哥请进 ***************
'the stored user name and password or the ones you specifies
'(It use RasDial for dialing)'You need a form with a list,2 textbox and a command buttonOption Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumberConst UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_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 TypePrivate Type RASENTRYNAME95
'set dwsize to 264
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End TypePrivate Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private 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
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As LongPrivate Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
Dim rp As RASDIALPARAMS, h As Long, resp As Long
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain 'Domain stored for the connection
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
Dial = (resp = 0)
End FunctionPrivate Function ChangeToStringUni(Bytes() As Byte) As String
'Changes an byte array to a Visual Basic unicode string
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End FunctionPrivate Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Changes a Visual Basic unicode string to an byte array
'Returns True if it truncates str
Dim lenBs As Long 'length of the byte array
Dim lenStr As Long 'length of the string
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs 'Queda truncado
ChangeBytes = True
End If
End FunctionPrivate Sub Command1_Click()
Dial List1.Text, Text1, Text2
End Sub
Private Sub List1_Click()
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes List1.Text, rdp.szEntryName
'Get User name and password for the connection
t = RasGetEntryDialParams(List1.Text, rdp, 0)
If t = 0 Then
Text1 = ChangeToStringUni(rdp.szUserName)
Text2 = ChangeToStringUni(rdp.szPassword)
End If
End SubPrivate Sub Form_Load()
'example created by Daniel Kaufmann ([email protected])
'load the connections
Text2.PasswordChar = "*"
Command1.Caption = "Dial"
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
List1_Click
End If
End Sub
最后,再一次感谢。