/[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.3 - (show annotations)
Mon Jun 4 12:34:40 2001 UTC (22 years, 9 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +4 -0 lines
File MIME type: text/plain
start of new exportSQL version 3.0

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

  ViewVC Help
Powered by ViewVC 1.1.26