发一个好用的DNS创建模块给大家用

Grant · 发表于 2012-1-29 18:08:22

我感觉挺好用的,喜欢的就收下吧,当是新年礼物

'*********************** Code Start ***************************
' 也可以通过域名解析给出域名
' 定义注册表API函数
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
ByVal lpftLastWriteTime As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
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 RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0&
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_value = &H1
Const KEY_SET_value = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_value Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Const REG_DWORD = 4
Const REG_BINARY = 3
Const REG_SZ = 1
Const ODBC_ADD_SYS_DSN = 4
Private Declare Function SQLConfigDataSource Lib "odbccp32.dll" _
(ByVal hwndParent As Long, _
ByVal fRequest As Integer, _
ByVal lpszDriver As String, _
ByVal lpszAttributes As String) As Long
Function Check_SDSN(ByVal JDS_Server_name As String, ByVal jds_dsn_name As String, ByVal SQLData As String)
' 查看我们要的系统数据源(DSN)是否存在。
' 如果存在，正好；否则，我们就创建一个。
Dim lngKeyHandle As Long
Dim lngResult As Long
Dim lngCurIdx As Long
Dim strvalue As String
Dim classvalue As String
Dim timevalue As String
Dim lngvalueLen As Long
Dim classlngvalueLen As Long
Dim lngData As Long
Dim lngDataLen As Long
Dim strResult As String
Dim DSNfound As Long
Dim syscmdresult As Long
syscmdresult = SysCmd(acSysCmdSetStatus, "查找系统DSN: " & jds_dsn_name & " …")
' 打开包含系统数据源(DSN)的注册表主键。
lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"SOFTWARE\ODBC\ODBC.INI", _
0&, _
KEY_READ, _
lngKeyHandle)
If lngResult <> ERROR_SUCCESS Then
MsgBox "错误: 不能打开注册键 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI." & _
vbCrLf & vbCrLf & _
"请安装SQL Server的ODBC驱动程序用以调用MDTS系统数据源。" & _
vbCrLf & _
"要获得更多的信息，请与管理员联系。"
syscmdresult = SysCmd(acSysCmdClearStatus)
Check_SDSN = -1
End If
' 现在这个注册键是打开的，我们在这个查找看是否我们需要的。
lngCurIdx = 0
DSNfound = False
Do
lngvalueLen = 512
classlngvalueLen = 512
strvalue = String(lngvalueLen, 0)
classvalue = String(classlngvalueLen, 0)
timevalue = String(lngvalueLen, 0)
lngDataLen = 512
lngResult = RegEnumKeyEx(lngKeyHandle, _
lngCurIdx, _
strvalue, _
lngvalueLen, _
0&, _
classvalue, _
classlngvalueLen, _
timevalue)
lngCurIdx = lngCurIdx + 1
If lngResult = ERROR_SUCCESS Then
' 是我们要的系统数据源吗?
If strvalue = jds_dsn_name Then
' 是! 那就不需要我们再做什么了。
DSNfound = True
syscmdresult = SysCmd(acSysCmdClearStatus)
End If
End If
Loop While lngResult = ERROR_SUCCESS And Not DSNfound
Call RegCloseKey(lngKeyHandle)
If Not DSNfound Then
' 我们所需的系统数据源不存在，因此，我们试着创建一个。
syscmdresult = SysCmd(acSysCmdSetStatus, "创建系统数据源DSN: " & jds_dsn_name & "…")
lngResult = SQLConfigDataSource(0, _
ODBC_ADD_SYS_DSN, _
"SQL Server", _
"DSN=" & jds_dsn_name & Chr(0) & _
"Server=" & JDS_Server_name & Chr(0) & _
"Database=" & SQLData & "" & Chr(0) & _
"UseProcForPrepare=Yes" & Chr(0) & _
"Description=MDTS Database" & Chr(0) & Chr(0))
If lngResult = False Then
MsgBox "错误: 不能创建系统数据源DSN: " & jds_dsn_name & "." & _
vbCrLf & vbCrLf & _
"请确认已安装了SQL Server的ODBC驱动程序。" & _
vbCrLf & _
"需要更的有关MDTS的信息，请与系统管理员联系。"
syscmdresult = SysCmd(acSysCmdClearStatus)
Check_SDSN = -1
End If
End If
syscmdresult = SysCmd(acSysCmdClearStatus)
Check_SDSN = 0
End Function

复制代码

yodong · 发表于 2012-1-29 20:14:46

好东西.收藏了.

andymark · 发表于 2012-1-30 11:54:38

能配一个示例更好

aslxt · 发表于 2012-1-30 14:55:17

同意楼上的说法！

t小宝 · 发表于 2012-1-30 15:14:33

学习，好东西！

简 · 发表于 2012-1-30 21:24:40

这个模块的功能是啥呢，我没有看懂呢，这个数据源是指啥，是数据库后台文件，还是什么呢？为啥要注册呢？

gl_zhangt · 发表于 2012-2-5 11:01:28

能配一个示例更好！

ithink2012 · 发表于 2012-2-5 12:42:50

先收了，谢谢！

帐号		自动登录	找回密码
密码			注册

群介绍
Access培训群 (792054000)
Access免费培训群2 (792054000)
Access经典源码培训群 (77130759)
Access源码技巧群 (138920637)
access vba (307776555)

主题相关群

地区相关群[您还没设置居住地]

[模块/函数] 发一个好用的DNS创建模块给大家用

群介绍
主题无相 (随机显示版	同地区群块其他地区)