Access-ODBC-SQL数据连接安全性如此提高

tsilon

先用带密码的connection语句刷，后用不带密码的，如下

1. Option Compare Database
   
2. Option Explicit
   
3. Public Sub ReLinkTbl()
   
4.     On Error GoTo Err_Dot:
   
5.     DoCmd.Echo False             '关闭屏幕更新
   
6.     DoCmd.Hourglass True      '将光标设为沙漏形以表示系统正在进行后台处理
   
7.     DoCmd.SetWarnings False '关闭系统警告提示消息
   
8.    
   
9.     Dim mydb As DAO.Database
   
10.     Dim MyTable As DAO.TableDef
    
11.     Dim strTblName As String
    
12.     Dim MySet As DAO.Recordset
    
13.     Dim i As Integer, j As Integer
    
14.     Dim connectstr As String
    
15.     Dim intFlag As Boolean
    
16.     Dim strAttributes As String
    
17.    
    
18.     RefreshTblSysTables '当添加了新的链接表的时候则需要此行
    
19.    
    
20.     connectstr = "ODBC;DSN=DBACD;"
    
21.     'connectstr = connectstr & "SERVER=XXX;"
    
22.     connectstr = connectstr & "APP=Microsoft Office 2003;" '"WSID= " & XXX & " ;"
    
23.     connectstr = connectstr & "DATABASE=XXX;"
    
24.     connectstr = connectstr & "UID=XXX;"
    
25.     connectstr = connectstr & "PWD=XXX;"
    
26.     connectstr = connectstr & "QuotedId=No;AnsiNPW=Yes;"
    
27.     connectstr = connectstr & "LANGUAGE=us_english;AutoTranslate=No" & Chr(0)
    
28.    
    
29.     'DoEvents---执行大批量操作时添加此行以移交系统控制权，使系统可以处理其它事件并防止程序假死.
    
30.     Set mydb = DBEngine.Workspaces(0).Databases(0)
    
31.     Set MySet = CurrentDb.OpenRecordset("TblSysTables", dbOpenTable, dbSeeChanges, dbOptimistic)
    
32.     If MySet.RecordCount > 0 Then
    
33.         MySet.MoveFirst
    
34.         For j = 1 To MySet.RecordCount
    
35.             intFlag = True
    
36.             strTblName = MySet.Fields("TblName")
    
37.             Set MyTable = mydb.TableDefs(strTblName)
    
38.             
    
39.             MyTable.Connect = connectstr
    
40.             MyTable.RefreshLink
    
41.             
    
42.             If intFlag Then
    
43.                 MySet.Edit
    
44.                 MySet.Fields("ConnectFlag") = 1
    
45.                 MySet.Fields("Flag") = "OK"
    
46.                 'MySet.Fields("TblPropertiy") = CurrentDb.TableDefs(strTblName).Connect
    
47.                 MySet.Update
    
48.             End If
    
49.             MySet.MoveNext
    
50.             Err.Clear
    
51.         Next
    
52.     Else
    
53.         Exit Sub
    
54.     End If
    
55.    
    
56.     ' 使用没有密码的连接字串更新链接表的Connect属性，避免泄露密码（否则密码会被保存在MSysObjects表中）
    
57.     connectstr = "ODBC;DSN=XXX;"
    
58.     'connectstr = connectstr & "SERVER=XXX;"
    
59.     connectstr = connectstr & "APP=Microsoft Office 2003;" '"WSID= " & XXX & " ;"
    
60.     connectstr = connectstr & "DATABASE=XXX;"
    
61.     connectstr = connectstr & "QuotedId=No;AnsiNPW=Yes;"
    
62.     connectstr = connectstr & "LANGUAGE=us_english;AutoTranslate=No" & Chr(0)
    
63.     If MySet.RecordCount > 0 Then
    
64.         MySet.MoveFirst
    
65.         For j = 1 To MySet.RecordCount
    
66.             intFlag = True
    
67.             strTblName = MySet.Fields("TblName")
    
68.             Set MyTable = mydb.TableDefs(strTblName)
    
69.             
    
70.             MyTable.Connect = connectstr
    
71.             MyTable.RefreshLink
    
72.             
    
73.             If intFlag Then
    
74.                 MySet.Edit
    
75.                 MySet.Fields("ConnectFlag") = 1
    
76.                 MySet.Fields("Flag") = "OK"
    
77.                 MySet.Update
    
78.             End If
    
79.             MySet.MoveNext
    
80.             Err.Clear
    
81.         Next
    
82.     End If
    
83.     GoTo Exit_Port
    
84.    
    
85. Err_Dot:
    
86.     If Err <> 0 Then
    
87.         MsgBox "刷新链接表--->错误源: " & "-->" & Err.Number & "---" & Err.Description, vbOKOnly, "Tsilon sys!"
    
88.         GoTo Exit_Port
    
89.     End If
    
90.    
    
91. Exit_Port:
    
92.     If Not (MySet Is Nothing) Then
    
93.         MySet.Close
    
94.     End If
    
95.     Set MySet = Nothing
    
96.    
    
97.     DoCmd.Echo True              '恢复屏幕更新
    
98.     DoCmd.Hourglass False       '恢复光标形状
    
99.     DoCmd.SetWarnings True   '恢复系统警告提示消息
    
100.     Exit Sub
     
101. End Sub
     
102. Public Sub RefreshTblSysTables()
     
103.     On Error Resume Next
     
104.     Dim MyTbl As DAO.TableDefs, i As Integer
     
105.     Dim rsSet As DAO.Recordset
     
106.    
     
107.     DoCmd.RunSQL "Delete * From TblSysTables"
     
108.    
     
109.     Set MyTbl = CurrentDb.TableDefs
     
110.     Set rsSet = CurrentDb.OpenRecordset("TblSysTables")
     
111.     For i = 0 To MyTbl.Count - 1
     
112.         If MyTbl(i).Attributes = DB_ATTACHEDODBC Or MyTbl(i).Attributes = DB_ATTACHEDODBC + DB_ATTACHSAVEPWD Then
     
113.             rsSet.AddNew
     
114.             rsSet.Fields("ConnectFlag") = 0
     
115.             rsSet.Fields("TblName") = MyTbl(i).Name
     
116.             rsSet.Update
     
117.         End If
     
118.     Next
     
119.     rsSet.Close
     
120.     Set rsSet = Nothing
     
121. End Sub
     
122. 
     

复制代码

67613188

有个实例的话一路了然了，谢谢

lirong

为什么我再次连时提示输入密码

yanwei82123300

谢谢分享
学习了

termisss

上班之余,来逛逛论坛.

xuwenning

谢谢分享
学习了

todaynew

学习一下

红尘如烟

帮你把注释改成中文的了，不过弄的那个日志表感觉没什么必要

t小宝

能否有文字简要说明一下