/[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.2 - (show 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 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 ' * 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 ' * 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