/[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.1 - (hide annotations)
Mon Jul 31 06:17:50 2000 UTC (23 years, 9 months ago) by dpavlin
Branch: MAIN
File MIME type: text/plain
Access module for export to PostgreSQL

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

  ViewVC Help
Powered by ViewVC 1.1.26