搜索
编程论坛 → 开发语言 → 『 VB6论坛 』 → 谁能帮我一下
标题：谁能帮我一下
只看楼主
快乐猫咪
Rank: 1
等　级：新手上路
帖　子：8
专家分：0
注　册：2012-6-18
结帖率：0
楼主
 已结贴√  问题点数：10 回复次数：4 
谁能帮我一下
谁能帮我设计一下.zip (1.77 KB)
2013-06-13 17:09
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等　级：贵宾
威　望：364
帖　子：4912
专家分：29900
注　册：2008-10-15
第 2 楼
 得分:10 
你去研究一下 Ras  吧。
我手头上的 RASAPI.BAS 文件，我自己改过了， 不适用外发。

授人于鱼，不如授人于渔
早已停用QQ了
2013-06-13 18:05
快乐猫咪
Rank: 1
等　级：新手上路
帖　子：8
专家分：0
注　册：2012-6-18
第 3 楼
 得分:0 
谁能帮我设计一下.zip (3.55 KB)
我把模块加进去了，可要怎么进行调用呢？是这样吗？
2013-06-14 09:03
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等　级：贵宾
威　望：364
帖　子：4912
专家分：29900
注　册：2008-10-15
第 4 楼
 得分:0 
显示宽带连接的名字
    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)
        Combo1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
    Next
    If Combo1.ListCount > 0 Then
        Combo1.ListIndex = 0
    End If

拨号
Dial_PPP_Connection(宽带连接的名称)

断线
Disconnect_PPP_Connection(宽带连接的名称)

以下是 RasAPI.bas 的文件内容。
程序代码：
Option Explicit

Private Const RASDT_TYPE_Modem = "modem"
Private Const RASDT_TYPE_Isdn = "isdn"
Private Const RASDT_TYPE_X25 = "x25"
Private Const RASDT_TYPE_Vpn = "vpn"
Private Const RASDT_TYPE_Pad = "pad"
Private Const RASDT_TYPE_Generic = "GENERIC"
Private Const RASDT_TYPE_Serial = "SERIAL"
Private Const RASDT_TYPE_FrameRelay = "FRAMERELAY"
Private Const RASDT_TYPE_Atm = "ATM"
Private Const RASDT_TYPE_Sonet = "SONET"
Private Const RASDT_TYPE_SW56 = "SW56"
Private Const RASDT_TYPE_Irda = "IRDA"
Private Const RASDT_TYPE_Parallel = "PARALLEL"
Private Const RASDT_TYPE_PPPoE = "PPPoE"

Public Enum RASDT_TYPE
    RASDT_Modem = 0
    RASDT_Isdn = 1
    RASDT_X25 = 2
    RASDT_Vpn = 3
    RASDT_Pad = 4
    RASDT_Generic = 5
    RASDT_Serial = 6
    RASDT_FrameRelay = 7
    RASDT_Atm = 8
    RASDT_Sonet = 9
    RASDT_SW56 = 10
    RASDT_Irda = 11
    RASDT_Parallel = 12
    RASDT_PPPoE = 13
End Enum

Private Const IS_TEXT_UNICODE_ASCII16 = &H1
Private Const IS_TEXT_UNICODE_REVERSE_ASCII16 = &H10
Private Const CP_ACP = 0  '  default to ANSI code page
Private Const ERROR_SUCCESS = 0&
Private Const RASP_Amb = &H10000
Private Const RASP_PppNbf = &H803F&
Private Const RASP_PppIpx = &H802B&
Private Const RASP_PppIp = &H8021&
Private Const RASP_PppLcp = &HC021&
Private Const RASP_Slip = &H20000
Private Const RASIDS_Disabled = &HFFFFFFFF
Private Const RDEOPT_PausedStates = &H2
Private Const WM_RASDIALEVENT = &HCCCD&

'RASCONNSTATE enum
Public Const RASCS_PAUSED = &H1000&
Public Const RASCS_DONE = &H2000&
'begin enum
Public Const RASCS_OpenPort = 0&
Public Const RASCS_PortOpened = 1&
Public Const RASCS_ConnectDevice = 2&
Public Const RASCS_DeviceConnected = 3&
Public Const RASCS_AllDevicesConnected = 4&
Public Const RASCS_Authenticate = 5&
Public Const RASCS_AuthNotify = 6&
Public Const RASCS_AuthRetry = 7&
Public Const RASCS_AuthCallback = 8&
Public Const RASCS_AuthChangePassword = 9&
Public Const RASCS_AuthProject = 10&
Public Const RASCS_AuthLinkSpeed = 11&
Public Const RASCS_AuthAck = 12&
Public Const RASCS_ReAuthenticate = 13&
Public Const RASCS_Authenticated = 14&
Public Const RASCS_PrepareForCallback = 15&
Public Const RASCS_WaitForModemReset = 16&
Public Const RASCS_WaitForCallback = 17&
Public Const RASCS_Projected = 18&
Public Const RASCS_StartAuthentication = 19&     'Windows 95 only
Public Const RASCS_CallbackComplete = 20&        'Windows 95 only
Public Const RASCS_LogonNetwork = 21&            'Windows 95 only
Public Const RASCS_Interactive = RASCS_PAUSED
Public Const RASCS_RetryAuthentication = RASCS_PAUSED + 1&
Public Const RASCS_CallbackSetByCaller = RASCS_PAUSED + 2&
Public Const RASCS_PasswordExpired = RASCS_PAUSED + 3&
Public Const RASCS_Connected = RASCS_DONE
Public Const RASCS_Disconnected = RASCS_DONE + 1&
'end enum

'**********************************
'*     RAS Error Return Codes     *
'**********************************
Public Const NOT_SUPPORTED = 120&

Public Const RASBASE = 600&
Public Const SUCCESS = 0&

Public Const PENDING = (RASBASE + 0)
Public Const ERROR_INVALID_PORT_HANDLE = (RASBASE + 1)
Public Const ERROR_PORT_ALREADY_OPEN = (RASBASE + 2)
Public Const ERROR_BUFFER_TOO_SMALL = (RASBASE + 3)
Public Const ERROR_WRONG_INFO_SPECIFIED = (RASBASE + 4)
Public Const ERROR_CANNOT_SET_PORT_INFO = (RASBASE + 5)
Public Const ERROR_PORT_NOT_CONNECTED = (RASBASE + 6)
Public Const ERROR_EVENT_INVALID = (RASBASE + 7)
Public Const ERROR_DEVICE_DOES_NOT_EXIST = (RASBASE + 8)
Public Const ERROR_DEVICETYPE_DOES_NOT_EXIST = (RASBASE + 9)
Public Const ERROR_BUFFER_INVALID = (RASBASE + 10)
Public Const ERROR_ROUTE_NOT_AVAILABLE = (RASBASE + 11)
Public Const ERROR_ROUTE_NOT_ALLOCATED = (RASBASE + 12)
Public Const ERROR_INVALID_COMPRESSION_SPECIFIED = (RASBASE + 13)
Public Const ERROR_OUT_OF_BUFFERS = (RASBASE + 14)
Public Const ERROR_PORT_NOT_FOUND = (RASBASE + 15)
Public Const ERROR_ASYNC_REQUEST_PENDING = (RASBASE + 16)
Public Const ERROR_ALREADY_DISCONNECTING = (RASBASE + 17)
Public Const ERROR_PORT_NOT_OPEN = (RASBASE + 18)
Public Const ERROR_PORT_DISCONNECTED = (RASBASE + 19)
Public Const ERROR_NO_ENDPOINTS = (RASBASE + 20)
Public Const ERROR_CANNOT_OPEN_PHONEBOOK = (RASBASE + 21)
Public Const ERROR_CANNOT_LOAD_PHONEBOOK = (RASBASE + 22)
Public Const ERROR_CANNOT_FIND_PHONEBOOK_ENTRY = (RASBASE + 23)
Public Const ERROR_CANNOT_WRITE_PHONEBOOK = (RASBASE + 24)
Public Const ERROR_CORRUPT_PHONEBOOK = (RASBASE + 25)
Public Const ERROR_CANNOT_LOAD_STRING = (RASBASE + 26)
Public Const ERROR_KEY_NOT_FOUND = (RASBASE + 27)
Public Const ERROR_DISCONNECTION = (RASBASE + 28)
Public Const ERROR_REMOTE_DISCONNECTION = (RASBASE + 29)
Public Const ERROR_HARDWARE_FAILURE = (RASBASE + 30)
Public Const ERROR_USER_DISCONNECTION = (RASBASE + 31)
Public Const ERROR_INVALID_SIZE = (RASBASE + 32)
Public Const ERROR_PORT_NOT_AVAILABLE = (RASBASE + 33)
Public Const ERROR_CANNOT_PROJECT_CLIENT = (RASBASE + 34)
Public Const ERROR_UNKNOWN = (RASBASE + 35)
Public Const ERROR_WRONG_DEVICE_ATTACHED = (RASBASE + 36)
Public Const ERROR_BAD_STRING = (RASBASE + 37)
Public Const ERROR_REQUEST_TIMEOUT = (RASBASE + 38)
Public Const ERROR_CANNOT_GET_LANA = (RASBASE + 39)
Public Const ERROR_NETBIOS_ERROR = (RASBASE + 40)
Public Const ERROR_SERVER_OUT_OF_RESOURCES = (RASBASE + 41)
Public Const ERROR_NAME_EXISTS_ON_NET = (RASBASE + 42)
Public Const ERROR_SERVER_GENERAL_NET_FAILURE = (RASBASE + 43)
Public Const WARNING_MSG_ALIAS_NOT_ADDED = (RASBASE + 44)
Public Const ERROR_AUTH_INTERNAL = (RASBASE + 45)
Public Const ERROR_RESTRICTED_LOGON_HOURS = (RASBASE + 46)
Public Const ERROR_ACCT_DISABLED = (RASBASE + 47)
Public Const ERROR_PASSWD_EXPIRED = (RASBASE + 48)
Public Const ERROR_NO_DIALIN_PERMISSION = (RASBASE + 49)
Public Const ERROR_SERVER_NOT_RESPONDING = (RASBASE + 50)
Public Const ERROR_FROM_DEVICE = (RASBASE + 51)
Public Const ERROR_UNRECOGNIZED_RESPONSE = (RASBASE + 52)
Public Const ERROR_MACRO_NOT_FOUND = (RASBASE + 53)
Public Const ERROR_MACRO_NOT_DEFINED = (RASBASE + 54)
Public Const ERROR_MESSAGE_MACRO_NOT_FOUND = (RASBASE + 55)
Public Const ERROR_DEFAULTOFF_MACRO_NOT_FOUND = (RASBASE + 56)
Public Const ERROR_FILE_COULD_NOT_BE_OPENED = (RASBASE + 57)
Public Const ERROR_DEVICENAME_TOO_LONG = (RASBASE + 58)
Public Const ERROR_DEVICENAME_NOT_FOUND = (RASBASE + 59)
Public Const ERROR_NO_RESPONSES = (RASBASE + 60)
Public Const ERROR_NO_COMMAND_FOUND = (RASBASE + 61)
Public Const ERROR_WRONG_KEY_SPECIFIED = (RASBASE + 62)
Public Const ERROR_UNKNOWN_DEVICE_TYPE = (RASBASE + 63)
Public Const ERROR_ALLOCATING_MEMORY = (RASBASE + 64)
Public Const ERROR_PORT_NOT_CONFIGURED = (RASBASE + 65)
Public Const ERROR_DEVICE_NOT_READY = (RASBASE + 66)
Public Const ERROR_READING_INI_FILE = (RASBASE + 67)
Public Const ERROR_NO_CONNECTION = (RASBASE + 68)
Public Const ERROR_BAD_USAGE_IN_INI_FILE = (RASBASE + 69)
Public Const ERROR_READING_SECTIONNAME = (RASBASE + 70)
Public Const ERROR_READING_DEVICETYPE = (RASBASE + 71)
Public Const ERROR_READING_DEVICENAME = (RASBASE + 72)
Public Const ERROR_READING_USAGE = (RASBASE + 73)
Public Const ERROR_READING_MAXCONNECTBPS = (RASBASE + 74)
Public Const ERROR_READING_MAXCARRIERBPS = (RASBASE + 75)
Public Const ERROR_LINE_BUSY = (RASBASE + 76)
Public Const ERROR_VOICE_ANSWER = (RASBASE + 77)
Public Const ERROR_NO_ANSWER = (RASBASE + 78)
Public Const ERROR_NO_CARRIER = (RASBASE + 79)
Public Const ERROR_NO_DIALTONE = (RASBASE + 80)
Public Const ERROR_IN_COMMAND = (RASBASE + 81)
Public Const ERROR_WRITING_SECTIONNAME = (RASBASE + 82)
Public Const ERROR_WRITING_DEVICETYPE = (RASBASE + 83)
Public Const ERROR_WRITING_DEVICENAME = (RASBASE + 84)
Public Const ERROR_WRITING_MAXCONNECTBPS = (RASBASE + 85)
Public Const ERROR_WRITING_MAXCARRIERBPS = (RASBASE + 86)
Public Const ERROR_WRITING_USAGE = (RASBASE + 87)
Public Const ERROR_WRITING_DEFAULTOFF = (RASBASE + 88)
Public Const ERROR_READING_DEFAULTOFF = (RASBASE + 89)
Public Const ERROR_EMPTY_INI_FILE = (RASBASE + 90)
Public Const ERROR_AUTHENTICATION_FAILURE = (RASBASE + 91)
Public Const ERROR_PORT_OR_DEVICE = (RASBASE + 92)
Public Const ERROR_NOT_BINARY_MACRO = (RASBASE + 93)
Public Const ERROR_DCB_NOT_FOUND = (RASBASE + 94)
Public Const ERROR_STATE_MACHINES_NOT_STARTED = (RASBASE + 95)
Public Const ERROR_STATE_MACHINES_ALREADY_STARTED = (RASBASE + 96)
Public Const ERROR_PARTIAL_RESPONSE_LOOPING = (RASBASE + 97)
Public Const ERROR_UNKNOWN_RESPONSE_KEY = (RASBASE + 98)
Public Const ERROR_RECV_BUF_FULL = (RASBASE + 99)
Public Const ERROR_CMD_TOO_LONG = (RASBASE + 100)
Public Const ERROR_UNSUPPORTED_BPS = (RASBASE + 101)
Public Const ERROR_UNEXPECTED_RESPONSE = (RASBASE + 102)
Public Const ERROR_INTERACTIVE_MODE = (RASBASE + 103)
Public Const ERROR_BAD_CALLBACK_NUMBER = (RASBASE + 104)
Public Const ERROR_INVALID_AUTH_STATE = (RASBASE + 105)
Public Const ERROR_WRITING_INITBPS = (RASBASE + 106)
Public Const ERROR_X25_DIAGNOSTIC = (RASBASE + 107)
Public Const ERROR_ACCT_EXPIRED = (RASBASE + 108)
Public Const ERROR_CHANGING_PASSWORD = (RASBASE + 109)
Public Const ERROR_OVERRUN = (RASBASE + 110)
Public Const ERROR_RASMAN_CANNOT_INITIALIZE = (RASBASE + 111)
Public Const ERROR_BIPLEX_PORT_NOT_AVAILABLE = (RASBASE + 112)
Public Const ERROR_NO_ACTIVE_ISDN_LINES = (RASBASE + 113)
Public Const ERROR_NO_ISDN_CHANNELS_AVAILABLE = (RASBASE + 114)
Public Const ERROR_TOO_MANY_LINE_ERRORS = (RASBASE + 115)
Public Const ERROR_IP_CONFIGURATION = (RASBASE + 116)
Public Const ERROR_NO_IP_ADDRESSES = (RASBASE + 117)
Public Const ERROR_PPP_TIMEOUT = (RASBASE + 118)
Public Const ERROR_PPP_REMOTE_TERMINATED = (RASBASE + 119)
Public Const ERROR_PPP_NO_PROTOCOLS_CONFIGURED = (RASBASE + 120)
Public Const ERROR_PPP_NO_RESPONSE = (RASBASE + 121)
Public Const ERROR_PPP_INVALID_PACKET = (RASBASE + 122)
Public Const ERROR_PHONE_NUMBER_TOO_LONG = (RASBASE + 123)
Public Const ERROR_IPXCP_NO_DIALOUT_CONFIGURED = (RASBASE + 124)
Public Const ERROR_IPXCP_NO_DIALIN_CONFIGURED = (RASBASE + 125)
Public Const ERROR_IPXCP_DIALOUT_ALREADY_ACTIVE = (RASBASE + 126)
Public Const ERROR_ACCESSING_TCPCFGDLL = (RASBASE + 127)
Public Const ERROR_NO_IP_RAS_ADAPTER = (RASBASE + 128)
Public Const ERROR_SLIP_REQUIRES_IP = (RASBASE + 129)
Public Const ERROR_PROJECTION_NOT_COMPLETE = (RASBASE + 130)
Public Const ERROR_PROTOCOL_NOT_CONFIGURED = (RASBASE + 131)
Public Const ERROR_PPP_NOT_CONVERGING = (RASBASE + 132)
Public Const ERROR_PPP_CP_REJECTED = (RASBASE + 133)
Public Const ERROR_PPP_LCP_TERMINATED = (RASBASE + 134)
Public Const ERROR_PPP_REQUIRED_ADDRESS_REJECTED = (RASBASE + 135)
Public Const ERROR_PPP_NCP_TERMINATED = (RASBASE + 136)
Public Const ERROR_PPP_LOOPBACK_DETECTED = (RASBASE + 137)
Public Const ERROR_PPP_NO_ADDRESS_ASSIGNED = (RASBASE + 138)
Public Const ERROR_CANNOT_USE_LOGON_CREDENTIALS = (RASBASE + 139)
Public Const ERROR_TAPI_CONFIGURATION = (RASBASE + 140)
Public Const ERROR_NO_LOCAL_ENCRYPTION = (RASBASE + 141)
Public Const ERROR_NO_REMOTE_ENCRYPTION = (RASBASE + 142)
Public Const ERROR_REMOTE_REQUIRES_ENCRYPTION = (RASBASE + 143)
Public Const ERROR_IPXCP_NET_NUMBER_CONFLICT = (RASBASE + 144)
Public Const ERROR_INVALID_SMM = (RASBASE + 145)
Public Const ERROR_SMM_UNINITIALIZED = (RASBASE + 146)
Public Const ERROR_NO_MAC_FOR_PORT = (RASBASE + 147)
Public Const ERROR_SMM_TIMEOUT = (RASBASE + 148)
Public Const ERROR_BAD_PHONE_NUMBER = (RASBASE + 149)
Public Const ERROR_WRONG_MODULE = (RASBASE + 150)
Public Const RASBASEEND = (RASBASE + 150)

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type RASIPADDR
    a As Byte
    B As Byte
    c As Byte
    d As Byte
End Type

Private Enum RasEntryOptions
    RASEO_UseCountryAndAreaCodes = &H1
    RASEO_SpecificIpAddr = &H2
    RASEO_SpecificNameServers = &H4
    RASEO_IpHeaderCompression = &H8
    RASEO_RemoteDefaultGateway = &H10
    RASEO_DisableLcpExtensions = &H20
    RASEO_TerminalBeforeDial = &H40
    RASEO_TerminalAfterDial = &H80
    RASEO_ModemLights = &H100
    RASEO_SwCompression = &H200
    RASEO_RequireEncryptedPw = &H400
    RASEO_RequireMsEncryptedPw = &H800
    RASEO_RequireDataEncryption = &H1000
    RASEO_NetworkLogon = &H2000
    RASEO_UseLogonCredentials = &H4000
    RASEO_PromoteAlternates = &H8000
    RASEO_SecureLocalFiles = &H10000
    RASEO_RequireEAP = &H20000
    RASEO_RequirePAP = &H40000
    RASEO_RequireSPAP = &H80000
    RASEO_Custom = &H100000
    RASEO_PreviewPhoneNumber = &H200000
    RASEO_SharedPhoneNumbers = &H800000
    RASEO_PreviewUserPw = &H1000000
    RASEO_PreviewDomain = &H2000000
    RASEO_ShowDialingProgress = &H4000000
    RASEO_RequireCHAP = &H8000000
    RASEO_RequireMsCHAP = &H10000000
    RASEO_RequireMsCHAP2 = &H20000000
    RASEO_RequireW95MSCHAP = &H40000000
    RASEO_CustomScript = &H80000000
End Enum

Private Enum RASNetProtocols
    RASNP_NetBEUI = &H1
    RASNP_Ipx = &H2
    RASNP_Ip = &H4
End Enum

Private Enum RasFramingProtocols
    RASFP_Ppp = &H1
    RASFP_Slip = &H2
    RASFP_Ras = &H4
End Enum

Public Enum RasType
    RASET_Phone = 1
    RASET_Vpn = 2
    RASET_Direct = 3
    RASET_Internet = 4
    RASET_Broadband = 5
End Enum

Public Enum VpnStrategy
    VS_Default = 0
    VS_PptpOnly = 1
    VS_PptpFirst = 2
    VS_L2tpOnly = 3
    VS_L2tpFirst = 4
End Enum

Private Enum RASCredMask
    RASCM_UserName = &H1&
    RASCM_Password = &H2&
    RASCM_Domain = &H4&
    RASCM_DefaultCreds = &H8&
    RASCM_PreSharedKey = &H10&
    RASCM_ServerPreSharedKey = &H20&
    RASCM_DDMPreSharedKey = &H40&
End Enum

Private Type RASENTRY
    dwSize As Long
    dwfOptions As RasEntryOptions
    dwCountryID As Long
    dwCountryCode As Long
    szAreaCode(10) As Byte
    szLocalPhoneNumber(128) As Byte
    dwAlternateOffset As Long
    ipaddr As RASIPADDR
    ipaddrDns As RASIPADDR
    ipaddrDnsAlt As RASIPADDR
    ipaddrWins As RASIPADDR
    ipaddrWinsAlt As RASIPADDR
    dwFrameSize As Long
    dwfNetProtocols As RASNetProtocols
    dwFramingProtocol As RasFramingProtocols
    szScript(259) As Byte
    szAutodialDll(259) As Byte
    szAutodialFunc(259) As Byte
    szDeviceType(16) As Byte
    szDeviceName(128) As Byte
    szX25PadType(32) As Byte
    szX25Address(200) As Byte
    szX25Facilities(200) As Byte
    szX25UserData(200) As Byte
    dwChannels As Long
    dwReserved1 As Long
    dwReserved2 As Long
    dwSubEntries As Long
    dwDialMode As Long
    dwDialExtraPercent As Long
    dwDialExtraSampleSeconds As Long
    dwHangUpExtraPercent As Long
    dwHangUpExtraSampleSeconds As Long
    dwIdleDisconnectSeconds As Long
    dwType As RasType
    dwEncryptionType As Long
    dwCustomAuthKey As Long
    guidId As GUID
    szCustomDialDll(259) As Byte
    dwVpnStrategy As Long
    dwfOptions2 As Long
    dwfOptions3 As Long
    szDnsSuffix(255) As Byte
    dwTcpWindowSize As Long
    szPrerequisitePbk(259) As Byte
    szPrerequisiteEntry(256) As Byte
    dwRedialCount As Long
    dwRedialPause As Long
End Type

Private Type RASCREDENTIALS
    dwSize As Long
    dwMask As RASCredMask
    szUserName(256) As Byte
    szPassword(256) As Byte
    szDomain(15) As Byte
End Type

Private Type RASDIALEXTENSIONS
    'set dwsize to 16
    dwSize As Long
    dwfOptions As Long
    hwndParent As Long
    Reserved As Long
End Type

Private Type RASDIALPARAMS
    'set dwsize to 736 unless winver >= 400 then set to 1052
    dwSize As Long
    szEntryName(20) As Byte
    szPhoneNumber(128) As Byte
    szCallbackNumber(128) As Byte
    szUserName(256) As Byte
    szPassword(256) As Byte
    szDomain(15) As Byte
End Type

Private Type RASCONN
    'set dwsize to 32
    dwSize As Long
    hRasConn As Long
    szEntryName(20) As Byte
End Type

Private Type RAS_STATS
    dwSize As Long
    dwBytesXmited As Long
    dwBytesRcved As Long
    dwFramesXmited As Long
    dwFramesRcved As Long
    dwCrcErr As Long
    dwTimeoutErr As Long
    dwAlignmentErr As Long
    dwHardwareOverrunErr As Long
    dwFramingErr As Long
    dwBufferOverrunErr As Long
    dwCompressionRatioIn As Long
    dwCompressionRatioOut As Long
    dwBps As Long
    dwConnectDuration As Long
End Type

Private Type RASCONNSTATUS
    'set dwsize to 64 unless winver >= 400 then set to 288
    dwSize As Long
    rasconnstate As Long                            'RASCONNSTATE Enumeration
    dwError As Long
    szDeviceType(16) As Byte
    szDeviceName(32) As Byte
End Type

Private Type RASPPPIP
    'set dwsize to 40
    dwSize As Long
    dwError As Long
    szIpAddress(15) As Byte
    szServerAddress(15) As Byte
End Type

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) As Long
Private Declare Function RasGetEntryProperties Lib "rasapi32" Alias "RasGetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpRasEntry As RASENTRY, ByVal dwEntryInfoSize As Long, ByVal lpbDeviceInfo As Long, ByVal dwDeviceInfoSize As Long) As Long
Private Declare Function RasSetEntryProperties Lib "rasapi32" Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpRasEntry As RASENTRY, ByVal dwEntryInfoSize As Long, ByVal lpbDeviceInfo As Long, ByVal dwDeviceInfoSize As Long) As Long
Private Declare Function RasGetCredentials Lib "rasapi32" Alias "RasGetCredentialsA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpCredentials As RASCREDENTIALS) As Long
Private Declare Function RasSetCredentials Lib "rasapi32" Alias "RasSetCredentialsA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpCredentials As RASCREDENTIALS, ByVal fClearCredentials As Long) As Long
Private Declare Function RasDeleteEntry Lib "rasapi32" Alias "RasDeleteEntryA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String) As Long
Private Declare Function RasGetEntryDialParams Lib "RasApi32.DLL" Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, lprasdialparams As RASDIALPARAMS, lpfPassword As Long) As Long
Private Declare Function RasSetEntryDialParams Lib "RasApi32.DLL" Alias "RasSetEntryDialParamsA" (ByVal lpszPhonebook As String, lprasdialparams As RASDIALPARAMS, ByVal fRemovePassword As Long) As Long
Private Declare Function RasDial Lib "RasApi32.DLL" Alias "RasDialA" (lpRasDialExtensions As RASDIALEXTENSIONS, ByVal lpszPhonebook As String, lprasdialparams As RASDIALPARAMS, ByVal dwNotifierType As Long, ByVal lpvNotifier As Long, lphRasConn As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectionStatistics Lib "RasApi32.DLL" (ByVal hRasConn As Long, lpStatistics As RAS_STATS) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" Alias "RasGetConnectStatusA" (ByVal hRasConn As Long, lprasconnstatus As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function IsTextUnicode Lib "advapi32" (ByVal lpBuffer As Long, ByVal cb As Long, ByVal lpi As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function RasGetProjectionInfo Lib "RasApi32.DLL" Alias "RasGetProjectionInfoA" (ByVal hRasConn As Long, ByVal rasprojection As Long, lpprojection As Any, lpcb As Long) As Long
Private Declare Function RasGetErrorString Lib "RasApi32.DLL" Alias "RasGetErrorStringA" (ByVal uErrorValue As Long, ByVal lpszErrorString As String, ByVal cBufSize As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public hRasConn As Long
Public RASDialErrorCode As Long

Private Function ExchangeRASType(ByVal Index As Long) As String
    Dim tempStr As String
    
    Select Case Index
        Case RASDT_Modem
            tempStr = RASDT_TYPE_Modem
        Case RASDT_Isdn
            tempStr = RASDT_TYPE_Isdn
        Case RASDT_X25
            tempStr = RASDT_TYPE_X25
        Case RASDT_Vpn
            tempStr = RASDT_TYPE_Vpn
        Case RASDT_Pad
            tempStr = RASDT_TYPE_Pad
        Case RASDT_Generic
            tempStr = RASDT_TYPE_Generic
        Case RASDT_Serial
            tempStr = RASDT_TYPE_Serial
        Case RASDT_FrameRelay
            tempStr = RASDT_TYPE_FrameRelay
        Case RASDT_Atm
            tempStr = RASDT_TYPE_Atm
        Case RASDT_Sonet
            tempStr = RASDT_TYPE_Sonet
        Case RASDT_SW56
            tempStr = RASDT_TYPE_SW56
        Case RASDT_Irda
            tempStr = RASDT_TYPE_Irda
        Case RASDT_Parallel
            tempStr = RASDT_TYPE_Parallel
        Case RASDT_PPPoE
            tempStr = RASDT_TYPE_PPPoE
        Case Else
            tempStr = ""
    End Select
    
    ExchangeRASType = tempStr
End Function

Public Function Create_PPP_Connection(ByVal sEntryName As String, ByVal dwRasType As RasType, ByVal DialVpnStrategy As VpnStrategy, ByVal sPhoneNumber As String, ByVal sUsername As String, ByVal sPassword As String, ByVal sDeviceName As String, ByVal sDeviceType As RASDT_TYPE, ByVal sUseIP As Long, ByVal sIPAddr As String, ByVal sUseDNS As Long, ByVal sDNS1 As String, ByVal sDNS2 As String, ByVal sUseDialRules As Long, ByVal sCountryID As String, ByVal sAreaCode As String) As Boolean
    Dim rEntry As RASENTRY
    Dim rCredential As RASCREDENTIALS

    Create_PPP_Connection = False
    
    With rEntry
        .dwSize = LenB(rEntry)
        .dwfOptions = RASEO_IpHeaderCompression Or RASEO_RemoteDefaultGateway Or RASEO_ModemLights Or RASEO_SwCompression Or RASEO_NetworkLogon Or RASEO_PreviewUserPw Or RASEO_ShowDialingProgress
        
        If sPhoneNumber <> "" Then
            .dwfOptions = .dwfOptions Or RASEO_PreviewPhoneNumber
            lstrcpy .szLocalPhoneNumber(0), ByVal sPhoneNumber
        End If
        
        lstrcpy .szDeviceName(0), ByVal sDeviceName
        lstrcpy .szDeviceType(0), ByVal ExchangeRASType(sDeviceType)
        
        If sUseIP <> 0 Then
            .dwfOptions = .dwfOptions Or RASEO_SpecificIpAddr
            .ipaddr = TransferAddrFromStr(ByVal sIPAddr)
        End If
        
        If sUseDNS <> 0 Then
            .dwfOptions = .dwfOptions Or RASEO_SpecificNameServers
            .ipaddrDns = TransferAddrFromStr(ByVal sDNS1)
            .ipaddrDnsAlt = TransferAddrFromStr(ByVal sDNS2)
        End If
        
        If sUseDialRules <> 0 Then
            .dwfOptions = .dwfOptions Or RASEO_UseCountryAndAreaCodes
            .dwCountryCode = Val(sCountryID)
            .dwCountryID = Val(sCountryID)
            lstrcpy .szAreaCode(0), ByVal sAreaCode
        End If
        
        .dwfNetProtocols = RASNP_Ip
        .dwFramingProtocol = RASFP_Ppp
        .dwRedialCount = 0
        .dwRedialPause = 60
        .dwIdleDisconnectSeconds = RASIDS_Disabled
        .dwType = dwRasType
        .dwVpnStrategy = DialVpnStrategy
        .dwTcpWindowSize = 0
    End With
    
    With rCredential
        .dwSize = LenB(rCredential)
        .dwMask = RASCM_UserName Or RASCM_Password Or RASCM_DefaultCreds
        lstrcpy .szUserName(0), ByVal sUsername
        lstrcpy .szPassword(0), ByVal sPassword
    End With
    
    If RasSetEntryProperties(vbNullString, sEntryName, rEntry, LenB(rEntry), 0, 0) = 0 Then
        If RasSetCredentials(vbNullString, sEntryName, rCredential, 0) = 0 Then
            Create_PPP_Connection = True
        End If
    End If
End Function

Private Function TransferAddrFromStr(ByVal sIPAddr As String) As RASIPADDR
    Dim sNum As Long
    Dim tempa As String
    Dim tempb As String
    Dim tempc As String
    Dim tempd As String
    
    If sIPAddr = "" Then
        GoTo TransferError
    End If
    
    sNum = InStr(sIPAddr, ".")
    If sNum > 0 Then
        tempa = Left(sIPAddr, sNum - 1)
        sIPAddr = Right(sIPAddr, Len(sIPAddr) - sNum)
    Else
        GoTo TransferError
    End If
    
    sNum = InStr(sIPAddr, ".")
    If sNum > 0 Then
        tempb = Left(sIPAddr, sNum - 1)
        sIPAddr = Right(sIPAddr, Len(sIPAddr) - sNum)
    Else
        GoTo TransferError
    End If
    
    sNum = InStr(sIPAddr, ".")
    If sNum > 0 Then
        tempc = Left(sIPAddr, sNum - 1)
        tempd = Right(sIPAddr, Len(sIPAddr) - sNum)
    Else
        GoTo TransferError
    End If
    
    With TransferAddrFromStr
        .a = Val(tempa)
        .B = Val(tempb)
        .c = Val(tempc)
        .d = Val(tempd)
    End With
    Exit Function
    
TransferError:
    With TransferAddrFromStr
        .a = 0
        .B = 0
        .c = 0
        .d = 0
    End With
    Exit Function
End Function

Public Function Delete_PPP_Connection(ByVal lpszEntry As String) As Boolean
    Delete_PPP_Connection = False
    
    If RasDeleteEntry(vbNullString, ByVal lpszEntry) = ERROR_SUCCESS Then
        Delete_PPP_Connection = True
    End If
End Function

授人于鱼，不如授人于渔
早已停用QQ了
2013-06-14 11:20
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等　级：贵宾
威　望：364
帖　子：4912
专家分：29900
注　册：2008-10-15
第 5 楼
 得分:0 
第二部分
程序代码：
Public Function Dial_PPP_Connection(ByVal lpszEntryName As String) As Boolean
    Dim lprasdialparams As RASDIALPARAMS
    Dim lpRasDialExtensions As RASDIALEXTENSIONS
    Dim lpfPassword As Long
    
    Dial_PPP_Connection = False
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = False Then
        With lpRasDialExtensions
            .dwSize = 16
            .dwfOptions = RDEOPT_PausedStates
            .hwndParent = vbNull
        End With
        
        With lprasdialparams
            .dwSize = 1052
            lstrcpy .szEntryName(0), ByVal lpszEntryName
        End With
        
        hRasConn = 0
        RASDialErrorCode = 0
        If RasGetEntryDialParams(vbNullString, lprasdialparams, lpfPassword) = 0 Then
            'If RasDial(lpRasDialExtensions, vbNullString, lprasdialparams, 1&, AddressOf RasDialFunc, hRasConn) = 0 Then
            If RasDial(lpRasDialExtensions, vbNullString, lprasdialparams, 0, 0, hRasConn) = 0 Then
                Dial_PPP_Connection = True
            End If
        End If
    End If
End Function

Public Function Disconnect_PPP_Connection(ByVal lpszEntryName As String) As Boolean
    Dim temp As Long
    
    Disconnect_PPP_Connection = False
    
    Is_PPP_Connecting ByVal lpszEntryName
    
    If hRasConn <> 0 Then
        If RasHangUp(hRasConn) = 0 Then
            temp = GetTickCount()
            Do Until GetTickCount - temp >= 2000
                DoEvents
            Loop
            hRasConn = 0
            Disconnect_PPP_Connection = True
        End If
    End If
End Function

Public Function Is_PPP_Connecting(ByVal lpszEntryName As String) As Boolean
    Dim lpRasConn(255) As RASCONN
    Dim lpcConnections As Long
    Dim temp As String
    Dim i As Long
    
    Is_PPP_Connecting = False
    
    lpRasConn(0).dwSize = 32
    If RasEnumConnections(lpRasConn(0), LenB(lpRasConn(0)) * 256, lpcConnections) = 0 Then
        For i = 0 To lpcConnections - 1
            temp = ReadStringFromMemory(ByVal VarPtr(lpRasConn(i).szEntryName(0)), 21)
            Do While Right(temp, 1) = Chr(0)
                temp = Left(temp, Len(temp) - 1)
            Loop
            If temp = lpszEntryName Then
                hRasConn = lpRasConn(i).hRasConn
                Is_PPP_Connecting = True
                Exit Function
            End If
        Next
    End If
End Function

Private Function ReadStringFromMemory(ByVal Memory_Address As Long, ByVal Menory_Length As Long, Optional ByRef Text_Ascii As Boolean) As String
    Dim tmpBuffer() As Byte
    Dim tmpB As Byte
    Dim actSize As Long
    Dim idx As Long
    Dim tempNum As Long
    Dim tempStr As String
    
    ReDim tmpBuffer(Menory_Length * 2 + 2) As Byte
    actSize = MultiByteToWideChar(CP_ACP, 0, ByVal Memory_Address, ByVal Menory_Length, ByVal VarPtr(tmpBuffer(0)), ByVal (Menory_Length * 2 + 2))
    
    For idx = 0 To actSize * 2 - 1 Step 2
        CopyMemory ByVal VarPtr(tempNum), ByVal VarPtr(tmpBuffer(idx)), 2
        tempStr = tempStr + ChrW(tempNum)
        
        tmpB = tmpBuffer(idx)
        tmpBuffer(idx) = tmpBuffer(idx + 1)
        tmpBuffer(idx + 1) = tmpB
    Next
    If Right(tempStr, 1) = Chr(0) Then
        tempStr = Left(tempStr, Len(tempStr) - 1)
    End If
    
    If Not (IsMissing(Text_Ascii)) Then
        tempNum = IS_TEXT_UNICODE_REVERSE_ASCII16
        IsTextUnicode ByVal VarPtr(tmpBuffer(0)), ByVal actSize * 2, ByVal VarPtr(tempNum)
        tempNum = (tempNum And IS_TEXT_UNICODE_REVERSE_ASCII16)
        If tempNum = IS_TEXT_UNICODE_REVERSE_ASCII16 Then
            Text_Ascii = True
        Else
            Text_Ascii = False
        End If
    End If
    
    ReadStringFromMemory = tempStr
End Function

Public Function Get_PPP_Duration(ByVal lpszEntryName As String) As Long
    Dim lpStatistics As RAS_STATS
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        lpStatistics.dwSize = Len(lpStatistics)
        If RasGetConnectionStatistics(ByVal hRasConn, lpStatistics) = 0 Then
            Get_PPP_Duration = lpStatistics.dwConnectDuration
        End If
    End If
End Function

Public Function Get_PPP_TXByte(ByVal lpszEntryName As String) As Long
    Dim lpStatistics As RAS_STATS
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        lpStatistics.dwSize = Len(lpStatistics)
        If RasGetConnectionStatistics(ByVal hRasConn, lpStatistics) = 0 Then
            Get_PPP_TXByte = lpStatistics.dwBytesXmited
        End If
    End If
End Function

Public Function Get_PPP_RXByte(ByVal lpszEntryName As String) As Long
    Dim lpStatistics As RAS_STATS
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        lpStatistics.dwSize = Len(lpStatistics)
        If RasGetConnectionStatistics(ByVal hRasConn, lpStatistics) = 0 Then
            Get_PPP_RXByte = lpStatistics.dwBytesRcved
        End If
    End If
End Function

Public Function Get_PPP_Status(ByVal lpszEntryName As String) As Long
    Dim lprasconnstatus As RASCONNSTATUS
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        lprasconnstatus.dwSize = LenB(lprasconnstatus)
        If RasGetConnectStatus(ByVal hRasConn, lprasconnstatus) = 0 Then
            Get_PPP_Status = lprasconnstatus.rasconnstate
        End If
    Else
        Get_PPP_Status = RASCS_Disconnected
    End If
End Function

Public Function Get_Client_PPP_IPAddress(ByVal lpszEntryName As String) As String
    Dim lpraspppip As RASPPPIP
    Dim rasprojection As Long
    Dim lpcb As Long
    Dim tempIP As String
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        rasprojection = RASP_PppIp
        lpraspppip.dwSize = 40
        lpcb = 40
        If RasGetProjectionInfo(hRasConn, rasprojection, lpraspppip, lpcb) = 0 Then
            tempIP = ReadStringFromMemory(ByVal VarPtr(lpraspppip.szIpAddress(0)), 16)
            Do While Right(tempIP, 1) = Chr(0)
                tempIP = Left(tempIP, Len(tempIP) - 1)
            Loop
            Get_Client_PPP_IPAddress = tempIP
        End If
    End If
End Function

Public Function Get_Server_PPP_IPAddress(ByVal lpszEntryName As String) As String
    Dim lpraspppip As RASPPPIP
    Dim rasprojection As Long
    Dim lpcb As Long
    Dim tempIP As String
    
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        rasprojection = RASP_PppIp
        lpraspppip.dwSize = 40
        lpcb = 40
        If RasGetProjectionInfo(hRasConn, rasprojection, lpraspppip, lpcb) = 0 Then
            tempIP = ReadStringFromMemory(ByVal VarPtr(lpraspppip.szServerAddress(0)), 16)
            Do While Right(tempIP, 1) = Chr(0)
                tempIP = Left(tempIP, Len(tempIP) - 1)
            Loop
            Get_Server_PPP_IPAddress = tempIP
        End If
    End If
End Function

Public Function Get_Dial_Error_String(ByVal dwError As Long) As String
    Dim strRASErrorString As String
    
    strRASErrorString = Space(256)
    If RasGetErrorString(ByVal dwError, strRASErrorString, ByVal 256&) = 0 Then
        Do While Right(strRASErrorString, 1) = Chr(0)
            strRASErrorString = Left(strRASErrorString, Len(strRASErrorString) - 1)
        Loop
        Get_Dial_Error_String = strRASErrorString
    End If
End Function

Private Sub RasDialFunc(ByVal lpRasConn As Long, ByVal unMsg As Long, ByVal RasConnectStatus As Long, ByVal dwError As Long, ByVal dwExtendedError As Long)
'这个函数我修改过， 忘了原始是什么的。临时删除了内容。
    hRasConn = lpRasConn
    RASDialErrorCode = dwError
end sub

授人于鱼，不如授人于渔
早已停用QQ了
2013-06-14 11:20



参与讨论请移步原网站贴子：https://bbs.bccn.net/thread-415105-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有，并保留所有权利。
Powered by Discuz, Processed in 1.927997 second(s), 9 queries.
Copyright©2004-2025, BCCN.NET, All Rights Reserved