' // reg API declarations.
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Friend Sub load_odbc_connectors(cbo As ComboBox)
Dim hKey As Long, Cnt As Long, sName As String, sData As String, ret As Long, RetData As Long
Const BUFFER_SIZE As Long = 255
ret = BUFFER_SIZE
' // Open the registry key
cbo.Clear
If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers", hKey) = 0 Then
' // Create a buffer
sName = Space(BUFFER_SIZE)
While RegEnumValue(hKey, Cnt, sName, ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
' // show data
If RetData > 0 Then
' // get the key
sName = Left$(sName, ret)
sName = IIf(InStr(1, sName, "(") > 0, Left(sName, InStr(1, sName, "(")), sName)
sName = Replace(sName, "(", "")
' // add to CBo
cbo.AddItem Left(sName, ret)
End If
' // prepare for next value
Cnt = Cnt + 1
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
ret = BUFFER_SIZE
RetData = BUFFER_SIZE
Wend
' // close the registry key
RegCloseKey hKey
End If
End Sub
Friend Function connect(db As ADODB.connection, adoConn As ADO_CONNECTION) As Boolean
' // set default return
connect = False
' // clear the error flags
db.Errors.Clear
' // set the error handler
On Error GoTo db_connect_err
If adoConn.server = "" Then
GoTo jmp99
End If
' // check to see if the connection is open, if so then close it.
If db.state = 1 Then
db.Close
'connect = True
'adoConn.state = db.state
'GoTo jmp99
End If
' // build the connection string
db.ConnectionString = "uid=" & adoConn.uName & ";" & _
"pwd=" & adoConn.pWord & ";" & _
"server=" & adoConn.server & ";" & _
"driver=" & adoConn.provider & ";" & _
"database=" & adoConn.dbase & ";dsn=;"
' // open a connection to the database
db.Open , , , adAsyncExecute
Do While db.state = adStateConnecting
DoEvents
Loop
' // it off error handler
On Error GoTo 0
'// check that the connection is open
If Not (db.state = ADODB.adStateOpen) Then
GoTo db_connect_err
End If
' // we have connected, return true
connect = True
adoConn.state = db.state
jmp99:
' // exit func
Exit Function
db_connect_err:
' // show on screen
adoConn.state = db.state
On Error GoTo 0
End Function
Friend Function connect_remote(db As ADODB.connection, adoConn As ADO_CONNECTION) As Boolean
' // set default return
connect_remote = False
' // clear the error flags
db.Errors.Clear
' // set the error handler
On Error GoTo db_connect_err
If adoConn.server_remote = "" Then
GoTo jmp99
End If
' // check to see if the connection is open, if so then close it.
If db.state = 1 Then
db.Close
End If
' // build the connection string
db.ConnectionString = "uid=" & adoConn.uName & ";" & _
"pwd=" & adoConn.pWord & ";" & _
"server=" & adoConn.server_remote & ";" & _
"driver=" & adoConn.provider & ";" & _
"database=" & adoConn.dbase & ";dsn=;"
' // open a connection to the database
db.Open , , , adAsyncExecute
Do While db.state = adStateConnecting
DoEvents
Loop
' // it off error handler
On Error GoTo 0
'// check that the connection is open
If Not (db.state = ADODB.adStateOpen) Then
GoTo db_connect_err
End If
' // we have connected, return true
connect_remote = True
adoConn.state = db.state
jmp99:
' // exit func
Exit Function
db_connect_err:
' // show on screen
adoConn.state = db.state
On Error GoTo 0
End Function
Friend Function makeSchema(pConn As ADODB.connection, pSchema As String) As Boolean
On Error Resume Next
pConn.Execute "CREATE DATABASE " & pSchema
If Err.Number = 0 Then
makeSchema = True
End If
On Error GoTo 0
End Function
Friend Function makePrimaryKey(pConn As ADODB.connection, pTable As String, pKey As String) As Boolean
On Error Resume Next
pConn.Execute "ALTER TABLE " & pTable & " ADD PRIMARY KEY (" & pKey & ")"
If Err.Number = 0 Then
makePrimaryKey = True
End If
On Error GoTo 0
End Function
Friend Function makeTable(pConn As ADODB.connection, pTable As String, pfirstCol) As Boolean
On Error Resume Next
pConn.Execute "CREATE TABLE " & pTable & "(" & pfirstCol & ")"
If Err.Number = 0 Then
makeTable = True
End If
On Error GoTo 0
End Function
Friend Function makeIndex(pConn As ADODB.connection, pTable As String, pIndex As String, pCols As String, pUnique As Boolean) As Boolean
On Error Resume Next
pConn.Execute "CREATE " & IIf(pUnique, "UNIQUE", "") & " INDEX " & pIndex & " " & _
"ON " & pTable & " (" & pCols & ")"
If Err.Number = 0 Then
makeIndex = True
End If
On Error GoTo 0
End Function
Friend Function addColumn(pConn As ADODB.connection, pTable As String, pColName As String, pColprops As String) As Boolean
Dim rs As New ADODB.Recordset, fld As ADODB.Field, colExists As Boolean
Dim fldLength As String, adata() As String, tKeys() As String, isColIndexed As Boolean, x As Integer
On Error GoTo jmp99
get_table_index_keys pConn, pTable, tKeys
Set rs = pConn.Execute("select COLUMN_NAME,DATA_TYPE, * from information_schema.columns where table_name = '" & pTable & "' order by ordinal_position")
Do While Not rs.EOF
If rs.Fields("COLUMN_NAME").Value = pColName Then
colExists = True
Exit Do
End If
rs.MoveNext
Loop
If Not colExists Then
pConn.Execute "ALTER TABLE " & pTable & " ADD " & pColprops
Else
' // check change in length
If rs.Fields("DATA_TYPE").Value = "nvarchar" Or rs.Fields("DATA_TYPE").Value = "varchar" Then
adata = Split(pColprops, "(")
If UBound(adata) > 0 Then
adata = Split(adata(1), ")")
' // check max
If LCase(adata(0)) = "max" Then
fldLength = "-1"
Else
fldLength = adata(0)
End If
For x = LBound(tKeys) To UBound(tKeys)
If LCase(pColName) = LCase(tKeys(x)) Then
isColIndexed = True
End If
Next x
' // do not allow alert of index...yet
If Not isColIndexed Then
If rs.Fields("CHARACTER_MAXIMUM_LENGTH").Value <> CInt(fldLength) Then
pConn.Execute "ALTER TABLE " & pTable & " ALTER COLUMN " & pColName & " " & rs.Fields("DATA_TYPE").Value & "(" & fldLength & ")"
End If
End If
End If
End If
End If
If Err.Number = 0 Then
addColumn = True
End If
jmp99:
rs.Close
On Error GoTo 0
End Function
Friend Sub disconnect(pConn As ADODB.connection)
On Error Resume Next
If pConn.state = 1 Then
pConn.Close
End If
On Error GoTo 0
End Sub
Public Function get_table_index(pdb As ADODB.connection, pTable As String, ByRef pArray() As String)
Dim rs As New ADODB.Recordset, x As Integer
On Error GoTo jmp99
ReDim pArray(0)
' // get the list of tables
Set rs = pdb.OpenSchema(adSchemaIndexes, Array(pdb.DefaultDatabase, "dbo", Empty, Empty, pTable))
' // create the tables array
If rs.RecordCount = 0 Then
ReDim pArray(0)
Else
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
If Not IsNull(rs.Fields("INDEX_NAME").Value) Then
ReDim Preserve pArray(x)
pArray(x) = rs.Fields("INDEX_NAME").Value
x = x + 1
End If
' // next record
rs.MoveNext
Loop
End If
jmp99:
End Function
Public Function get_table_keys(pdb As ADODB.connection, pTable As String, ByRef pArray() As String)
Dim rs As New ADODB.Recordset
ReDim pArray(0)
With rs
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.ActiveConnection = pdb
.Source = "SELECT col.Column_Name from INFORMATION_SCHEMA.TABLE_CONSTRAINTS Tab,INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE Col " & _
"WHERE Col.Constraint_Name = Tab.Constraint_Name " & _
"AND col.Table_Name = Tab.Table_Name " & _
"AND Constraint_Type = 'PRIMARY KEY '" & _
"AND col.Table_Name = '" & pTable & "'"
.Open
End With
If rs.RecordCount < 1 Then
ReDim pArray(0)
Else
ReDim pArray(rs.RecordCount - 1)
rs.MoveFirst
Do While Not rs.EOF
If Not IsNull(rs.Fields("Column_name").Value) Then
pArray(rs.AbsolutePosition - 1) = rs.Fields("Column_name").Value
End If
' // next record
rs.MoveNext
Loop
End If
End Function
Public Function get_table_index_keys(pdb As ADODB.connection, pTable As String, ByRef pArray() As String)
Dim rs As New ADODB.Recordset, x As Integer
On Error GoTo jmp99
ReDim pArray(0)
' // get the list of tables
Set rs = pdb.OpenSchema(adSchemaIndexes, Array(pdb.DefaultDatabase, "dbo", Empty, Empty, pTable))
' // create the tables array
If rs.RecordCount = 0 Then
ReDim pArray(0)
Else
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
If Not IsNull(rs.Fields("INDEX_NAME").Value) Then
ReDim Preserve pArray(x)
pArray(x) = rs.Fields("COLUMN_NAME").Value
x = x + 1
End If
' // next record
rs.MoveNext
Loop
End If
jmp99:
End Function
