cmysql.cls

Usb Key loock vb soucrse code. ocx not found

'Public Sub fetch_row()
'Public Sub field_count()
'Public Sub field_seek()
'Public Sub field_tell()
Private Sub data_seek(row As Long)  'Seeks to an arbitrary row in a query result set.
  Dim A As Double
  CopyMemory A, convertl264(row).bytes(1), 8
   Call API_mysql_data_seek(myRec_res, A)
End Sub

Public Sub ping()
  Dim ret As Long
  ret = API_mysql_ping(myRec)
  If ret <> 0 Then Err.Raise API_mysql_errno(myRec), "cMysql::ping", ptr2str(API_mysql_error(myRec))
End Sub
Public Function query(SQL As String) As Recordset
Dim ret As Long
 ret = API_mysql_query(myRec, StrPtr(StrConv(SQL, vbFromUnicode)))
 If ret = 0 Then 'query was good
  ret = API_mysql_store_result(myRec)
   If ret Then
     CopyMemory myRec_res, ByVal ret, LenB(myRec_res)
     Set query = ConvertResult(myRec_res)
   End If
  Else
 Err.Raise API_mysql_errno(myRec), "cMysql::query", ptr2str(API_mysql_error(myRec))
 ' frmerror.XLabel1.Caption = "度鞍篮 酒捞叼啊 粮犁钦聪促." & vbCrLf _
  '                          & "促弗 酒捞叼甫 涝仿窍绞矫坷."
  'frmerror.Show 1
  Exit Function
  End If
End Function
Public Function real_query(query As String, Length As Long) As Recordset
Dim ret As Long
Dim rs As Recordset
 ret = API_mysql_real_query(myRec, StrPtr(StrConv(query, vbFromUnicode)), Length)
 If ret = 0 Then 'query was good
  ret = API_mysql_store_result(myRec)
   If ret Then
     CopyMemory myRec_res, ByVal ret, LenB(myRec_res)
     Set real_query = ConvertResult(myRec_res)
   End If
  Else
  Err.Raise API_mysql_errno(myRec), "cMysql::real_query", ptr2str(API_mysql_error(myRec))
  End If
End Function
Public Sub Refresh(refresh_options As API_refresh_options)
Dim ret As Long
  ret = API_mysql_refresh(myRec, refresh_options)
  If ret <> 0 Then Err.Raise API_mysql_errno(myRec), "cMysql::refresh", ptr2str(API_mysql_error(myRec))
End Sub
Public Sub select_db(DB As String)
Dim ret As Long
  ret = API_mysql_select_db(myRec, StrPtr(StrConv(DB, vbFromUnicode)))
  If ret <> 0 Then Err.Raise API_mysql_errno(myRec), "cMysql::select_db", ptr2str(API_mysql_error(myRec))
End Sub
Public Sub shutdown()
Dim ret As Long
  ret = API_mysql_shutdown(myRec)
  If ret <> 0 Then Err.Raise API_mysql_errno(myRec), "cMysql::shutdown", ptr2str(API_mysql_error(myRec))
End Sub
Public Function stat() As String
Dim ret As Long
 ret = API_mysql_stat(myRec)
 If ret <> 0 Then stat = ptr2str(ret) Else Err.Raise API_mysql_errno(myRec), "cMysql::stat", ptr2str(API_mysql_error(myRec))
End Function
Public Function thread_id() As Long
Dim ret As Long
 ret = API_mysql_thread_id(myRec)
 If ret <> 0 Then thread_id = ret Else Err.Raise API_mysql_errno(myRec), "cMysql::thread_id", ptr2str(API_mysql_error(myRec))
End Function
Public Function thread_safe() As Long
thread_safe = API_mysql_thread_safe
End Function

'##############################################################################'
'right now i automatically use these to store and convert into recordsets
'  Public Sub store_result()
'  Public Sub use_result()
'##############################################################################'

'##############################################################################'
'   Functions I needed to do some conversions...
'##############################################################################'
'Translate MYSQL_RES's into Recordsets so our users can use recordsets
' instead of MySQL proprietary types...
' NOTE: if you use ADO,DAO,RDO..change code here
'       this is actually the core of the translation
Private Function ConvertResult(m As API_MYSQL_RES) As Recordset
Dim m_fieldcount As Long
Dim m_rowcount As Long
Dim i As Long
Dim j As Long
Dim ret As Long
Dim s As String
Dim rs As Recordset
Dim PickUp() As Long


  Set rs = New Recordset
  m_fieldcount = myRec_res.field_count
  m_rowcount = convert642l(myRec_res.row_count)
  ReDim PickUp(1 To m_fieldcount) 'if we don't have any..mysql should error before we get into trouble
  With rs
          For i = 1 To m_fieldcount  'append the fields to the recordset
            ret = API_mysql_fetch_field(myRec_res)
            If ret Then
             CopyMemory myRec_field, ByVal ret, LenB(myRec_field)
             '#################################################################
             ' you may need to alter the line below to meet your specifications
             ' if you use a different type of recordset. As of now everything
             ' is a bstr..i'll change this later
             .Fields.Append ptr2str(myRec_field.name), adBSTR, myRec_field.Length
             '#################################################################
             End If
          Next
          .Open
            For j = 1 To m_rowcount  'append rows to the recordset
               ret = API_mysql_fetch_row(myRec_res) 'fetch a row
               If ret Then
                CopyMemory PickUp(1), ByVal ret, SIZE_OF_CHAR * m_fieldcount 'copy it into array so we can pick it up
                .AddNew
                    For i = 1 To m_fieldcount
                       s = ptr2str(PickUp(i))
                      '#################################################################
                      ' you may need to alter the line below to meet your specifications
                      ' if you use a different type of recordset
                      .Fields(i - 1) = s
                      '#################################################################
                   Next i
               End If
            Next j
         .UpdateBatch adAffectAllChapters
  End With
  Set ConvertResult = rs
End Function
'convert an lpstrsz to a visual basic valid bstr
Private Function ptr2str(ByVal ptr As Long) As String
On Error Resume Next
    If ptr = 0 Then Exit Function    'yeah..should never happen though
    Dim test As Byte
    Dim sout() As Byte
    Dim cchars As Long
     cchars = lstrlen(ptr)
     If cchars = 0 Then Exit Function
     ReDim sout(1 To cchars)                   'byte array
     sout = String$(cchars, " ")
     CopyMemory sout(1), ByVal (ptr), cchars
    ptr2str = StripNull(StrConv(sout, vbUnicode))  'convert byte array (lpstr) to unicode
End Function
Private Function StripNull(sName As String) As String
   Dim f As Long
   f = InStr(sName, vbNullChar)
   If f > 0 Then
    StripNull = Trim(left$(sName, f - 1))
   Else
    StripNull = sName
   End If
End Function
' We must call this sub to calculate a pseudo-64 bit number
' because vb6 as of now doesn't support 64 bit unsigned integers
' so we convert a 64 to 32 bit integer (long)
' it is an 8 byte structure, so the last 4 we just NEVER use
' note: the limit on this is 2,147,483,647 (you could also transform into single)
'       so don't try and retrieve more than 2 billion records! :)
Private Function convert642l(A As API_myulonglong) As Long
Dim res As Long
  CopyMemory res, A.bytes(1), 4
  convert642l = res  'return our result from computations
End Function
' opposite of the above function:
' converts a long to a 64 bit ulonglong type
Private Function convertl264(l2convert As Long) As API_myulonglong
Dim A As API_myulonglong
  CopyMemory A.bytes(1), l2convert, 4
  convertl264 = A
End Function
'##############################################################################'
'#          Property Declarations..                                           #'
'#                         Host,Username,Password,db,port,clientflag,         #'
'#                                        unix_socket                         #'
'##############################################################################'
Public Property Let user(ByVal sUserName As String)
    mUser = sUserName
End Property
Public Property Get user() As String
   user = mUser
End Property
Public Property Let Password(ByVal sPassword As String)
   mPassword = sPassword
End Property
Public Property Get Password() As String
  Password = mPassword
End Property
Public Property Let host(ByVal sHost As String)
   mHost = sHost
End Property
Public Property Get host() As String
  host = mHost
End Property
Public Property Let Port(ByVal sPort As Long)
  mPort = sPort
End Property
Public Property Get Port() As Long
  Port = mPort
End Property
Public Property Let DB(ByVal sDB As String)
  mDb = sDB
End Property
Public Property Get DB() As String
  DB = mDb
End Property
Public Property Let ClientFlags(ByVal sClientFlags As Long)
 mClientFlag = sClientFlags
End Property
Public Property Get ClientFlags() As Long
 ClientFlags = mClientFlag
End Property
Public Property Let Unix_Socket(ByVal sUnix_socket As String)
  mUnix_socket = sUnix_socket
End Property
Public Property Get Unix_Socket() As String
  Unix_Socket = mUnix_socket
End Property