Access-ODBC-SQL数据安全性可以如此提高的

tsilon

前一次用带密码的Connect，后一次不用，如下

Option Compare Database
Option Explicit
Public Sub ReLinkTbl()
    On Error GoTo Err_Dot:
    DoCmd.Echo False 'close form repaint action
    DoCmd.Hourglass True 'change the mouse to hourglass icon
    DoCmd.SetWarnings False 'close system hint
   
    Dim mydb As DAO.Database
    Dim MyTable As DAO.TableDef
    Dim strTblName As String
    Dim MySet As DAO.Recordset
    Dim i As Integer, j As Integer
    Dim connectstr As String
    Dim intFlag As Boolean
    Dim strAttributes As String
   
    RefreshTblSysTables 'when add linked table, then need run this line.
   
    connectstr = "ODBC;DSN=DBACD;"
    'connectstr = connectstr & "SERVER=XXX;"
    connectstr = connectstr & "APP=Microsoft Office 2003;" '"WSID= " & XXX & " ;"
    connectstr = connectstr & "DATABASE=XXX;"
    connectstr = connectstr & "UID=XXX;"
    connectstr = connectstr & "PWD=XXX;"
    connectstr = connectstr & "QuotedId=No;AnsiNPW=Yes;"
    connectstr = connectstr & "LANGUAGE=us_english;AutoTranslate=No" & Chr(0)
   
    'DoEvents---Yields execution so that the operating system can process other events.
    Set mydb = DBEngine.Workspaces(0).Databases(0)
    Set MySet = CurrentDb.OpenRecordset("TblSysTables", dbOpenTable, dbSeeChanges, dbOptimistic)
    If MySet.RecordCount > 0 Then
        MySet.MoveFirst
        For j = 1 To MySet.RecordCount
            intFlag = True
            strTblName = MySet.Fields("TblName")
            Set MyTable = mydb.TableDefs(strTblName)
            
            MyTable.Connect = connectstr
            MyTable.RefreshLink
            
            If intFlag Then
                MySet.Edit
                MySet.Fields("ConnectFlag") = 1
                MySet.Fields("Flag") = "OK"
                'MySet.Fields("TblPropertiy") = CurrentDb.TableDefs(strTblName).Connect
                MySet.Update
            End If
            MySet.MoveNext
            Err.Clear
        Next
    Else
        Exit Sub
    End If
   
    ' use connect string without password to refresh table's connect string to hide password for avoiding disclose password in Msysobject table.
    connectstr = "ODBC;DSN=XXX;"
    'connectstr = connectstr & "SERVER=XXX;"
    connectstr = connectstr & "APP=Microsoft Office 2003;" '"WSID= " & XXX & " ;"
    connectstr = connectstr & "DATABASE=XXX;"
    connectstr = connectstr & "QuotedId=No;AnsiNPW=Yes;"
    connectstr = connectstr & "LANGUAGE=us_english;AutoTranslate=No" & Chr(0)
    If MySet.RecordCount > 0 Then
        MySet.MoveFirst
        For j = 1 To MySet.RecordCount
            intFlag = True
            strTblName = MySet.Fields("TblName")
            Set MyTable = mydb.TableDefs(strTblName)
            
            MyTable.Connect = connectstr
            MyTable.RefreshLink
            
            If intFlag Then
                MySet.Edit
                MySet.Fields("ConnectFlag") = 1
                MySet.Fields("Flag") = "OK"
                MySet.Update
            End If
            MySet.MoveNext
            Err.Clear
        Next
    End If
    GoTo Exit_Port
   
Err_Dot:
    If Err <> 0 Then
        MsgBox "Refresh Link Table--->Error source: " & "-->" & Err.Number & "---" & Err.Description, vbOKOnly, "Tsilon sys!"
        GoTo Exit_Port
    End If
   
Exit_Port:
    If Not (MySet Is Nothing) Then
        MySet.Close
    End If
    Set MySet = Nothing
   
    Application.Echo True
    DoCmd.Hourglass False
    DoCmd.SetWarnings True
    Exit Sub
End Sub
Public Sub RefreshTblSysTables()
    On Error Resume Next
    Dim MyTbl As DAO.TableDefs, i As Integer
    Dim rsSet As DAO.Recordset
   
    DoCmd.RunSQL "Delete * From TblSysTables"
   
    Set MyTbl = CurrentDb.TableDefs
    Set rsSet = CurrentDb.OpenRecordset("TblSysTables")
    For i = 0 To MyTbl.Count - 1
        If MyTbl(i).Attributes = DB_ATTACHEDODBC Or MyTbl(i).Attributes = DB_ATTACHEDODBC + DB_ATTACHSAVEPWD Then
            rsSet.AddNew
            rsSet.Fields("ConnectFlag") = 0
            rsSet.Fields("TblName") = MyTbl(i).Name
            rsSet.Update
        End If
    Next
    rsSet.Close
    Set rsSet = Nothing
End Sub

termisss

上班之余,来逛逛论坛.

ui

不保存密码. 关闭整个程序再打开,肯定要提示输入密码