mdlpublic.bas

配置数据库参数 采用VB6.0 ADO+SQL Server 2000数据库实现程序功能

Attribute VB_Name = "mdlPublic"
Option Explicit

Public g_Conn As Connection   '用于全局的数据连接

'ActiveX DLL的启动程序，DLL初始化时执行
Public Sub Main()
  If ConnectToDatabase = False Then MsgBox "连接数据库出错！", vbInformation
End Sub

'连接到数据库
Public Function ConnectToDatabase() As Boolean
  On Error GoTo ErrHandler
  Set g_Conn = New Connection
  '设置服务器名称，数据库名称，登录名（此时假设密码为空）
  Dim ServerName As String, DBName As String, UserName As String, strPassword As String
  '连接Sql Server的连接字符串设置
  ServerName = "(local)"
  DBName = "BuySaleStorage"
  UserName = "sa"
  strPassword = ""
  '连接到SQL Server数据库
  With g_Conn
    .CursorLocation = adUseClient
    .CommandTimeout = 100
    .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True" & _
                        ";User ID=" & UserName & ";Initial Catalog=" & DBName & _
                        ";Data Source=" & ServerName & ";pwd=" & strPassword
    .Open
  End With
  '函数返回值
  ConnectToDatabase = True
  Exit Function
ErrHandler:
  ConnectToDatabase = False
  MsgBox Err.Description, vbInformation
End Function

'替换字符串中的单引号
Public Function RealString(strOrigional) As String
  RealString = Replace(strOrigional, "'", "''")
End Function

'根据给定的主键值，获取某一指定的字段值（字符型）
Public Function GetValueByID(ByVal strTable As String, ByVal strId As String, _
                             ByVal lngID As Long, ByVal strValueField As String) As String
'参数：第一个为表名，第二个为主键字段名，第三个为主键字段值，第四个为要获取值（字符型）的字段名
  Dim rs As Recordset
  Set rs = g_Conn.Execute("SELECT " & strValueField & " FROM " & strTable & _
                          " WHERE " & strId & " = " & lngID)
  If rs.RecordCount = 1 Then
    GetValueByID = rs(0).Value
  Else
    GetValueByID = ""
  End If
  Set rs = Nothing
End Function