Updating Your Exsisting Applications Database

Hey there everyone,

For my first ever post on vbforums I thought I would write about something that has been a right pain in the CPU.

I have been looking for several weeks now for a low cost (or preferably free) module or other kind of add in that will allow me to update or create a database system. which will be used for one of my VB6 Applications, so i can easily update the structure of the database when I make a new version of my application. Thus far I have had no success (Except for the ones that cost money of course).

However I have decided that the best way to accoplish this would be just to create an empty set of tables in a database to form a model database. This way I can just compare the model to the live database and alter or add as appropriate.

I have written a module that will accomplish the update and am now getting ready to compile it in some form.

I am however wondering if this might be a useful tool for anyone here?

I also want to ask what and how is the best way is to compile my script to a dll or similar form?

At present My script supports MySQL only, and I have created the script so if like me your database needs more than 1 set of the same tables you can add a suffix to the table name. If there is a need for a script like this then give me a shout as I am also looking into making the script compatible with a whole host of Databases, Including: -

MSSQL, Oracle, PostgreSQL, Access, MySQL, DB2

Also if things go well maybe even to others not yet stumbled upon.

Also if there are any features that may be useful to the script I would be willing to add any possable requests.

------ Life is a waste of time ------
------ Time is a waste of life ------
------ Get wasted all the time ------
- and you'll have the time of your life -

Izzy Out.

Are you going to be posting your code in our CodeBank?

Hi again,

Once this code is near finnished I will indeed post the code on here for everyone to use, also if required i can upload the module file for vb6.

Save everyone from having to spend money.

Right, After a long time of umming and arring I have finaly got my first test script for database updating ready. As I described before I uses 2 databases, a live one which is to be updated, and a model which is the new database structure to be used. At presant this has only got MySQL writen into the script as this is my development database type. Here is my code so far:

VB Code:

Public Function UDB(DBC1 As ADODB.Connection, _
DBC2 As ADODB.Connection, dbname1 As String, dbname2 As String, _
DBT, DoEdits As Integer, suffix, prefix As String, Progress As ProgressBar, _
lbl1 As label) As Boolean
    DoEvents
    Dim DBrs As ADODB.Recordset, DBrs2 As ADODB.Recordset
    Dim DBrs1 As ADODB.Recordset, DBrs3 As ADODB.Recordset
    Dim strSQL, IsFound As Boolean, extracheck As Boolean
    On Error GoTo UDerr
    Set DBrs = New ADODB.Recordset
    DBrs.ActiveConnection = DBC1
    Set DBrs2 = New ADODB.Recordset
    DBrs2.ActiveConnection = DBC2
    Select Case DBT
        Case "MySQL"
            DBrs2.Open "SHOW TABLES WHERE Tables_in_" & dbname2 & _
" LIKE '" & prefix & "%'"
            Do While Not DBrs2.EOF
                DBrs.Open "SHOW TABLES WHERE Tables_in_" & dbname1 & _
"='" & DBrs2("Tables_in_" & dbname2) & suffix & "'"
                If Not DBrs.EOF Then
                    DBrs.Close
                    Set DBrs1 = New ADODB.Recordset
                    DBrs1.ActiveConnection = DBC2
                    DBrs1.Open "DESCRIBE " & DBrs2("Tables_in_" & dbname2)
                    Do While Not DBrs1.EOF
                        Set DBrs3 = New ADODB.Recordset
                        DBrs3.ActiveConnection = DBC1
                        DBrs.Open "DESCRIBE " & DBrs2("Tables_in_" & dbname2) _
& suffix
                        IsFound = False
                        extracheck = False
                        Do While Not DBrs.EOF
                            If DBrs("Field") = DBrs1("Field") Then
                                IsFound = True
                                If DBrs("Type") = DBrs1("Type") And DBrs("Null") _
= DBrs1("Null") And DBrs("Default") = DBrs1("Default") And DBrs("Key") = _
DBrs1("Key") And DBrs("Extra") = DBrs1("Extra") Then extracheck = True
                            End If
                            DBrs.MoveNext
                        Loop
                        DBrs.Close
                        If IsFound Then
                            If DoEdits = 0 Then
                                If DBrs1("Key") <> "PRI" Then
                                If Not extracheck Then
                                lbl1.Caption = "Updating Current Column: " & _
DBrs2("Tables_in_" & dbname2) & suffix & "." & DBrs1("Field")
                                Progress.value = Progress.value + 1
                                strSQL = "ALTER TABLE " & DBrs2("Tables_in_" & _
dbname2) & suffix & " MODIFY " & DBrs1("Field") & " " & " " & _
DBrs1("Type") & " "
                                If DBrs1("Null") = "NO" Then strSQL = strSQL & _
"NOT NULL "
                                If DBrs1("Default") <> "" Then strSQL = _
strSQL & "DEFAULT '" & DBrs1("Default") & "'"
                                DBrs3.Open strSQL
                                End If
                                End If
                            End If
                        Else
                            lbl1.Caption = "Adding Column to Current Table: " & _
DBrs2("Tables_in_" & dbname2) & suffix & "." & DBrs1("Field")
                            Progress.value = Progress.value + 1
                            strSQL = "ALTER TABLE " & DBrs2("Tables_in_" & _
dbname2) & suffix & " ADD COLUMN " & DBrs1("Field") & " " & " " & _
DBrs1("Type") & " "
                            If DBrs1("Null") = "NO" Then strSQL = strSQL & _
"NOT NULL "
                            If DBrs1("Default") <> "" Then strSQL = strSQL _
& "DEFAULT '" & DBrs1("Default") & "' "
                            If DBrs1("Key") = "PRI" Then strSQL = strSQL _
& "PRIMARY KEY "
                            If DBrs1("Extra") = "auto_increment" Then strSQL = _
strSQL & "AUTO_INCREMENT"
                            DBrs3.Open strSQL
                        End If
                        DBrs1.MoveNext
                    Loop
                Else
                    DBrs.Close
                    lbl1.Caption = "Adding Table: " & DBrs2("Tables_in_" & _
dbname2) & suffix
                    Progress.value = Progress.value + 1
                    strSQL = "CREATE TABLE " & DBrs2("Tables_in_" & dbname2) _
& suffix & " ("
                    Set DBrs1 = New ADODB.Recordset
                    DBrs1.ActiveConnection = DBC2
                    DBrs1.Open "DESCRIBE " & DBrs2("Tables_in_" & dbname2)
                    Do While Not DBrs1.EOF
                        strSQL = strSQL & DBrs1("Field") & " " & DBrs1("Type") & " "
                        If DBrs1("Null") = "NO" Then strSQL = strSQL & "NOT NULL "
                        If DBrs1("Default") <> "" Then strSQL = strSQL _
& "DEFAULT '" & DBrs1("Default") & "' "
                        If DBrs1("Key") = "PRI" Then strSQL = strSQL & _
"PRIMARY KEY "
                        If DBrs1("Extra") = "auto_increment" Then strSQL = _
strSQL & "AUTO_INCREMENT"
                        strSQL = strSQL & ","
                        DBrs1.MoveNext
                    Loop
                    strSQL = Mid(strSQL, 1, Len(strSQL) - 1) & ")"
                    DBrs.Open strSQL
                End If
                DBrs2.MoveNext
            Loop
    End Select
    UDB = True
    Progress.value = Progress.value + 1
    lbl1.Caption = "Database Section Updated: - " & prefix
    Exit Function
UDerr:
    UDB = False
End Function

to call this script use the following syntax

VB Code:

success = UDB(Live DB Connection, Model DB Connection, Name of Live Dabatase, Name of Model Database, Database Type, Do all changes (1=yes,0=no), table name suffix (used if there are more that 1 tables with same structure), table name prefix (used if you only want to updte 1 section of your database i.e. Users), ProgressBar name (used for returning progressbar status), label name (used to return current update status))

If the function returns true the update was successful, other wise there was an error.

If anybody has any further sugesstions to add to this i would be happy to incorporate them in

Hope this helps.