/[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

Annotation of /exportSQL3.txt

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Tue Mar 26 12:21:24 2002 UTC (22 years ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +2 -2 lines
File MIME type: text/plain
removed extra QUERY_SEPARATOR, thanks to Frédéric Morace <frederic.morace(at)xsalto.com>

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

  ViewVC Help
Powered by ViewVC 1.1.26