JSEMTS搜尋引擎
 

Option Compare Database
Option Explicit

' exportSQL version 2.0
' www.cynergi.net/prod/exportsql/
'
' (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net
' (C) Pedro Freire - pedro.freire@cynergi.net (do not add to mailing lists without permission)
'
' This code is provided free for anyone's use and is therefore without guarantee or support.
' This does NOT mean CYNERGI delegates its copyright to anyone using it! You may change the
' code in any way, as long as this notice remains on the code and CYNERGI is notified (if you
' publish the changes: if your changes/corrections prove valuable and are added to the code,
' you will be listed in a credit list on this file).
'
' You may NOT sell this as part of a non-free package:
' IF YOU HAVE PAID FOR THIS CODE, YOU HAVE BEEN ROBBED! CONTACT admin@cynergi.net!

' MODULE
' "exportSQL"
'
' GOAL
' Export all tables in a MS-Access database file to 2 text files:
' one containing SQL instructions to delete the new tables to be created,
' and the other with SQL instructions to create and insert data into
' the new tables. The table structure and data will resemble as much as
' possible the current Access database.
'
' HOW TO USE
' Copy-and-paste this text file into an Access module and run the first
' (and only public) function. in more detail, you:
' * Open the Access .mdb file you wish to export
' * in the default database objects window, click on "Modules", and then on "New"
' * The code window that opens has some pre-written text (code). Delete it.
' * Copy-and-paste this entire file to the code module window
' * You may hit the compile button (looks like 3 sheets of paper with an arrow on
' top of them, pressing down on them), or select Debug, Compile Loaded Modules
' from the top menu, just to make sure there are no errors, and that this code
' works on your Access version (it works on Access'97 and should work on Access'95)
' * Close the code module window - windows will prompt you to save the code:
' answer "Yes", and when promped for a name for the module, type anything
' (say, "MexportSQL")
' The module is now part of your Access database. To run the export, you:
' * Re-open the code module (by double-clicking on it, or clicking "Design"
' with it selected). Move the cursor to where the first "Function" keyword appears.
' Press F5 or select Run, Go/Continue from the top menu.
' * Alternativelly, click on "Macros" on the database objects window,
' and then on "New". On the macro window, select "RunCode" as the macro action,
' and "exportSQL" as the function name, bellow. Save the macro similarly to the
' module, and this time double-clicking on it, or clicking "Run" will run the export.
'
' BEFORE RUNNING THE EXPORT
' Before running the export, be sure to check out the Export Options just bellow this
' text, and change any according to your wishes and specs.
'
' TECH DATA
' Public identifiers:
' * Only one: "exportSQL", a function taking and returning no arguments. It runs the export.
' Functionallity:
' * Can export to mSQL v1, mSQL v2 or MySQL-recognised SQL statements
' * Excellent respect for name conversion, namespace verification, type matching, etc.
' * Detects default values "=Now()", "=Date()" and "=Time()" to create types like "TIMESTAMP"
' * Fully configurable via private constants on top of code
' * Exports two files: one for erasures, another for creations (useful when updating dbs)
' * Generates compatibility warnings when necessary
' * Code and generated files are paragraphed and easy to read
' * Access text and memo fields can have any type of line termination: \n\r, \r\n, \n or \r
' * Properly escapes text and memo fields, besides all types of binary fields
' * Closes all open objects and files on error
' * Known bugs / incomplete constructs are signalled with comments starting with "!!!!"
' * Two alternatives on absent date/time type on mSQL: REAL or CHAR field


' Export Options - change at will

Private Const DB_ENGINE As String = "MY" ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2) or "MY" (MySQL)
Private Const DB_NAME As String = "" ' Use empty string for current. Else use filename or DSN name of database to export
Private Const DB_CONNECT As String = "" ' Used only if above string is not empty
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)
Private Const WS_REPLACEMENT As String = "_" ' Use "" to simply eat whitespaces in identifiers (table and field names)
Private Const IDENT_MAX_SIZE As Integer = 19 ' Suggest 64. Max size of identifiers (table and field names)
Private Const PREFIX_ON_KEYWORD As String = "_" ' Prefix to add to identifier, if it is a reserved word
Private Const SUFFIX_ON_KEYWORD As String = "" ' Suffix to add to identifier, if it is a reserved word
Private Const PREFIX_ON_INDEX As String = "ix" ' Prefix to add to index identifier, to make it unique (mSQL v2)
Private Const SUFFIX_ON_INDEX As String = "" ' Suffix to add to index identifier, to make it unique (mSQL v2)
Private Const ADD_SQL_FILE As String = "c:\temp\esql_add.txt" ' Use empty if open on #1. Will be overwritten if exists!
Private Const DEL_SQL_FILE As String = "c:\temp\esql_del.txt" ' Use empty if open on #2. Will be overwritten if exists!
Private Const LINE_BREAK As String = "\n" ' Try "
". String to replace line breaks in text fields
Private Const QUERY_SEPARATOR As String = "\g" ' Terminator/separator of SQL queries (to instruct some monitor program to execute them)
Private Const COMMENT_PREFIX As String = "#" ' Use empty string for no comments
Private Const DISPLAY_WARNINGS As Boolean = True ' False to output the warnings to the files, only
Private Const DATE_AS_STR As Boolean = True ' False to use real number data type for date, time and timestamp (in mSQL only)
Private Const PARA_INSERT_AFTER As Integer = 3 ' Field count after which print INSERTs different lines
Private Const INDENT_SIZE As Integer = 5 ' Number of spaces on indents


' Global var to store inter-funtion data
Private warnings As String ' Not an option: do not set in any way


' Primary Export Function

Sub exportSQL()
On Error GoTo exportSQL_error

Dim cdb As Database
Dim ctableix As Integer, ctablename As String

If DB_NAME = "" Then
Set cdb = CurrentDb()
Else
Set cdb = OpenDatabase(DB_NAME, False, True, DB_CONNECT) ' Shared, read-only
End If

If ADD_SQL_FILE <> "" Then Open ADD_SQL_FILE For Output As #1
If DEL_SQL_FILE <> "" Then Open DEL_SQL_FILE For Output As #2

DoCmd.Hourglass True

If COMMENT_PREFIX <> "" Then
Print #1, COMMENT_PREFIX & " Exported from MS Access to " & IIf(Left$(DB_ENGINE, 2) = "MY", "MySQL", "mSQL")
Print #1, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
Print #1,

Print #2, COMMENT_PREFIX & " Exported from MS Access to " & IIf(Left$(DB_ENGINE, 2) = "MY", "MySQL", "mSQL")
Print #2, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net"
Print #2,
End If

'Go through the table definitions
For ctableix = 0 To cdb.TableDefs.Count - 1

Dim cfieldix As Integer, cfieldname As String
Dim fieldlst As String, sqlcode As String
Dim primary_found As Boolean
Dim crs As Recordset

' Let's take only the visible tables
If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _
(cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then

ctablename = conv_name("" & cdb.TableDefs(ctableix).Name)

Print #2,
Print #2, "DROP TABLE " & ctablename & QUERY_SEPARATOR

' CREATE clause
Print #1,
Print #1, "CREATE TABLE " & ctablename
Print #1, Space$(INDENT_SIZE) & "("

warnings = ""
fieldlst = ""
primary_found = False

' loop thorugh each field in the table
For cfieldix = 0 To cdb.TableDefs(ctableix).Fields.Count - 1

Dim typestr As String, fieldsz As Integer, dvstr As String
Dim found_ix As Boolean, cindex As Index, cfield As Field

' if this is not the first iteration, add separators
If fieldlst <> "" Then
fieldlst = fieldlst & ", "
Print #1, ","
End If

' get field name
cfieldname = conv_name("" & cdb.TableDefs(ctableix).Fields(cfieldix).Name)
fieldlst = fieldlst & cfieldname

' translate types
If DB_ENGINE = "M1" Or DB_ENGINE = "M2" Then
Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
Case dbChar
typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
Case dbText
fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
If fieldsz = 0 Then fieldsz = 255
typestr = "CHAR(" & fieldsz & ")"
Case dbBoolean, dbByte, dbInteger, dbLong
typestr = "INT"
Case dbDouble, dbFloat, dbSingle
typestr = "REAL"
Case dbCurrency, dbDecimal, dbNumeric
typestr = "REAL"
warn "In new field '" & cfieldname & "', currency/BCD will be converted to REAL - there may be precision loss!", False
Case dbDate
typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
Case dbTime
typestr = IIf(DATE_AS_STR, "CHAR(8)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False
Case dbTimeStamp
typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & "." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_timestamp'.", ""), False
Case dbMemo
If DB_ENGINE = "M2" Then
typestr = "TEXT(" & MSQL_64kb_AVG & ")"
Else
typestr = "CHAR(" & MSQL_64kb_AVG & ")"
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
End If
Case dbBinary, dbVarBinary
typestr = "CHAR(255)"
warn "In new field '" & cfieldname & "', dbBinary and dbVarBinary are not supported by mSQL! - will use a text (CHAR(255)) field.", True
Case dbLongBinary
typestr = "CHAR(" & MSQL_64kb_AVG & ")"
warn "In new field '" & cfieldname & "', dbLongBinary is not supported by mSQL! - will use a text (CHAR(" & MSQL_64kb_AVG & ")) field.", True
Case Else
warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
Error 5 ' invalid Procedure Call
End Select
Else
Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type
Case dbBinary
typestr = "TINYBLOB"
Case dbBoolean
typestr = "TINYINT"
Case dbByte
typestr = "TINYINT UNSIGNED"
Case dbChar
typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")"
Case dbCurrency
typestr = "DECIMAL(20,4)"
Case dbDate
typestr = "DATETIME"
Case dbDecimal
typestr = "DECIMAL(20,4)"
Case dbDouble
typestr = "REAL"
Case dbFloat
typestr = "REAL"
Case dbInteger
typestr = "SMALLINT"
Case dbLong
typestr = "INT"
Case dbLongBinary
typestr = "LONGBLOB"
Case dbMemo
typestr = "LONGBLOB" ' !!!!! MySQL bug! Replace by LONGTEXT when corrected!
Case dbNumeric
typestr = "DECIMAL(20,4)"
Case dbSingle
typestr = "FLOAT"
Case dbText
fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size
If fieldsz = 0 Then fieldsz = 255
typestr = "CHAR(" & fieldsz & ")"
Case dbTime
typestr = "TIME"
Case dbTimeStamp
typestr = "TIMESTAMP"
Case dbVarBinary
typestr = "TINYBLOB"
Case dbBigInt, dbGUID
warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True
Error 5 ' invalid Procedure Call
Case Else
typestr = "LONGBLOB"
End Select
End If

' check not null and auto-increment properties
If ((cdb.TableDefs(ctableix).Fields(cfieldix).Attributes And dbAutoIncrField) <> 0) Then
If Left$(DB_ENGINE, 2) = "MY" Then
typestr = typestr & " NOT NULL AUTO_INCREMENT"
Else
typestr = typestr & " NOT NULL"
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
End If
ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = True Then
typestr = typestr & " NOT NULL"
End If

' default value
dvstr = cdb.TableDefs(ctableix).Fields(cfieldix).DefaultValue
If dvstr <> "" Then
If Left$(DB_ENGINE, 2) <> "MY" Then
warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False
ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = False Then
warn "In new field '" & cfieldname & "', MySQL needs NOT NULL to support default values! - it won't be set a default.", False
ElseIf Left$(dvstr, 1) = """" Then
typestr = typestr & " DEFAULT '" & conv_str(Mid$(dvstr, 2, Len(dvstr) - 2)) & "'"
ElseIf ((LCase(dvstr) = "now()" Or LCase(dvstr) = "date()" Or LCase(dvstr) = "time()") And _
(Left$(typestr, 5) = "DATE " Or Left$(typestr, 5) = "TIME " Or Left$(typestr, 9) = "DATETIME ")) Then
typestr = "TIMESTAMP " & Right$(typestr, Len(typestr) - InStr(typestr, " "))
ElseIf LCase(dvstr) = "no" Then
typestr = typestr & " DEFAULT 0"
ElseIf LCase(dvstr) = "yes" Then
typestr = typestr & " DEFAULT 1"
Else
typestr = typestr & " DEFAULT " & dvstr
End If
End If

' check if primary key (for mSQL v1)
If DB_ENGINE = "M1" Then
found_ix = False
For Each cindex In cdb.TableDefs(ctableix).Indexes
If cindex.Primary Then
For Each cfield In cindex.Fields
If cfield.Name = cdb.TableDefs(ctableix).Fields(cfieldix).Name Then
found_ix = True
Exit For
End If
Next cfield
If found_ix Then Exit For
End If
Next cindex
If found_ix Then
If primary_found Then
warn "On new table '" & ctablename & "', mSQL v1 does not support more than one PRIMARY KEY! Only first key was set.", False
Else
typestr = typestr & " PRIMARY KEY"
primary_found = True
End If
End If
End If

'print out field info
Print #1, Space$(INDENT_SIZE) & cfieldname & Space$(IDENT_MAX_SIZE - Len(cfieldname) + 2) & typestr;

Next cfieldix

' terminate CREATE clause
If DB_ENGINE = "M2" Then
Print #1,
Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
End If

' primary key and other index declaration
If DB_ENGINE = "M2" Or Left$(DB_ENGINE, 2) = "MY" Then
For Each cindex In cdb.TableDefs(ctableix).Indexes
sqlcode = ""
For Each cfield In cindex.Fields
sqlcode = sqlcode & IIf(sqlcode = "", "", ", ") & conv_name(cfield.Name)
Next cfield
If DB_ENGINE = "M2" Then
Print #1, "CREATE " & IIf(cindex.Unique, "UNIQUE ", "") & "INDEX " & _
conv_name(PREFIX_ON_INDEX & cindex.Name & SUFFIX_ON_INDEX) & " ON " & _
ctablename & " (" & sqlcode & ")" & QUERY_SEPARATOR
Else
Print #1, ","
Print #1, Space$(INDENT_SIZE) & IIf(cindex.Primary, "PRIMARY ", "") & _
"KEY (" & sqlcode & ")";
End If
Next cindex
End If

' terminate CREATE clause
If DB_ENGINE <> "M2" Then
Print #1,
Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR
End If

' print any warnings bellow it
If COMMENT_PREFIX <> "" And warnings <> "" Then
If DB_ENGINE = "M2" Then Print #1, COMMENT_PREFIX & " "
Print #1, warnings
warnings = ""
End If

Print #1,

' INSERT clause
Set crs = cdb.OpenRecordset(cdb.TableDefs(ctableix).Name)
If crs.RecordCount <> 0 Then

' loop thorugh each record in the table
crs.MoveFirst
Do Until crs.EOF

' start paragraphing
sqlcode = "INSERT INTO " & ctablename
If crs.Fields.Count > PARA_INSERT_AFTER Then
Print #1, sqlcode
If DB_ENGINE = "M1" Then Print #1, Space$(INDENT_SIZE) & "(" & fieldlst & ")"
Print #1, "VALUES ("
sqlcode = Space$(INDENT_SIZE)
Else
If DB_ENGINE = "M1" Then sqlcode = sqlcode & " (" & fieldlst & ")"
sqlcode = sqlcode & " VALUES ("
End If

' loop through each field in each record
For cfieldix = 0 To crs.Fields.Count - 1

' based on type, prepare the field value
If IsNull(crs.Fields(cfieldix).Value) Then
sqlcode = sqlcode & "NULL"
Else
Select Case crs.Fields(cfieldix).Type
Case dbBoolean
sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "1", "0")
Case dbChar, dbText, dbMemo
sqlcode = sqlcode & "'" & conv_str(crs.Fields(cfieldix).Value) & "'"
Case dbDate, dbTimeStamp
If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "YYYY-MM-DD HH:MM:SS") & "'"
Else
'print in Access internal format: IEEE 64-bit (8-byte) FP
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
End If
Case dbTime
If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "HH:MM:SS") & "'"
Else
'print in Access internal format: IEEE 64-bit (8-byte) FP
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'"
End If
Case dbBinary, dbLongBinary, dbVarBinary
sqlcode = sqlcode & "'" & conv_bin(crs.Fields(cfieldix).Value) & "'"
Case Else
sqlcode = sqlcode & conv_str(crs.Fields(cfieldix).Value)
End Select
End If

' paragraph separators
If cfieldix < crs.Fields.Count - 1 Then
sqlcode = sqlcode & ", "
If crs.Fields.Count > PARA_INSERT_AFTER Then
Print #1, sqlcode
sqlcode = Space$(INDENT_SIZE)
End If
End If

Next cfieldix

' print out result and any warnings
sqlcode = sqlcode & IIf(crs.Fields.Count > PARA_INSERT_AFTER, " )", ")") & QUERY_SEPARATOR
Print #1, sqlcode
If COMMENT_PREFIX <> "" And warnings <> "" Then
Print #1, warnings
warnings = ""
End If
If crs.Fields.Count > PARA_INSERT_AFTER Then Print #1,

crs.MoveNext
Loop

Else

' if there is no data on the table
If COMMENT_PREFIX <> "" Then Print #1, COMMENT_PREFIX & " This table has no data"

End If

crs.Close
Set crs = Nothing

End If 'print only unhidden tables

Next ctableix

exportSQL_exit:
Close #2
Close #1

cdb.Close
Set cdb = Nothing

DoCmd.Hourglass False

Exit Sub

exportSQL_error:
MsgBox Err.Description
Resume exportSQL_exit

End Sub


Private Function conv_name(strname As String) As String
Dim i As Integer, str As String

' replace inner spaces with WS_REPLACEMENT
str = strname
i = 1
While i <= Len(str)
Select Case Mid$(str, i, 1)
Case " ", Chr$(9), Chr$(10), Chr$(13) ' space, tab, newline, carriage return
str = Left$(str, i - 1) & WS_REPLACEMENT & Right$(str, Len(str) - i)
i = i + Len(WS_REPLACEMENT)
Case Else
i = i + 1
End Select
Wend
' restrict tablename to IDENT_MAX_SIZE chars, *after* eating spaces
str = Left$(str, IDENT_MAX_SIZE)
' check for reserved words
conv_name = str
If Left$(DB_ENGINE, 2) = "MY" Then
Select Case LCase$(str)
Case "add", "all", "alter", "and", "as", "asc", "auto_increment", "between", _
"bigint", "binary", "blob", "both", "by", "cascade", "char", "character", _
"change", "check", "column", "columns", "create", "data", "datetime", "dec", _
"decimal", "default", "delete", "desc", "describe", "distinct", "double", _
"drop", "escaped", "enclosed", "explain", "fields", "float", "float4", _
"float8", "foreign", "from", "for", "full", "grant", "group", "having", _
"ignore", "in", "index", "infile", "insert", "int", "integer", "interval", _
"int1", "int2", "int3", "int4", "int8", "into", "is", "key", "keys", _
"leading", "like", "lines", "limit", "lock", "load", "long", "longblob", _
"longtext", "match", "mediumblob", "mediumtext", "mediumint", "middleint", _
"numeric", "not", "null", "on", "option", "optionally", "or", "order", _
"outfile", "partial", "precision", "primary", "procedure", "privileges", _
"read", "real", "references", "regexp", "repeat", "replace", "restrict", _
"rlike", "select", "set", "show", "smallint", "sql_big_tables", _
"sql_big_selects", "sql_select_limit", "straight_join", "table", "tables", _
"terminated", "tinyblob", "tinytext", "tinyint", "trailing", "to", "unique", _
"unlock", "unsigned", "update", "usage", "values", "varchar", "varying", _
"with", "write", "where", "zerofill"
conv_name = Left$(PREFIX_ON_KEYWORD & str & SUFFIX_ON_KEYWORD, IDENT_MAX_SIZE)
If (str = conv_name) Then
warn "In identifier '" & strname & "', the new form '" & strname & _
"' is a reserved word, and PREFIX_ON_KEYWORD ('" & _
PREFIX_ON_KEYWORD & "') and SUFFIX_ON_KEYWORD ('" & SUFFIX_ON_KEYWORD & _
"') make it larger than IDENT_MAX_SIZE, and after cut it is the same as the original! " & _
"This is usually caused by a void or empty PREFIX_ON_KEYWORD.", True
Error 5 ' invalid Procedure Call
End If
End Select
End If
End Function


Private Function conv_str(str As String) As String
Dim i As Integer, nlstr As String, rstr As Variant

nlstr = ""
rstr = Null
i = 1
While i <= Len(str)
Select Case Mid$(str, i, 1)
Case Chr$(0) ' ASCII NUL
nlstr = ""
rstr = "\0"
Case Chr$(8) ' backspace
nlstr = ""
rstr = "\b"
Case Chr$(9) ' tab
nlstr = ""
rstr = "\t"
Case "'"
nlstr = ""
rstr = "\'"
Case """"
nlstr = ""
rstr = "\"""
Case "\"
nlstr = ""
rstr = "\\"
Case Chr$(10), Chr$(13) ' line feed and carriage return
If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then
' there was a previous newline and this is its pair: eat it
rstr = ""
nlstr = ""
Else
' this is a fresh newline
rstr = LINE_BREAK
nlstr = Mid$(str, i, 1)
End If
Case Else
nlstr = ""
End Select
If Not IsNull(rstr) Then
str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
i = i + Len(rstr)
rstr = Null
Else
i = i + 1
End If
Wend
conv_str = str
End Function


Private Function conv_bin(str As String) As String
Dim i As Integer, rstr As String

rstr = ""
i = 1
While i <= Len(str)
Select Case Mid$(str, i, 1)
Case Chr$(0) ' ASCII NUL
rstr = "\0"
Case Chr$(8) ' backspace
rstr = "\b"
Case Chr$(9) ' tab
rstr = "\t"
Case "'"
rstr = "\'"
Case """"
rstr = "\"""
Case "\"
rstr = "\\"
Case Chr$(10) ' line feed
rstr = "\n"
Case Chr$(13) ' carriage return
rstr = "\r"
End Select
If rstr <> "" Then
str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i)
i = i + Len(rstr)
rstr = ""
Else
i = i + 1
End If
Wend
conv_bin = str
End Function


Private Sub warn(str As String, abortq As Boolean)
If DISPLAY_WARNINGS Then MsgBox str, vbOKOnly Or vbExclamation, "Warning"
warnings = warnings & COMMENT_PREFIX & " Warning: " & str & Chr$(13) & Chr$(10)
End Sub






搜尋引擎讓我們程式搜尋結果更加完美
  • 如果您覺得該文件有幫助到您,煩請按下我
  • 如果您覺得該文件是一個一無是處的文件,也煩請按下我

  • 搜尋引擎該文件您看起來是亂碼嗎?您可以切換編碼方式試試看!ISO-8859-1 | latin1 | euc-kr | euc-jp | CP936 | CP950 | UTF-8 | GB2312 | BIG5 |
    搜尋引擎本文件可能涉及色情、暴力,按我申請移除該文件

    搜尋引擎網址長?按我產生分享用短址

    ©2024 JSEMTS

    https://tw.search.yahoo.com/search;_ylt=A8tUwZJ2QE1YaVcAUmFr1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC1zLXR3BGdwcmlkAwRuX3JzbHQDMARuX3N1Z2cDMARvcmlnaW4DdHcuc2VhcmNoLnlhaG9vLmNvbQRwb3MDMARwcXN0cgMEcHFzdHJsAwRxc3RybAM4NARxdWVyeQMlRTglQjYlODUlRTUlOEYlQUYlRTYlODQlOUIlRTclOUElODQlRTUlQUYlQjYlRTUlQUYlQjYlMjAlRTglODMlQTElRTUlQUUlODklRTUlQTglOUMEdF9zdG1wAzE0ODE0NTc3OTM-?p=%E8%B6%85%E5%8F%AF%E6%84%9B%E7%9A%84%E5%AF%B6%E5%AF%B6+%E8%83%A1%E5%AE%89%E5%A8%9C&fr2=sb-top-tw.search&fr=yfp-t-900-s-tw&rrjfid=3829481 https://tw.search.yahoo.com/search;_ylt=A8tUwZJ2QE1YaVcAUmFr1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC1zLXR3BGdwcmlkAwRuX3JzbHQDMARuX3N1Z2cDMARvcmlnaW4DdHcuc2VhcmNoLnlhaG9vLmNvbQRwb3MDMARwcXN0cgMEcHFzdHJsAwRxc3RybAM4NARxdWVyeQMlRTglQjYlODUlRTUlOEYlQUYlRTYlODQlOUIlRTclOUElODQlRTUlQUYlQjYlRTUlQUYlQjYlMjAlRTglODMlQTElRTUlQUUlODklRTUlQTglOUMEdF9zdG1wAzE0ODE0NTc3OTM-?p=%E8%B6%85%E5%8F%AF%E6%84%9B%E7%9A%84%E5%AF%B6%E5%AF%B6+%E8%83%A1%E5%AE%89%E5%A8%9C&fr2=sb-top-tw.search&fr=yfp-t-900-s-tw&rrjfid=2629394 https://tw.search.yahoo.com/search;_ylt=A8tUwYgkQU1YcXoAUE9r1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC10dwRncHJpZAMxWU5tY2FYMVFGQ2ZvUXZGN1N0bzVBBG5fcnNsdAMwBG5fc3VnZwMwBG9yaWdpbgN0dy5zZWFyY2gueWFob28uY29tBHBvcwMwBHBxc3RyAwRwcXN0cmwDBHFzdHJsAzQ4BHF1ZXJ5AyVFNiVBRCVBMSVFNiVBRCU4QyUyMCVFNSVCMCU4OCVFNiU4MyU4NSVFNSU5QyU5OAR0X3N0bXADMTQ4MTQ1Nzk3Ng--?p=%E6%AD%A1%E6%AD%8C+%E5%B0%88%E6%83%85%E5%9C%98&fr2=sb-top-tw.search&fr=yfp-t-900-tw&rrjfid=3582085 https://tw.search.yahoo.com/search;_ylt=A8tUwZJ2QE1YaVcAUmFr1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC1zLXR3BGdwcmlkAwRuX3JzbHQDMARuX3N1Z2cDMARvcmlnaW4DdHcuc2VhcmNoLnlhaG9vLmNvbQRwb3MDMARwcXN0cgMEcHFzdHJsAwRxc3RybAM4NARxdWVyeQMlRTglQjYlODUlRTUlOEYlQUYlRTYlODQlOUIlRTclOUElODQlRTUlQUYlQjYlRTUlQUYlQjYlMjAlRTglODMlQTElRTUlQUUlODklRTUlQTglOUMEdF9zdG1wAzE0ODE0NTc3OTM-?p=%E8%B6%85%E5%8F%AF%E6%84%9B%E7%9A%84%E5%AF%B6%E5%AF%B6+%E8%83%A1%E5%AE%89%E5%A8%9C&fr2=sb-top-tw.search&fr=yfp-t-900-s-tw&rrjfid=4465331 https://tw.search.yahoo.com/search;_ylt=A8tUwZJ2QE1YaVcAUmFr1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC1zLXR3BGdwcmlkAwRuX3JzbHQDMARuX3N1Z2cDMARvcmlnaW4DdHcuc2VhcmNoLnlhaG9vLmNvbQRwb3MDMARwcXN0cgMEcHFzdHJsAwRxc3RybAM4NARxdWVyeQMlRTglQjYlODUlRTUlOEYlQUYlRTYlODQlOUIlRTclOUElODQlRTUlQUYlQjYlRTUlQUYlQjYlMjAlRTglODMlQTElRTUlQUUlODklRTUlQTglOUMEdF9zdG1wAzE0ODE0NTc3OTM-?p=%E8%B6%85%E5%8F%AF%E6%84%9B%E7%9A%84%E5%AF%B6%E5%AF%B6+%E8%83%A1%E5%AE%89%E5%A8%9C&fr2=sb-top-tw.search&fr=yfp-t-900-s-tw&rrjfid=3056911 https://tw.search.yahoo.com/search;_ylt=A8tUwZJ2QE1YaVcAUmFr1gt.;_ylc=X1MDMjExNDcwNTAwMwRfcgMyBGZyA3lmcC10LTkwMC1zLXR3BGdwcmlkAwRuX3JzbHQDMARuX3N1Z2cDMARvcmlnaW4DdHcuc2VhcmNoLnlhaG9vLmNvbQRwb3MDMARwcXN0cgMEcHFzdHJsAwRxc3RybAM4NARxdWVyeQMlRTglQjYlODUlRTUlOEYlQUYlRTYlODQlOUIlRTclOUElODQlRTUlQUYlQjYlRTUlQUYlQjYlMjAlRTglODMlQTElRTUlQUUlODklRTUlQTglOUMEdF9zdG1wAzE0ODE0NTc3OTM-?p=%E8%B6%85%E5%8F%AF%E6%84%9B%E7%9A%84%E5%AF%B6%E5%AF%B6+%E8%83%A1%E5%AE%89%E5%A8%9C&fr2=sb-top-tw.search&fr=yfp-t-900-s-tw&rrjfid=6023491