如何实现数据库访问的安全性（*********在线等候，答者给分********************）

可以考虑用COM+组件实现，一种方法供参考
1、构造数据库连接组件DatabaseConnect.DLL，从DB.INI文件中读取连接信息,另可加入加密解密组件于服务器上，加密组件无须发布
2、将组件发布于服务器上，导出组件安装程序*.msi（也可通过程序中创建）
3、在客户端安装，注意权限等问题，可在服务器组件管理中设置
这样数据库密码改变后可不需更改客户端设置

请问导出组件安装程序怎样实现。在服务中也可以直接添加的。服务器组件和数据库连接组件怎样设置，怎样才可以控制权限用dll，不知道能否给出代码，因为我从来没有编写过com+组件，平时在ERP软件的实施中也经常碰到谢谢。

TO kingbear2000(相信自己) ：
你把没办法实现的地方说清楚，如果明天还未解决的话，我再说说我的做法。今天有事，要下线了

直接用com组件，封装数据库的信息或业务逻辑
这样com组件和程序都保留在客户端使用com+组件
1、构造数据库连接组件DatabaseConnect.DLL，从DB.INI文件中读取连接信息,另可加入加密解密组件于服务器上，加密组件无须发布
2、将组件发布于服务器上，导出组件安装程序*.msi
3、在客户端安装，注意权限等问题，可在服务器组件管理中设置
这样数据库密码改变后可不需更改客户端设置
同意

http://www.ourfly.com/forum/View.aspx?fbId=9&Id=307在com中完成数据库的操作或者业务逻辑的封装。http://expert.csdn.net/Expert/topic/1747/1747840.xml?temp=.1829492
举个例子
新建ACTIVE DLL工程,工程名COM_Test,类名clsAdd,类中粘贴代码:
Option Explicit
Public x, y As Integer
Public Function myAdd() As Integer
myAdd = x + y
End Function
编译得到COM_Test.dll,下面开始注册组件
开始-设置-控制面板-组件服务,找到COM+应用程序,右键新建应用程序,创建一个空应用程序,就叫myadd吧,然后右键新建组建,导入刚才生成的COM_Test.dll,成功以后点击myadd应用程序,将其导出,注意类型选代理,就会生成myadd.msi和myadd.msi.cab两个文件Option Explicit
Dim myAdd As New clsAddPrivate Sub Command1_Click()With myAdd
    .x = Val(Text1.Text)
    .y = Val(Text2.Text)
    Text3.Text = .myAdd
End WithEnd SubPrivate Sub Command2_Click()
Set myAdd = Nothing
End
End SubPrivate Sub Form_Load()
Set myAdd = New clsAdd
End Sub
然后编译生成COM_CLIENT.EXE,将这个文件和刚才导出的两个文件复制到客户机上(WIN2000),
在客户机上安装myadd.msi,再运行COM_CLIENT.EXE试试!
注意在客户机登录的用户要有安装和访问服务器组件的权限!

但是对于一般的程序而言，使用com组件就可以了对于企业级的考虑com+这是一个vb的com组件，用于asp的，希望对你有帮助
启动vb6.0，新建-->Active  dll工程。单击"工程"-->引用,选择"microsoft  active  server  pages  object  library"
和"microsoft  activeX  data  objects  2.1  library"两项。将类模块的名称改为dcss.将工程的名称改为yygwy.保存工程文件yygwy.vbp和类文件dcss.cls。
在dcss.cls中写入:
Private  myscriptingcontext  As  ScriptingContext
Private  myapplication  As  Application
Private  myrequest  As  Request
Private  myresponse  As  Response
Private  myserver  As  Server
Private  mysession  As  Session Public  Sub  onstartpage(passedscriptingcontext  As  ScriptingContext)
Set  myscriptingcontext  =  passedscriptingcontext
Set  myapplication  =  myscriptingcontext.Application
Set  myrequest  =  myscriptingcontext.Request
Set  myresponse  =  myscriptingcontext.Response
Set  myserver  =  myscriptingcontext.Server
Set  mysession  =  myscriptingcontext.Session
End  Sub Public  Sub  onendpage()
Set  myscriptingcontext  =  Nothing
Set  myapplication  =  Nothing
Set  myrequest  =  Nothing
Set  myresponse  =  Nothing
Set  myserver  =  Nothing
Set  mysession  =  Nothing
End  Sub '以上语句是必须的。
'定义两个公有函数 Public  Function  rsresult(strsql  As  String)  As  Recordset
Dim  mycnn  As  Connection
Dim  myset  As  Recordset
Dim  strconnstring  As  String
'strconnstring  =  "provider=sqloledb.1;
password=;"  &  "user  id=sa;"  &  "initial  catalog=vlog;"  &  "data  source=hpe60;
connect  timeout=15"
strconnstring  =  "driver={sql  server};server=yang;uid=sa;pwd=;
database=dcss"
'mycnn.ConnectionString  =  strconnstring
mycnn.Open  strconnstring
myset.ActiveConnection  =  mycnn
myset.Open  strsql,  mycnn,  3,  adCmdText
Set  rsresult  =  myset
End  Function Public  Function  datasource()  As  Variant
datasource  =  "driver={sql  server};server=yang;uid=sa;pwd=;  database=dcss"
End  Function 编译生成dcss.dll文件。注册regsvr32  路径\dcss.dll。
用visual  interdev打开global.asa文件.当然了，你也可以在其它文件中使用。
set    dcss=server.CreateObject("yygwy.dcss")
oconn=dcss.datasource()
application("strconn")=oconn   在其它的页面中如下调用即可：
set  objConn  =  Server.CreateObject("ADODB.Connection")
objConn.Open  application("strconn")

放在配置文件中dbconn.ini,
通过组件来读取即可
最后形成strconnstring = "driver={sql server};server=yang;uid=sa;pwd=;
这样的即可但是这样的话，ini文件要加密，麻烦抱歉，我在出差，没有vb

我想请问一下，直接生成的dll文件和com+组件应该不一样，好像我在别的资料上看上有上下文、事务的考虑，如果我是多用户请问如何处理。

数据库连接的例子（注：加密采用DES算法）
模块内容：
Option Explicit
'lpBuffer   :   buffer for system directory
'uSize      :   size of directory buffer
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
                        (ByVal lpBuffer As String, ByVal nSize As Long) As Long'lpAppName          :   section name
'lpKeyName          :   key name
'lpDefault          :   default string
'lpReturnedString   :   destination buffer
'nSize              :   size of destination buffer
'lpFileName         :   initialization file name
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
                                (ByVal lpApplicationName As String, _
                                 ByVal lpKeyName As Any, _
                                 ByVal lpDefault As String, _
                                 ByVal lpReturnedString As String, _
                                 ByVal nSize As Long, _
                                 ByVal lpFileName As String) As Long'lpAppName  :   section name
'lpKeyName  :   key name
'lpString   :   string to add
'lpFileName :   initialization file
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
                                (ByVal lpApplicationName As String, _
                                 ByVal lpKeyName As Any, _
                                 ByVal lpString As Any, _
                                 ByVal lpFileName As String) As Long
'////////////////////////////////////////////////////////////////////////////////
'// 函数功能：从ini配置文件中读取指定段名、关键字名的值
'// 调用语法: GetInIKeyValue(SectionName as string,KeyName As String,FileName As String)
'// 参数说明:
'//         SectionName :段名
'//         KeyName     :关键字名
'//         FileName    :ini文件名包括路径
'// 返回值:
'//         String      :返回关键字值
'// 处理说明:
'//         调用API函数GetPrivateProfileString
'//////////////////////////////////////////////////////////////////////////////
Public Function GetInIKeyValue(ByVal SectionName As String, _
                               ByVal KeyName As String, _
                               ByVal FileName As String) As String
    Dim KeyValue$
    Dim strTmp As String

    KeyValue$ = String$(512, " ")
    GetPrivateProfileString SectionName, KeyName, "", KeyValue$, 512, FileName
    strTmp = Trim(KeyValue$)
    GetInIKeyValue = Left(strTmp, Len(strTmp) - 1)
End Function'////////////////////////////////////////////////////////////////////////////////
'// 函数功能：从ini配置文件中写入指定段名、关键字名及值
'// 调用语法: SetInIKeyValue(SectionName as string,KeyName As String,KeyValue as string ,FileName As String)
'// 参数说明:
'//         SectionName :段名
'//         KeyName     :关键字名
'//         KeyValue    :关键字值
'//         FileName    :ini文件名包括路径
'// 返回值:
'// 处理说明:
'//         调用API函数WritePrivateProfileString
'//////////////////////////////////////////////////////////////////////////////
Public Sub SetInIKeyValue(ByVal SectionName As String, _
                           ByVal KeyName As String, _
                           ByVal KeyValue As String, _
                           ByVal FileName As String)
    Dim lng As Long

    lng = WritePrivateProfileString(SectionName, KeyName, KeyValue, FileName)
End Sub'////////////////////////////////////////////////////////////////////////////////
'// 函数功能：读取系统目录路径
'// 调用语法: GetSysDir()
'// 参数说明:
'// 返回值:
'//         String      :系统目录
'// 处理说明:
'//         调用API函数GetSystemDirectory
'//////////////////////////////////////////////////////////////////////////////
Public Function GetSysDir() As String
    Dim sysDir$
    Dim strTmp As String

    sysDir = String$(128, " ")
    GetSystemDirectory sysDir$, 127
    strTmp = Trim(sysDir$)
    GetSysDir = Left(strTmp, Len(strTmp) - 1)
End Function'////////////////////////////////////////////////////////////////////////////////
'// 函数功能：加密与解密字符串
'// 调用语法: PasswordEncrypt(ByVal strVar As String)
'// 参数说明:
'//         strVar  :   待加密字符
'// 返回值:
'//         String  :   已经加密字符串
'// 处理说明:
'//         255-取字符的ASCII码
'//////////////////////////////////////////////////////////////////////////////
Public Function PasswordEncrypt(ByVal strVar As String) As String
    Dim intI As Integer
    Dim bytVar() As Byte

    bytVar = StrConv(strVar, vbFromUnicode)
    For intI = LBound(bytVar) To UBound(bytVar)
        bytVar(intI) = (255 - bytVar(intI))
    Next intI
    strVar = StrConv(bytVar, vbUnicode)
    PasswordEncrypt = strVar
End Function

Class Model内容：(ConnectDB.CLS)
Option Explicit'********************************************************************************
'*   模块名称：ConnectDB
'*   功能描述：实现读取连接数据库对象
'********************************************************************************Const PKEY = "AA 44 78 19 CC B5 35 35"  '密钥Private mvaradoConn As ADODB.Connection '数据连接对象'数据连接对象为只读属性
Public Property Get adoConn() As ADODB.Connection
    If mvaradoConn.State <> adStateOpen Then
        Err.Raise vbObjectError + 514, , "当前没有建立数据连接"
    Else
        Set adoConn = mvaradoConn
    End If
End Property
Private Sub Class_Initialize()
    Dim objSP As SharedProperty                 '
    Dim objSPG As SharedPropertyGroup           '
    Dim objSPGM As SharedPropertyGroupManager   '
    Dim blnFlag As Boolean                      '
    Dim strConn As String                       '
    Dim strErr As String                        '
    Dim adoConn As ADODB.Connection             '

    On Error GoTo ErrorHandler

    Set adoConn = New ADODB.Connection
    adoConn.CursorLocation = adUseClient
    Set objSPGM = New SharedPropertyGroupManager
    Set objSPG = objSPGM.CreatePropertyGroup("DBConnect", LockSetGet, Standard, blnFlag)

    If blnFlag = False Then
        blnFlag = ReadConfig(strConn, strErr)
        If blnFlag = False Then GoTo ErrorHandler   '读取连接参数失败
        adoConn.Open strConn                        '连接数据库
        Set objSP = objSPG.CreateProperty("ConnectString", blnFlag)
        objSP.Value = strConn
    End If
    Set objSP = objSPG.CreateProperty("ConnectString", blnFlag)
    If blnFlag = False Then GoTo ExitHandler
    If adoConn.State <> adStateOpen Then adoConn.Open objSP.Value
    Set mvaradoConn = adoConn
    Set objSPGM = Nothing
    Exit Sub
ExitHandler:
    Set objSPGM = Nothing
    strErr = "缺少连接字符信息,无法建立与数据库连接"
ErrorHandler:
    If strErr = "" Then
        Err.Raise vbObjectError + 513, Err.Source, Err.Description   '可能是因为缺少加密解密组件而出错
    Else
        Err.Raise vbObjectError + 513, Me, strErr
    End If
End Sub
'********************************************************************************
'*   功能  描述：从数据库配置文件中读取连接信息DBConfig.ini
'*   参数  说明：
'*         输入：
'*         输出：strConn连接字串,strErr出错信息
'*   返回值说明：成功-->True，失败-->False
'********************************************************************************
Private Function ReadConfig(ByRef strConn As String, ByRef strErr As String) As Boolean
    Dim strProvider As String   '数据提供者
    Dim strSName As String      '服务器名Data Source
    Dim strDBName As String     '数据库名Initial Catalog
    Dim strUID As String        '数据库访问用户名
    Dim strPWD As String        '密码
    Dim strFlag As String       '密码加密标志
    Dim strFilePath As String   '配置文件DBConfig.ini存储路径
    Dim objEnt As UnicodeTextEncrypt.IUnicodeTextEncrypt
    Dim blnFlag As Boolean

    On Error GoTo ExitHandler
    strFilePath = App.Path & "\DBConfig.ini"
    strProvider = Trim(GetInIKeyValue("DatabaseInfo", "Provider", strFilePath))
    strSName = Trim(GetInIKeyValue("DatabaseInfo", "Data Source", strFilePath))
    strDBName = Trim(GetInIKeyValue("DatabaseInfo", "Initial Catalog", strFilePath))
    strUID = Trim(GetInIKeyValue("DatabaseInfo", "User ID", strFilePath))
    strPWD = Trim(GetInIKeyValue("DatabaseInfo", "Password", strFilePath))
    strFlag = Trim(GetInIKeyValue("DatabaseInfo", "Flag", strFilePath))

    If strProvider = "" Then
        strErr = "缺少数据提供者[Provider],请查看数据库配置文件DBConfig.ini"
        GoTo ExitHandler
    End If
    If strSName = "" Then
        strErr = "缺少数据源[Data Source],请查看数据库配置文件DBConfig.ini"
        GoTo ExitHandler
    End If
    strConn = "Provider=" & strProvider & ";Data Source=" & strSName
    If strDBName <> "" Then strConn = strConn & ";Initial Catalog=" & strDBName
    strConn = strConn & ";User ID=" & strUID & ";Password="
    If strPWD = "" Then GoTo ContineH   '不加密也不解密
    Set objEnt = New UnicodeTextEncrypt.DesUnicode
    If strFlag = "0" Then
        strConn = strConn & strPWD
        blnFlag = objEnt.UnicodeTextEncrypt(strPWD, PKEY)
        If Not blnFlag Then
            Set objEnt = Nothing
            strErr = "加密失败,请查看数据库配置文件DBConfig.ini"
            GoTo ExitHandler
        End If
        SetInIKeyValue "DatabaseInfo", "Password", "A" & strPWD & "A", strFilePath
        SetInIKeyValue "DatabaseInfo", "Flag", "1", strFilePath
    Else
        strPWD = Mid(strPWD, 2, Len(strPWD) - 2)
        blnFlag = objEnt.UnicodeTextDecrypt(strPWD, PKEY)
        If Not blnFlag Then
            Set objEnt = Nothing
            strErr = "解密失败,密文不正确,请查看数据库配置文件DBConfig.ini"
            GoTo ExitHandler
        End If
        strConn = strConn & strPWD
    End If
    Set objEnt = Nothing
ContineH:
    ReadConfig = True
    Exit Function
ExitHandler:
    If strErr = "" Then strErr = Err.Description        '可能是因为缺少加密解密组件而出错
    ReadConfig = False
End Function

注：类中需添加引用COM+ Services Type Library 及Microsoft ActiveX Data Objects 2.7 Library

调试易

如何实现数据库访问的安全性（*在线等候，答者给分************）

解决方案 »