/[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.1 - (hide annotations)
Mon Jun 4 12:34:40 2001 UTC (22 years, 9 months ago) by dpavlin
Branch: MAIN
File MIME type: text/plain
start of new exportSQL version 3.0

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

  ViewVC Help
Powered by ViewVC 1.1.26