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

Contents of /exportSQL3.txt

Parent Directory Parent Directory | Revision Log Revision Log


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

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

  ViewVC Help
Powered by ViewVC 1.1.26