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

Contents of /exportSQL2+pg.txt

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Mon Jul 31 06:17:50 2000 UTC (23 years, 8 months ago) by dpavlin
Branch: MAIN
File MIME type: text/plain
Access module for export to PostgreSQL

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