/[sql]/exportSQL2+pg.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 /exportSQL2+pg.txt

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Mon Jun 4 12:34:40 2001 UTC (22 years, 10 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +4 -0 lines
File MIME type: text/plain
start of new exportSQL version 3.0

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

  ViewVC Help
Powered by ViewVC 1.1.26