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