/[sql]/exportSQL3.txt
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /exportSQL3.txt

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by dpavlin, Mon Jun 4 12:34:40 2001 UTC revision 1.2 by dpavlin, Tue Mar 19 21:00:27 2002 UTC
# Line 1  Line 1 
1  Option Compare Database  Option Compare Database
2  Option Explicit  Option Explicit
3    
4  ' exportSQL version 3.0  ' exportSQL version 3.0
5  ' www.rot13.org/~dpavlin/projects.html#sql  ' www.rot13.org/~dpavlin/projects.html#sql
6  '  '
7  ' based on exportSQL version 2.0 from www.cynergi.net/prod/exportsql/  ' based on exportSQL version 2.0 from www.cynergi.net/prod/exportsql/
8  '  '
9  ' (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net  ' (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net
10  ' (C) Pedro Freire - pedro.freire@cynergi.net  (do not add to mailing lists without permission)  ' (C) Pedro Freire - pedro.freire@cynergi.net  (do not add to mailing lists without permission)
11  ' (c) 2000-2001 Dobrica Pavlinusic <dpavlin@rot13.org> - added PostgreSQL support  ' (c) 2000-2001 Dobrica Pavlinusic <dpavlin@rot13.org> - added PostgreSQL support
12  '  '
13  ' This code is provided free for anyone's use and is therefore without guarantee or support.  ' This code is provided free for anyone's use and is therefore without guarantee or support.
14  ' This does NOT mean CYNERGI delegates its copyright to anyone using it! You may change the  ' This does NOT mean CYNERGI delegates its copyright to anyone using it! You may change the
15  ' code in any way, as long as this notice remains on the code and CYNERGI is notified (if you  ' code in any way, as long as this notice remains on the code and CYNERGI is notified (if you
16  ' publish the changes: if your changes/corrections prove valuable and are added to the code,  ' publish the changes: if your changes/corrections prove valuable and are added to the code,
17  ' you will be listed in a credit list on this file).  ' you will be listed in a credit list on this file).
18  '  '
19  ' You may NOT sell this as part of a non-free package:  ' You may NOT sell this as part of a non-free package:
20  ' IF YOU HAVE PAID FOR THIS CODE, YOU HAVE BEEN ROBBED! CONTACT admin@cynergi.net!  ' IF YOU HAVE PAID FOR THIS CODE, YOU HAVE BEEN ROBBED! CONTACT admin@cynergi.net!
21    
22  ' MODULE  ' MODULE
23  '   "exportSQL"  '   "exportSQL"
24  '  '
25  ' GOAL  ' GOAL
26  '   Export all tables in a MS-Access database file to 2 text files:  '   Export all tables in a MS-Access database file to 2 text files:
27  '   one containing SQL instructions to delete the new tables to be created,  '   one containing SQL instructions to delete the new tables to be created,
28  '   and the other with SQL instructions to create and insert data into  '   and the other with SQL instructions to create and insert data into
29  '   the new tables. The table structure and data will resemble as much as  '   the new tables. The table structure and data will resemble as much as
30  '   possible the current Access database.  '   possible the current Access database.
31  '  '
32  ' HOW TO USE  ' HOW TO USE
33  '   Copy-and-paste this text file into an Access module and run the first  '   Copy-and-paste this text file into an Access module and run the first
34  '   (and only public) function. in more detail, you:  '   (and only public) function. in more detail, you:
35  '   * Open the Access .mdb file you wish to export  '   * Open the Access .mdb file you wish to export
36  '   * in the default database objects window, click on "Modules", and then on "New"  '   * in the default database objects window, click on "Modules", and then on "New"
37  '   * The code window that opens has some pre-written text (code). Delete it.  '   * The code window that opens has some pre-written text (code). Delete it.
38  '   * Copy-and-paste this entire file to the code module window  '   * Copy-and-paste this entire file to the code module window
39  '   * If you are using Microsoft Access 2000 you will have to make  '   * If you are using Microsoft Access 2000 you will have to make
40  '     one additional step: go into Tools/References and check following  '     one additional step: go into Tools/References and check following
41  '     component: Microsoft DAO Object 3.6 Library and uncheck Microsoft  '     component: Microsoft DAO Object 3.6 Library and uncheck Microsoft
42  '     ActiveX Data Objects Library  '     ActiveX Data Objects Library
43  '   * You may hit the compile button (looks like 3 sheets of paper with an arrow on  '   * You may hit the compile button (looks like 3 sheets of paper with an arrow on
44  '     top of them, pressing down on them), or select Debug, Compile Loaded Modules  '     top of them, pressing down on them), or select Debug, Compile Loaded Modules
45  '     from the top menu, just to make sure there are no errors, and that this code  '     from the top menu, just to make sure there are no errors, and that this code
46  '     works on your Access version (it works on Access'97 and should work on Access'95)  '     works on your Access version (it works on Access'97 and should work on Access'95)
47  '   * Close the code module window - windows will prompt you to save the code:  '   * Close the code module window - windows will prompt you to save the code:
48  '     answer "Yes", and when promped for a name for the module, type anything  '     answer "Yes", and when promped for a name for the module, type anything
49  '     (say, "MexportSQL")  '     (say, "MexportSQL")
50  '   The module is now part of your Access database. To run the export, you:  '   The module is now part of your Access database. To run the export, you:
51  '   * Re-open the code module (by double-clicking on it, or clicking "Design"  '   * Re-open the code module (by double-clicking on it, or clicking "Design"
52  '     with it selected). Move the cursor to where the first "Function" keyword appears.  '     with it selected). Move the cursor to where the first "Function" keyword appears.
53  '     Press F5 or select Run, Go/Continue from the top menu.  '     Press F5 or select Run, Go/Continue from the top menu.
54  '   * Alternativelly, click on "Macros" on the database objects window,  '   * Alternativelly, click on "Macros" on the database objects window,
55  '     and then on "New". On the macro window, select "RunCode" as the macro action,  '     and then on "New". On the macro window, select "RunCode" as the macro action,
56  '     and "exportSQL" as the function name, bellow. Save the macro similarly to the  '     and "exportSQL" as the function name, bellow. Save the macro similarly to the
57  '     module, and this time double-clicking on it, or clicking "Run" will run the export.  '     module, and this time double-clicking on it, or clicking "Run" will run the export.
58  '  '
59  ' BEFORE RUNNING THE EXPORT  ' BEFORE RUNNING THE EXPORT
60  '   Before running the export, be sure to check out the Export Options just bellow this  '   Before running the export, be sure to check out the Export Options just bellow this
61  '   text, and change any according to your wishes and specs.  '   text, and change any according to your wishes and specs.
62  '  '
63  ' TECH DATA  ' TECH DATA
64  '   Public identifiers:  '   Public identifiers:
65  '   * Only one: "exportSQL", a function taking and returning no arguments. It runs the export.  '   * Only one: "exportSQL", a function taking and returning no arguments. It runs the export.
66  '   Functionallity:  '   Functionallity:
67  '   * Can export to mSQL v1, mSQL v2, MySQL or PostgreSQL recognised SQL statements  '   * Can export to mSQL v1, mSQL v2, MySQL or PostgreSQL recognised SQL statements
68  '   * Excellent respect for name conversion, namespace verification, type matching, etc.  '   * Excellent respect for name conversion, namespace verification, type matching, etc.
69  '   * Detects default values "=Now()", "=Date()" and "=Time()" to create types like "TIMESTAMP"  '   * Detects default values "=Now()", "=Date()" and "=Time()" to create types like "TIMESTAMP"
70  '   * Fully configurable via private constants on top of code  '   * Fully configurable via private constants on top of code
71  '   * Exports two files: one for erasures, another for creations (useful when updating dbs)  '   * Exports two files: one for erasures, another for creations (useful when updating dbs)
72  '   * Generates compatibility warnings when necessary  '   * Generates compatibility warnings when necessary
73  '   * Code and generated files are paragraphed and easy to read  '   * Code and generated files are paragraphed and easy to read
74  '   * Access text and memo fields can have any type of line termination: \n\r, \r\n, \n or \r  '   * Access text and memo fields can have any type of line termination: \n\r, \r\n, \n or \r
75  '   * Properly escapes text and memo fields, besides all types of binary fields  '   * Properly escapes text and memo fields, besides all types of binary fields
76  '   * Closes all open objects and files on error  '   * Closes all open objects and files on error
77  '   * Known bugs / incomplete constructs are signalled with comments starting with "!!!!"  '   * Known bugs / incomplete constructs are signalled with comments starting with "!!!!"
78  '   * Two alternatives on absent date/time type on mSQL: REAL or CHAR field  '   * Two alternatives on absent date/time type on mSQL: REAL or CHAR field
79  '   * Exports Primary key and Indexes for PostgreSQL  '   * Exports Primary key and Indexes for PostgreSQL
80  '   * Inserts Constrains as comments in SQL dump  '   * Inserts Constrains as comments in SQL dump
81    
82  ' Export Options - change at will  ' TODO:
83    '   + fix fields with non-valid characters (-, /, and friend)
84  Private Const DB_ENGINE As String = "Pg"  ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2), "MY" (MySQL) or "Pg" (PostgreSQL)  '   + fix CR/LF in output
85  Private Const DB_NAME As String = ""  ' Use empty string for current. Else use filename or DSN name of database to export  '   + fix boolean fields
86  Private Const DB_CONNECT As String = ""  ' Used only if above string is not empty  '   + output of create table in separate file
87  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)  '   - create index (FIX)
88  Private Const WS_REPLACEMENT As String = "_"  ' Use "" to simply eat whitespaces in identifiers (table and field names)  
89  Private Const IDENT_MAX_SIZE As Integer = 19  ' Suggest 64. Max size of identifiers (table and field names)  ' Export Options - change at will
90  Private Const PREFIX_ON_KEYWORD As String = "_"  ' Prefix to add to identifier, if it is a reserved word  
91  Private Const SUFFIX_ON_KEYWORD As String = ""  ' Suffix to add to identifier, if it is a reserved word  Private Const DB_ENGINE As String = "Pg"  ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2), "MY" (MySQL) or "Pg" (PostgreSQL)
92  Private Const PREFIX_ON_INDEX As String = "ix"  ' Prefix to add to index identifier, to make it unique (mSQL v2)  Private Const DB_NAME As String = ""  ' Use empty string for current. Else use filename or DSN name of database to export
93  Private Const SUFFIX_ON_INDEX As String = ""  ' Suffix to add to index identifier, to make it unique (mSQL v2)  Private Const DB_CONNECT As String = ""  ' Used only if above string is not empty
94  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 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)
95  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 WS_REPLACEMENT As String = "_"  ' Use "" to simply eat whitespaces in identifiers (table and field names)
96  Private Const LINE_BREAK As String = "\n"  ' Try "<br>". String to replace line breaks in text fields  Private Const IDENT_MAX_SIZE As Integer = 19  ' Suggest 64. Max size of identifiers (table and field names)
97  Private Const COMMENTS As Boolean = True  ' Dump comments into output file  Private Const PREFIX_ON_KEYWORD As String = "_"  ' Prefix to add to identifier, if it is a reserved word
98  Private Const DISPLAY_WARNINGS As Boolean = True  ' False to output the warnings to the files, only  Private Const SUFFIX_ON_KEYWORD As String = ""  ' Suffix to add to identifier, if it is a reserved word
99  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 PREFIX_ON_INDEX As String = "ix"  ' Prefix to add to index identifier, to make it unique (mSQL v2)
100  Private Const PARA_INSERT_AFTER As Integer = 3  ' Field count after which print INSERTs different lines  Private Const SUFFIX_ON_INDEX As String = ""  ' Suffix to add to index identifier, to make it unique (mSQL v2)
101  Private Const INDENT_SIZE As Integer = 5  ' Number of spaces on indents  Private Const CREATE_SQL_FILE As String = "c:\temp\esql_create.txt" ' Use empty if open on #1. Will be overwritten if exists!
102    Private Const DEL_SQL_FILE As String = "c:\temp\esql_del.txt"  ' Use empty if open on #2. Will be overwritten if exists!
103    Private Const ADD_SQL_FILE As String = "c:\temp\esql_add.txt"  ' Use empty if open on #1. Will be overwritten if exists!
104  ' Global var to store inter-funtion data  Private Const LINE_BREAK As String = "\n"  ' Try "<br>". String to replace line breaks in text fields
105  Private warnings As String  ' Not an option: do not set in any way  Private Const COMMENTS As Boolean = True  ' Dump comments into output file
106  Private COMMENT_PREFIX As String  Private Const DISPLAY_WARNINGS As Boolean = True  ' False to output the warnings to the files, only
107  Private QUERY_SEPARATOR As String ' Terminator/separator of SQL queries (to instruct some monitor program to execute them)  Private Const DATE_AS_STR As Boolean = True  ' False to use real number data type for date, time and timestamp (in mSQL only)
108    Private Const PARA_INSERT_AFTER As Integer = 3  ' Field count after which print INSERTs different lines
109    Private Const INDENT_SIZE As Integer = 5  ' Number of spaces on indents
110  ' Primary Export Function  
111    ' Global var to store inter-funtion data
112  Sub exportSQL()  Private warnings As String  ' Not an option: do not set in any way
113  On Error GoTo exportSQL_error  Private COMMENT_PREFIX As String
114    Private QUERY_SEPARATOR As String ' Terminator/separator of SQL queries (to instruct some monitor program to execute them)
115      Dim cdb As Database  
116      Dim ctableix As Integer, ctablename As String  
117      If COMMENTS Then  ' Primary Export Function
118          If DB_ENGINE = "Pg" Then  
119              COMMENT_PREFIX = "--"  Sub exportSQL()
120              QUERY_SEPARATOR = ";"  On Error GoTo exportSQL_error
121          Else  
122              COMMENT_PREFIX = "#"      Dim cdb As Database
123              QUERY_SEPARATOR = "\g"      Dim ctableix As Integer, ctablename As String
124          End If      If COMMENTS Then
125      End If          If DB_ENGINE = "Pg" Then
126                COMMENT_PREFIX = "--"
127      If DB_NAME = "" Then              QUERY_SEPARATOR = ";"
128          Set cdb = CurrentDb()          Else
129      Else              COMMENT_PREFIX = "#"
130          Set cdb = OpenDatabase(DB_NAME, False, True, DB_CONNECT) ' Shared, read-only              QUERY_SEPARATOR = "\g"
131      End If          End If
132            End If
133      If ADD_SQL_FILE <> "" Then Open ADD_SQL_FILE For Output As #1  
134      If DEL_SQL_FILE <> "" Then Open DEL_SQL_FILE For Output As #2      If DB_NAME = "" Then
135            Set cdb = CurrentDb()
136      DoCmd.Hourglass True      Else
137            Set cdb = OpenDatabase(DB_NAME, False, True, DB_CONNECT) ' Shared, read-only
138      If COMMENTS Then      End If
139          Dim convert_to As String      
140          If (Left$(DB_ENGINE, 2) = "MY") Then      If CREATE_SQL_FILE <> "" Then Open CREATE_SQL_FILE For Output As #1
141              convert_to = "MySQL"      If DEL_SQL_FILE <> "" Then Open DEL_SQL_FILE For Output As #2
142          ElseIf (DB_ENGINE = "Pg") Then      If ADD_SQL_FILE <> "" Then Open ADD_SQL_FILE For Output As #3
143              convert_to = "PostgreSQL"  
144          Else      DoCmd.Hourglass True
145              convert_to = "mSQL"  
146          End If      If COMMENTS Then
147          Print #1, COMMENT_PREFIX & " Exported from MS Access to " & convert_to          Dim convert_to As String
148          Print #2, COMMENT_PREFIX & " Exported from MS Access to " & convert_to          If (Left$(DB_ENGINE, 2) = "MY") Then
149          Print #1, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"              convert_to = "MySQL"
150          Print #2, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"          ElseIf (DB_ENGINE = "Pg") Then
151      End If              convert_to = "PostgreSQL"
152            Else
153      'Go through the table definitions              convert_to = "mSQL"
154      For ctableix = 0 To cdb.TableDefs.Count - 1          End If
155                Print #1, COMMENT_PREFIX & " Exported from MS Access to " & convert_to
156          Dim cfieldix As Integer, cfieldname As String          Print #2, COMMENT_PREFIX & " Exported from MS Access to " & convert_to
157          Dim fieldlst As String, sqlcode As String          Print #3, COMMENT_PREFIX & " Exported from MS Access to " & convert_to
158          Dim primary_found As Boolean          Print #1, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
159          Dim crs As Recordset          Print #2, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
160                Print #3, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
161          ' Let's take only the visible tables      End If
162          If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _  
163          (cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then      'Go through the table definitions
164                    For ctableix = 0 To cdb.TableDefs.Count - 1
165              ctablename = conv_name("" & cdb.TableDefs(ctableix).Name)      
166                        Dim cfieldix As Integer, cfieldname As String
167              Print #2,          Dim fieldlst As String, sqlcode As String
168              Print #2, "DROP TABLE " & ctablename & QUERY_SEPARATOR          Dim primary_found As Boolean
169                        Dim crs As Recordset
170              ' CREATE clause      
171              Print #1,          ' Let's take only the visible tables
172              Print #1, "CREATE TABLE " & ctablename          If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _
173              Print #1, Space$(INDENT_SIZE) & "("          (cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then
174                            
175              warnings = ""              ctablename = conv_name("" & cdb.TableDefs(ctableix).Name)
176              fieldlst = ""              
177              primary_found = False              Print #2,
178                            Print #2, "DROP TABLE " & ctablename & QUERY_SEPARATOR
179              ' loop thorugh each field in the table              
180              For cfieldix = 0 To cdb.TableDefs(ctableix).Fields.Count - 1              ' CREATE clause
181                                Print #1,
182                  Dim typestr As String, fieldsz As Integer, dvstr As String              Print #1, "CREATE TABLE " & ctablename
183                  Dim found_ix As Boolean, cindex, tmpindex As Index, cfield, tmpfield As Field              Print #1, Space$(INDENT_SIZE) & "("
184                                
185                  ' if this is not the first iteration, add separators              warnings = ""
186                  If fieldlst <> "" Then              fieldlst = ""
187                      fieldlst = fieldlst & ", "              primary_found = False
188                      Print #1, ","              
189                  End If              ' loop thorugh each field in the table
190                                For cfieldix = 0 To cdb.TableDefs(ctableix).Fields.Count - 1
191                  ' get field name                  
192                  cfieldname = conv_name("" & cdb.TableDefs(ctableix).Fields(cfieldix).Name)                  Dim typestr As String, fieldsz As Integer, dvstr As String
193                  fieldlst = fieldlst & cfieldname                  Dim found_ix As Boolean, cindex, tmpindex As Index, cfield, tmpfield As Field
194                                    
195                  ' translate types                  ' if this is not the first iteration, add separators
196                  If DB_ENGINE = "M1" Or DB_ENGINE = "M2" Then                  If fieldlst <> "" Then
197                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type                      fieldlst = fieldlst & ", "
198                          Case dbChar                      Print #1, ","
199                              typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"                  End If
200                          Case dbText                  
201                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size                  ' get field name
202                              If fieldsz = 0 Then fieldsz = 255                  cfieldname = conv_name("" & cdb.TableDefs(ctableix).Fields(cfieldix).Name)
203                              typestr = "CHAR(" & fieldsz & ")"                  fieldlst = fieldlst & cfieldname
204                          Case dbBoolean, dbByte, dbInteger, dbLong                  
205                              typestr = "INT"                  ' translate types
206                          Case dbDouble, dbFloat, dbSingle                  If DB_ENGINE = "M1" Or DB_ENGINE = "M2" Then
207                              typestr = "REAL"                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
208                          Case dbCurrency, dbDecimal, dbNumeric                          Case dbChar
209                              typestr = "REAL"                              typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
210                              warn "In new field '" & cfieldname & "', currency/BCD will be converted to REAL - there may be precision loss!", False                          Case dbText
211                          Case dbDate                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
212                              typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP                              If fieldsz = 0 Then fieldsz = 255
213                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False                              typestr = "CHAR(" & fieldsz & ")"
214                          Case dbTime                          Case dbBoolean, dbByte, dbInteger, dbLong
215                              typestr = IIf(DATE_AS_STR, "CHAR(8)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP                              typestr = "INT"
216                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False                          Case dbDouble, dbFloat, dbSingle
217                          Case dbTimeStamp                              typestr = "REAL"
218                              typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP                          Case dbCurrency, dbDecimal, dbNumeric
219                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & "." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_timestamp'.", ""), False                              typestr = "REAL"
220                          Case dbMemo                              warn "In new field '" & cfieldname & "', currency/BCD will be converted to REAL - there may be precision loss!", False
221                              If DB_ENGINE = "M2" Then                          Case dbDate
222                                  typestr = "TEXT(" & MSQL_64kb_AVG & ")"                              typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
223                              Else                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
224                                  typestr = "CHAR(" & MSQL_64kb_AVG & ")"                          Case dbTime
225                                  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                              typestr = IIf(DATE_AS_STR, "CHAR(8)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
226                              End If                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
227                          Case dbBinary, dbVarBinary                          Case dbTimeStamp
228                              typestr = "CHAR(255)"                              typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
229                              warn "In new field '" & cfieldname & "', dbBinary and dbVarBinary are not supported by mSQL! - will use a text (CHAR(255)) field.", True                              warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & "." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_timestamp'.", ""), False
230                          Case dbLongBinary                          Case dbMemo
231                              typestr = "CHAR(" & MSQL_64kb_AVG & ")"                              If DB_ENGINE = "M2" Then
232                              warn "In new field '" & cfieldname & "', dbLongBinary is not supported by mSQL! - will use a text (CHAR(" & MSQL_64kb_AVG & ")) field.", True                                  typestr = "TEXT(" & MSQL_64kb_AVG & ")"
233                          Case Else                              Else
234                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True                                  typestr = "CHAR(" & MSQL_64kb_AVG & ")"
235                              Error 5  ' invalid Procedure Call                                  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
236                      End Select                              End If
237                  ElseIf DB_ENGINE = "MY" Then                          Case dbBinary, dbVarBinary
238                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type                              typestr = "CHAR(255)"
239                          Case dbBinary                              warn "In new field '" & cfieldname & "', dbBinary and dbVarBinary are not supported by mSQL! - will use a text (CHAR(255)) field.", True
240                              typestr = "TINYBLOB"                          Case dbLongBinary
241                          Case dbBoolean                              typestr = "CHAR(" & MSQL_64kb_AVG & ")"
242                              typestr = "TINYINT"                              warn "In new field '" & cfieldname & "', dbLongBinary is not supported by mSQL! - will use a text (CHAR(" & MSQL_64kb_AVG & ")) field.", True
243                          Case dbByte                          Case Else
244                              typestr = "TINYINT UNSIGNED"                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
245                          Case dbChar                              Error 5  ' invalid Procedure Call
246                              typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"                      End Select
247                          Case dbCurrency                  ElseIf DB_ENGINE = "MY" Then
248                              typestr = "DECIMAL(20,4)"                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
249                          Case dbDate                          Case dbBinary
250                              typestr = "DATETIME"                              typestr = "TINYBLOB"
251                          Case dbDecimal                          Case dbBoolean
252                              typestr = "DECIMAL(20,4)"                              typestr = "TINYINT"
253                          Case dbDouble                          Case dbByte
254                              typestr = "REAL"                              typestr = "TINYINT UNSIGNED"
255                          Case dbFloat                          Case dbChar
256                              typestr = "REAL"                              typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
257                          Case dbInteger                          Case dbCurrency
258                              typestr = "SMALLINT"                              typestr = "DECIMAL(20,4)"
259                          Case dbLong                          Case dbDate
260                              typestr = "INT"                              typestr = "DATETIME"
261                          Case dbLongBinary                          Case dbDecimal
262                              typestr = "LONGBLOB"                              typestr = "DECIMAL(20,4)"
263                          Case dbMemo                          Case dbDouble
264                              typestr = "LONGBLOB"  ' !!!!! MySQL bug! Replace by LONGTEXT when corrected!                              typestr = "REAL"
265                          Case dbNumeric                          Case dbFloat
266                              typestr = "DECIMAL(20,4)"                              typestr = "REAL"
267                          Case dbSingle                          Case dbInteger
268                              typestr = "FLOAT"                              typestr = "SMALLINT"
269                          Case dbText                          Case dbLong
270                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size                              typestr = "INT"
271                              If fieldsz = 0 Then fieldsz = 255                          Case dbLongBinary
272                              typestr = "CHAR(" & fieldsz & ")"                              typestr = "LONGBLOB"
273                          Case dbTime                          Case dbMemo
274                              typestr = "TIME"                              typestr = "LONGBLOB"  ' !!!!! MySQL bug! Replace by LONGTEXT when corrected!
275                          Case dbTimeStamp                          Case dbNumeric
276                              typestr = "TIMESTAMP"                              typestr = "DECIMAL(20,4)"
277                          Case dbVarBinary                          Case dbSingle
278                              typestr = "TINYBLOB"                              typestr = "FLOAT"
279                          Case dbBigInt, dbGUID                          Case dbText
280                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
281                              Error 5  ' invalid Procedure Call                              If fieldsz = 0 Then fieldsz = 255
282                          Case Else                              typestr = "CHAR(" & fieldsz & ")"
283                              typestr = "LONGBLOB"                          Case dbTime
284                      End Select                              typestr = "TIME"
285                  ElseIf DB_ENGINE = "Pg" Then                          Case dbTimeStamp
286                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type                              typestr = "TIMESTAMP"
287                          Case dbBinary                          Case dbVarBinary
288                              typestr = "int2"                              typestr = "TINYBLOB"
289                          Case dbBoolean                          Case dbBigInt, dbGUID
290                              typestr = "bool"                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
291                          Case dbByte                              Error 5  ' invalid Procedure Call
292                              typestr = "int2"                          Case Else
293                          Case dbChar                              typestr = "LONGBLOB"
294                              typestr = "varchar(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"                      End Select
295                          Case dbCurrency                  ElseIf DB_ENGINE = "Pg" Then
296                              typestr = "DECIMAL(20,4)"                      Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
297                          Case dbDate                          Case dbBinary
298                              typestr = "DATETIME"                              typestr = "int2"
299                          Case dbDecimal                          Case dbBoolean
300                              typestr = "DECIMAL(20,4)"                              typestr = "bool"
301                          Case dbDouble                          Case dbByte
302                              typestr = "float8"                              typestr = "int2"
303                          Case dbFloat                          Case dbChar
304                              typestr = "float4"                              typestr = "varchar(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
305                          Case dbInteger                          Case dbCurrency
306                              typestr = "int4"                              typestr = "DECIMAL(20,4)"
307                          Case dbLong                          Case dbDate
308                              typestr = "int8"                              typestr = "DATETIME"
309                          Case dbLongBinary                          Case dbDecimal
310                              typestr = "text"        ' hm?                              typestr = "DECIMAL(20,4)"
311                          Case dbMemo                          Case dbDouble
312                              typestr = "text"                              typestr = "float8"
313                          Case dbNumeric                          Case dbFloat
314                              typestr = "DECIMAL(20,4)"                              typestr = "float4"
315                          Case dbSingle                          Case dbInteger
316                              typestr = "float4"                              typestr = "int4"
317                          Case dbText                          Case dbLong
318                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size                              typestr = "int8"
319                              If fieldsz = 0 Then fieldsz = 255                          Case dbLongBinary
320                              typestr = "varchar(" & fieldsz & ")"                              typestr = "text"        ' hm?
321                          Case dbTime                          Case dbMemo
322                              typestr = "TIME"                              typestr = "text"
323                          Case dbTimeStamp                          Case dbNumeric
324                              typestr = "TIMESTAMP"                              typestr = "DECIMAL(20,4)"
325                          Case dbVarBinary                          Case dbSingle
326                              typestr = "text"        ' hm?                              typestr = "float4"
327                          Case dbBigInt, dbGUID                          Case dbText
328                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True                              fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
329                              Error 5  ' invalid Procedure Call                              If fieldsz = 0 Then fieldsz = 255
330                          Case Else                              typestr = "varchar(" & fieldsz & ")"
331                              typestr = "text"                          Case dbTime
332                      End Select                              typestr = "TIME"
333                  Else                          Case dbTimeStamp
334                      warn "unkown DB_ENGINE string " & DB_ENGINE, True                              typestr = "TIMESTAMP"
335                      Error 5  ' invalid Procedure Call                          Case dbVarBinary
336                  End If                              typestr = "text"        ' hm?
337                                            Case dbBigInt, dbGUID
338                  ' check not null and auto-increment properties                              warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
339                  If ((cdb.TableDefs(ctableix).Fields(cfieldix).Attributes And dbAutoIncrField) <> 0) Then                              Error 5  ' invalid Procedure Call
340                      If Left$(DB_ENGINE, 2) = "MY" Then                          Case Else
341                          typestr = typestr & " NOT NULL AUTO_INCREMENT"                              typestr = "text"
342                      ElseIf DB_ENGINE = "Pg" Then                      End Select
343                          typestr = " serial"                  Else
344                      Else                      warn "unkown DB_ENGINE string " & DB_ENGINE, True
345                          typestr = typestr & " NOT NULL"                      Error 5  ' invalid Procedure Call
346                          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
347                      End If                  
348                  ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = True Then                  ' check not null and auto-increment properties
349                      typestr = typestr & " NOT NULL"                  If ((cdb.TableDefs(ctableix).Fields(cfieldix).Attributes And dbAutoIncrField) <> 0) Then
350                  End If                      If Left$(DB_ENGINE, 2) = "MY" Then
351                                                typestr = typestr & " NOT NULL AUTO_INCREMENT"
352                  ' default value                      ElseIf DB_ENGINE = "Pg" Then
353                  dvstr = cdb.TableDefs(ctableix).Fields(cfieldix).DefaultValue                          typestr = " serial"
354                  If dvstr <> "" Then                      Else
355                      If Left$(DB_ENGINE, 2) <> "MY" And DB_ENGINE <> "Pg" Then                          typestr = typestr & " NOT NULL"
356                          warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False                          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
357                      ElseIf Left$(DB_ENGINE, 2) = "MY" And cdb.TableDefs(ctableix).Fields(cfieldix).Required = False Then                      End If
358                          warn "In new field '" & cfieldname & "', MySQL needs NOT NULL to support default values! - it won't be set a default.", False                  ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = True Then
359                      ElseIf Left$(dvstr, 1) = """" Then                      typestr = typestr & " NOT NULL"
360                          typestr = typestr & " DEFAULT '" & conv_str(Mid$(dvstr, 2, Len(dvstr) - 2)) & "'"                  End If
361                      ElseIf ((LCase(dvstr) = "now()" Or LCase(dvstr) = "date()" Or LCase(dvstr) = "time()") And _                      
362                      (Left$(typestr, 5) = "DATE " Or Left$(typestr, 5) = "TIME " Or Left$(typestr, 9) = "DATETIME ")) Then                  ' default value
363                          typestr = "TIMESTAMP " & Right$(typestr, Len(typestr) - InStr(typestr, " "))                  dvstr = cdb.TableDefs(ctableix).Fields(cfieldix).DefaultValue
364                      ElseIf LCase(dvstr) = "no" Then                  If dvstr <> "" Then
365                          typestr = typestr & " DEFAULT 0"                      If Left$(DB_ENGINE, 2) <> "MY" And DB_ENGINE <> "Pg" Then
366                      ElseIf LCase(dvstr) = "yes" Then                          warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False
367                          typestr = typestr & " DEFAULT 1"                      ElseIf Left$(DB_ENGINE, 2) = "MY" And cdb.TableDefs(ctableix).Fields(cfieldix).Required = False Then
368                      Else                          warn "In new field '" & cfieldname & "', MySQL needs NOT NULL to support default values! - it won't be set a default.", False
369                          typestr = typestr & " DEFAULT " & dvstr                      ElseIf Left$(dvstr, 1) = """" Then
370                      End If                          typestr = typestr & " DEFAULT '" & conv_str(Mid$(dvstr, 2, Len(dvstr) - 2)) & "'"
371                  End If                      ElseIf ((LCase(dvstr) = "now()" Or LCase(dvstr) = "date()" Or LCase(dvstr) = "time()") And _
372                                        (Left$(typestr, 5) = "DATE " Or Left$(typestr, 5) = "TIME " Or Left$(typestr, 9) = "DATETIME ")) Then
373                  ' add constrains                          typestr = "TIMESTAMP " & Right$(typestr, Len(typestr) - InStr(typestr, " "))
374                  Dim val_rule, val_text As String                      ElseIf LCase(dvstr) = "no" Then
375                  val_rule = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationRule                          typestr = typestr & " DEFAULT 0"
376                  val_text = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationText                      ElseIf LCase(dvstr) = "yes" Then
377                  If DB_ENGINE = "Pg" And val_rule <> "" Then                          typestr = typestr & " DEFAULT 1"
378                      typestr = typestr & COMMENT_PREFIX & " check ( " & val_rule & " ) " & COMMENT_PREFIX & " " & val_text                      Else
379                      warn "Field '" & cfieldname & "' has constrain '" & val_rule & "' with text '" & val_text & "' which you have to convert manually (inserted as comment in SQL)", False                          typestr = typestr & " DEFAULT " & dvstr
380                  End If                      End If
381                    End If
382                  ' check if primary key (for mSQL v1)                  
383                  If DB_ENGINE = "M1" Then                  ' add constrains
384                      found_ix = False                  Dim val_rule, val_text As String
385                      For Each cindex In cdb.TableDefs(ctableix).Indexes                  val_rule = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationRule
386                          If cindex.Primary Then                  val_text = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationText
387                              For Each cfield In cindex.Fields                  If DB_ENGINE = "Pg" And val_rule <> "" Then
388                                  If cfield.Name = cdb.TableDefs(ctableix).Fields(cfieldix).Name Then                      typestr = typestr & COMMENT_PREFIX & " check ( " & val_rule & " ) " & COMMENT_PREFIX & " " & val_text
389                                      found_ix = True                      warn "Field '" & cfieldname & "' has constrain '" & val_rule & "' with text '" & val_text & "' which you have to convert manually (inserted as comment in SQL)", False
390                                      Exit For                  End If
391                                  End If  
392                              Next cfield                  ' check if primary key (for mSQL v1)
393                              If found_ix Then Exit For                  If DB_ENGINE = "M1" Then
394                          End If                      found_ix = False
395                      Next cindex                      For Each cindex In cdb.TableDefs(ctableix).Indexes
396                      If found_ix Then                          If cindex.Primary Then
397                          If primary_found Then                              For Each cfield In cindex.Fields
398                              warn "On new table '" & ctablename & "', mSQL v1 does not support more than one PRIMARY KEY! Only first key was set.", False                                  If cfield.Name = cdb.TableDefs(ctableix).Fields(cfieldix).Name Then
399                          Else                                      found_ix = True
400                              typestr = typestr & " PRIMARY KEY"                                      Exit For
401                              primary_found = True                                  End If
402                          End If                              Next cfield
403                      End If                              If found_ix Then Exit For
404                  End If                          End If
405                                        Next cindex
406                  'print out field info                      If found_ix Then
407                  Print #1, Space$(INDENT_SIZE) & cfieldname & Space$(IDENT_MAX_SIZE - Len(cfieldname) + 2) & typestr;                          If primary_found Then
408                                            warn "On new table '" & ctablename & "', mSQL v1 does not support more than one PRIMARY KEY! Only first key was set.", False
409              Next cfieldix                          Else
410                                                  typestr = typestr & " PRIMARY KEY"
411              ' terminate CREATE clause                              primary_found = True
412              If DB_ENGINE = "M2" Then                          End If
413                  Print #1,                      End If
414                  Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR                  End If
415              End If                  
416                                      'print out field info
417              ' primary key and other index declaration                  Print #1, Space$(INDENT_SIZE) & cfieldname & Space$(IDENT_MAX_SIZE - Len(cfieldname) + 2) & typestr;
418              If DB_ENGINE = "M2" Or Left$(DB_ENGINE, 2) = "MY" Or DB_ENGINE = "Pg" Then              
419                  For Each cindex In cdb.TableDefs(ctableix).Indexes              Next cfieldix
420                      sqlcode = ""                    
421                      For Each cfield In cindex.Fields              ' terminate CREATE clause
422                          sqlcode = sqlcode & IIf(sqlcode = "", "", ", ") & conv_name(cfield.Name)              If DB_ENGINE = "M2" Then
423                      Next cfield                  Print #1,
424                      If DB_ENGINE = "M2" Then                  Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
425                          Print #1, "CREATE " & IIf(cindex.Unique, "UNIQUE ", "") & "INDEX " & _              End If
426                          conv_name(PREFIX_ON_INDEX & cindex.Name & SUFFIX_ON_INDEX) & " ON " & _                    
427                          ctablename & " (" & sqlcode & ")" & QUERY_SEPARATOR              ' primary key and other index declaration
428                      ElseIf DB_ENGINE = "Pg" Then              If DB_ENGINE = "M2" Or Left$(DB_ENGINE, 2) = "MY" Or DB_ENGINE = "Pg" Then
429                          If cindex.Primary Then                  For Each cindex In cdb.TableDefs(ctableix).Indexes
430                              Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "PRIMARY KEY (" & sqlcode & ")";                      sqlcode = ""
431                          ElseIf cindex.Unique Then                      For Each cfield In cindex.Fields
432                              Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "UNIQUE INDEX (" & sqlcode & ")";                          sqlcode = sqlcode & IIf(sqlcode = "", "", ", ") & conv_name(cfield.Name)
433                          Else                      Next cfield
434                              ' skip indexes which are part of primary key                      If DB_ENGINE = "M2" Then
435                              primary_found = False                          Print #1, "CREATE " & IIf(cindex.Unique, "UNIQUE ", "") & "INDEX " & _
436                              For Each tmpindex In cdb.TableDefs(ctableix).Indexes                          conv_name(PREFIX_ON_INDEX & cindex.Name & SUFFIX_ON_INDEX) & " ON " & _
437                                  If tmpindex.Primary Then                          ctablename & " (" & sqlcode & ")" & QUERY_SEPARATOR
438                                      For Each tmpfield In tmpindex.Fields                      ElseIf DB_ENGINE = "Pg" Then
439                                          If sqlcode = conv_name(tmpfield.Name) Then                          If cindex.Primary Then
440                                              primary_found = True                              Print #1, ","
441                                              Exit For                              Print #1, Space$(INDENT_SIZE) & "PRIMARY KEY (" & sqlcode & ")";
442                                          End If                          ElseIf cindex.Unique Then
443                                      Next tmpfield                              Print #1, ","
444                                  End If                              Print #1, Space$(INDENT_SIZE) & "UNIQUE INDEX (" & sqlcode & ")";
445                              Next tmpindex                          Else
446                              If Not primary_found Then                              ' skip indexes which are part of primary key
447                                  Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "INDEX (" & sqlcode & ")";                              primary_found = False
448                              End If                              For Each tmpindex In cdb.TableDefs(ctableix).Indexes
449                          End If                                  If tmpindex.Primary Then
450                                        For Each tmpfield In tmpindex.Fields
451                      Else                                          If sqlcode = conv_name(tmpfield.Name) Then
452                          Print #1, ","                                              primary_found = True
453                          Print #1, Space$(INDENT_SIZE) & IIf(cindex.Primary, "PRIMARY ", "") & _                                              Exit For
454                          "KEY (" & sqlcode & ")";                                          End If
455                      End If                                      Next tmpfield
456                  Next cindex                                  End If
457              End If                              Next tmpindex
458                                            If Not primary_found Then
459              ' terminate CREATE clause                                  If DB_ENGINE = "Pg" Then
460              If DB_ENGINE <> "M2" Then                                      ' FIX: create index....
461                  Print #1,                                  Else
462                  Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR                                      Print #1, ","
463              End If                                      Print #1, Space$(INDENT_SIZE) & "INDEX (" & sqlcode & ")";
464                                    End If
465              ' print any warnings bellow it                              End If
466              If COMMENTS And warnings <> "" Then                          End If
467                  If DB_ENGINE = "M2" Then Print #1, COMMENT_PREFIX & " "  
468                  Print #1, warnings                      Else
469                  warnings = ""                          Print #1, ","
470              End If                          Print #1, Space$(INDENT_SIZE) & IIf(cindex.Primary, "PRIMARY ", "") & "KEY (" & sqlcode & ")" & QUERY_SEPARATOR;
471                                    End If
472              Print #1,                  Next cindex
473                            End If
474              ' INSERT clause              
475              Set crs = cdb.OpenRecordset(cdb.TableDefs(ctableix).Name)              ' terminate CREATE clause
476              If crs.RecordCount <> 0 Then              If DB_ENGINE <> "M2" Then
477                                    Print #1,
478                  ' loop thorugh each record in the table                  Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
479                  crs.MoveFirst              End If
480                  Do Until crs.EOF  
481                                    ' print any warnings bellow it
482                      ' start paragraphing              If COMMENTS And warnings <> "" Then
483                      sqlcode = "INSERT INTO " & ctablename                  If DB_ENGINE = "M2" Then Print #1, COMMENT_PREFIX & " "
484                      If crs.Fields.Count > PARA_INSERT_AFTER Then                  Print #1, warnings
485                          Print #1, sqlcode                  warnings = ""
486                          If DB_ENGINE = "M1" Then Print #1, Space$(INDENT_SIZE) & "(" & fieldlst & ")"              End If
487                          Print #1, "VALUES ("              
488                          sqlcode = Space$(INDENT_SIZE)              Print #1,
489                      Else              
490                          If DB_ENGINE = "M1" Then sqlcode = sqlcode & " (" & fieldlst & ")"              ' INSERT clause
491                          sqlcode = sqlcode & " VALUES ("              Set crs = cdb.OpenRecordset(cdb.TableDefs(ctableix).Name)
492                      End If              If crs.RecordCount <> 0 Then
493                                        
494                      ' loop through each field in each record                  ' loop thorugh each record in the table
495                      For cfieldix = 0 To crs.Fields.Count - 1                  crs.MoveFirst
496                                        Do Until crs.EOF
497                          ' based on type, prepare the field value                      
498                          If IsNull(crs.Fields(cfieldix).Value) Then                      ' start paragraphing
499                              sqlcode = sqlcode & "NULL"                      sqlcode = "INSERT INTO " & ctablename
500                          Else                      If crs.Fields.Count > PARA_INSERT_AFTER Then
501                              Select Case crs.Fields(cfieldix).Type                          Print #3, sqlcode
502                                  Case dbBoolean                          If DB_ENGINE = "M1" Then Print #3, Space$(INDENT_SIZE) & "(" & fieldlst & ")"
503                                      sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "1", "0")                          Print #3, "VALUES ("
504                                  Case dbChar, dbText, dbMemo                          sqlcode = Space$(INDENT_SIZE)
505                                      sqlcode = sqlcode & "'" & conv_str(crs.Fields(cfieldix).Value) & "'"                      Else
506                                  Case dbDate, dbTimeStamp                          If DB_ENGINE = "M1" Then sqlcode = sqlcode & " (" & fieldlst & ")"
507                                      If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then                          sqlcode = sqlcode & " VALUES ("
508                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "YYYY-MM-DD HH:MM:SS") & "'"                      End If
509                                      Else                      
510                                          'print in Access internal format: IEEE 64-bit (8-byte) FP                      ' loop through each field in each record
511                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"                      For cfieldix = 0 To crs.Fields.Count - 1
512                                      End If                      
513                                  Case dbTime                          ' based on type, prepare the field value
514                                      If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then                          If IsNull(crs.Fields(cfieldix).Value) Then
515                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "HH:MM:SS") & "'"                              sqlcode = sqlcode & "NULL"
516                                      Else                          Else
517                                          'print in Access internal format: IEEE 64-bit (8-byte) FP                              Select Case crs.Fields(cfieldix).Type
518                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"                                  Case dbBoolean
519                                      End If                                      If DB_ENGINE = "Pg" Then
520                                  Case dbBinary, dbLongBinary, dbVarBinary                                          sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "'t'", "'f'")
521                                      sqlcode = sqlcode & "'" & conv_bin(crs.Fields(cfieldix).Value) & "'"                                      Else
522                                  Case dbCurrency, dbDecimal, dbDouble, dbFloat, dbNumeric, dbSingle                                          sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "1", "0")
523                                      sqlcode = sqlcode & conv_float(crs.Fields(cfieldix).Value)                                      End If
524                                  Case Else                                  Case dbChar, dbText, dbMemo
525                                      sqlcode = sqlcode & conv_str(crs.Fields(cfieldix).Value)                                      sqlcode = sqlcode & "'" & conv_str(crs.Fields(cfieldix).Value) & "'"
526                              End Select                                  Case dbDate, dbTimeStamp
527                          End If                                      If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
528                                                                    sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "YYYY-MM-DD HH:MM:SS") & "'"
529                          ' paragraph separators                                      Else
530                          If cfieldix < crs.Fields.Count - 1 Then                                          'print in Access internal format: IEEE 64-bit (8-byte) FP
531                              sqlcode = sqlcode & ", "                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
532                              If crs.Fields.Count > PARA_INSERT_AFTER Then                                      End If
533                                  Print #1, sqlcode                                  Case dbTime
534                                  sqlcode = Space$(INDENT_SIZE)                                      If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
535                              End If                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "HH:MM:SS") & "'"
536                          End If                                      Else
537                                                                    'print in Access internal format: IEEE 64-bit (8-byte) FP
538                      Next cfieldix                                          sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
539                                                            End If
540                      ' print out result and any warnings                                  Case dbBinary, dbLongBinary, dbVarBinary
541                      sqlcode = sqlcode & IIf(crs.Fields.Count > PARA_INSERT_AFTER, " )", ")") & QUERY_SEPARATOR                                      sqlcode = sqlcode & "'" & conv_bin(crs.Fields(cfieldix).Value) & "'"
542                      Print #1, sqlcode                                  Case dbCurrency, dbDecimal, dbDouble, dbFloat, dbNumeric, dbSingle
543                      If COMMENTS And warnings <> "" Then                                      sqlcode = sqlcode & conv_float(crs.Fields(cfieldix).Value)
544                          Print #1, warnings                                  Case Else
545                          warnings = ""                                      sqlcode = sqlcode & conv_str(crs.Fields(cfieldix).Value)
546                      End If                              End Select
547                      If crs.Fields.Count > PARA_INSERT_AFTER Then Print #1,                          End If
548                                                
549                      crs.MoveNext                          ' paragraph separators
550                  Loop                          If cfieldix < crs.Fields.Count - 1 Then
551                                                sqlcode = sqlcode & ", "
552              Else                              If crs.Fields.Count > PARA_INSERT_AFTER Then
553                                                    Print #3, sqlcode
554                  ' if there is no data on the table                                  sqlcode = Space$(INDENT_SIZE)
555                  If COMMENTS Then Print #1, COMMENT_PREFIX & " This table has no data"                              End If
556                                        End If
557              End If                          
558                                    Next cfieldix
559              crs.Close                      
560              Set crs = Nothing                      ' print out result and any warnings
561                                sqlcode = sqlcode & IIf(crs.Fields.Count > PARA_INSERT_AFTER, " )", ")") & QUERY_SEPARATOR
562          End If  'print only unhidden tables                      Print #3, sqlcode
563                            If COMMENTS And warnings <> "" Then
564      Next ctableix                          Print #3, warnings
565                                warnings = ""
566  exportSQL_exit:                      End If
567      Close #2                      If crs.Fields.Count > PARA_INSERT_AFTER Then Print #3,
568      Close #1                      
569                            crs.MoveNext
570      cdb.Close                  Loop
571      Set cdb = Nothing                  
572                Else
573      DoCmd.Hourglass False                  
574                    ' if there is no data on the table
575      Exit Sub                  If COMMENTS Then Print #3, COMMENT_PREFIX & " This table has no data"
576                
577  exportSQL_error:              End If
578      MsgBox Err.Description              
579      Resume exportSQL_exit              crs.Close
580                Set crs = Nothing
581  End Sub          
582            End If  'print only unhidden tables
583        
584  Private Function conv_name(strname As String) As String      Next ctableix
585      Dim i As Integer, str As String      
586    exportSQL_exit:
587      ' replace inner spaces with WS_REPLACEMENT      Close #3
588      str = strname      Close #2
589      i = 1      Close #1
590      While i <= Len(str)      
591          Select Case Mid$(str, i, 1)      cdb.Close
592              Case " ", Chr$(9), Chr$(10), Chr$(13)  ' space, tab, newline, carriage return      Set cdb = Nothing
593                  str = Left$(str, i - 1) & WS_REPLACEMENT & Right$(str, Len(str) - i)  
594                  i = i + Len(WS_REPLACEMENT)      DoCmd.Hourglass False
595              Case Else  
596                  i = i + 1      Exit Sub
597          End Select  
598      Wend  exportSQL_error:
599      ' restrict tablename to IDENT_MAX_SIZE chars, *after* eating spaces      MsgBox Err.Description
600      str = Left$(str, IDENT_MAX_SIZE)      Resume exportSQL_exit
601      ' check for reserved words  
602      conv_name = str  End Sub
603      If Left$(DB_ENGINE, 2) = "MY" Then  
604          Select Case LCase$(str)  
605              Case "add", "all", "alter", "and", "as", "asc", "auto_increment", "between", _  Private Function conv_name(strname As String) As String
606              "bigint", "binary", "blob", "both", "by", "cascade", "char", "character", _      Dim i As Integer, str As String
607              "change", "check", "column", "columns", "create", "data", "datetime", "dec", _  
608              "decimal", "default", "delete", "desc", "describe", "distinct", "double", _      ' replace inner spaces with WS_REPLACEMENT
609              "drop", "escaped", "enclosed", "explain", "fields", "float", "float4", _      str = strname
610              "float8", "foreign", "from", "for", "full", "grant", "group", "having", _      i = 1
611              "ignore", "in", "index", "infile", "insert", "int", "integer", "interval", _      While i <= Len(str)
612              "int1", "int2", "int3", "int4", "int8", "into", "is", "key", "keys", _          Select Case Mid$(str, i, 1)
613              "leading", "like", "lines", "limit", "lock", "load", "long", "longblob", _              Case " ", Chr$(9), Chr$(10), Chr$(13), "-", "/"  ' space, tab, newline, carriage return
614              "longtext", "match", "mediumblob", "mediumtext", "mediumint", "middleint", _                  str = Left$(str, i - 1) & WS_REPLACEMENT & Right$(str, Len(str) - i)
615              "numeric", "not", "null", "on", "option", "optionally", "or", "order", _                  i = i + Len(WS_REPLACEMENT)
616              "outfile", "partial", "precision", "primary", "procedure", "privileges", _              Case Else
617              "read", "real", "references", "regexp", "repeat", "replace", "restrict", _                  i = i + 1
618              "rlike", "select", "set", "show", "smallint", "sql_big_tables", _          End Select
619              "sql_big_selects", "sql_select_limit", "straight_join", "table", "tables", _      Wend
620              "terminated", "tinyblob", "tinytext", "tinyint", "trailing", "to", "unique", _      ' restrict tablename to IDENT_MAX_SIZE chars, *after* eating spaces
621              "unlock", "unsigned", "update", "usage", "values", "varchar", "varying", _      str = Left$(str, IDENT_MAX_SIZE)
622              "with", "write", "where", "zerofill"      ' check for reserved words
623                  conv_name = Left$(PREFIX_ON_KEYWORD & str & SUFFIX_ON_KEYWORD, IDENT_MAX_SIZE)      conv_name = str
624                  If (str = conv_name) Then      If Left$(DB_ENGINE, 2) = "MY" Then
625                      warn "In identifier '" & strname & "', the new form '" & strname & _          Select Case LCase$(str)
626                      "' is a reserved word, and PREFIX_ON_KEYWORD ('" & _              Case "add", "all", "alter", "and", "as", "asc", "auto_increment", "between", _
627                      PREFIX_ON_KEYWORD & "') and SUFFIX_ON_KEYWORD ('" & SUFFIX_ON_KEYWORD & _              "bigint", "binary", "blob", "both", "by", "cascade", "char", "character", _
628                      "') make it larger than IDENT_MAX_SIZE, and after cut it is the same as the original! " & _              "change", "check", "column", "columns", "create", "data", "datetime", "dec", _
629                      "This is usually caused by a void or empty PREFIX_ON_KEYWORD.", True              "decimal", "default", "delete", "desc", "describe", "distinct", "double", _
630                      Error 5  ' invalid Procedure Call              "drop", "escaped", "enclosed", "explain", "fields", "float", "float4", _
631                  End If              "float8", "foreign", "from", "for", "full", "grant", "group", "having", _
632          End Select              "ignore", "in", "index", "infile", "insert", "int", "integer", "interval", _
633      End If              "int1", "int2", "int3", "int4", "int8", "into", "is", "key", "keys", _
634  End Function              "leading", "like", "lines", "limit", "lock", "load", "long", "longblob", _
635                "longtext", "match", "mediumblob", "mediumtext", "mediumint", "middleint", _
636                "numeric", "not", "null", "on", "option", "optionally", "or", "order", _
637  Private Function conv_str(str As String) As String              "outfile", "partial", "precision", "primary", "procedure", "privileges", _
638      Dim i As Integer, nlstr As String, rstr As Variant              "read", "real", "references", "regexp", "repeat", "replace", "restrict", _
639                    "rlike", "select", "set", "show", "smallint", "sql_big_tables", _
640      nlstr = ""              "sql_big_selects", "sql_select_limit", "straight_join", "table", "tables", _
641      rstr = Null              "terminated", "tinyblob", "tinytext", "tinyint", "trailing", "to", "unique", _
642      i = 1              "unlock", "unsigned", "update", "usage", "values", "varchar", "varying", _
643      While i <= Len(str)              "with", "write", "where", "zerofill"
644          Select Case Mid$(str, i, 1)                  conv_name = Left$(PREFIX_ON_KEYWORD & str & SUFFIX_ON_KEYWORD, IDENT_MAX_SIZE)
645              Case Chr$(0)  ' ASCII NUL                  If (str = conv_name) Then
646                  nlstr = ""                      warn "In identifier '" & strname & "', the new form '" & strname & _
647                  rstr = "\0"                      "' is a reserved word, and PREFIX_ON_KEYWORD ('" & _
648              Case Chr$(8)  ' backspace                      PREFIX_ON_KEYWORD & "') and SUFFIX_ON_KEYWORD ('" & SUFFIX_ON_KEYWORD & _
649                  nlstr = ""                      "') make it larger than IDENT_MAX_SIZE, and after cut it is the same as the original! " & _
650                  rstr = "\b"                      "This is usually caused by a void or empty PREFIX_ON_KEYWORD.", True
651              Case Chr$(9)  ' tab                      Error 5  ' invalid Procedure Call
652                  nlstr = ""                  End If
653                  rstr = "\t"          End Select
654              Case "'"      End If
655                  nlstr = ""  End Function
656                  rstr = "\'"  
657              Case """"  
658                  nlstr = ""  Private Function conv_str(str As String) As String
659                  rstr = "\"""      Dim i As Integer, nlstr As String, rstr As Variant
660              Case "\"      
661                  nlstr = ""      nlstr = ""
662                  rstr = "\\"      rstr = Null
663              Case Chr$(10), Chr$(13)  ' line feed and carriage return      i = 1
664                  If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then      While i <= Len(str)
665                      ' there was a previous newline and this is its pair: eat it          Select Case Mid$(str, i, 1)
666                      rstr = ""              Case Chr$(0)  ' ASCII NUL
667                      nlstr = ""                  nlstr = ""
668                  Else                  rstr = "\0"
669                      ' this is a fresh newline              Case Chr$(8)  ' backspace
670                      rstr = LINE_BREAK                  nlstr = ""
671                      nlstr = Mid$(str, i, 1)                  rstr = "\b"
672                  End If              Case Chr$(9)  ' tab
673              Case Else                  nlstr = ""
674                  nlstr = ""                  rstr = "\t"
675          End Select              Case "'"
676          If Not IsNull(rstr) Then                  nlstr = ""
677              str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)                  rstr = "\'"
678              i = i + Len(rstr)              Case """"
679              rstr = Null                  nlstr = ""
680          Else                  rstr = "\"""
681              i = i + 1              Case "\"
682          End If                  nlstr = ""
683      Wend                  rstr = "\\"
684      conv_str = str              Case Chr$(10), Chr$(13)  ' line feed and carriage return
685  End Function                  If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then
686                        ' there was a previous newline and this is its pair: eat it
687                        rstr = ""
688  Private Function conv_bin(str As String) As String                      nlstr = ""
689      Dim i As Integer, rstr As String                  Else
690                            ' this is a fresh newline
691      rstr = ""                      rstr = LINE_BREAK
692      i = 1                      nlstr = Mid$(str, i, 1)
693      While i <= Len(str)                  End If
694          Select Case Mid$(str, i, 1)              Case Else
695              Case Chr$(0)  ' ASCII NUL                  nlstr = ""
696                  rstr = "\0"          End Select
697              Case Chr$(8)  ' backspace          If Not IsNull(rstr) Then
698                  rstr = "\b"              str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
699              Case Chr$(9)  ' tab              i = i + Len(rstr)
700                  rstr = "\t"              rstr = Null
701              Case "'"          Else
702                  rstr = "\'"              i = i + 1
703              Case """"          End If
704                  rstr = "\"""      Wend
705              Case "\"      conv_str = str
706                  rstr = "\\"  End Function
707              Case Chr$(10)  ' line feed  
708                  rstr = "\n"  
709              Case Chr$(13)  ' carriage return  Private Function conv_bin(str As String) As String
710                  rstr = "\r"      Dim i As Integer, rstr As String
711          End Select      
712          If rstr <> "" Then      rstr = ""
713              str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)      i = 1
714              i = i + Len(rstr)      While i <= Len(str)
715              rstr = ""          Select Case Mid$(str, i, 1)
716          Else              Case Chr$(0)  ' ASCII NUL
717              i = i + 1                  rstr = "\0"
718          End If              Case Chr$(8)  ' backspace
719      Wend                  rstr = "\b"
720      conv_bin = str              Case Chr$(9)  ' tab
721  End Function                  rstr = "\t"
722                Case "'"
723  ' This function is used to convert local setting of decimal , to .                  rstr = "\'"
724  Private Function conv_float(str As String) As String              Case """"
725      Dim i As Integer                  rstr = "\"""
726                    Case "\"
727      i = 1                  rstr = "\\"
728      While i <= Len(str)              Case Chr$(10)  ' line feed
729          If Mid$(str, i, 1) = "," Then                  rstr = "\n"
730              str = Left$(str, i - 1) & "." & Right$(str, Len(str) - i)              Case Chr$(13)  ' carriage return
731          End If                  rstr = "\r"
732          i = i + 1          End Select
733      Wend          If rstr <> "" Then
734      conv_float = str              str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
735  End Function              i = i + Len(rstr)
736                rstr = ""
737            Else
738  Private Sub warn(str As String, abortq As Boolean)              i = i + 1
739      If DISPLAY_WARNINGS Then MsgBox str, vbOKOnly Or vbExclamation, "Warning"          End If
740      warnings = warnings & COMMENT_PREFIX & " Warning: " & str & Chr$(13) & Chr$(10)      Wend
741  End Sub      conv_bin = str
742    End Function
743    
744    ' This function is used to convert local setting of decimal , to .
745    Private Function conv_float(str As String) As String
746        Dim i As Integer
747        
748        i = 1
749        While i <= Len(str)
750            If Mid$(str, i, 1) = "," Then
751                str = Left$(str, i - 1) & "." & Right$(str, Len(str) - i)
752            End If
753            i = i + 1
754        Wend
755        conv_float = str
756    End Function
757    
758    
759    Private Sub warn(str As String, abortq As Boolean)
760        If DISPLAY_WARNINGS Then MsgBox str, vbOKOnly Or vbExclamation, "Warning"
761        warnings = warnings & COMMENT_PREFIX & " Warning: " & str & Chr$(13) & Chr$(10)
762    End Sub
763    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.26