VB6.0如何用 libmySQL.dll API访问MYSQL数据库

MYSQL 应用十分广范，很多网站几乎都在用他，因为他的小巧和灵活性等方面让我决定要对他进行研究，到现在已经成功的不用经过ODBC，ADO等方式就可以读取和更新数据。

 

好了不多罗嗦，以下我来介绍总个程序的细节:

 

（一）API声明

 

1.  '分配或初始化适合mysql_real_connect()的一个MYSQL对像。
Public Declare Function mysql_init Lib "libmySQL" (ByVal lMysql As Long) As Long

 

2. '关闭一个以前打开了的连接
Public Declare Sub mysql_close Lib "libmySQL" (ByVal lMysql As Long)

 

3. '能用於设置额外连接选项并且影响一个连接的行为。
'这个函数可以被多次调用来设置多个选项。
'mysql_options()应该在mysql_init()之後和mysql_connect()或mysql_real_connect()之前调用。
'option参数是你想要设置的选项；
'arg   参数是选项的值。如果选项是一个整数，那麽arg应该指向整数值。
Public Declare Function mysql_options Lib "libmySQL" _
                                (ByVal lMysql As Long, _
                                ByVal lOption As Long, _
                                ByVal sArg As String) As Long

 

4. 设置客户端访问的字符集 （这个很重要，访问中文时一定要用这个）

Public Declare Function mysql_set_character_set Lib "libmySQL" (ByVal lMysql As Long, ByVal cs_name As String) As Long

5.联接数据库

Public Declare Function mysql_real_connect Lib "libmySQL" _
                                (ByVal lMysql As Long, _
                                ByVal sHostName As String, _
                                ByVal sUserName As String, _
                                ByVal sPassword As String, _
                                ByVal sDbName As String, _
                                ByVal lPortNum As Long, _
                                ByVal sSocketName As String, _
                                ByVal lFlags As Long) As Long

 

6.执行查询操作

Public Declare Function mysql_query Lib "libmySQL" _
                                (ByVal lMysql As Long, ByVal sQueryString As String) As Long

 

7. 获取查询的结果集

Public Declare Function mysql_affected_rows Lib "libmySQL" (ByVal lMYSQL_RES As Long) As Long
Public Declare Sub mysql_data_seek Lib "libmySQL" _
                                (ByVal lMYSQL_RES As Long, ByVal lOffset As Currency)

Public Declare Function mysql_fetch_field_direct Lib "libmySQL" _
                                (ByVal lMYSQL_RES As Long, ByVal lFieldNum As Long) As Long
                               
Public Declare Function mysql_fetch_lengths Lib "libmySQL" (ByVal lMYSQL_RES As Long) As Long
Public Declare Function mysql_fetch_row Lib "libmySQL" (ByVal lMYSQL_RES As Long) As Long
Public Declare Function mysql_field_count Lib "libmySQL" (ByVal lMysql As Long) As Long

Public Declare Sub mysql_free_result Lib "libmySQL" (ByVal lMysql As Long)
Public Declare Function mysql_info Lib "libmySQL" (ByVal lMysql As Long) As Long
Public Declare Function mysql_insert_id Lib "libmySQL" (ByVal lMysql As Long) As Long
Public Declare Function mysql_num_fields Lib "libmySQL" (ByVal lMYSQL_RES As Long) As Long
Public Declare Function mysql_num_rows Lib "libmySQL" (ByVal lMYSQL_RES As Long) As Long
Public Declare Function mysql_store_result Lib "libmySQL" (ByVal lMysql As Long) As Long
Public Declare Function mysql_use_result Lib "libmySQL" (ByVal lMysql As Long) As Long

 

8. 出错信息获取

'status and error-reporting routines
Public Declare Function mysql_errno Lib "libmySQL" (ByVal lMysql As Long) As Long
Public Declare Function mysql_error Lib "libmySQL" (ByVal lMysql As Long) As Long

 

9. MYSQL 字段结构

Public Type typ_MYSQL_FIELD
   FieldName As Long           '字段名称，由Null终结的字符串。如果用AS子句为该字段指定了别名，名称的值也是别名。
   org_Name As Long            '段名称，由Null终结的字符串。忽略别名。
   Table As Long               '包含该字段的表的名称，如果该字段不是计算出的字段的话。对于计算出的字段，表值为空的字符串。如果用AS子句为该表指定了别名，表的值也是别名。
   org_table As Long           '表的名称，由Null终结的字符串。忽略别名。
   Db As Long                  '字段源自的数据的名称，由Null终结的字符串。如果该字段是计算出的字段，db为空的字符串。
   Catalog As Long             'catalog名称。该值总是"def"。
   Def As Long                 '该字段的默认值，由Null终结的字符串。仅当使用mysql_list_fields()时才设置它。
   Length As Long              '字段的宽度，如表定义中所指定的那样。
   Max_length As Long          '用于结果集的字段的最大宽度（对于实际位于结果集中的行，最长字段值的长度）。如果使用mysql_store_result()或mysql_list_fields()，它将包含字段的最大长度。如果使用mysql_use_result()，该变量的值为0。
   Name_length As Long         '名称的长度。
   org_name_length As Long     'org_name的长度。
   Table_length As Long        '表的长度。
   org_table_length As Long    'org_table的长度。
   Db_length As Long           'db的长度。
   Catalog_length As Long      'catalog的长度。
   Def_length As Long          'def的长度。
   Flags As Long               '用于字段的不同“位标志”
   Decimals As Long            '用于数值字段的十进制数数目。
   Charsetnr As Long           '用于字段的字符集编号。
   FieldType As Long           '字段的类型
End Type

 

10. 要用到的WINDOS API

Public Const LONG_SIZE = 4
Public Const INT_SIZE = 2
Public Const BYTE_SIZE = 1

Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                                (lpDestination As Any, _
                                lpSource As Any, _
                                ByVal lLength As Long)

 

11. 常量

 

Public Enum MYSQL_OPTION
    MYSQL_OPT_CONNECT_TIMEOUT = 0        '以秒计的连接超时。
    MYSQL_OPT_COMPRESS = 1               '使用压缩的客户机/服务器协议。
    MYSQL_OPT_NAMED_PIPE = 2             '使用命名管道连接一个在NT上的MySQL服务器。
    MYSQL_INIT_COMMAND = 3               '当连接MySQL服务器时执行的命令。
                                         '当重新连接时，将自动重新执行。
    MYSQL_READ_DEFAULT_FILE = 4          '从命名的选项文件而不是从“my.cnf”读取选项。
    MYSQL_READ_DEFAULT_GROUP = 5         '从“my.cnf”或用MYSQL_READ_DEFAULT_FILE指定的文件中的命名组中读取选项。
    'MYSQL_SET_CHARSET_DIR = 6
    'MYSQL_SET_CHARSET_NAME = 7
End Enum

' absolute position enum
Public Enum enumAbsolutePosition
    MY_POS_BOF = -3
    MY_POS_EOF = -2
    MY_POS_UNKNOWN = -1
End Enum

 

Public Enum MYSQL_FLAG
    CLIENT_LONG_PASSWORD = 1             'new more secure passwords
    CLIENT_FOUND_ROWS = 2                'Found instead of affected rows
    CLIENT_LONG_FLAG = 4                 'Get all column flags
    CLIENT_CONNECT_WITH_DB = 8           'One can specify db on connect
    CLIENT_NO_SCHEMA = 16                'Don't allow database.table.column
    CLIENT_COMPRESS = 32                 'Can use compression protocol
    CLIENT_ODBC = 64                     'Odbc client
    CLIENT_LOCAL_FILES = 128             'Can use LOAD DATA LOCAL
    CLIENT_IGNORE_SPACE = 256            'Ignore spaces before '('
    CLIENT_CHANGE_USER = 512             'Support the mysql_change_user()
    CLIENT_INTERACTIVE = 1024            'This is an interactive client
    CLIENT_SSL = 2048                    'Switch to SSL after handshake
    CLIENT_IGNORE_SIGPIPE = 4096         'IGNORE sigpipes
    CLIENT_TRANSACTIONS = 8196           'Client knows about transactions
'#define CLIENT_MULTI_STATEMENTS (1UL << 16) /* Enable/disable multi-stmt support */
'#define CLIENT_MULTI_RESULTS    (1UL << 17) /* Enable/disable multi-results */
    CLIENT_MULTI_STATEMENTS = 65536
    CLIENT_MULTI_RESULTS = 131072
End Enum

 

' connection state enum
Public Enum MYSQL_CONNECTION_STATE
    MY_CONN_OPEN = 0
    MY_CONN_CLOSED = 1
End Enum

 

 

（二）打开数据库联接

Private Type MyOption                      
    eOption As MYSQL_OPTION
    sArg As String
End Type

Private MyOptArr() As MyOption            

Private m_MYSQL As Long                     'pointer to mysql connection

 

 

‘打开数据库联接

’sHostName 主机名称

‘sUserName 用户名

’sPassword 密码

‘sDbName 数据库名称

’lPortNum 端口号

’lFlags 联接参数

‘cs_name 字符集

Function OpenConnection(ByVal sHostName As String, _
                               ByVal sUserName As String, _
                               ByVal sPassword As String, _
                               ByVal sDbName As String, _
                      Optional ByVal lPortNum As Long = 3306, _
                      Optional ByVal lFlags As MYSQL_FLAG, _
                      Optional ByVal cs_name As String) As MYSQL_CONNECTION_STATE
Dim lNumber As Long
   
    Me.CloseConnection
    OpenConnection = m_State

    gServerName = sHostName
    gUserID = sUserName
    gUserPass = sPassword
    gDbName = sDbName
    gPortNum = lPortNum
    gOptions = lFlags
    gCharacterSetName = cs_name
    m_MYSQL = mysql_init(m_MYSQL)
   
    If m_MYSQL = 0 Then
        Err.Raise vbObjectError + 1, "OpenConnection", "Couldn't obtain a connection handler."
        Exit Function
    Else
        If UBound(MyOptArr) > 0 Then
            Dim i As Integer
            'set options
            For i = 1 To UBound(MyOptArr)
                Select Case MyOptArr(i).eOption
                Case MYSQL_OPT_CONNECT_TIMEOUT
                    mysql_options m_MYSQL, MYSQL_OPT_CONNECT_TIMEOUT, MyOptArr(i).sArg
                Case MYSQL_OPT_COMPRESS
                    mysql_options m_MYSQL, MYSQL_OPT_COMPRESS, 0
                Case MYSQL_OPT_NAMED_PIPE
                    mysql_options m_MYSQL, MYSQL_OPT_NAMED_PIPE, 0
                Case MYSQL_INIT_COMMAND
                    mysql_options m_MYSQL, MYSQL_INIT_COMMAND, MyOptArr(i).sArg
                Case MYSQL_READ_DEFAULT_FILE
                    mysql_options m_MYSQL, MYSQL_READ_DEFAULT_FILE, MyOptArr(i).sArg
                Case MYSQL_READ_DEFAULT_GROUP
                    mysql_options m_MYSQL, MYSQL_READ_DEFAULT_GROUP, MyOptArr(i).sArg
                End Select
            Next i
        End If

        If mysql_real_connect(m_MYSQL, gServerName, gUserID, gUserPass, gDbName, gPortNum, m_CESApp.SoftWare, gOptions) = 0 Then
            'connection attempt NG ...
            CheckForError "OpenConnection"
            pRealClose
        Else
            m_State = MY_CONN_OPEN
           
            If cs_name <> "" Then
               gCharacterSetName = UCase(gCharacterSetName)
              
               lNumber = mysql_set_character_set(m_MYSQL, gCharacterSetName)
               If lNumber > 0 Then
                  CheckForError "OpenConnection"
               End If
            End If
        End If
    End If

    OpenConnection = m_State
End Function

 

‘錯誤檢查

Private Sub CheckForError(ByVal vProcName As String)

    Dim lNumber As Long

    Dim LPSTR As Long

 

    lNumber = mysql_errno(m_MYSQL)

 

    If lNumber <> 0 Then

        LPSTR = mysql_error(m_MYSQL)

        Err.Raise lNumber, vProcName, CStringPointerToVbString(LPSTR)

    End If

End Sub
 

（三）执行SQL语句并获取数据

Private m_CurrentRecord   As Long                  'current record #

Private m_RowCount     As Long                     'number of records in result set

Private m_FieldCount      As Long                  'number of fields in result set

 

Private m_AffectedRecords As Long                  'number of rows affected by query

Private m_MySqlString As String                    'last sql statement queried on this rs object

 

Private m_MYSQL_RES As Long                        'pointer to mysql result set

Private m_MYSQL_ROW As Long                        'pointer to mysql row

Private m_MYSQL_FIELD_LENGTHS As Long              'pointer to array of column lengths

 

Function OpenRecordset(sSQL As String, _

                               lMysql As Long, _

                               bGotError As Boolean) As enumRecordSetState

    Dim lRc As Long

    CloseRecordset

    m_AffectedRecords = 0

    OpenRecordset = m_State

 

    m_MySqlString = sSQL

      

    If gSystemDebugSQL Then

       WriteToLog sSQL

    End If

       

    lRc = mysql_real_query(lMysql, sSQL, lstrlen(sSQL))

    If lRc <> 0 Then

        bGotError = True

        m_State = MY_RS_CLOSED

        OpenRecordset = MY_RS_CLOSED

        Exit Function

    End If

 

    m_MYSQL_RES = mysql_store_result(lMysql)

 

    If m_MYSQL_RES = 0 Then

        lRc = mysql_field_count(lMysql)

 

        If lRc = 0 Then

            m_AffectedRecords = mysql_affected_rows(lMysql)

        Else

            bGotError = True

            Exit Function

        End If

    Else

        m_AffectedRecords = mysql_affected_rows(lMysql)

        m_RowCount = mysql_num_rows(m_MYSQL_RES)

        m_FieldCount = mysql_num_fields(m_MYSQL_RES)

 

        'start by pointing to row #1

        m_CurrentRecord = 1

        m_State = MY_RS_OPEN

        OpenRecordset = m_State

        'reposition the record pointer

        pGetRow

    End If

End Function

 

Private Sub pGetRow()

    If m_CurrentRecord > 0 And m_CurrentRecord <= m_RowCount Then

        Dim cSeekRow As Currency

 

        'adjust because currency fields have 4 fixed decimals

        ' 1.000 gets adjusted to 0.001

        cSeekRow = (m_CurrentRecord - 1) / (10 ^ 4)

 

        mysql_data_seek m_MYSQL_RES, cSeekRow

 

        m_MYSQL_ROW = mysql_fetch_row(m_MYSQL_RES)

        m_MYSQL_FIELD_LENGTHS = mysql_fetch_lengths(m_MYSQL_RES)

    Else

        m_MYSQL_ROW = 0

        m_MYSQL_FIELD_LENGTHS = 0

    End If

End Sub

 

Function SetProperties(ByRef vRequestedField As Variant, _

                              ByRef lFieldCount As Long, _

                              ByRef lMYSQL_RES As Long, _

                              ByRef lMYSQL_ROW As Long, _

                              ByRef lMYSQL_FIELD_LENGTHS As Long)

 

    'setup the values required for handling MYSQL_FIELD properties ...

 

    m_FieldCount = lFieldCount              'set the field count

    m_MYSQL_RES = lMYSQL_RES                'set the pointer to the result set

    m_MYSQL_ROW = lMYSQL_ROW                'set the pointer to the current row

    'set the pointer to the arrary of column lengths

    m_MYSQL_FIELD_LENGTHS = lMYSQL_FIELD_LENGTHS

 

    If IsNumeric(vRequestedField) Then

        'column referenced by index

        m_RequestedField = vRequestedField

    Else

        'column referenced by name

        pBuildNameCollection

        m_RequestedField = pGetFieldFromNameCollection(vRequestedField)

    End If

 

    'check for any invalid values

    If m_RequestedField < 0 _

            Or m_FieldCount = 0 _

            Or m_RequestedField >= m_FieldCount Then

        m_MYSQL_RES = 0

        m_MYSQL_ROW = 0

        m_MYSQL_FIELD_LENGTHS = 0

    End If

End Function

 

‘獲取字段名集合

Private Sub pBuildNameCollection()

    'attempt to build collection of column names

    Dim lCnt As Long

    Dim sName As String

 

    On Local Error Resume Next      'in case multiple columns in rs have same name

 

    If oNames.Count = 0 And m_FieldCount > 0 Then

        For lCnt = 1 To m_FieldCount

            sName = pGetFieldName(lCnt - 1)

            If Len(sName) > 0 Then oNames.Add lCnt, sName

        Next

    End If

End Sub

 

Private Function pGetFieldFromNameCollection(ByRef vRequestedField As Variant) As Long

    On Local Error Resume Next      'in case requested field is not in collection ...

 

    If oNames.Count > 0 Then pGetFieldFromNameCollection = oNames.Item(vRequestedField)

    'collection is 1 based ... fields are 0 based

    pGetFieldFromNameCollection = pGetFieldFromNameCollection - 1

End Function

 

‘獲取字段名

Private Function pGetFieldName(ByRef lField As Long) As String

    Dim mField As typ_MYSQL_FIELD

 

    mField = pGetFieldStructure(lField)

 

    pGetFieldName = CStringPointerToVbString(mField.FieldName)

End Function

 

'获取 MYSQL 字段结构指针

Private Function pGetFieldStructure(ByRef lField As Long) As typ_MYSQL_FIELD

    Dim lMYSQL_FIELD As Long

    Dim mField As typ_MYSQL_FIELD

   

    If m_MYSQL_RES = 0 _

            Or lField < 0 _

            Or lField >= m_FieldCount Then

        Exit Function

    End If

 

    lMYSQL_FIELD = mysql_fetch_field_direct(m_MYSQL_RES, lField)

    'Debug.Print "Pointer to MYSQL_FIELD structure for field " & lField & " = " & pGetFieldStructure

   

    If lMYSQL_FIELD = 0 Then Exit Function

    CopyMemory mField, ByVal lMYSQL_FIELD, LenB(mField)

   

    Let pGetFieldStructure = mField

End Function

 

‘获取 MYSQL 字段值

Public Property Get Value() As Variant

    Dim lTmpChar As Long, lCurLen As Long

    Dim lRowData As Long

    Dim b() As Byte

    Dim sVal As String

    Dim sName As String

 

    'get pointer to requested field

    CopyMemory lRowData, ByVal (m_MYSQL_ROW + (LONG_SIZE * m_RequestedField)), LONG_SIZE

 

    'get length of requested field

    CopyMemory lCurLen, ByVal (m_MYSQL_FIELD_LENGTHS + (LONG_SIZE * m_RequestedField)), LONG_SIZE

 

    If lRowData = 0 Then

        Value = Null

    Else

        sVal = ""

        If lCurLen > 0 Then

            ReDim b(0 To (lCurLen - 1))

            'copy string to byte array

            CopyMemory b(0), ByVal lRowData, BYTE_SIZE * lCurLen

           

            'convert to unicode

            sVal = StrConv(b(), vbUnicode)

        Else

            sVal = ""

        End If

 

        Value = sVal

    End If

End Property

 

-- 完 --