Option Compare Database Option Explicit ' Please note this PostgreSQL patch to exportSQL version 2.0 is now ' obsolete! New version is located at ' http://www.rot13.org/~dpavlin/projects/sql/exportSQL3.txt ' exportSQL version 2.0 ' www.cynergi.net/prod/exportsql/ ' ' (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) ' (c) 2000 Dobrica Pavlinusic - added PostgreSQL support ' ' 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 ' * If you are using Microsoft Access 2000 you will have to make ' one additional step: go into Tools/References and check following ' component: Microsoft DAO Object 3.6 Library and uncheck Microsoft ' ActiveX Data Objects Library ' * 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 = "Pg" ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2), "MY" (MySQL) or "Pg" (PostgreSQL) 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 "
". 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 COMMENTS As Boolean = True ' Dump comments into output file 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 Private COMMENT_PREFIX As String ' Primary Export Function Sub exportSQL() On Error GoTo exportSQL_error Dim cdb As Database Dim ctableix As Integer, ctablename As String If COMMENTS Then If DB_ENGINE = "Pg" Then COMMENT_PREFIX = "--" Else COMMENT_PREFIX = "#" End If End If 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 COMMENTS 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 ElseIf DB_ENGINE = "MY" Then 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 ElseIf DB_ENGINE = "Pg" Then Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type Case dbBinary typestr = "int2" Case dbBoolean typestr = "bool" Case dbByte typestr = "int2" Case dbChar typestr = "varchar(" & 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 = "float8" Case dbFloat typestr = "float4" Case dbInteger typestr = "int4" Case dbLong typestr = "int8" Case dbLongBinary typestr = "text" ' hm? Case dbMemo typestr = "text" Case dbNumeric typestr = "DECIMAL(20,4)" Case dbSingle typestr = "float4" Case dbText fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size If fieldsz = 0 Then fieldsz = 255 typestr = "varchar(" & fieldsz & ")" Case dbTime typestr = "TIME" Case dbTimeStamp typestr = "TIMESTAMP" Case dbVarBinary typestr = "text" ' hm? Case dbBigInt, dbGUID warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True Error 5 ' invalid Procedure Call Case Else typestr = "text" End Select Else warn "unkown DB_ENGINE string " & DB_ENGINE, True Error 5 ' invalid Procedure Call 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" ElseIf DB_ENGINE = "Pg" Then typestr = " serial" 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" And DB_ENGINE <> "Pg" Then warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False ElseIf Left$(DB_ENGINE, 2) = "MY" And 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 COMMENTS 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 dbCurrency, dbDecimal, dbDouble, dbFloat, dbNumeric, dbSingle sqlcode = sqlcode & conv_float(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 COMMENTS 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 COMMENTS 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 ' This function is used to convert local setting of decimal , to . Private Function conv_float(str As String) As String Dim i As Integer i = 1 While i <= Len(str) If Mid$(str, i, 1) = "," Then str = Left$(str, i - 1) & "." & Right$(str, Len(str) - i) End If i = i + 1 Wend conv_float = 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