Option Compare Database
Option Explicit

' exportSQL version 2.0
'
' (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net
' (C) Pedro Freire - pedro.freire@cynergi.net  (do not add to mailing lists without permission)
'
' This code is provided free for anyone's use and is therefore without guarantee or support.
' This does NOT mean CYNERGI delegates its copyright to anyone using it! You may change the
' code in any way, as long as this notice remains on the code and CYNERGI is notified (if you
' publish the changes: if your changes/corrections prove valuable and are added to the code,
' you will be listed in a credit list on this file).
'
' You may NOT sell this as part of a non-free package:
' IF YOU HAVE PAID FOR THIS CODE, YOU HAVE BEEN ROBBED! CONTACT admin@cynergi.net!

' MODULE
'   "exportSQL"
'
' GOAL
'   Export all tables in a MS-Access database file to 2 text files:
'   one containing SQL instructions to delete the new tables to be created,
'   and the other with SQL instructions to create and insert data into
'   the new tables. The table structure and data will resemble as much as
'   possible the current Access database.
'
' HOW TO USE
'   Copy-and-paste this text file into an Access module and run the first
'   (and only public) function. in more detail, you:
'   * Open the Access .mdb file you wish to export
'   * in the default database objects window, click on "Modules", and then on "New"
'   * The code window that opens has some pre-written text (code). Delete it.
'   * Copy-and-paste this entire file to the code module window
'   * You may hit the compile button (looks like 3 sheets of paper with an arrow on
'     top of them, pressing down on them), or select Debug, Compile Loaded Modules
'     from the top menu, just to make sure there are no errors, and that this code
'     works on your Access version (it works on Access'97 and should work on Access'95)
'   * Close the code module window - windows will prompt you to save the code:
'     answer "Yes", and when promped for a name for the module, type anything
'     (say, "MexportSQL")
'   The module is now part of your Access database. To run the export, you:
'   * Re-open the code module (by double-clicking on it, or clicking "Design"
'     with it selected). Move the cursor to where the first "Function" keyword appears.
'     Press F5 or select Run, Go/Continue from the top menu.
'   * Alternativelly, click on "Macros" on the database objects window,
'     and then on "New". On the macro window, select "RunCode" as the macro action,
'     and "exportSQL" as the function name, bellow. Save the macro similarly to the
'     module, and this time double-clicking on it, or clicking "Run" will run the export.
'
' BEFORE RUNNING THE EXPORT
'   Before running the export, be sure to check out the Export Options just bellow this
'   text, and change any according to your wishes and specs.
'
' TECH DATA
'   Public identifiers:
'   * Only one: "exportSQL", a function taking and returning no arguments. It runs the export.
'   Functionallity:
'   * Can export to mSQL v1, mSQL v2 or MySQL-recognised SQL statements
'   * Excellent respect for name conversion, namespace verification, type matching, etc.
'   * Detects default values "=Now()", "=Date()" and "=Time()" to create types like "TIMESTAMP"
'   * Fully configurable via private constants on top of code
'   * Exports two files: one for erasures, another for creations (useful when updating dbs)
'   * Generates compatibility warnings when necessary
'   * Code and generated files are paragraphed and easy to read
'   * Access text and memo fields can have any type of line termination: \n\r, \r\n, \n or \r
'   * Properly escapes text and memo fields, besides all types of binary fields
'   * Closes all open objects and files on error
'   * Known bugs / incomplete constructs are signalled with comments starting with "!!!!"
'   * Two alternatives on absent date/time type on mSQL: REAL or CHAR field


' Export Options - change at will

Private Const DB_ENGINE As String = "MY"  ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2) or "MY" (MySQL)
Private Const DB_NAME As String = ""  ' Use empty string for current. Else use filename or DSN name of database to export
Private Const DB_CONNECT As String = ""  ' Used only if above string is not empty
Private Const MSQL_64kb_AVG As Long = 2048  ' ALWAYS < 65536 (to be consistent with MS Access). Set to max expected size of Access MEMO field (to preserve space in mSQL v1)
Private Const WS_REPLACEMENT As String = "_"  ' Use "" to simply eat whitespaces in identifiers (table and field names)
Private Const IDENT_MAX_SIZE As Integer = 19  ' Suggest 64. Max size of identifiers (table and field names)
Private Const PREFIX_ON_KEYWORD As String = "_"  ' Prefix to add to identifier, if it is a reserved word
Private Const SUFFIX_ON_KEYWORD As String = ""  ' Suffix to add to identifier, if it is a reserved word
Private Const PREFIX_ON_INDEX As String = "ix"  ' Prefix to add to index identifier, to make it unique (mSQL v2)
Private Const SUFFIX_ON_INDEX As String = ""  ' Suffix to add to index identifier, to make it unique (mSQL v2)
Private Const ADD_SQL_FILE As String = "c:\temp\esql_add.txt"  ' Use empty if open on #1. Will be overwritten if exists!
Private Const DEL_SQL_FILE As String = "c:\temp\esql_del.txt"  ' Use empty if open on #2. Will be overwritten if exists!
Private Const LINE_BREAK As String = "\n"  ' Try "<br>". String to replace line breaks in text fields
Private Const QUERY_SEPARATOR As String = "\g"  ' Terminator/separator of SQL queries (to instruct some monitor program to execute them)
Private Const COMMENT_PREFIX As String = "#"  ' Use empty string for no comments
Private Const DISPLAY_WARNINGS As Boolean = True  ' False to output the warnings to the files, only
Private Const DATE_AS_STR As Boolean = True  ' False to use real number data type for date, time and timestamp (in mSQL only)
Private Const PARA_INSERT_AFTER As Integer = 3  ' Field count after which print INSERTs different lines
Private Const INDENT_SIZE As Integer = 5  ' Number of spaces on indents


' Global var to store inter-funtion data
Private warnings As String  ' Not an option: do not set in any way


' Primary Export Function

Sub exportSQL()
On Error GoTo exportSQL_error

    Dim cdb As Database
    Dim ctableix As Integer, ctablename As String

    If DB_NAME = "" Then
        Set cdb = CurrentDb()
    Else
        Set cdb = OpenDatabase(DB_NAME, False, True, DB_CONNECT) ' Shared, read-only
    End If
    
    If ADD_SQL_FILE <> "" Then Open ADD_SQL_FILE For Output As #1
    If DEL_SQL_FILE <> "" Then Open DEL_SQL_FILE For Output As #2

    DoCmd.Hourglass True

    If COMMENT_PREFIX <> "" Then
        Print #1, COMMENT_PREFIX & " Exported from MS Access to " & IIf(Left$(DB_ENGINE, 2) = "MY", "MySQL", "mSQL")
        Print #1, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
        Print #1,
    
        Print #2, COMMENT_PREFIX & " Exported from MS Access to " & IIf(Left$(DB_ENGINE, 2) = "MY", "MySQL", "mSQL")
        Print #2, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
        Print #2,
    End If

    'Go through the table definitions
    For ctableix = 0 To cdb.TableDefs.Count - 1
    
        Dim cfieldix As Integer, cfieldname As String
        Dim fieldlst As String, sqlcode As String
        Dim primary_found As Boolean
        Dim crs As Recordset
    
        ' Let's take only the visible tables
        If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _
        (cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then
            
            ctablename = conv_name("" & cdb.TableDefs(ctableix).Name)
            
            Print #2,
            Print #2, "DROP TABLE " & ctablename & QUERY_SEPARATOR
            
            ' CREATE clause
            Print #1,
            Print #1, "CREATE TABLE " & ctablename
            Print #1, Space$(INDENT_SIZE) & "("
            
            warnings = ""
            fieldlst = ""
            primary_found = False
            
            ' loop thorugh each field in the table
            For cfieldix = 0 To cdb.TableDefs(ctableix).Fields.Count - 1
                
                Dim typestr As String, fieldsz As Integer, dvstr As String
                Dim found_ix As Boolean, cindex As Index, cfield As Field
                
                ' if this is not the first iteration, add separators
                If fieldlst <> "" Then
                    fieldlst = fieldlst & ", "
                    Print #1, ","
                End If
                
                ' get field name
                cfieldname = conv_name("" & cdb.TableDefs(ctableix).Fields(cfieldix).Name)
                fieldlst = fieldlst & cfieldname
                
                ' translate types
                If DB_ENGINE = "M1" Or DB_ENGINE = "M2" Then
                    Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
                        Case dbChar
                            typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
                        Case dbText
                            fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
                            If fieldsz = 0 Then fieldsz = 255
                            typestr = "CHAR(" & fieldsz & ")"
                        Case dbBoolean, dbByte, dbInteger, dbLong
                            typestr = "INT"
                        Case dbDouble, dbFloat, dbSingle
                            typestr = "REAL"
                        Case dbCurrency, dbDecimal, dbNumeric
                            typestr = "REAL"
                            warn "In new field '" & cfieldname & "', currency/BCD will be converted to REAL - there may be precision loss!", False
                        Case dbDate
                            typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
                            warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
                        Case dbTime
                            typestr = IIf(DATE_AS_STR, "CHAR(8)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
                            warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
                        Case dbTimeStamp
                            typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
                            warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & "." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_timestamp'.", ""), False
                        Case dbMemo
                            If DB_ENGINE = "M2" Then
                                typestr = "TEXT(" & MSQL_64kb_AVG & ")"
                            Else
                                typestr = "CHAR(" & MSQL_64kb_AVG & ")"
                                warn "In new field '" & cfieldname & "', dbMemo is not supported by mSQL v1 - fields larger than MSQL_64kb_AVG (" & MSQL_64kb_AVG & ") will not be accepted!", False
                            End If
                        Case dbBinary, dbVarBinary
                            typestr = "CHAR(255)"
                            warn "In new field '" & cfieldname & "', dbBinary and dbVarBinary are not supported by mSQL! - will use a text (CHAR(255)) field.", True
                        Case dbLongBinary
                            typestr = "CHAR(" & MSQL_64kb_AVG & ")"
                            warn "In new field '" & cfieldname & "', dbLongBinary is not supported by mSQL! - will use a text (CHAR(" & MSQL_64kb_AVG & ")) field.", True
                        Case Else
                            warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
                            Error 5  ' invalid Procedure Call
                    End Select
                Else
                    Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
                        Case dbBinary
                            typestr = "TINYBLOB"
                        Case dbBoolean
                            typestr = "TINYINT"
                        Case dbByte
                            typestr = "TINYINT UNSIGNED"
                        Case dbChar
                            typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
                        Case dbCurrency
                            typestr = "DECIMAL(20,4)"
                        Case dbDate
                            typestr = "DATETIME"
                        Case dbDecimal
                            typestr = "DECIMAL(20,4)"
                        Case dbDouble
                            typestr = "REAL"
                        Case dbFloat
                            typestr = "REAL"
                        Case dbInteger
                            typestr = "SMALLINT"
                        Case dbLong
                            typestr = "INT"
                        Case dbLongBinary
                            typestr = "LONGBLOB"
                        Case dbMemo
                            typestr = "LONGBLOB"  ' !!!!! MySQL bug! Replace by LONGTEXT when corrected!
                        Case dbNumeric
                            typestr = "DECIMAL(20,4)"
                        Case dbSingle
                            typestr = "FLOAT"
                        Case dbText
                            fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
                            If fieldsz = 0 Then fieldsz = 255
                            typestr = "CHAR(" & fieldsz & ")"
                        Case dbTime
                            typestr = "TIME"
                        Case dbTimeStamp
                            typestr = "TIMESTAMP"
                        Case dbVarBinary
                            typestr = "TINYBLOB"
                        Case dbBigInt, dbGUID
                            warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
                            Error 5  ' invalid Procedure Call
                        Case Else
                            typestr = "LONGBLOB"
                    End Select
                End If
                
                ' check not null and auto-increment properties
                If ((cdb.TableDefs(ctableix).Fields(cfieldix).Attributes And dbAutoIncrField) <> 0) Then
                    If Left$(DB_ENGINE, 2) = "MY" Then
                        typestr = typestr & " NOT NULL AUTO_INCREMENT"
                    Else
                        typestr = typestr & " NOT NULL"
                        warn "In new field '" & cfieldname & "', mSQL does not support auto-increment fields! - they will be pure INTs." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_rowid' or SEQUENCEs.", ""), False
                    End If
                ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = True Then
                    typestr = typestr & " NOT NULL"
                End If
                    
                ' default value
                dvstr = cdb.TableDefs(ctableix).Fields(cfieldix).DefaultValue
                If dvstr <> "" Then
                    If Left$(DB_ENGINE, 2) <> "MY" Then
                        warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False
                    ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = False Then
                        warn "In new field '" & cfieldname & "', MySQL needs NOT NULL to support default values! - it won't be set a default.", False
                    ElseIf Left$(dvstr, 1) = """" Then
                        typestr = typestr & " DEFAULT '" & conv_str(Mid$(dvstr, 2, Len(dvstr) - 2)) & "'"
                    ElseIf ((LCase(dvstr) = "now()" Or LCase(dvstr) = "date()" Or LCase(dvstr) = "time()") And _
                    (Left$(typestr, 5) = "DATE " Or Left$(typestr, 5) = "TIME " Or Left$(typestr, 9) = "DATETIME ")) Then
                        typestr = "TIMESTAMP " & Right$(typestr, Len(typestr) - InStr(typestr, " "))
                    ElseIf LCase(dvstr) = "no" Then
                        typestr = typestr & " DEFAULT 0"
                    ElseIf LCase(dvstr) = "yes" Then
                        typestr = typestr & " DEFAULT 1"
                    Else
                        typestr = typestr & " DEFAULT " & dvstr
                    End If
                End If
                
                ' check if primary key (for mSQL v1)
                If DB_ENGINE = "M1" Then
                    found_ix = False
                    For Each cindex In cdb.TableDefs(ctableix).Indexes
                        If cindex.Primary Then
                            For Each cfield In cindex.Fields
                                If cfield.Name = cdb.TableDefs(ctableix).Fields(cfieldix).Name Then
                                    found_ix = True
                                    Exit For
                                End If
                            Next cfield
                            If found_ix Then Exit For
                        End If
                    Next cindex
                    If found_ix Then
                        If primary_found Then
                            warn "On new table '" & ctablename & "', mSQL v1 does not support more than one PRIMARY KEY! Only first key was set.", False
                        Else
                            typestr = typestr & " PRIMARY KEY"
                            primary_found = True
                        End If
                    End If
                End If
                
                'print out field info
                Print #1, Space$(INDENT_SIZE) & cfieldname & Space$(IDENT_MAX_SIZE - Len(cfieldname) + 2) & typestr;
            
            Next cfieldix
                  
            ' terminate CREATE clause
            If DB_ENGINE = "M2" Then
                Print #1,
                Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
            End If
                  
            ' primary key and other index declaration
            If DB_ENGINE = "M2" Or Left$(DB_ENGINE, 2) = "MY" Then
                For Each cindex In cdb.TableDefs(ctableix).Indexes
                    sqlcode = ""
                    For Each cfield In cindex.Fields
                        sqlcode = sqlcode & IIf(sqlcode = "", "", ", ") & conv_name(cfield.Name)
                    Next cfield
                    If DB_ENGINE = "M2" Then
                        Print #1, "CREATE " & IIf(cindex.Unique, "UNIQUE ", "") & "INDEX " & _
                        conv_name(PREFIX_ON_INDEX & cindex.Name & SUFFIX_ON_INDEX) & " ON " & _
                        ctablename & " (" & sqlcode & ")" & QUERY_SEPARATOR
                    Else
                        Print #1, ","
                        Print #1, Space$(INDENT_SIZE) & IIf(cindex.Primary, "PRIMARY ", "") & _
                        "KEY (" & sqlcode & ")";
                    End If
                Next cindex
            End If
            
            ' terminate CREATE clause
            If DB_ENGINE <> "M2" Then
                Print #1,
                Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
            End If

            ' print any warnings bellow it
            If COMMENT_PREFIX <> "" And warnings <> "" Then
                If DB_ENGINE = "M2" Then Print #1, COMMENT_PREFIX & " "
                Print #1, warnings
                warnings = ""
            End If
            
            Print #1,
            
            ' INSERT clause
            Set crs = cdb.OpenRecordset(cdb.TableDefs(ctableix).Name)
            If crs.RecordCount <> 0 Then
                
                ' loop thorugh each record in the table
                crs.MoveFirst
                Do Until crs.EOF
                    
                    ' start paragraphing
                    sqlcode = "INSERT INTO " & ctablename
                    If crs.Fields.Count > PARA_INSERT_AFTER Then
                        Print #1, sqlcode
                        If DB_ENGINE = "M1" Then Print #1, Space$(INDENT_SIZE) & "(" & fieldlst & ")"
                        Print #1, "VALUES ("
                        sqlcode = Space$(INDENT_SIZE)
                    Else
                        If DB_ENGINE = "M1" Then sqlcode = sqlcode & " (" & fieldlst & ")"
                        sqlcode = sqlcode & " VALUES ("
                    End If
                    
                    ' loop through each field in each record
                    For cfieldix = 0 To crs.Fields.Count - 1
                    
                        ' based on type, prepare the field value
                        If IsNull(crs.Fields(cfieldix).Value) Then
                            sqlcode = sqlcode & "NULL"
                        Else
                            Select Case crs.Fields(cfieldix).Type
                                Case dbBoolean
                                    sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "1", "0")
                                Case dbChar, dbText, dbMemo
                                    sqlcode = sqlcode & "'" & conv_str(crs.Fields(cfieldix).Value) & "'"
                                Case dbDate, dbTimeStamp
                                    If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
                                        sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "YYYY-MM-DD HH:MM:SS") & "'"
                                    Else
                                        'print in Access internal format: IEEE 64-bit (8-byte) FP
                                        sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
                                    End If
                                Case dbTime
                                    If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
                                        sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "HH:MM:SS") & "'"
                                    Else
                                        'print in Access internal format: IEEE 64-bit (8-byte) FP
                                        sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
                                    End If
                                Case dbBinary, dbLongBinary, dbVarBinary
                                    sqlcode = sqlcode & "'" & conv_bin(crs.Fields(cfieldix).Value) & "'"
                                Case Else
                                    sqlcode = sqlcode & conv_str(crs.Fields(cfieldix).Value)
                            End Select
                        End If
                        
                        ' paragraph separators
                        If cfieldix < crs.Fields.Count - 1 Then
                            sqlcode = sqlcode & ", "
                            If crs.Fields.Count > PARA_INSERT_AFTER Then
                                Print #1, sqlcode
                                sqlcode = Space$(INDENT_SIZE)
                            End If
                        End If
                        
                    Next cfieldix
                    
                    ' print out result and any warnings
                    sqlcode = sqlcode & IIf(crs.Fields.Count > PARA_INSERT_AFTER, " )", ")") & QUERY_SEPARATOR
                    Print #1, sqlcode
                    If COMMENT_PREFIX <> "" And warnings <> "" Then
                        Print #1, warnings
                        warnings = ""
                    End If
                    If crs.Fields.Count > PARA_INSERT_AFTER Then Print #1,
                    
                    crs.MoveNext
                Loop
                
            Else
                
                ' if there is no data on the table
                If COMMENT_PREFIX <> "" Then Print #1, COMMENT_PREFIX & " This table has no data"
            
            End If
            
            crs.Close
            Set crs = Nothing
        
        End If  'print only unhidden tables
    
    Next ctableix
    
exportSQL_exit:
    Close #2
    Close #1
    
    cdb.Close
    Set cdb = Nothing

    DoCmd.Hourglass False

    Exit Sub

exportSQL_error:
    MsgBox Err.Description
    Resume exportSQL_exit

End Sub


Private Function conv_name(strname As String) As String
    Dim i As Integer, str As String

    ' replace inner spaces with WS_REPLACEMENT
    str = strname
    i = 1
    While i <= Len(str)
        Select Case Mid$(str, i, 1)
            Case " ", Chr$(9), Chr$(10), Chr$(13)  ' space, tab, newline, carriage return
                str = Left$(str, i - 1) & WS_REPLACEMENT & Right$(str, Len(str) - i)
                i = i + Len(WS_REPLACEMENT)
            Case Else
                i = i + 1
        End Select
    Wend
    ' restrict tablename to IDENT_MAX_SIZE chars, *after* eating spaces
    str = Left$(str, IDENT_MAX_SIZE)
    ' check for reserved words
    conv_name = str
    If Left$(DB_ENGINE, 2) = "MY" Then
        Select Case LCase$(str)
            Case "add", "all", "alter", "and", "as", "asc", "auto_increment", "between", _
            "bigint", "binary", "blob", "both", "by", "cascade", "char", "character", _
            "change", "check", "column", "columns", "create", "data", "datetime", "dec", _
            "decimal", "default", "delete", "desc", "describe", "distinct", "double", _
            "drop", "escaped", "enclosed", "explain", "fields", "float", "float4", _
            "float8", "foreign", "from", "for", "full", "grant", "group", "having", _
            "ignore", "in", "index", "infile", "insert", "int", "integer", "interval", _
            "int1", "int2", "int3", "int4", "int8", "into", "is", "key", "keys", _
            "leading", "like", "lines", "limit", "lock", "load", "long", "longblob", _
            "longtext", "match", "mediumblob", "mediumtext", "mediumint", "middleint", _
            "numeric", "not", "null", "on", "option", "optionally", "or", "order", _
            "outfile", "partial", "precision", "primary", "procedure", "privileges", _
            "read", "real", "references", "regexp", "repeat", "replace", "restrict", _
            "rlike", "select", "set", "show", "smallint", "sql_big_tables", _
            "sql_big_selects", "sql_select_limit", "straight_join", "table", "tables", _
            "terminated", "tinyblob", "tinytext", "tinyint", "trailing", "to", "unique", _
            "unlock", "unsigned", "update", "usage", "values", "varchar", "varying", _
            "with", "write", "where", "zerofill"
                conv_name = Left$(PREFIX_ON_KEYWORD & str & SUFFIX_ON_KEYWORD, IDENT_MAX_SIZE)
                If (str = conv_name) Then
                    warn "In identifier '" & strname & "', the new form '" & strname & _
                    "' is a reserved word, and PREFIX_ON_KEYWORD ('" & _
                    PREFIX_ON_KEYWORD & "') and SUFFIX_ON_KEYWORD ('" & SUFFIX_ON_KEYWORD & _
                    "') make it larger than IDENT_MAX_SIZE, and after cut it is the same as the original! " & _
                    "This is usually caused by a void or empty PREFIX_ON_KEYWORD.", True
                    Error 5  ' invalid Procedure Call
                End If
        End Select
    End If
End Function


Private Function conv_str(str As String) As String
    Dim i As Integer, nlstr As String, rstr As Variant
    
    nlstr = ""
    rstr = Null
    i = 1
    While i <= Len(str)
        Select Case Mid$(str, i, 1)
            Case Chr$(0)  ' ASCII NUL
                nlstr = ""
                rstr = "\0"
            Case Chr$(8)  ' backspace
                nlstr = ""
                rstr = "\b"
            Case Chr$(9)  ' tab
                nlstr = ""
                rstr = "\t"
            Case "'"
                nlstr = ""
                rstr = "\'"
            Case """"
                nlstr = ""
                rstr = "\"""
            Case "\"
                nlstr = ""
                rstr = "\\"
            Case Chr$(10), Chr$(13)  ' line feed and carriage return
                If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then
                    ' there was a previous newline and this is its pair: eat it
                    rstr = ""
                    nlstr = ""
                Else
                    ' this is a fresh newline
                    rstr = LINE_BREAK
                    nlstr = Mid$(str, i, 1)
                End If
            Case Else
                nlstr = ""
        End Select
        If Not IsNull(rstr) Then
            str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
            i = i + Len(rstr)
            rstr = Null
        Else
            i = i + 1
        End If
    Wend
    conv_str = str
End Function


Private Function conv_bin(str As String) As String
    Dim i As Integer, rstr As String
    
    rstr = ""
    i = 1
    While i <= Len(str)
        Select Case Mid$(str, i, 1)
            Case Chr$(0)  ' ASCII NUL
                rstr = "\0"
            Case Chr$(8)  ' backspace
                rstr = "\b"
            Case Chr$(9)  ' tab
                rstr = "\t"
            Case "'"
                rstr = "\'"
            Case """"
                rstr = "\"""
            Case "\"
                rstr = "\\"
            Case Chr$(10)  ' line feed
                rstr = "\n"
            Case Chr$(13)  ' carriage return
                rstr = "\r"
        End Select
        If rstr <> "" Then
            str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
            i = i + Len(rstr)
            rstr = ""
        Else
            i = i + 1
        End If
    Wend
    conv_bin = str
End Function


Private Sub warn(str As String, abortq As Boolean)
    If DISPLAY_WARNINGS Then MsgBox str, vbOKOnly Or vbExclamation, "Warning"
    warnings = warnings & COMMENT_PREFIX & " Warning: " & str & Chr$(13) & Chr$(10)
End Sub