' this program converts Microsoft SQL Server databases to MySQL databases

' (c) 2001 Michael Kofler
'     http://www.kofler.cc/mysql
'     mssql2mysql@kofler.cc

' LICENSE: GPL (Gnu Public License)
' VERSION: 0.01 (Jan. 18 2001)

' USEAGE:
' 1) copy this code into a new VBA 6 module
'    (i.e. start Excel 2000 or Word 2000 or another
'     program with VBA editor, hit Alt+F11, execute
'     Insert|Module, insert code)
'    OR copy code into an empty form of a new VB6 project
'
' 2) change the constants at the beginning of the code,
' 3) hit F5 and execute Main()
'    the program now connects to Microsoft SQL Server
'    and converts the database; the resulting SQL commands
'    are either saved in an ASCII file or executed immediately

' FUNCTION:
' converts both schema (tables and indices) and
' data (numbers, strings, dates etc.)
' handles table and column names which are not legal in MySQL (see MySQLName())

' LIMITATIONS:
' no foreign keys            (not yet supported by MySQL)
' no SPs, no triggers        (not yet supported by MySQL)
' no views                   (not yet supported by MySQL)
' no user defined data types (not yet supported by MySQL)
' no privileges/access infos (the idea of logins/users in M$ SQL Server is incompatible with user/group/database/table/column privileges of MySQL)
' cannot handle ADO type adFileTime yet
' GUIDs not tested
' fairly slow and no visible feedback during conversion process
'   for example, it takes 80 seconds to convert Northwind (2.8 MB data)
'   with M$SQL running on PII 350 (CPU=0) and this script running in
'   Excel 2000 on PII 400 (CPU=100); unfortunately, compiling the program
'   with VB6 does not make it any faster
'   tip: test with MAX_RECORDS = 10 first to see if it works for you at all

' DATA:
' Unicode string can be converted either to ANSI strings or to BLOBs
' (Unicode --> BLOB is untested, though)

' INTERNALS:
' method:   read database schema using DMO
'           read data using a ADO recordset

' NECESSARY LIBRARIES:
'   ADODB  (tested with 2.5, should also run with all versions >=2.1)
'   SQLDMO (tested with the version provided by M$ SQL Server 7 / MSDE 1)
'   SCRIPTING

Option Explicit
Option Compare Text

' -------------- change these constants before use!

                                  'M$ SQL Server
Const MSSQL_SECURE_LOGIN = True   'login type (True for NT security)
Const MSSQL_LOGIN_NAME = ""       'login name (for NT security use "" here)
Const MSSQL_PASSWORD = ""         'password   (for NT security use "" here)
Const MSSQL_HOST = "mars"         'if localhost: use "(local)"
Const MSSQL_DB_NAME = "pubs" 'database name

Const OUTPUT_TO_FILE = 0          '1 --> write file;
                                  '0 --> connect to MySQL, execute SQL commands directly
                                  
                                  'output file (only needed if OUTPUT_TO_FILE=1)
Const OUTPUT_FILENAME = "c:\export.sql"

                                  'connect to MySQL (only needed if OUTPUT_TO_FILE=0)
Const MYSQL_USER_NAME = "root"    'login name
Const MYSQL_PASSWORD = "uranus"   'password
Const MYSQL_HOST = "localhost"    'if localhost: use "localhost"

Const NEW_DB_NAME = "pubs2"       'name of new MySQL database ("" if same as M$SQL db name)
                                  'conversion options
Const UNICODE_TO_BLOB = False      'unicode --> BLOBs (True) or ASCII (False)
Const DROP_DATABASE = True        'begin with DROP dbname?
Const MAX_RECORDS = 0             'max. nr of records per table (0 for all records, n for testing purposes)


' ----------------------------- don't change below here (unless you know what you are doing)

Const SQLDMOIndex_DRIPrimaryKey = 2048
Const SQLDMOIndex_Unique = 2
Const adEmpty = 0
Const adTinyInt = 16
Const adSmallInt = 2
Const adInteger = 3
Const adBigInt = 20
Const adUnsignedTinyInt = 17
Const adUnsignedSmallInt = 18
Const adUnsignedInt = 19
Const adUnsignedBigInt = 21
Const adSingle = 4
Const adDouble = 5
Const adCurrency = 6
Const adDecimal = 14
Const adNumeric = 131
Const adBoolean = 11
Const adError = 10
Const adUserDefined = 132
Const adVariant = 12
Const adIDispatch = 9
Const adIUnknown = 13
Const adGUID = 72
Const adDate = 7
Const adDBDate = 133
Const adDBTime = 134
Const adDBTimeStamp = 135
Const adBSTR = 8
Const adChar = 129
Const adVarChar = 200
Const adLongVarChar = 201
Const adWChar = 130
Const adVarWChar = 202
Const adLongVarWChar = 203
Const adBinary = 128
Const adVarBinary = 204
Const adLongVarBinary = 205
Const adChapter = 136
Const adFileTime = 64
Const adPropVariant = 138
Const adVarNumeric = 139
Const adArray = &H2000

Public dmoApplic 'As New SQLDMO.Application  'SQLDMO Application object
Public dmoSrv    'As New SQLDMO.SQLServer    'SQLDMO Server object
Public mssqlConn 'As New Connection          'ADO Connection to M$ SQL Server
Public mysqlConn 'As New Connection          'ADO Connection to MySQL
Public fso       'As Scripting.FileSystemObject
Public fileout   'AS FSO.TextStream

Public Sub Main()
  Set dmoApplic = CreateObject("SQLDMO.Application")
  Set dmoSrv = CreateObject("SQLDMO.SQLServer")
  Set mssqlConn = CreateObject("ADODB.Connection")
  Set mysqlConn = CreateObject("ADODB.Connection")
  Set fso = CreateObject("Scripting.FileSystemObject")
  ConnectToDatabases
  ConvertDatabase
  MsgBox "done"
End Sub

' connect to M$ SQL Server and MySQL
Private Sub ConnectToDatabases()
  dmoSrv.LoginTimeout = 10
  On Error Resume Next
  
  ' DMO connection to M$ SQL Server
  If MSSQL_SECURE_LOGIN Then
    dmoSrv.LoginSecure = True
    dmoSrv.Connect MSSQL_HOST
  Else
    dmoSrv.LoginSecure = False
    dmoSrv.Connect MSSQL_HOST, MSSQL_LOGIN_NAME, MSSQL_PASSWORD
  End If
  If Err Then
    MsgBox "Sorry, cannot connect to M$ SQL Server. " & _
      "Please edit the MSSQL constats at the beginning " & _
      "of the code." & vbCrLf & vbCrLf & Error
    End
  End If
  
  ' ADO connection to M$ SQL Server
  Dim tmpCStr$
  tmpCStr = _
    "Provider=SQLOLEDB;" & _
    "Data Source=" & MSSQL_HOST & ";" & _
    "Initial Catalog=" & MSSQL_DB_NAME & ";"
  If MSSQL_SECURE_LOGIN Then
    tmpCStr = tmpCStr & "Integrated Security=SSPI"
  Else
    tmpCStr = tmpCStr & _
      "User ID=" & MSSQL_LOGIN_NAME & ";" & _
      "Password=" & MSSQL_PASSWORD
  End If
  mssqlConn.ConnectionString = tmpCStr
  mssqlConn.Open
  If Err Then
    MsgBox "Sorry, cannot connect to M$ SQL Server. " & _
      "Please edit the MSSQL constats at the beginning " & _
      "of the code." & vbCrLf & vbCrLf & Error
    End
  End If
  
  ' ADO connection to MySQL or open output file
  If (OUTPUT_TO_FILE = 0) Then
    mysqlConn.ConnectionString = _
      "Provider=MSDASQL;Driver=MySQL;" & _
      "Server=" & MYSQL_HOST & ";" & _
      "UID=" & MYSQL_USER_NAME & ";" & _
      "PWD=" & MYSQL_PASSWORD
    mysqlConn.Open
    If Err Then
      MsgBox "Sorry, cannot connect to MySQL. " & _
        "Please edit the MYSQL constats at the beginning " & _
        "of the code." & vbCrLf & vbCrLf & Error
      End
    End If
  Else
    Set fileout = fso.CreateTextFile(OUTPUT_FILENAME)
  End If
End Sub

Private Sub ConvertDatabase()
  ' copy database schema
  Dim dmoDB 'As SQLDMO.Database
  Set dmoDB = dmoSrv.Databases(MSSQL_DB_NAME)
  DBDefinition dmoDB
  ' copy data
  CopyDB dmoDB
End Sub

' build SQL code to define one column
' ColDefinition$(col As SQLDMO.Column)
Function ColDefinition$(col)
  Dim cdef$
  cdef = MySQLName(col.Name) & " " & DataType(col)
  If col.Default <> "" Then
    cdef = cdef & " DEFAULT " & col.Default
  End If
  If col.AllowNulls Then
    cdef = cdef & " NULL"
  Else
    cdef = cdef & " NOT NULL"
  End If
  If col.Identity Then
    cdef = cdef & " AUTO_INCREMENT"
  End If
  ColDefinition = cdef
End Function

' datatype transition M$ SQL Server --> MySQL
' DataType$(col As SQLDMO.Column)
Function DataType$(col)
  Dim oldtype$, length&, precision&, scal&
  Dim newtype$
  
  oldtype = col.PhysicalDatatype
  length = col.length
  precision = col.NumericPrecision
  scal = col.NumericScale
  If LCase(oldtype) = "money" Then
    precision = 19
    scal = 4
  ElseIf LCase(oldtype) = "smallmoney" Then
    precision = 10
    scal = 4
  End If
  
  Select Case LCase(oldtype)
  
  ' integers
  Case "bit", "tinyint"
    newtype = "TINYINT"
  Case "smallint"
    newtype = "SMALLINT"
  Case "int"
    newtype = "INT"
  
  ' floating points
  Case "float"
    newtype = "DOUBLE"
  Case "real"
    newtype = "FLOAT"
  Case "decimal", "numeric", "money", "smallmoney"
    newtype = "DECIMAL(" & precision & ", " & scal & ")"
  
  ' strings
  Case "char"
    If length < 255 Then
      newtype = "CHAR(" & length & ")"
    Else
      newtype = "TEXT"
    End If
  Case "varchar"
    If length < 255 Then
      newtype = "VARCHAR(" & length & ")"
    Else
      newtype = "TEXT"
    End If
  Case "text"
    newtype = "LONGTEXT"
    
  ' unicode strings
  Case "nchar"
    If UNICODE_TO_BLOB Then
      newtype = "BLOB"
    Else
      If length <= 255 Then
        newtype = "CHAR(" & length & ")"
      Else
        newtype = "TEXT"
      End If
    End If
  Case "nvarchar"
    If UNICODE_TO_BLOB Then
      newtype = "BLOB"
    Else
      If length <= 255 Then
        newtype = "VARCHAR(" & length & ")"
      Else
        newtype = "TEXT"
      End If
    End If
  
  Case "ntext"
    If UNICODE_TO_BLOB Then
      newtype = "LONGBLOB"
    Else
      newtype = "LONGTEXT"
    End If
    
  ' date/time
  Case "datetime", "smalldatetime"
    newtype = "DATETIME"
  Case "timestamp"
    newtype = "TIMESTAMP"
    
  ' binary and other
  Case "uniqueidentifier"
    newtype = "TINYBLOB"
  Case "binary", "varbinary"
    newtype = "BLOB"
  Case "image"
    newtype = "LONGBLOB"
  
  Case Else
    Stop
  End Select
  
  DataType = newtype
End Function

' IndexDefinition$(tbl As SQLDMO.Table, idx As SQLDMO.Index)
Function IndexDefinition$(tbl, idx)
  Dim i&
  Dim tmp$
  Dim col 'As SQLDMO.Column
  ' don't deal with system indices (used i.e. to ensure ref. integr.)
  If Left(idx.Name, 1) = "_" Then Exit Function
  ' index type (very incomplete !!!)
  If idx.Type And SQLDMOIndex_DRIPrimaryKey Then
    tmp = tmp & "PRIMARY KEY"
  ElseIf idx.Type And SQLDMOIndex_Unique Then
    tmp = tmp & "UNIQUE " & MySQLName(idx.Name)
  Else
    tmp = tmp & "INDEX " & MySQLName(idx.Name)
  End If
  ' index columns
  tmp = tmp & "("
  For i = 1 To idx.ListIndexedColumns.Count
    Set col = idx.ListIndexedColumns(i)
    tmp = tmp & MySQLName(col.Name)
    ' specify index length
    If (col.PhysicalDatatype = "nchar" Or col.PhysicalDatatype = "nvarchar" Or col.PhysicalDatatype = "ntext") And UNICODE_TO_BLOB = True Then
      ' 2 byte per unicode char!
      tmp = tmp & "(" & IIf(col.length * 2 < 255, col.length * 2, 255) & ")"
    ElseIf Right(DataType(col), 4) = "BLOB" Or Right(DataType(col), 4) = "TEXT" Then
      tmp = tmp & "(" & IIf(col.length < 255, col.length, 255) & ")"
    End If
    ' seperate, if more than one index column
    If i < idx.ListIndexedColumns.Count Then tmp = tmp & ","
  Next
  tmp = tmp & ")"
  IndexDefinition = tmp
End Function

' build SQL code to define one table
' TableDefinition$(tbl As SQLDMO.Table)
Function TableDefinition$(tbl)
  Dim i&
  Dim tmp$, ixdef$
  ' table
  tmp = "CREATE TABLE " & _
        NewDBName(tbl.Parent) & "." & MySQLName(tbl.Name) & vbCrLf & "("
  For i = 1 To tbl.Columns.Count
    tmp = tmp & ColDefinition(tbl.Columns(i))
    If i < tbl.Columns.Count Then
      tmp = tmp & ", " & vbCrLf
    End If
  Next
  ' indices
  For i = 1 To tbl.Indexes.Count
    ixdef = IndexDefinition(tbl, tbl.Indexes(i))
    If ixdef <> "" Then
      tmp = tmp & ", " & vbCrLf & ixdef
    End If
  Next
  tmp = tmp & ")"
  TableDefinition = tmp
End Function

' build SQL code to define database (all tables)
' DBDefinition(db As SQLDMO.Database)
Sub DBDefinition(db)
  Dim i&
  Dim sql, dbname$
  dbname = NewDBName(db)
  If DROP_DATABASE Then
    sql = "DROP DATABASE IF EXISTS " & dbname
    ExecuteSQL sql
  End If
  sql = "CREATE DATABASE " & dbname
  ExecuteSQL sql
  For i = 1 To db.Tables.Count
    If Not db.Tables(i).SystemObject Then
      sql = TableDefinition(db.Tables(i))
      ExecuteSQL sql
    End If
  Next
End Sub

' copy content of all M$ SQL Server tables to new MySQL database
' CopyDB(msdb As SQLDMO.Database)
Sub CopyDB(msdb)
  Dim i&
  Dim tmp$
  ExecuteSQL "USE " & NewDBName(msdb)
  For i = 1 To msdb.Tables.Count
    If Not msdb.Tables(i).SystemObject Then
      CopyTable msdb.Tables(i)
    End If
  Next
End Sub

' copy content of one table from M$ SQL Server to MySQL
' CopyTable(mstable As SQLDMO.Table)
Sub CopyTable(mstable)
  Dim rec ' As Recordset
  Dim sqlInsert$, sqlValues$
  Dim i&, recordCounter&
  Set rec = CreateObject("ADODB.Recordset")
  rec.Open "SELECT * FROM [" & mstable.Name & "]", mssqlConn
  ' build beginning statement of SQL INSERT command
  ' for example: INSERT INTO tablename (column1, column2)
  sqlInsert = "INSERT INTO " & MySQLName(mstable.Name) & " ("
  For i = 0 To rec.Fields.Count - 1
    sqlInsert = sqlInsert & MySQLName(rec.Fields(i).Name)
    If i <> rec.Fields.Count - 1 Then
      sqlInsert = sqlInsert & ", "
    End If
  Next
  sqlInsert = sqlInsert & ") "
  ' for each recordset in M$SS table: build sql statement
  Do While Not rec.EOF
    sqlValues = ""
    For i = 0 To rec.Fields.Count - 1
      sqlValues = sqlValues & DataValue(rec.Fields(i))
      If i <> rec.Fields.Count - 1 Then
        sqlValues = sqlValues & ", "
      End If
    Next
    ExecuteSQL sqlInsert & " VALUES(" & sqlValues & ")"
    rec.MoveNext
    ' counter
    recordCounter = recordCounter + 1
    If MAX_RECORDS <> 0 Then
      If recordCounter >= MAX_RECORDS Then Exit Do
    End If
  Loop
End Sub

' data transition M$ SQL Server --> MySQL
' DataValue$(fld As ADO.Field)
Function DataValue$(fld)
  If IsNull(fld.Value) Then
    DataValue = "NULL"
  Else

    Select Case fld.Type
    
    ' integer numbers
    Case adBigInt, adInteger, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt
      DataValue = fld.Value
    
    ' decimal numbers
    Case adCurrency, adDecimal, adDouble, adNumeric, adSingle, adVarNumeric
      DataValue = Str(fld.Value)
      
    ' boolean
    Case adBoolean
      DataValue = IIf(fld.Value, -1, 0)
      
    ' date, time
    Case adDate, adDBDate, adDBTime
      DataValue = Format(fld.Value, "'yyyy-mm-dd Hh:Nn:Ss'")
    Case adDBTimeStamp
      DataValue = Format(fld.Value, "yyyymmddHhNnSs")
    Case adFileTime
      ' todo
      Beep
      Stop
      
    ' ANSI strings
    Case adBSTR, adChar, adLongVarChar, adVarChar
      DataValue = "'" & Quote(fld.Value) & "'"
    
    ' UNICODE strings
    Case adLongVarWChar, adVarWChar, adWChar
      If UNICODE_TO_BLOB = True Then
        DataValue = HexCodeStr(fld.Value)
      Else
        ' we hope the string only contains ANSI characters ...
        DataValue = "'" & Quote(fld.Value) & "'"
      End If
    
    ' binary and other
    Case adGUID
      DataValue = HexCode(fld.Value)
    Case adLongVarBinary, adVarBinary
      DataValue = HexCode(fld.Value)
    
    End Select
  End If
End Function

' converts a Byte-array into a hex string
' HexCode$(bytedata() As Byte)
Function HexCode(bytedata)
  Dim i&
  Dim tmp$
  tmp = ""
  For i = LBound(bytedata) To UBound(bytedata)
    If bytedata(i) <= 15 Then
      tmp = tmp + "0" + Hex(bytedata(i))
    Else
      tmp = tmp + Hex(bytedata(i))
    End If
  Next
  HexCode = "0x" + tmp
End Function

' converts a String into a hex string
' HexCode$(bytedata() As Byte)
Function HexCodeStr(bytedata)
  Dim i&, b&
  Dim tmp$
  tmp = ""
  For i = 1 To LenB(bytedata)
    b = AscB(MidB(bytedata, i, 1))
    If b <= 15 Then
      tmp = tmp + "0" + Hex(b)
    Else
      tmp = tmp + Hex(b)
    End If
  Next
  HexCodeStr = "0x" + tmp
End Function

' returns name of new database
' NewDBName$(db As SQLDMO.Database)
Function NewDBName$(db)
  If NEW_DB_NAME = "" Then
    NewDBName = db.Name
  Else
    NewDBName = NEW_DB_NAME
  End If
End Function

' quote ' " and \; replace chr(0) by \0
Function Quote(tmp)
  tmp = Replace(tmp, "\", "\\")
  tmp = Replace(tmp, """", "\""")
  tmp = Replace(tmp, "'", "\'")
  Quote = Replace(tmp, Chr(0), "\0")
End Function

' to translate MSSQL names to legal MySQL names
' replace blank, -, ( and ) by '_'
Function MySQLName(tmp)
  tmp = Replace(tmp, " ", "_")
  tmp = Replace(tmp, "-", "_")
  tmp = Replace(tmp, "(", "_")
  MySQLName = Replace(tmp, ")", "_")
End Function

' either execute SQL command or write it into file
Function ExecuteSQL(sql)
  If OUTPUT_TO_FILE Then
    fileout.WriteLine sql & ";"
    If Left(sql, 6) <> "INSERT" Then
      fileout.WriteLine
    End If
  Else
    mysqlConn.Execute sql
  End If
End Function

' this event procedures starts the converter if it is run as a VB6 programm
Private Sub Form_Load()
  Main
  End
End Sub