一组SQL Server身份验证管理子程序

本子程序配合《关于 SQL Server 2000 身份验证与安全控制》一文。

Option Compare Database
Public appAccess As access.Application

Sub CallSQLDMOSQLServerLogin()
    Dim srvname As String
    Dim suid As String
    Dim pwd As String
   
    ' 设置 SQL Server 的登录参数
    srvname = "(local)"
    'suid = "sa"
    'pwd = ""
   
    ' 调用 SQL Server 登录过程
    SQLDMOSQLServerLogin srvname, suid, pwd
End Sub

Sub SQLDMOSQLServerLogin(srvname As String, suid As String, pwd As String)
    Dim srv1 As SQLDMO.SQLServer
   
    ' 新建一个服务器实例
    Set srv1 = New SQLDMO.SQLServer
   
    ' 调用 SQL Server 登录连接方法
    srv1.Connect srvname, suid, pwd
   
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing
End Sub

Sub CallSQLDMOWindowsLogin()
    Dim srvname As String
   
    ' 设置 Windows 登录参数
    srvname = "(local)"
   
    SQLDMOWindowsLogin srvname
End Sub

Sub SQLDMOWindowsLogin(srvname As String)
    Dim srv1 As SQLDMO.SQLServer
   
    ' 新建一个服务器实例
    Set srv1 = New SQLDMO.SQLServer
   
    ' 在调用前，设置 LoginSecure 属性为 True
    ' 使用服务名进行连接
    srv1.LoginSecure = True
    srv1.Connect srvname
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing
End Sub

Sub CallChangeServerAuthenticationMode()
    Dim constAuth As Byte
   
    ' 设置 constAuth 参数为：
    '    SQLDMOSecurity_Integrated 为 Windows Authentication 模式
    '    SQLDMOSecurity_Mixed 为 Mixed Authentication 模式
   
    ' 设置 constAuth 的默认值
    constAuth = SQLDMOSecurity_Mixed
   
    ' 调用改变 SQL Server 身份认证模式的方法
    ChangeServerAuthenticationMode constAuth
End Sub

Sub ChangeServerAuthenticationMode(constAuth As Byte)
    Dim srv1 As SQLDMO.SQLServer
   
    ' 指定哪个服务器，默认为 Local (本地服务器)
    srvname = "(local)"
   
    ' 使用集成安全(Windows)方式新建一个 SQL Server 对象并进行连接
    Set srv1 = New SQLDMO.SQLServer
    srv1.LoginSecure = True
    srv1.Connect srvname
   
    ' 设置 SecurityMode 属性为 Windows 或混合身份验证模式
    srv1.IntegratedSecurity.SecurityMode = constAuth
    srv1.Disconnect
   
    ' 调用 Stop 方法停止服务器，直到服务器完全停止
    srv1.Stop
    Do Until srv1.Status = SQLDMOSvc_Stopped
    Loop
   
    ' 重新以混合模式启动服务器
    srv1.Start True, srvname
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing
End Sub

Sub ToWindowsAuthentication()
    Dim srv1 As SQLDMO.SQLServer
   
    ' 指定哪个服务器，默认为 Local (本地服务器)
    srvname = "(local)"
   
    ' 使用集成安全(Windows)方式新建一个 SQL Server 对象并进行连接
    Set srv1 = New SQLDMO.SQLServer
    srv1.LoginSecure = True
    srv1.Connect srvname
   
    ' 设置 SecurityMode 属性为 Windows 身份验证模式
    srv1.IntegratedSecurity.SecurityMode = SQLDMOSecurity_Integrated
    srv1.Disconnect
   
    ' 调用 Stop 方法停止服务器，直到服务器完全停止
    srv1.Stop
    Do Until srv1.Status = SQLDMOSvc_Stopped
    Loop
   
    ' 重新以混合模式启动服务器
    srv1.Start True, srvname
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing

End Sub

Sub WindowsToMixedAuthentication()
Dim srv1 As SQLDMO.SQLServer

    ' 指定哪个服务器，默认为 Local (本地服务器)
    srvname = "(local)"
   
    ' 使用集成安全(Windows)方式新建一个 SQL Server 对象并进行连接
    Set srv1 = New SQLDMO.SQLServer
    srv1.LoginSecure = True
    srv1.Connect srvname
   
    ' 设置 SecurityMode 属性混合身份验证模式
    srv1.IntegratedSecurity.SecurityMode = SQLDMOSecurity_Mixed
    srv1.Disconnect
   
    ' 调用 Stop 方法停止服务器，直到服务器完全停止
    srv1.Stop
    Do Until srv1.Status = SQLDMOSvc_Stopped
    Loop
   
    ' 重新以混合模式启动服务器
    srv1.Start True, srvname
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing

End Sub

Sub CallOpenADPWindowsOrSQLServer()
    Dim srvname As String
    Dim dbname As String
    Dim prpath As String
    Dim prname As String
    Dim suid As String
    Dim pwd As String
    Dim bolWindowsLogin As Boolean
   
    ' 设置打开 ADP 程序的参数
    srvname = "(local)"
    dbname = "NorthwindCS"  ' ADP 连接的数据库
    prpath = "C:\Documents and Settings\Administrator\My Documents\"    ' ADP 文件所在的磁盘位置
    prname = "NorthwindCS"  ' ADP 文件名
    suid = "msdn5"
    pwd = "password"
   
    ' 该参数用于控制当前用户使用 Windows 登录
    ' 代替 SQL Server 的 suid 和 pwd
    bolWindowsLogin = False
   
    ' 使用 Windows 或 SQL Server 登录调用打开名为 prname ADP 的子程序
    OpenADPWindowsOrSQLServer srvname, dbname, prpath, prname, suid, pwd, bolWindowsLogin
End Sub

Sub OpenADPWindowsOrSQLServer(srvname As String, dbname As String, _
    prpath As String, prname As String, _
    suid As String, pwd As String, bolWindowsLogin As Boolean)

    Dim bolLeaveOpen As Boolean
    Dim strPrFilePath As String
    Dim sConnectionString As String
   
    ' 是否保持现有打开的程序?
    If MsgBox("在该过程中是否关闭打开的 ADP?", vbYesNo) = vbYes Then
        bolLeaveOpen = True
    End If
   
    ' 新建 Access 会话实例 (使用 .9 : Access 2000, .10 : access 2002)
    Set appAccess = CreateObject("access.Application.9")
   
    ' 使用登录名和口令打开 ADP 并使其可视
    strPrFilePath = prpath & prname
    appAccess.OpenaccessProject strPrFilePath
    appaccess.Visible = True
   
    ' 指定 ADP 使用的新的 Windwos 或 SQL Server 登录方式
    If bolWindowsLogin Then
        appaccess.CurrentProject.OpenConnection _
            "PROVIDER=SQLOLEDB.1;INTEGRATED SECURITY=SSPI;" & _
            "PERSIST SECURITY INFO=FALSE;INITIAL CATALOG=" & _
            dbname & ";DATA SOURCE=" & srvname
    Else
        sConnectionString = "PROVIDER=SQLOLEDB.1;INITIAL CATALOG=" & _
            dbname & ";DATA SOURCE=" & srvname
        appaccess.CurrentProject.OpenConnection _
            sConnectionString, _
            suid, pwd
    End If
   
    ' 按上面提出的要求关闭 access 会话实例
    If bolLeaveOpen = False Then
        appaccess.CloseCurrentDatabase
        Set appaccess = Nothing
    End If
End Sub

Sub CallLoginDemo()
    Dim srvname As String
    Dim suid As String
    Dim pwd As String
   
    ' 设置登录 SQL Server 的参数
    srvname = "(local)"
    suid = "sa"
    pwd = ""
   
    ' 调用 SQL Server 登录子程序
    LoginDemo srvname, suid, pwd
End Sub

Sub LoginDemo(srvname As String, suid As String, pwd As String)
    Dim srv1 As SQLDMO.SQLServer
    Dim lgn1 As SQLDMO.Login
   
    ' 新建一服务器实例
    Set srv1 = New SQLDMO.SQLServer
   
    ' 以 SQL Server 方式连接 SQL Server
    srv1.Connect srvname, suid, pwd
   
    ' 新建登录对象
    Set lgn1 = New SQLDMO.Login
   
    ' 添加默认 SQL Server 登录 msdn6
    lgn1.Name = "UserX"
    lgn1.Database = "NorthwindCS"
    lgn1.SetPassword "", "password"
    srv1.Logins.Add lgn1
   
    '重新新建登录对象
    Set lgn1 = New SQLDMO.Login
   
    ' 添加基于 Windows 组 SQL_users 的登录对象
    lgn1.Name = "MYDESK\UserSQL"
    lgn1.Database = "NorthwindCS"
    lgn1.Type = SQLDMOLogin_NTGroup
    srv1.Logins.Add lgn1
   
    ' 在添加登录后，列出登录列表
    Debug.Print "添加 2 个新登录后的登录列表:"
    For Each lgn1 In srv1.Logins
        Debug.Print DecodeLoginType(lgn1.Type), lgn1.Name
    Next lgn1
   
    ' 删除刚新建的登录
    srv1.Logins.Remove "MYDESK\UserSQL"
    srv1.Logins.Remove "UserX"
   
    ' 列出登录列表
    Debug.Print vbCr & "删除 2 个新登录后的登录列表:"
    For Each lgn1 In srv1.Logins
        Debug.Print DecodeLoginType(lgn1.Type), lgn1.Name
    Next lgn1
   
    ' 断开连接
    srv1.Disconnect
    Set srv1 = Nothing
End Sub

Function DecodeLoginType(lgn_type As Byte) As String

    Select Case lgn_type
        Case 0
            DecodeLoginType = "SQLDMOLogin_NTUser"
        Case 1
            DecodeLoginType = "SQLDMOLogin_NTGroup"
        Case 2
            DecodeLoginType = "SQLDMOLogin_Standard"
        Case Else
            DecodeLoginType = "超出范围"
    End Select

End Function

Sub MakeLoginWithDatareaderUser()
    Dim srv1 As SQLDMO.SQLServer
    Dim lgn1 As SQLDMO.Login
    Dim usr1 As SQLDMO.User
    Dim srvname As String
    Dim suid As String
    Dim pwd As String
    Dim dbname As String
    Dim prpath As String
    Dim prname As String
    Dim bolWindowsLogin As Boolean
   
    ' 设置参数
    srvname = "(local)"
    suid = "sa"
    pwd = ""
    dbname = "NorthwindCS"
   
    ' 新建服务器实例
    Set srv1 = New SQLDMO.SQLServer
   
    ' 以 SQL Server 登录方式进行连接
    srv1.Connect srvname, suid, pwd
   
    ' 新建一个 SQL Server 登录对象 UserX
    suid = "UserX"
    Set lgn1 = New SQLDMO.Login
    lgn1.Name = suid
    lgn1.Database = dbname
    lgn1.SetPassword "", pwd
    srv1.Logins.Add lgn1
   
    ' 在数据库 NorthwindCS 上新建一个用户对象 UserX，并与登录对象 UserX 相关联
    Set usr1 = New SQLDMO.User
    usr1.Name = suid
    usr1.Login = lgn1.Name
    srv1.Databases(dbname).Users.Add usr1
    srv1.Databases(dbname).DatabaseRoles("db_datareader").AddMember usr1.Name
   
    ' 设置调用 ADP 的子程序参数
    prpath = "C:\Documents and Settings\Administrator\My Documents\"
    prname = "NorthwindCS"
   
    ' 该参数用于控制当前用户使用 Windows 登录
    ' 代替 SQL Server 的 suid 和 pwd
    bolWindowsLogin = False
   
    ' 使用 Windows 或 SQL Server 登录调用打开名为 prname ADP 的子程序
    OpenADPWindowsOrSQLServer srvname, dbname, prpath, prname, suid, pwd, bolWindowsLogin
End Sub

Sub CleanUpAfterMakeLoginWithDAtaReader()
    Dim srv1 As New SQLDMO.SQLServer
   
    srv1.Connect "(local)", "sa", ""
   
    srv1.Databases("NorthwindCS").Users.Remove "UserX"
    srv1.Logins.Remove "UserX"
End Sub