/[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.2 - (hide annotations)
Thu Apr 12 12:39:30 2001 UTC (23 years ago) by dpavlin
Branch: MAIN
Changes since 1.1: +4 -0 lines
File MIME type: text/plain
documented Microsoft Access 2000 problem with this script (you have
to change References)

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

  ViewVC Help
Powered by ViewVC 1.1.26