bas-

来自「注释：用VB开发的进销存系统源码」· 代码 · 共 80 行

Attribute VB_Name = "bas通讯"


'*****************************************
'               主模块
'            模块文件代码
'*****************************************

Option Explicit


'以下为全局变量

Public LCode As String
Public LName As String
Public UploadPath As String
Public LUploadPath As String



Private Declare Function RegOpenKeyEx Lib "advapi32" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, _
   phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As _
   String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" _
   (ByVal hKey As Long) As Long
'常数
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0&

Public Function GetConnect() As String
   Dim hKey As Long
   Dim SubKey As String
   hKey = HKEY_CURRENT_USER    '主键
   SubKey = "RemoteAccess"     '子键
   '取得默认连接名
   GetConnect = GetRegValue(hKey, SubKey, "Default")
End Function

Public Function GetRegValue(hKey As Long, lpszSubKey As String, szKey As String) As Variant

   On Error GoTo ErrorRoutineErr:

   Dim phkResult As Long
   Dim lResult As Long
   Dim szBuffer As String
   Dim lBuffSize As Long

   '创建缓冲区
   szBuffer = Space(255)
   lBuffSize = Len(szBuffer)

   '打开注册键
   RegOpenKeyEx hKey, lpszSubKey, 0, 1, phkResult

   '查询结果
   lResult = RegQueryValueEx(phkResult, szKey, 0, 0, szBuffer, lBuffSize)

   '关闭注册键
   RegCloseKey phkResult

   '返回结果
   If lResult = ERROR_SUCCESS Then
      GetRegValue = Left(szBuffer, lBuffSize - 1)
   Else
      GetRegValue = ""
   End If
   Exit Function

ErrorRoutineErr:
   GetRegValue = ""
End Function