Option Compare Database
Option Explicit

'****This code is only secure if the user is given a mde or accde file.*****
'The Purpose of this code is to make your Linked ODBC Tables, Views, and Pass-through Queries safe
'where they do not reveal the UID and PWD of the SQL Server, or SQL Azure Database.
'
'Import this Module into your database by using the Visual Basic code window. On the Menu click
'File > Import File and browse to and select this file.
'
'This code is based on an article by Ben Clothier, Access MVP:
'Power Tip: Improve the security of database connections
'
'The First Step that must be done is to make all of your Tables, Views, and
'Pass-through Queries DSN-Less.
'See http://www.accessmvp.com/djsteele/DSNLessLinks.html for how to do this.
'
'Note: I never use "Connection" or "Cnn" in the names of my Variables or Procedures.
'I disguise them to make it hard for a hacker to use code to get my Connection string
'These terms are only used here to make the code easer to understand.
'
'If the code does not work you may need to download and install the SQL Native Client Drivers.
'You can find links to the download you need at http://gainingaccess.net/SQLAzure/SADownloads.aspx
'
'How to call the code:
'I use an UNBOUND form and use code to call the procedures like this:
'The Display Form must be an unbound Form with no Recordsource.
'Uncomment the code below and use the code below in the Display Form's
'Open Event.
'
'    If InitODBCDB("MyUserName", "MyPa$sW0rd") = True Then
'        'Set up Secure Linked Table and View Connections.
'        If SecureTablesNViewsRelink = True Then
'            'Set up Secure Pass-through Query Connections.
'            Call SecurePTQueriesRelink
'        End If
'
'    End If
'
'You can also call the 3 Procedures using an AutoExec macro.

---

'---------------------------------------------------------------------------------------
' Procedure : GetSafeCString
' Author    : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net/
' Date      : 2/25/2013
' Purpose   : Get Connection String without UID and PWD.
'---------------------------------------------------------------------------------------
'
Public Function GetSafeCnnString() As String
On Error GoTo ErrHandle

'For SQL Server 2005, 2008, 2008 R2 you can use
'        & "DRIVER=SQL Server Native Client 10.0;" _
'instead of
'        & "Driver={SQL Server Native Client 11.0};" _

    GetSafeCnnString = "ODBC;" _
        & "DRIVER=SQL Server Native Client 11.0;" _
        & "SERVER=myserver.net;" _
        & "DATABASE=MyDatabaseName"

ExitHere:
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In Procedure GetSafeCnnString"
    Resume ExitHere

End Function

---

'---------------------------------------------------------------------------------------
' Procedure : InitODBCDB
' Author    : 'This code is based on an article by Ben Clothier, Access MVP:
'           : Power Tip: Improve the security of database connections
' Modified  : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net/
' Date      : 2/25/2013
' Purpose   : Cache and hide the User Name and Password in the Database. It will enable
'           : you to use Linked Tables, Views, and Pass-Through Queries without revealing
'           : the User Name and Password. It is only effective in an mde and accde file.
'           : Call this Procedure first every time your database is opened so the User
'           : Name and Password will be cached and hidden from being discovered. This
'           : Function should be called using the opening Macro or in the Display Form's
'           : Open Event before you do anything else in the database.
' Example   : Call InitODBCDB("UserName", "Pa$sW0rd")
'---------------------------------------------------------------------------------------
'
Public Function InitODBCDB(UserName As String, Password As String) As Boolean
On Error GoTo ErrHandle

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim strCnn As String

'For SQL Server 2005, 2008, 2008 R2 you can use
'        & "DRIVER=SQL Server Native Client 10.0;" _
'instead of
'        & "Driver={SQL Server Native Client 11.0};" _

    strCnn = "ODBC;" _
        & "Driver={SQL Server Native Client 11.0};" _
        & "SERVER=myserver.net;" _
        & "DATABASE=MyDatabaseName"

    Set db = CurrentDb
    Set qdf = db.CreateQueryDef("")

    With qdf
        .Connect = strCnn _
            & "Uid=" & UserName & ";" _
            & "Pwd=" & Password & ";" _
            & "Encrypt=Yes;"

        .SQL = "SELECT SYSTEM_USER As MyLogin;"

'        Use this if the line above does not work for you:
'        .SQL = "SELECT CURRENT_USER"

        .ReturnsRecords = True

        Set rst = .OpenRecordset(dbOpenSnapshot, dbSQLPassThrough)
    End With

    InitODBCDB = True

ExitHere:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    Exit Function

ErrHandle:
    InitODBCDB = False
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In Procedure InitODBCDB"
    Resume ExitHere
End Function

---

'---------------------------------------------------------------------------------------
' Procedure : SecureTablesNViewsRelink
' Author    : Patrick Wood  http://gainingaccess.net
' Date      : 2/25/2013
' Purpose   : Relink all ODBC Linked Tables and Views with a safe connection Property.
'---------------------------------------------------------------------------------------
'
Public Function SecureTablesNViewsRelink() As Boolean
    On Error GoTo ErrHandle

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim strConnection As String

    Set db = CurrentDb

    'Use a Function to get the Connection string
    'In actual use I never use "Connection" or "Cnn" in my Variables or Procedure names.
    'I disguise them to make it hard for a hacker to use code to get my Connection string.
    strConnection = GetSafeCnnString 'Connection without Password

    'Loop through the TableDefs Collection
    For Each tdf In db.TableDefs
        'Verify the table is an ODBC linked table
        If Left$(tdf.Connect, 5) = "ODBC;" Then
            'Skip System tables
            If Left$(tdf.Name, 1) <> "~" Then
                Set tdf = db.TableDefs(tdf.Name)
                tdf.Connect = strConnection
                If tdf.Attributes < 537001984 Then
                    tdf.Attributes = dbAttachSavePWD    'dbAttachSavePWD = 131072
                End If
                tdf.RefreshLink
            End If
        End If
        DoEvents
    Next tdf

    SecureTablesNViewsRelink = True

ExitHere:
    On Error Resume Next
    Set tdf = Nothing
    Set db = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In Procedure SecureTablesNViewsRelink"
    Resume ExitHere
End Function

---

'---------------------------------------------------------------------------------------
' Procedure : SecurePTQueriesRelink
' Author    : Patrick Wood  http://gainingaccess.net
' Date      : 2/25/2013
' Purpose   : Relink all Pass-through queries with a safe connection Property.
'---------------------------------------------------------------------------------------
'
Function SecurePTQueriesRelink() As Boolean
On Error GoTo ErrHandle

     Dim db As DAO.Database
     Dim qdf As DAO.QueryDef
     Dim strConnection As String

     Set db = CurrentDb

     'Use a Function to get the Connection string
     'Note: I never use "Connection" in the names of my Variables or Procedures.
     'I disguise them to make it hard for a hacker to use code to get my Connection string
     strConnection = GetSafeCnnString

    'Loop through the TableDefs Collection
    For Each qdf In db.QueryDefs
        'Verify the table is an ODBC linked table
        If Left$(qdf.Connect, 5) = "ODBC;" Then
            'Skip System tables
            If Left$(qdf.Name, 1) <> "~" Then
                Set qdf = db.QueryDefs(qdf.Name)
                qdf.Connect = strConnection
             End If
         End If
     Next qdf

     SecurePTQueriesRelink = True

ExitHere:
    On Error Resume Next
    Set qdf = Nothing
    Set db = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In Procedure SecurePTQueriesRelink"
    Resume ExitHere

End Function