Office中国论坛/Access中国论坛

标题: Access-ODBC-SQL数据连接安全性如此提高 [打印本页]
作者: tsilon    时间: 2010-11-20 23:39
标题: Access-ODBC-SQL数据连接安全性如此提高
本帖最后由 红尘如烟 于 2010-11-21 11:36 编辑

先用带密码的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

复制代码

作者: t小宝    时间: 2010-11-21 10:29
能否有文字简要说明一下
作者: 红尘如烟    时间: 2010-11-21 11:33
帮你把注释改成中文的了，不过弄的那个日志表感觉没什么必要
作者: todaynew    时间: 2010-11-21 19:55
学习一下
作者: xuwenning    时间: 2010-11-22 08:50
谢谢分享
学习了
作者: termisss    时间: 2010-11-22 09:48
上班之余,来逛逛论坛.
作者: yanwei82123300    时间: 2010-11-22 10:04
谢谢分享
学习了
作者: lirong    时间: 2010-12-9 22:33
为什么我再次连时提示输入密码
作者: 67613188    时间: 2010-12-11 14:46
有个实例的话一路了然了，谢谢



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3