Tools/WinSN5.0Ver.iso/PVb5.0/VB/SAMPLES/VISDATA/VISDATA.BAS

BASIC Source File | 1997-03-12 | 66.7 KB | 2,225 lines

Attribute VB_Name = "modVisData"
'------------------------------------------------------------
' VISDATA.BAS
' ┐╔╩╙╗»╩²╛▌╩╛└²╙ª╙├│╠╨≥╡─╓º│╓║»╩²
'
' ╥╗░π╨┼╧óú║┤╦╙ª╙├│╠╨≥╓╝╘┌╩╛╖╢║═┴╖╧░ Visual Basic 5.0 ╡─ DAO
'   ú¿╩²╛▌╖├╬╩╢╘╧≤ú⌐╡─╦∙╙╨┐╔─▄╡─╣ª─▄íú
'
'------------------------------------------------------------

Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
Const MSG1 = "╩╫╧╚╓┤╨╨╠ß╜╗╗≥╗╪╣÷íú"
Const MSG2 = "╒²╘┌╣╪▒╒╝╟┬╝╝»"
Const MSG3 = "▒φ╥╤╛¡┤µ╘┌ú¼╔╛│²┬≡ú┐"
Const MSG4 = "╩Σ╚δ╨┬▒φ├√│╞ú║"
Const MSG5 = "┤²├ⁿ"
Const MSG6 = "ú¼╟δ╡╚┤²..."
Const MSG7 = "╒²╘┌╦ó╨┬▒φ┴╨▒φ"
Const MSG8 = "╩²ú║"
Const MSG9 = "╧╘╩╛╩²╛▌╖├╬╩ Errors ╝»║╧┬≡ú┐"
Const MSG10 = "▓╗─▄╘┌┴┤╜╙▒φ╔╧┤≥┐¬ Table ╢╘╧≤ú¼╩╣╙├╢»╠¼╝»┬≡ú┐"
Const MSG11 = "╒²╘┌╥╘╢»╠¼╝»└α╨═┤≥┐¬┴┤╜╙▒φ"
Const MSG12 = "╒²╘┌╥╘┐∞╒╒└α╨═┤≥┐¬┴┤╜╙▒φ"
Const MSG13 = "╒²╘┌┤≥┐¬╒√╕÷▒φ"
Const MSG14 = "╒²╘┌┤≥┐¬╡Ñ╥╗▒φ╢»╠¼╝»"
Const MSG15 = "╒²╘┌┤≥┐¬╡Ñ╥╗▒φ┐∞╒╒"
Const MSG16 = "╒²╘┌┤≥┐¬┤½╡▌┐∞╒╒"
Const MSG17 = "╒Γ╩╟ SQL ┤½╡▌▓Θ╤»┬≡ú┐"
Const MSG18 = "╩Σ╚δ┴¼╜╙╩⌠╨╘╓╡ú║"
Const MSG19 = "▓╗─▄┤╙▓Θ╤»╢¿╥σ╓╨┤≥┐¬ Table ╢╘╧≤ú¼╩╣╙├╢»╠¼╝»┬≡ú┐"
Const MSG20 = "╒²╘┌┤≥┐¬▓Θ╤»┐∞╒╒"
Const MSG21 = "╒²╘┌┤≥┐¬▓Θ╤»╢»╠¼╝»"
Const MSG22 = "SQL ╙∩╛Σ"
Const MSG23 = "╓┤╨╨"
Const MSG24 = "▓Θ╤»┬≡ú┐"
Const MSG25 = "╒²╘┌╓┤╨╨▓Θ╤»"
Const MSG26 = "  [▓╗┐╔╕ⁿ╨┬]"
Const MSG27 = "▒φ╥╤╛¡┤µ╘┌ú¼╔╛│²┬≡ú┐"
Const MSG28 = "▓Θ╤»╢¿╥σ╥╤╛¡┤µ╘┌ú¼╔╛│²┬≡ú┐"
Const MSG29 = "╩Σ╚δ╓╡ú¼╢╘▓╬╩²"
Const MSG30 = "├╗╙╨╩²╛▌╖├╬╩┤φ╬≤úí"
Const MSG31 = "┤╦╩▒▓╗─▄╧╘╩╛┤φ╬≤úí"
Const MSG32 = "╩²╛▌╥╤╛¡╕─▒Σú¼╠ß╜╗┬≡ú┐"
Const MSG33 = "╗╪╣÷╦∙╙╨╕─▒Σ┬≡ú┐"
Const MSG34 = "╒²╘┌┤ª└φ╩┬╬±ú¼▓╗─▄╣╪▒╒úí"
Const MSG35 = "▒╪╨δ╩╫╧╚╣╪▒╒úí"
Const MSG36 = "┤≥┐¬ Microsoft Access ╩²╛▌┐Γ"
Const MSG37 = "┤≥┐¬ Dbase ╩²╛▌┐Γ"
Const MSG38 = "┤≥┐¬ FoxPro ╩²╛▌┐Γ"
Const MSG39 = "┤≥┐¬ Paradox ╩²╛▌┐Γ"
Const MSG40 = "┤≥┐¬ Excel ╬─╝■"
Const MSG41 = "┤≥┐¬ Btrieve ╩²╛▌┐Γ"
Const MSG42 = "┤≥┐¬╬─▒╛╩²╛▌┐Γ "
Const MSG43 = "╒²╘┌┤≥┐¬╩²╛▌┐Γ"
Const MSG44 = "╫ó╥Γú║═╞╝÷╩╣╙├╕╜╝╙▒φ"
Const MSG45 = "╒²╘┌╨▐╕┤"
Const MSG46 = "╩╘═╝╨▐╕┤╦ⁿ┬≡ú┐"
Const MSG47 = "╩Σ╚δ╨┬╡─ ISAM ╩²╛▌┐Γ╡──┐┬╝├√│╞ú║"
Const MSG48 = "╤í╘±╥¬╤╣╦⌡╡─ Microsoft Access ╩²╛▌┐Γ"
Const MSG49 = "Microsoft Access MDB (*.mdb)|*.mdb"
Const MSG50 = "|╦∙╙╨╬─╝■ (*.*)|*.*"
Const MSG51 = "╤í╘±╥¬╤╣╦⌡╡╜─╟└∩╡─ Microsoft Access ╩²╛▌┐Γ"
Const MSG52 = "╝╙├▄╤╣╦⌡╡─╩²╛▌┐Γ┬≡ú┐"
Const MSG53 = "╒²╘┌╤╣╦⌡"
Const MSG54 = "┤≥┐¬╨┬╜ⁿ╤╣╦⌡╡─╩²╛▌┐Γ┬≡ú┐"
Const MSG55 = "╤í╘±╥¬┤┤╜¿╡─ Microsoft Access ╩²╛▌┐Γ"
Const MSG56 = "╡╝│÷▒φú║"
Const MSG57 = "╡╝│÷"
Const MSG58 = "╘┌"
Const MSG59 = "┤┤╜¿╦≈╥²ú║"
Const MSG60 = "│╔╣ª╡╝│÷ú║"
Const MSG61 = "│╔╣ª╡╝│÷ SQL ╙∩╛Σíú"
Const MSG62 = "▒φ╥╤╛¡┤µ╘┌ú¼╕▓╕╟┬≡ú┐"
Const MSG63 = "╒²╘┌╩Σ╚δ▒φú║"
Const MSG64 = "│╔╣ª╩Σ╚δú║"
Const MSG65 = "╬▐╨º╡──┐┬╝├√│╞úí"
'>>>>>>>>>>>>>>>>>>>>>>>>


'api ╔∙├≈
Declare Function OSGetPrivateProfileString% Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal ReturnString$, ByVal NumBytes As Integer, ByVal FileName$)
Declare Function OSWritePrivateProfileString% Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Declare Function SQLAllocEnv% Lib "ODBC32.DLL" (env&)
Declare Function SQLDataSources% Lib "ODBC32.DLL" (ByVal henv&, ByVal fdir%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDesc$, ByVal cbDescMax%, pcbDesc%)
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Declare Function GetDesktopWindow Lib "user32" () As Long

'╚½╛╓╢╘╧≤▒Σ┴┐
Global gVDClass      As New VisDataClass
Global gnodDBNode    As Node        'treeview ╓╨╡─╡▒╟░╩²╛▌┐Γ╜┌╡π
Global gnodDBNode2   As Node        'treeview ╓╨╡▒╟░╩²╛▌┐Γ╜┌╡π╡─▒╕╖▌
Global gwsMainWS     As Workspace   '╓≈╣ñ╫≈┐╪╝■╢╘╧≤
Global gdbCurrentDB  As Database    '╓≈╩²╛▌┐Γ╢╘╧≤
Global gbDBOpenFlag  As Integer     '╩²╛▌┐Γ┤≥┐¬╙δ╖±╡─▒Ω╓╛
Global gPropObject   As Object      '╧╘╩╛╩⌠╨╘╡─╢╘╧≤
Global gDataCtlObj   As Object      '╚½╛╓╩²╛▌┐╪╝■╢╘╧≤
Global gtdfTableDef  As TableDef    '╙╔ frmTblStruct ╩╣╙├╡─╚½╛╓▒φ╢¿╥σ
Global gnFormType    As Integer     '╘┌╓≈┤░╠σ╔╧╤í╢¿╡─┤░╠σ└α╨═
                                    '0 = ╩²╛▌┐╪╝■
                                    '1 = ├╗╙╨╩²╛▌┐╪╝■
                                    '2 = ═°╕±┐╪╝■
Global gnRSType      As Integer     '╘┌╓≈┤░╠σ╔╧╤í╢¿╡─╝╟┬╝╝»└α╨═
                                    '0 = ▒φ
                                    '1 = ╢»╠¼╝»
                                    '2 = ┐∞╒╒

'╚½╛╓╩²╛▌┐Γ▒Σ┴┐
Global gsDataType       As String   '╢╘╜╙╩▄ Access ╡─╢½╬≈
                                    '╩²╛▌║≤╢╦ = ┴¼╜╙╫╓╖√┤«
Global gsDBName         As String   '╡▒╟░╩²╛▌┐Γ├√│╞
Global gsODBCDatasource As String   '╚½╛╓ odbc ╓╡
Global gsODBCDatabase   As String   '       "
Global gsODBCUserName   As String   '       "
Global gsODBCPassword   As String   '       "
Global gsODBCDriver     As String   '       "
Global gsODBCServer     As String   '       "
Global gsTblName        As String   '
Global glQueryTimeout   As Long     '
Global glLoginTimeout   As Long     '
Global gsTableDynaFilter As String  '
Global gnReadOnly       As Integer  '╩²╛▌┐Γ╓╗╢┴▒Ω╓╛

'╞Σ╦√╚½╛╓▒Σ┴┐
Global gsZoomData       As String   '┤½╡▌╨┼╧ó╕°╖┼┤≤┤░╠σ

'╢α╙├╗º▒Σ┴┐
Global gnMURetryCnt     As Integer
Global gnMUDelay        As Integer
Global gnMULocking      As Integer  '▒ú╩╪╗≥┐¬╖┼╦°╢¿╡─▒Ω╓╛

'╚½╛╓▓Θ╒╥╓╡ú¼╙├╙┌╘┌╢»╠¼╝»┤░╠σ║═▓Θ╒╥╢╘╗░┐≥╓«╝Σ┤½╡▌╨┼╧ó
Global gbFindFailed     As Boolean
Global gsFindExpr       As String
Global gsFindOp         As String
Global gsFindField      As String
Global gnFindType       As Integer
Global gbFromTableView  As Boolean

'╚½╛╓╦╤╦≈╓╡ú¼╙├╙┌╘┌▒φ┤░╠σ║═▓Θ╒╥╢╘╗░┐≥╓«╝Σ┤½╡▌╨┼╧ó
Global gsSeekOperator   As String
Global gsSeekValue      As String

'╚½╛╓▒Ω╓╛
Global gbDBChanged      As Boolean   '
Global gbTransPending   As Boolean   '╙├╙┌╩┬╬±╣▄└φ
Global gbFromSQL        As Boolean   'sql ╙∩╛Σ╡─╘┤╛═╩╟ SQL ┤░╠σ
Global gbAddTableFlag   As Boolean   '╨┬╜¿╗≥╔Φ╝╞╓╕╩╛╞≈
Global gbSettingDataCtl As Boolean   '╙├╙┌╓╪╓├╩²╛▌┤░╠σ╩⌠╨╘

'╚½╛╓▒Σ┴┐ú¼╙├╙┌╡╝╚δ╡╝│÷┤·┬δ╓╨
Global gnDataType As Integer
Global gImpDB As Database
Global gExpDB As Database
Global gExpTable As String

'╩²╛▌║≤╢╦└α╨═ú¼╙├╫≈╬¬┴¼╜╙╫╓╖√┤«
Global Const gsMSACCESS = "Microsoft Access"
Global Const gsDBASEIII = "Dbase III;"
Global Const gsDBASEIV = "Dbase IV;"
Global Const gsDBASE5 = "Dbase 5.0;"
Global Const gsFOXPRO20 = "FoxPro 2.0;"
Global Const gsFOXPRO25 = "FoxPro 2.5;"
Global Const gsFOXPRO26 = "FoxPro 2.6;"
Global Const gsFOXPRO30 = "FoxPro 3.0;"
Global Const gsPARADOX3X = "Paradox 3.X;"
Global Const gsPARADOX4X = "Paradox 4.X;"
Global Const gsPARADOX5X = "Paradox 5.X;"
Global Const gsBTRIEVE = "Btrieve;"
Global Const gsEXCEL30 = "Excel 3.0;"
Global Const gsEXCEL40 = "Excel 4.0;"
Global Const gsEXCEL50 = "Excel 5.0;"
Global Const gsTEXTFILES = "Text;"
Global Const gsSQLDB = "ODBC;"

'╡╝╚δ/╡╝│÷╩²╛▌└α╨═
Global Const gnDT_NONE = -1
Global Const gnDT_MSACCESS = 0
Global Const gnDT_DBASEIV = 1
Global Const gnDT_DBASEIII = 2
Global Const gnDT_FOXPRO26 = 3
Global Const gnDT_FOXPRO25 = 4
Global Const gnDT_FOXPRO20 = 5
Global Const gnDT_PARADOX4X = 6
Global Const gnDT_PARADOX3X = 7
Global Const gnDT_BTRIEVE = 8
Global Const gnDT_EXCEL50 = 9
Global Const gnDT_EXCEL40 = 10
Global Const gnDT_EXCEL30 = 11
Global Const gnDT_TEXTFILE = 12
Global Const gnDT_SQLDB = 13

'╚½╛╓│ú╩²
Global Const gsDEFAULT_DRIVER = "SQL Server"  '╙├╙┌╫ó▓ß╩²╛▌┐Γ
Global Const gnEOF_ERR = 626                  '
Global Const gnFTBLS = 0                      '
Global Const gnFFLDS = 1                      '
Global Const gnFINDX = 2                      '
Global Const gnMAX_GRID_ROWS = 31999          '
Global Const gnMAX_MEMO_SIZE = 20000          '
Global Const gnGETCHUNK_CUTOFF = 50           '

Global Const gnFORM_DATACTL = 0               '
Global Const gnFORM_NODATACTL = 1             '
Global Const gnFORM_DATAGRID = 2              '

Global Const gnRS_TABLE = vbRSTypeTable
Global Const gnRS_DYNASET = vbRSTypeDynaset
Global Const gnRS_SNAPSHOT = vbRSTypeSnapShot
Global Const gnRS_PASSTHRU = 8

Global Const gnCTLARRAYHEIGHT = 340&          '
Global Const gnSCREEN = 0                     '╙├╙┌╜½┤░╠σ╘┌╞┴─╗╔╧╛╙╓╨
Global Const gnMDIFORM = 1                    '╙├╙┌╜½┤░╠σ╘┌ frmMDI ╔╧╛╙╓╨

'╟δ╫ó╥Γú¼╧┬├µ╒Γ╥╗╢╬╡─╫╓╖√┤«╢╝▓╗─▄╖¡╥δ│╔╓╨╬─
Global Const TABLE_STR = "Table"
Global Const ATTACHED_STR = "Attached"
Global Const QUERY_STR = "Query"
Global Const FIELD_STR = "Field"
Global Const FIELDS_STR = "Fields"
Global Const INDEX_STR = "Index"
Global Const INDEXES_STR = "Indexes"
Global Const PROPERTY_STR = "Property"
Global Const PROPERTIES_STR = "Properties"

Global Const APP_CATEGORY = "Microsoft Visual Basic ═Γ╜╙│╠╨≥"

Sub Main()
  frmMDI.Show
End Sub


'------------------------------------------------------------
'╒Γ╕÷║»╩²╢╘ frmTables ┤░╠σ╔╧▓Θ╤»╢¿╥σ┴╨▒φ╓╨╤í╓╨╡─╧ε─┐
'╖╡╗╪▓Θ╤»╢¿╥σ└α╨═
'------------------------------------------------------------
Function ActionQueryType(qdf As QueryDef) As String

  '╝∞▓Θ┐┤╩╟╖±╩╟╢»╫≈▓Θ╤»
  If (qdf.Type And dbQAction) = 0 Then
    ActionQueryType = vbNullString
    Exit Function
  End If

  '╥╗╢¿╩╟╢»╫≈▓Θ╤»└α╨═
  Select Case qdf.Type
    Case dbQCrosstab
      ActionQueryType = "╜╗▓µ▒φ"
    Case dbQDelete
      ActionQueryType = "╔╛│²"
    Case dbQUpdate
      ActionQueryType = "╕ⁿ╨┬"
    Case dbQAppend
      ActionQueryType = "╫╖╝╙"
    Case dbQMakeTable
      ActionQueryType = "╔·│╔▒φ"
    Case dbQDDL
      ActionQueryType = "DDL"
    Case dbQSQLPassThrough
      ActionQueryType = "SQL ┤½╡▌"
    Case dbQSetOperation
      ActionQueryType = "╔Φ╓├▓┘╫≈"
    Case dbQSPTBulk
      ActionQueryType = "SPT ┼·┤ª└φ"  'SPT Bulk
    Case Else
      ActionQueryType = vbNullString
  End Select

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╕°─╟╨⌐┐╔─▄╨Φ╥¬└¿║┼╡─╢╘╧≤├√│╞╠φ╝╙ []ú¼
'╥≥╬¬├√│╞╓╨╝Σ┐╔─▄┤µ╘┌┐╒╕±
'------------------------------------------------------------
Function AddBrackets(rObjName As String) As String
  '╕°╓╨╝Σ╙╨┐╒╕±╡─╢╘╧≤├√│╞╠φ╝╙└¿║┼
  If InStr(rObjName, " ") > 0 And Mid(rObjName, 1, 1) <> "[" Then
    AddBrackets = "[" & rObjName & "]"
  Else
    AddBrackets = rObjName
  End If
End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╝∞▓Θ┐┤╩╟╖±╩┬╬±╒²╘┌┤ª└φ
'▓ó╧╘╩╛╥╗╠⌡╧√╧ó▒φ├≈╒²╘┌┤ª└φ
'------------------------------------------------------------
Function CheckTransPending(MSG As String) As Integer

  If gbTransPending Then
    MsgBox MSG & vbCrLf & MSG1, 48
    CheckTransPending = True
  Else
    CheckTransPending = False
  End If

End Function

'------------------------------------------------------------
'╟σ│² table ║═ dynasnap ┤░╠σ╔╧╡─╩²╛▌╫╓╢╬
'------------------------------------------------------------
Sub ClearDataFields(frm As Form, nCnt As Integer)
  Dim i As Integer

  '╟σ│²╓≈┤░╠σ╔╧╡─╫╓╢╬
  For i = 0 To nCnt - 1
    frm.txtFieldData(i).Text = vbNullString
  Next
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠═¿╣²▓Θ╒╥╛▀╙╨í░Recordsetí▒▒Ω╫óú¿Tagú⌐╡─┤░╠σ╣╪▒╒
'╦∙╙╨╡─ frmDynaSnapíófrmTableObj ║═ frmDataGrid ┤░╠σ
'------------------------------------------------------------
Sub CloseAllRecordsets()
  Dim i As Integer

  MsgBar MSG2, True
  While i < Forms.Count
    If Forms(i).Tag = "Recordset" Then
      Unload Forms(i)
    Else
      i = i + 1
    End If
  Wend
  MsgBar vbNullString, False

End Sub

'------------------------------------------------------------
'╒Γ╕÷║»╩²╘┌ frmCopyStruct ┤░╠σ╓╨┤╙╥╗╕÷▒φ╧≥┴φ╥╗╕÷▒φ╕┤╓╞╩²╛▌
'╒Γ└∩╩╛╖╢┴╦╩┬╬±╡─╙├╖¿└┤╝╙┐∞╒Γ╓╓└α╨═╡─▓┘╫≈
'------------------------------------------------------------
Function CopyData(rFromDB As Database, rToDB As Database, rFromName As String, rToName As String) As Integer
  On Error GoTo CopyErr

  Dim recRecordset1 As Recordset, recRecordset2 As Recordset
  Dim i As Integer
  Dim nRC As Integer
  Dim fld As Field

  '┤≥┐¬┴╜╕÷╝╟┬╝╝»
  Set recRecordset1 = rFromDB.OpenRecordset(rFromName)
  Set recRecordset2 = rToDB.OpenRecordset(rToName)
  gwsMainWS.BeginTrans
  While recRecordset1.EOF = False
    recRecordset2.AddNew
    '╒Γ╕÷╤¡╗╖┤╙├┐╕÷╫╓╢╬╧≥╨┬▒φ╕┤╓╞╩²╛▌
'    For Each fld In recRecordset1.Fields
    For i = 0 To recRecordset1.Fields.Count - 1
      Set fld = recRecordset1.Fields(i)
      recRecordset2(fld.Name).Value = fld.Value
    Next
    recRecordset2.Update
    recRecordset1.MoveNext
    nRC = nRC + 1
    '╒Γ╕÷▓Γ╩╘╜½░┤├┐ 1000 ╝╟┬╝╠ß╜╗╥╗┤╬╩┬╬±
    If nRC = 1000 Then
      gwsMainWS.CommitTrans
      gwsMainWS.BeginTrans
      nRC = 0
    End If
  Wend
  gwsMainWS.CommitTrans

  CopyData = True
  Exit Function

CopyErr:
  gwsMainWS.Rollback
  ShowError
  CopyData = False
End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╕┤╓╞╥╗╕÷▒φ╡─╜ß╣╣╕°╥╗╕÷╨┬▒φú¼
'╒Γ╕÷╨┬▒φ╗≥╩╟╘┌═¼╥╗╕÷╩²╛▌┐Γ╓╨╗≥╩╟╘┌▓╗═¼╡─╩²╛▌┐Γ╓╨
'------------------------------------------------------------
Function CopyStruct(vFromDB As Database, vToDB As Database, vFromName As String, vToName As String, bCreateIndex As Integer) As Integer
  On Error GoTo CSErr

  Dim i As Integer
  Dim tblTableDefObj As TableDef
  Dim fldFieldObj As Field
  Dim indIndexObj As Index
  Dim tdf As TableDef
  Dim fld As Field
  Dim idx As Index

  '╦╤╦≈┐┤▒φ╩╟╖±┤µ╘┌
NameSearch:
'  For Each tdf In vToDB.Tabledefs
  For i = 0 To vToDB.TableDefs.Count - 1
    Set tdf = vToDB.TableDefs(i)
    If UCase(tdf.Name) = UCase(vToName) Then
      If MsgBox(MSG3, 4) = vbYes Then
         vToDB.TableDefs.Delete tdf.Name
      Else
         vToName = InputBox(MSG4)
         If Len(vToName) = 0 Then
           Exit Function
         Else
           GoTo NameSearch
         End If
      End If
      Exit For
    End If
  Next

  Set tblTableDefObj = gdbCurrentDB.CreateTableDef()

  '▒╪╥¬╩▒╚Ñ╡⌠╙╡╙╨╒▀
  tblTableDefObj.Name = StripOwner(vToName)

  '┤┤╜¿╫╓╢╬
'  For Each fld In vFromDB.Tabledefs(vFromName).Fields
  For i = 0 To vFromDB.TableDefs(vFromName).Fields.Count - 1
    Set fld = vFromDB.TableDefs(vFromName).Fields(i)
    Set fldFieldObj = vFromDB.TableDefs(vFromName).CreateField(fld.Name, fld.Type, fld.Size)
    tblTableDefObj.Fields.Append fldFieldObj
  Next

  '┤┤╜¿╦≈╥²
  If bCreateIndex <> False Then
'    For Each idx In vFromDB.Tabledefs(vFromName).Indexes
    For i = 0 To vFromDB.TableDefs(vFromName).Indexes.Count - 1
      Set idx = vFromDB.TableDefs(vFromName).Indexes(i)
      Set indIndexObj = vFromDB.TableDefs(vFromName).CreateIndex(idx.Name)
      With indIndexObj
        indIndexObj.Fields = idx.Fields
        indIndexObj.Unique = idx.Unique
        If gsDataType <> gsSQLDB Then
          indIndexObj.Primary = idx.Primary
        End If
      End With
      tblTableDefObj.Indexes.Append indIndexObj
    Next
  End If

  '╫╖╝╙╨┬▒φ
  vToDB.TableDefs.Append tblTableDefObj

  CopyStruct = True
  Exit Function

CSErr:
  ShowError
  CopyStruct = False
End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╙├▒φ┤░╠σ╓╨╡─▒φú¿║═▓Θ╤»╢¿╥σú⌐╠ε│Σ┴╨▒φ┐≥╗≥╫Θ║╧┐≥
'ItemData ╬¬ 0 ┤·▒φ▒φ╢¿╥σú¼╬¬ 1 ┤·▒φ▓Θ╤»╢¿╥σ
'------------------------------------------------------------
Sub GetTableList(rctl As Control, rbIncludeQDFs As Integer, rbIncludeSys As Integer, rbStripConnect As Integer)
  On Error GoTo FTLErr

  Dim i As Integer
  Dim sTmp As String
  Dim tbl As TableDef
  Dim qdf As QueryDef

  '╠φ╝╙▒φ╢¿╥σ
  For Each tbl In gdbCurrentDB.TableDefs
    sTmp = tbl.Name
    If rbIncludeSys Then
      rctl.AddItem sTmp
      rctl.ItemData(rctl.NewIndex) = 0
    Else
      If (gdbCurrentDB.TableDefs(sTmp).Attributes And dbSystemObject) = 0 Then
        rctl.AddItem sTmp
        rctl.ItemData(rctl.NewIndex) = 0
      End If
    End If
  Next

  '╠φ╝╙▓Θ╤»╢¿╥σ
  If rbIncludeQDFs Then
    For Each qdf In gdbCurrentDB.QueryDefs
      rctl.AddItem qdf.Name
      rctl.ItemData(rctl.NewIndex) = 1
    Next
  End If

  Exit Sub

FTLErr:
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷║»╩²╢╘╥╘╫╓╖√┤«┤½╡▌╡─▓╬╩²╖╡╗╪╩²╓╡╫╓╢╬└α╨═
'------------------------------------------------------------
Function GetFieldType(rFldType As String) As Integer
  '╖╡╗╪╫╓╢╬│ñ╢╚
  If rFldType = "Text" Then
    GetFieldType = dbText
  Else
    Select Case rFldType
      Case "Counter"
        GetFieldType = dbLong
      Case "Boolean"
        GetFieldType = dbBoolean
      Case "Byte"
        GetFieldType = dbByte
      Case "Integer"
        GetFieldType = dbInteger
      Case "Long"
        GetFieldType = dbLong
      Case "Currency"
        GetFieldType = dbCurrency
      Case "Single"
        GetFieldType = dbSingle
      Case "Double"
        GetFieldType = dbDouble
      Case "Date/Time"
        GetFieldType = dbDate
      Case "Binary"
        GetFieldType = dbLongBinary
      Case "Memo"
        GetFieldType = dbMemo
    End Select
  End If

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╢╘┤½╡▌╡─╫╓╢╬└α╨═╖╡╗╪╩╩╡▒╡─╫╓╢╬┐φ╢╚ú¼
'╦ⁿ╩╟╙├╘┌ frmDynaSnap ║═ frmTableObj ┤░╠σ╔╧╡─┐╪╝■┐φ╢╚╡─
'------------------------------------------------------------
Function GetFieldWidth(rType As Integer)
  Select Case rType
    Case dbBoolean
      GetFieldWidth = 850
    Case dbByte
      GetFieldWidth = 650
    Case dbInteger
      GetFieldWidth = 900
    Case dbLong
      GetFieldWidth = 1100
    Case dbCurrency
      GetFieldWidth = 1800
    Case dbSingle
      GetFieldWidth = 1800
    Case dbDouble
      GetFieldWidth = 2200
    Case dbDate
      GetFieldWidth = 2000
    Case dbText
      GetFieldWidth = 3250
    Case dbLongBinary
      GetFieldWidth = 3250
    Case dbMemo
      GetFieldWidth = 3250
    Case Else
      GetFieldWidth = 3250
  End Select

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╢╘┤½╡▌╡─╧ε─┐║═╜┌╖╡╗╪ INI ╬─╝■╓╨╡─╔Φ╓├
'------------------------------------------------------------
Function GetINIString(ByVal vsItem As String, ByVal vsDefault As String) As String
  GetINIString = GetSetting(APP_CATEGORY, App.Title, vsItem, vsDefault)
End Function

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╥■▓╪▓╦╡Ñ║═╣ñ╛▀└╕ú¼╦ⁿ├╟╓╗╘┌╩²╛▌┐Γ┤≥┐¬╩▒╩╣╙├
'------------------------------------------------------------
Sub HideDBTools()
  frmMDI.mnuDBClose.Enabled = False
  frmMDI.mnuDBImpExp.Enabled = False
  frmMDI.mnuUtil.Enabled = False
  frmMDI.mnuUBar1.Visible = False
  frmMDI.mnuUAttachments.Visible = False
  frmMDI.mnuUGroupsUsers.Visible = False
  frmMDI.mnuUSystemDB.Visible = False
  frmMDI.tlbToolBar.Buttons("BeginTrans").Enabled = False
  frmMDI.tlbToolBar.Buttons("Commit").Enabled = False
  frmMDI.tlbToolBar.Buttons("Rollback").Enabled = False
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╜½┤½╚δ╡─╧√╧ó╧╘╩╛╘┌ MDI ┤░╠σ╡╫▓┐╡─╫┤╠¼└╕╓╨
'------------------------------------------------------------
Sub MsgBar(rsMsg As String, rPauseFlag As Integer)
  If Len(rsMsg) = 0 Then
    Screen.MousePointer = vbDefault
    frmMDI.stsStatusBar.Panels(1).Text = MSG5
  Else
    If rPauseFlag Then
      frmMDI.stsStatusBar.Panels(1).Text = rsMsg & MSG6
    Else
      frmMDI.stsStatusBar.Panels(1).Text = rsMsg
    End If
  End If
  frmMDI.stsStatusBar.Refresh
End Sub

'==================================================
' ╣²│╠ú║   ObjectExists
'
' ─┐╡─ú║   ╚╖╢¿╥╗╕÷│╔╘▒╩╟╖±┤µ╘┌
'          │²┴╦╡┌╥╗╕÷▓╬╩²╔∙├≈╬¬╢╘╧≤╥╘═Γú¼╙δ MemberExists ╧α═¼ú¼
'          ╒Γ╛═╘╩╨φ┤½╡▌╧± VBComponentsíóVBProjects ╡╚─╟╤∙╡─╝»║╧
' ▓╬╩²ú║
'   pColl:    ╥¬╝∞▓Θ╡─╝»║╧
'   sMemName: ╥¬╝∞▓Θ╡─│╔╘▒╡─├√│╞ú¿╣╪╝ⁿ╫╓ú⌐
' ╩Σ│÷ú║
'   True:  │╔╘▒╘┌╝»║╧╓╨┤µ╘┌
'   False: │╔╘▒╘┌╝»║╧╓╨▓╗┤µ╘┌
' ╬¼╗ñú║   J$
'==================================================
Function ObjectExists(pColl As Object, sMemName As String) As Boolean
Dim pObj As Object

  On Error Resume Next
  Err = 0
  Set pObj = pColl(sMemName)
  ObjectExists = (Err = 0)
End Function

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╦ó╨┬╚╬║╬╫≈╬¬╢╘╧≤┤½╚δ╡─▒φ┴╨▒φ
'------------------------------------------------------------
Sub RefreshTables(rListObject As Object)
  On Error GoTo TRefErr

  Dim tdf As TableDef
  Dim qdf As QueryDef
  Dim sTmp As String

  Dim i As Integer

  MsgBar MSG7, True
  Screen.MousePointer = vbHourglass

  '╚τ╣√▒╗╡≈╙├╦ó╨┬╩²╛▌┐Γ┤░┐┌ú¼
  '╛═╠°╣²╙├▒φ├√╠ε│Σ┴╨▒φ┐≥╡─└╧╖╜╖¿
    If rListObject Is Nothing Then GoTo LoadTreeView

  rListObject.Clear
  If frmMDI.mnuPAllowSys.Checked Then
    '┴╨│÷╦∙╙╨╡─▒φ
    For Each tdf In gdbCurrentDB.TableDefs
      If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
        If Left(tdf.Connect, 1) = ";" Then
          '▒╪╨δ╩▒╥╗╕÷ Microsoft Access ╕╜╝╙▒φ
          rListObject.AddItem tdf.Name & " -> Microsoft Access"
        Else
          '▒╪╨δ╩╟╥╗╕÷ ISAM ╕╜╝╙▒φ
          rListObject.AddItem tdf.Name & " -> " & Left(tdf.Connect, InStr(tdf.Connect, ";") - 1)
        End If
      ElseIf (tdf.Attributes And dbAttachedODBC) = dbAttachedODBC Then
        rListObject.AddItem tdf.Name & " -> ODBC"
      Else
        rListObject.AddItem tdf.Name
      End If
    Next
  Else
    '▓╗┴╨│÷╧╡═│▒φ
    For Each tdf In gdbCurrentDB.TableDefs
      If (tdf.Attributes And dbSystemObject) = 0 Then
        If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
          If Left(tdf.Connect, 1) = ";" Then
            '▒╪╨δ╩▒╥╗╕÷ Microsoft Access ╕╜╝╙▒φ
            rListObject.AddItem tdf.Name & " -> Microsoft Access"
          Else
            '▒╪╨δ╩╟╥╗╕÷ ISAM ╕╜╝╙▒φ
            rListObject.AddItem tdf.Name & " -> " & Left(tdf.Connect, InStr(tdf.Connect, ";") - 1)
          End If
        ElseIf (tdf.Attributes And dbAttachedODBC) = dbAttachedODBC Then
          rListObject.AddItem tdf.Name & " -> ODBC"
        Else
          rListObject.AddItem tdf.Name
        End If
      End If
    Next
  End If
  '╚τ╣√╙╨─┌╚▌╤í╓╨╡┌╥╗╕÷╧ε─┐
  If rListObject.ListCount > 0 Then
    rListObject.ListIndex = 0
  End If

LoadTreeView:
  frmDatabase.LoadDatabase

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub

TRefErr:
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷║»╩²╖╡╗╪┤½╚δ╫╓╢╬└α╨═╡─┤≤╨íú¼
'╙├╘┌ frmAddField ┤░╠σ
'------------------------------------------------------------
Function SetFldProperties(rnType As Integer) As Integer
  '╖╡╗╪╫╓╢╬│ñ╢╚
  Select Case rnType
    Case dbBoolean
      SetFldProperties = 1
    Case dbByte
      SetFldProperties = 1
    Case dbInteger
      SetFldProperties = 2
    Case dbLong
      SetFldProperties = 4
    Case dbCurrency
      SetFldProperties = 8
    Case dbSingle
      SetFldProperties = 4
    Case dbDouble
      SetFldProperties = 8
    Case dbDate
      SetFldProperties = 8
    Case dbText
      SetFldProperties = 50
    Case dbLongBinary
      SetFldProperties = 0
    Case dbMemo
      SetFldProperties = 0
  End Select
End Function

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╧╘╩╛▓╦╡Ñ║═╣ñ╛▀└╕ú¼╦ⁿ├╟╓╗╘┌╩²╛▌┐Γ┤≥┐¬╩▒╩╣╙├
'------------------------------------------------------------
Sub ShowDBTools()
  Dim sTmp As String

  frmMDI.mnuDBClose.Enabled = True
  frmMDI.mnuDBImpExp.Enabled = True
  frmMDI.mnuUtil.Enabled = True
  frmMDI.tlbToolBar.Buttons("BeginTrans").Enabled = True
  frmMDI.tlbToolBar.Buttons("Commit").Enabled = False
  frmMDI.tlbToolBar.Buttons("Rollback").Enabled = False
  frmMDI.tlbToolBar.Refresh

  '╔Φ╓├╥╗░π╧ε─┐ú¼╒Γ╨⌐╧ε─┐╙ª╙├╙┌╗≥▓╗╙ª╙├╙┌ MDB
  If gsDataType = gsMSACCESS Then
    frmMDI.mnuUBar1.Visible = True
    frmMDI.mnuUAttachments.Visible = True
    frmMDI.mnuUGroupsUsers.Visible = True
    frmMDI.mnuUSystemDB.Visible = True
    frmSQL.cmdSaveQueryDef.Visible = True
    frmMDI.mnuDBPURename.Visible = True
  Else
    frmSQL.cmdSaveQueryDef.Visible = False
    frmMDI.mnuDBPURename.Visible = False
  End If

  '╔Φ╓├ ODBC ╠╪╢¿╡─╧ε─┐
  If gsDataType = gsSQLDB Then
    If gnRSType = gnRS_TABLE Then
      frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed
      gnRSType = gnRS_DYNASET
    End If
    frmMDI.tlbToolBar.Buttons("PassThrough").Visible = True
    frmMDI.tlbToolBar.Buttons("Table").Visible = False
  Else
    If gnRSType = gnRS_PASSTHRU Then
      frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed
      gnRSType = gnRS_DYNASET
    End If
    frmMDI.tlbToolBar.Buttons("PassThrough").Visible = False
    frmMDI.tlbToolBar.Buttons("Table").Visible = True
  End If
  frmMDI.tlbToolBar.Refresh
  '╧╘╩╛┴╜╕÷╓≈╥¬╡─╫╙┤░╠σ
  frmDatabase.Show
  frmSQL.Show
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╙├╦ⁿ╡─ Err ┬δ╧╘╩╛┤φ╬≤╨┼╧óú¼▓ó╟╥
'╚τ╣√╩╟╩²╛▌╖├╬╩└α╨═┤φ╬≤ú¼╛═╠ß╩╛╧╘╩╛ Errors ╝»║╧
'------------------------------------------------------------
Sub ShowError()
  Dim sTmp As String

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False

  sTmp = "╖ó╔·┴╦╧┬├µ╡─┤φ╬≤ú║" & vbCrLf & vbCrLf
  '╠φ╝╙┤φ╬≤╫╓╖√┤«
  sTmp = sTmp & Err.Description & vbCrLf
  '╠φ╝╙┤φ╬≤║┼
  sTmp = sTmp & MSG8 & Err

  Beep
  '╝∞▓Θ┐┤┤φ╬≤╩╟╖±╘┤╙┌╩²╛▌┐Γ errors ╝»║╧
  If DBEngine.Errors.Count > 0 Then
    If DBEngine.Errors(0).Number = Err Then
      '╠φ╝╙┤φ╬≤╠ß╩╛╧╘╩╛ errors ╝»║╧
      sTmp = sTmp & vbCrLf & vbCrLf & MSG9
      '├∙╡╤▓ó╧╘╩╛┤φ╬≤
      If MsgBox(sTmp, vbYesNo + vbQuestion) = vbYes Then
        RefreshErrors
      End If
    Else
      MsgBox sTmp
    End If
  Else
    MsgBox sTmp
  End If

End Sub

'------------------------------------------------------------
'╒Γ╕÷║»╩²∞ε│²╕╜╝╙▒φ┴¼╜╙╫╓╖√┤«
'------------------------------------------------------------
Function StripConnect(rsTblName As String) As String
  If InStr(rsTblName, "->") > 0 Then
    StripConnect = Left(rsTblName, InStr(rsTblName, "->") - 2)
  Else
    StripConnect = rsTblName
  End If

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²∞ε│²╩²╛▌╢╘╧≤╡─ []
'------------------------------------------------------------
Function StripBrackets(rsObjName As String) As String
  '╕°╙╨┐╒╕±╡─╢╘╧≤├√│╞╠φ╝╙└¿║┼  ú┐ú┐╘¡╬─╙╨╬≤úí
  If Mid(rsObjName, 1, 1) = "[" Then
    StripBrackets = Mid(rsObjName, 2, Len(rsObjName) - 2)
  Else
    StripBrackets = rsObjName
  End If

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²┤╙ path\file ╫╓╖√┤«╓╨╚Ñ╡⌠╬─╝■├√
'------------------------------------------------------------
Function StripFileName(rsFileName As String) As String
  On Error Resume Next
  Dim i As Integer

  For i = Len(rsFileName) To 1 Step -1
    If Mid(rsFileName, i, 1) = "\" Then
      Exit For
    End If
  Next

  StripFileName = Mid(rsFileName, 1, i - 1)

End Function

'------------------------------------------------------------
'╒Γ╕÷║»╩²╘┌╧╘╩╛╟░╚Ñ╡⌠ memo ╫╓╢╬╩²╛▌╡─╖╟ Ascii ╫╓╖√
'ú¿├╗░╤╬╒╩╟╖±╫▄╩╟╨Φ╥¬ú⌐
'------------------------------------------------------------
Function StripNonAscii(rvntVal As Variant) As String
  Dim i As Integer
  Dim sTmp As String

  '╚Ñ╡⌠╬▓░═┐╔┤ª└φ DBCS ╫╓╖√
  StripNonAscii = rvntVal
  Exit Function

  For i = 1 To Len(rvntVal)
    If Asc(Mid(rvntVal, i, 1)) < 32 Or Asc(Mid(rvntVal, i, 1)) > 126 Then
      sTmp = sTmp & " "
    Else
      sTmp = sTmp & Mid(rvntVal, i, 1)
    End If
  Next

  StripNonAscii = sTmp

End Function

'------------------------------------------------------------
'╚Ñ╡⌠ ODBC ▒φ├√╡─╙╡╙╨╒▀
'------------------------------------------------------------
Function StripOwner(rsTblName As String) As String

  If InStr(rsTblName, ".") > 0 Then
    rsTblName = Mid(rsTblName, InStr(rsTblName, ".") + 1, Len(rsTblName))
  End If
  StripOwner = rsTblName

End Function

'------------------------------------------------------------
'╖╡╗╪ true ╗≥ false ╫╓╖√┤«
'------------------------------------------------------------
Function stTrueFalse(rvntTF As Variant) As String
  If rvntTF Then
    stTrueFalse = "True"
  Else
    stTrueFalse = "False"
  End If
End Function

'------------------------------------------------------------
'╚τ╣√╫╓╢╬╩╟ Null ╘≥╖╡╗╪ ""
'------------------------------------------------------------
Function vFieldVal(rvntFieldVal As Variant) As Variant
  If IsNull(rvntFieldVal) Then
    vFieldVal = vbNullString
  Else
    vFieldVal = CStr(rvntFieldVal)
  End If
End Function

'------------------------------------------------------------
'╬¬ VisData ╝╙╘╪╦∙╙╨▒ú┤µ╡─ INI ╔Φ╓├╓╡
'------------------------------------------------------------
Sub LoadINISettings()
  On Error Resume Next

  Dim sTmp As String
  Dim X As Integer

  glQueryTimeout = Val(GetINIString("QueryTimeout", "5"))
  glLoginTimeout = Val(GetINIString("LoginTimeout", "20"))


  frmMDI.mnuPOpenOnStartup.Checked = Val(GetINIString("OpenOnStartup", "0"))
  frmMDI.mnuPAllowSys.Checked = Val(GetINIString("AllowSys", "0"))

  '╗±╡├╫ε╜ⁿ╩╣╙├╡─╩²╛▌┐Γ
  For X = 1 To 8
    sTmp = GetINIString("MRUDatabase" & X, "")
    If Len(sTmp) > 0 Then
      frmMDI.mnuBarMRU.Visible = True
      frmMDI.mnuDBMRU(X).Caption = "&" & X & " " & sTmp
      frmMDI.mnuDBMRU(X).Visible = True
      sTmp = GetINIString("MRUConnect" & X, "")
      frmMDI.mnuDBMRU(X).Tag = sTmp
    End If
  Next

  '┤╙ INI ╬─╝■╓╨╗±╡├╫ε╜ⁿ╩╣╙├╡─╩²╛▌┐Γ
  gsDataType = GetINIString("DataType", vbNullString)
  gsDBName = GetINIString("DatabaseName", vbNullString)
  gsODBCDatasource = GetINIString("ODBCDatasource", vbNullString)
  gsODBCDatabase = GetINIString("ODBCDatabase", vbNullString)
  gsODBCUserName = GetINIString("ODBCUserName", vbNullString)
  gsODBCPassword = GetINIString("ODBCPassword", vbNullString)
  gsODBCDriver = GetINIString("ODBCDriver", vbNullString)
  gsODBCServer = GetINIString("ODBCServer", vbNullString)

  sTmp = GetINIString("ViewMode", CStr(gnFORM_NODATACTL))
  Select Case Val(sTmp)
    Case gnFORM_NODATACTL
      gnFormType = gnFORM_NODATACTL
    Case gnFORM_DATACTL
      gnFormType = gnFORM_DATACTL
    Case gnFORM_DATAGRID
      gnFormType = gnFORM_DATAGRID
  End Select
  sTmp = GetINIString("RecordsetType", CStr(vbRSTypeDynaset))
  Select Case Val(sTmp)
    Case vbRSTypeTable
      gnRSType = gnRS_TABLE
    Case vbRSTypeDynaset
      gnRSType = gnRS_DYNASET
    Case vbRSTypeSnapShot
      gnRSType = gnRS_SNAPSHOT
    Case gnRS_PASSTHRU
      gnRSType = gnRS_PASSTHRU
  End Select

  DoEvents
  Select Case gnFormType
    Case gnFORM_NODATACTL
      frmMDI.tlbToolBar.Buttons("NoDataControl").Value = tbrPressed
    Case gnFORM_DATACTL
      frmMDI.tlbToolBar.Buttons("DataControl").Value = tbrPressed
    Case gnFORM_DATAGRID
      frmMDI.tlbToolBar.Buttons("DBGrid").Value = tbrPressed
  End Select
  Select Case gnRSType
    Case vbRSTypeDynaset
      frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed
    Case vbRSTypeSnapShot
      frmMDI.tlbToolBar.Buttons("Snapshot").Value = tbrPressed
    Case vbRSTypeTable
      frmMDI.tlbToolBar.Buttons("Table").Value = tbrPressed
    Case gnRS_PASSTHRU
      frmMDI.tlbToolBar.Buttons("PassThrough").Value = tbrPressed
  End Select

End Sub

'------------------------------------------------------------
'╘┌ VISDATA.INI╓╨▒ú┤µ╡▒╟░ VisData ╓╡
'------------------------------------------------------------
Sub SaveINISettings()
  On Error Resume Next

  Dim i As Integer

  SaveSetting APP_CATEGORY, App.Title, "DataType", gsDataType
  SaveSetting APP_CATEGORY, App.Title, "DatabaseName", gsDBName
  SaveSetting APP_CATEGORY, App.Title, "ODBCDatasource", gsODBCDatasource
  SaveSetting APP_CATEGORY, App.Title, "ODBCDatabase", gsODBCDatabase
  SaveSetting APP_CATEGORY, App.Title, "ODBCUserName", gsODBCUserName
  SaveSetting APP_CATEGORY, App.Title, "ODBCPassword", gsODBCPassword
  SaveSetting APP_CATEGORY, App.Title, "ODBCDriver", gsODBCDriver
  SaveSetting APP_CATEGORY, App.Title, "ODBCServer", gsODBCServer
  SaveSetting APP_CATEGORY, App.Title, "QueryTimeout", glQueryTimeout
  SaveSetting APP_CATEGORY, App.Title, "LoginTimeout", glLoginTimeout
  DBEngine.LoginTimeout = glLoginTimeout
  SaveSetting APP_CATEGORY, App.Title, "ViewMode", gnFormType
  SaveSetting APP_CATEGORY, App.Title, "RecordsetType", gnRSType

  SaveSetting APP_CATEGORY, App.Title, "OpenOnStartup", IIf(frmMDI.mnuPOpenOnStartup.Checked, "-1", "0")
  SaveSetting APP_CATEGORY, App.Title, "AllowSys", IIf(frmMDI.mnuPAllowSys.Checked, "-1", "0")

  For i = 1 To 8
    If frmMDI.mnuDBMRU(i).Visible Then
      SaveSetting APP_CATEGORY, App.Title, "MRUDatabase" & i, Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))
      SaveSetting APP_CATEGORY, App.Title, "MRUConnect" & i, frmMDI.mnuDBMRU(i).Tag
    Else
      SaveSetting APP_CATEGORY, App.Title, "MRUDatabase" & i, ""
      SaveSetting APP_CATEGORY, App.Title, "MRUConnect" & i, ""
    End If
  Next

  SaveSetting APP_CATEGORY, App.Title, "WindowState", frmMDI.WindowState
  If frmMDI.WindowState = vbNormal Then
    SaveSetting APP_CATEGORY, App.Title, "WindowTop", frmMDI.Top
    SaveSetting APP_CATEGORY, App.Title, "WindowLeft", frmMDI.Left
    SaveSetting APP_CATEGORY, App.Title, "WindowWidth", frmMDI.Width
    SaveSetting APP_CATEGORY, App.Title, "WindowHeight", frmMDI.Height
  End If
  SaveSetting APP_CATEGORY, App.Title, "ViewMode", gnFormType
  SaveSetting APP_CATEGORY, App.Title, "RecordsetType", gnRSType

End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠ú¼╗∙╙┌╙├╗º╘┌╓≈ MDI ┤░╠σ╔╧╤í╢¿╡─╤í╧εú¼╜½┤≥┐¬╩╩╡▒╡─
'╩²╛▌└α╨═┤░╠σú¼▓ó╘┌╫┤╠¼└╕╓╨╧╘╩╛╩╩╡▒╡─╨┼╧ó
'------------------------------------------------------------
Sub OpenTable(rName As String)
  On Error GoTo OpenTableErr

  Dim rsTmp As Recordset
  Dim sTmp As String
  Dim nAttach As Integer
  Dim frmTmp As Form

  If gsDataType = gsMSACCESS Then   '╚τ╣√╩╟ MDB ▓Θ╒╥╕╜╝╙▒φ
    If (gdbCurrentDB.TableDefs(rName).Attributes And dbAttachedTable) = dbAttachedTable Then
      nAttach = 1
    ElseIf (gdbCurrentDB.TableDefs(rName).Attributes And dbAttachedODBC) = dbAttachedODBC Then
      nAttach = 2
    End If
    If nAttach > 0 And gnRSType = gnRS_TABLE Then
      Beep
      If MsgBox(MSG10, vbYesNo + vbQuestion) = vbYes Then
        frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed         '╓╪╓├╬¬╢»╠¼╝»
      Else
        Exit Sub
      End If
    End If
  End If

  If nAttach > 0 Then
    If gnRSType = gnRS_DYNASET Then
      sTmp = MSG11
    ElseIf gnRSType = gnRS_SNAPSHOT Then
      sTmp = MSG12
    End If
  Else
    If gnRSType = gnRS_TABLE Then
      sTmp = MSG13
    ElseIf gnRSType = gnRS_DYNASET Then
      sTmp = MSG14
    ElseIf gnRSType = gnRS_SNAPSHOT Then
      sTmp = MSG15
    ElseIf gnRSType = gnRS_PASSTHRU Then
      sTmp = MSG16
    End If
  End If

  MsgBar sTmp, True

  Screen.MousePointer = vbHourglass
  If gnRSType = gnRS_TABLE Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenTable)
    sTmp = "Table:"
  ElseIf gnRSType = gnRS_DYNASET Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenDynaset)
    sTmp = "Dynaset:"
  ElseIf gnRSType = gnRS_SNAPSHOT Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot)
    sTmp = "Snapshot:"
  ElseIf gnRSType = gnRS_PASSTHRU Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot, dbSQLPassThrough)
    sTmp = "Passthrough Snapshot:"
  End If
  Screen.MousePointer = vbDefault

  If gnFormType = gnFORM_NODATACTL Then
    If gnRSType = gnRS_TABLE Then
      Set frmTmp = New frmTableObj
      sTmp = "Table:"
    Else
      Set frmTmp = New frmDynaSnap
    End If
  ElseIf gnFormType = gnFORM_DATACTL Then
    Set frmTmp = New frmDataControl
  ElseIf gnFormType = gnFORM_DATAGRID Then
    Set frmTmp = New frmDataGrid
  End If

  Set frmTmp.mrsFormRecordset = rsTmp
  frmTmp.Caption = sTmp & rName
  frmTmp.Show

  MsgBar vbNullString, False

  Exit Sub
OpenTableErr:
  ShowError
End Sub

'------------------------------------------------------------
'╙├╙├╗º╤í╢¿╡─┤░╠σ└α╨═┤≥┐¬╥╗╕÷▓Θ╤»╢¿╥σ
'------------------------------------------------------------
Sub OpenQuery(rName As String, bTemp As Boolean)
  On Error GoTo OpenQueryErr

  Dim sTmp As String
  Dim rsTmp As Recordset
  Dim qdfTmp As QueryDef
  Dim sQueryType As String
  Dim frmTmp As Form

  If bTemp Then
    Set qdfTmp = gdbCurrentDB.CreateQueryDef("", rName)
    If MsgBox(MSG17, vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
      sTmp = InputBox(MSG18)
      If Len(sTmp) > 0 Then
        qdfTmp.Connect = sTmp
      End If
    End If
    '╝┘╔Φ┐¬╩╝╩▒╩╟╖╟╨╨╖╡╗╪
    qdfTmp.ReturnsRecords = False
  Else
    Set qdfTmp = gdbCurrentDB.QueryDefs(rName)
    sQueryType = ActionQueryType(qdfTmp)
    If qdfTmp.Type <> dbQSQLPassThrough Then
      '▓╗╩╟ sql ┤½╡▌ú¼╥≥┤╦╨Φ╥¬╔Φ╓├ ReturnsRecords
      If qdfTmp.Type = 0 Or qdfTmp.Type = dbQCrosstab Then
        qdfTmp.ReturnsRecords = True
      Else
        qdfTmp.ReturnsRecords = False
      End If
    End If
  End If

  If qdfTmp.ReturnsRecords And (gnRSType = gnRS_TABLE) Then
    Beep
    If MsgBox(MSG19, vbYesNo + vbQuestion) = vbYes Then
      frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed         '╓╪╓├╬¬╝╟┬╝╝»
    Else
      Exit Sub
    End If
  End If

  SetQDFParams qdfTmp

  If qdfTmp.ReturnsRecords Then
MakeDynaset:
    Screen.MousePointer = vbHourglass
    If qdfTmp.Type = dbQSQLPassThrough Then
      MsgBar MSG16, True
      Set rsTmp = qdfTmp.OpenRecordset(dbOpenSnapshot, dbSQLPassThrough)
    ElseIf gnRSType = gnRS_SNAPSHOT Then
      MsgBar MSG20, True
      Set rsTmp = qdfTmp.OpenRecordset(dbOpenSnapshot)
    Else
      MsgBar MSG21, True
      Set rsTmp = qdfTmp.OpenRecordset(dbOpenDynaset)
    End If
    Screen.MousePointer = vbDefault

    If gnFormType = gnFORM_NODATACTL Then
      Set frmTmp = New frmDynaSnap
    ElseIf gnFormType = gnFORM_DATACTL Then
      Set frmTmp = New frmDataControl
    ElseIf gnFormType = gnFORM_DATAGRID Then
      Set frmTmp = New frmDataGrid
    End If

    Set frmTmp.mrsFormRecordset = rsTmp
    If Len(qdfTmp.SQL) > 50 Then
      frmTmp.Caption = MSG22
    Else
      frmTmp.Caption = qdfTmp.SQL
    End If
    frmTmp.Show

  Else
    Screen.MousePointer = vbDefault
    If MsgBox(MSG23 & sQueryType & MSG24, vbYesNo + vbQuestion) = vbYes Then
      Screen.MousePointer = vbHourglass
      MsgBar MSG25, True
      qdfTmp.Execute
      If gdbCurrentDB.RecordsAffected > 0 Then
        If gbTransPending Then gbDBChanged = True
      End If
    End If
  End If

  MsgBar vbNullString, False

  Exit Sub
OpenQueryErr:
  If Err = 3065 Or Err = 3078 Then
    '╨╨╖╡╗╪ú¼╩╘╫┼┤┤╜¿╝╟┬╝╝»
    Resume MakeDynaset
  End If
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╘┌ table ║═ dynasnap ┤░╠σ╔╧╧╘╩╛╡▒╟░╨╨╡─
'╦∙╙╨╫╓╢╬╡─╩²╛▌
'------------------------------------------------------------
Sub DisplayCurrentRecord(frm As Object, rec As Recordset, lCnt As Long, bNew As Integer)
  Dim i As Integer
  Dim sCurrStat As String
  Dim lCurrRec As Long
  Dim bNoInd As Integer

  On Error GoTo DCRErr

  Screen.MousePointer = vbHourglass

  sCurrStat = "Row "

  '╝∞▓Θ┐┤╩╟╖±├╗╙╨╦≈╥²╡─▒φ╒²╘┌╩╣╙├
  If rec.Type = dbOpenTable Then
    If gdbCurrentDB(rec.Name).Indexes.Count = 0 Then
      bNoInd = True
    End If
  End If

  '╝∞▓Θ┐╒╝╟┬╝╝»
  If rec.RecordCount > 0 Then
    lCurrRec = (lCnt * (rec.PercentPosition * 0.01)) + 1
  End If

  '╝∞▓Θ BOF/EOF ▒Ω╓╛ú¼╦∙╥╘╛═╓¬╡└
  '╩╟╖±┤ª╘┌╙╨╨º╡─╝╟┬╝╔╧
  If bNew Then
    If bNoInd Then
      sCurrStat = lCnt & " Rows"
    Else
      sCurrStat = lCurrRec & "/" & lCnt
    End If
  Else
    If rec.BOF Then
      sCurrStat = "(BOF)/" & lCnt
      ClearDataFields frm, rec.Fields.Count
    ElseIf rec.EOF Then
      sCurrStat = "(EOF)/" & lCnt
      ClearDataFields frm, rec.Fields.Count
    Else
      If bNoInd Then
        sCurrStat = lCnt & " Rows"
      Else
        sCurrStat = lCurrRec & "/" & lCnt
      End If
      '╘┌┤░╠σ╫╓╢╬╓╨╖┼╓├╩²╛▌
      For i = 0 To rec.Fields.Count - 1
        If rec(i).Type = dbMemo Then
          If rec(i).FieldSize() < gnGETCHUNK_CUTOFF Then
            frm.txtFieldData(i).Text = StripNonAscii(vFieldVal(rec(i)))
          Else
            frm.txtFieldData(i).Text = StripNonAscii(vFieldVal(rec(i).GetChunk(0, gnGETCHUNK_CUTOFF)))
          End If
        ElseIf rec(i).Type = dbText Then
          frm.txtFieldData(i).Text = vFieldVal(rec(i))
        Else
          frm.txtFieldData(i).Text = vFieldVal(rec(i))
        End If
      Next
    End If
  End If
  If rec.Updatable = False Then sCurrStat = sCurrStat & MSG26
  frm.lblStatus.Caption = sCurrStat
  Screen.MousePointer = vbDefault
  Exit Sub

DCRErr:
  ShowError
  Resume Next    '╦∙╥╘╛═┐╔╥╘╩╘╫┼╧╘╩╛╛í┐╔─▄╢α╡─╩²╛▌
End Sub

'------------------------------------------------------------
'╒Γ╕÷║»╩²╝∞▓Θ┐┤┤½╚δ╡─├√│╞╘┌╦ⁿ╒╥╡╜╡─ Tabledefs ╗≥
' Querydefs ╝»║╧╓╨╩╟╖±┤µ╘┌
'╠ß╩╛╔╛│²▓ó╘┌╙├╗º╤í╘±╔╛│²╩▒╖╡╗╪ false
'╗≥╤í╘±▓╗╔╛│²╩▒╖╡╗╪ true
'╚τ╣√╬┤╒╥╡╜ú¼╖╡╗╪ false
'------------------------------------------------------------
Function DupeTableName(rName As String) As Integer
  On Error GoTo DTNErr

  Dim tdf As TableDef
  Dim qdf As QueryDef
  Dim i As Integer

  For Each tdf In gdbCurrentDB.TableDefs
    If UCase(tdf.Name) = UCase(rName) Then
      If MsgBox(MSG27, vbYesNo + vbQuestion) = vbYes Then
        gdbCurrentDB.TableDefs.Delete rName
        DupeTableName = False
      Else
        DupeTableName = True
      End If
      Exit Function
    End If
  Next

  If gsDataType = gsMSACCESS Then
    For Each qdf In gdbCurrentDB.QueryDefs
      If UCase(qdf.Name) = UCase(rName) Then
        If MsgBox(MSG28, vbYesNo + vbQuestion) = vbYes Then
          gdbCurrentDB.QueryDefs.Delete rName
          DupeTableName = False
        Else
          DupeTableName = True
        End If
        Exit Function
      End If
    Next
  End If

  DupeTableName = False
  Exit Function

DTNErr:
  ShowError
  DupeTableName = False
End Function

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╨╢╘╪│² SQLíóTables ║═ MDI ╓«═Γ╡─╦∙╙╨┤░╠σ
'------------------------------------------------------------
Sub UnloadAllForms()
  On Error Resume Next

  Dim i As Integer

  '╣╪▒╒│² Tables ║═ SQL ┤░╠σ╥╘═Γ╡─╦∙╙╨┤░╠σ
  For i = Forms.Count - 1 To 1 Step -1
    Unload Forms(i)
  Next
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠▒Θ└·▓╬╩²▓Θ╤»╡─╦∙╙╨▓╬╩²╝»║╧ú¼▓ó
'╠ß╩╛╙├╗º╢╘├┐╕÷▓╬╩²╩Σ╚δ╥╗╕÷╓╡
'------------------------------------------------------------
Sub SetQDFParams(rqdf As QueryDef)
  On Error GoTo SPErr

  Dim prm As Parameter
  Dim sTmp As String

  For Each prm In rqdf.Parameters
    '┤╙╙├╗º─╟└∩╡├╡╜╓╡
    sTmp = InputBox(MSG29, "'" & prm.Name & "':")
    '┤µ┤ó╒Γ╕÷╓╡
    prm.Value = CVar(sTmp)
  Next

  Exit Sub

SPErr:
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╙├╫ε╜ⁿ│÷╧╓╡─┤φ╬≤╦ó╨┬ Error ┤░╠σ
'------------------------------------------------------------
Sub RefreshErrors()
  On Error GoTo RErr

  Dim errObj As Error
  Dim i As Integer

  If DBEngine.Errors.Count = 0 Then
    MsgBox MSG30, 48
    Unload frmErrors
    Exit Sub
  End If

  frmErrors.Show
  frmErrors.lstErrors.Clear
  For i = 0 To DBEngine.Errors.Count - 1
    Set errObj = DBEngine.Errors(i)
    frmErrors.lstErrors.AddItem errObj.Number & vbTab & errObj.Source & vbTab & errObj.Description
  Next
  frmErrors.SetFocus

  Exit Sub

RErr:
  MsgBox MSG31, 48
  Unload frmErrors
  Exit Sub
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠░╤╕╒╕╒┤≥┐¬╡─╩²╛▌┐Γ╠φ╝╙╡╜í░╬─╝■í▒▓╦╡Ñ╡─
'╫ε╜ⁿ╩╣╙├┴╨▒φ╓╨
'------------------------------------------------------------
Sub AddMRU()
  On Error GoTo AMErr

  Dim i As Integer, j As Integer

  '╩╫╧╚ú¼┐┤╩╟╖±╥╤╛¡┤µ╘┌ú¼╚τ╣√┤µ╘┌╛═╜╗╗╗╥╗╧┬
  For i = 1 To 8
    If UCase(Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))) = UCase(gsDBName) Then
      For j = i To 2 Step -1
        frmMDI.mnuDBMRU(j).Caption = "&" & j & " " & Mid(frmMDI.mnuDBMRU(j - 1).Caption, 4, Len(frmMDI.mnuDBMRU(j - 1).Caption))
        frmMDI.mnuDBMRU(j).Tag = frmMDI.mnuDBMRU(j - 1).Tag
      Next
      GoTo Finish
    End If
  Next

  '▓╗┤µ╘┌ú¼╦∙╥╘├┐╥╗╠⌡╧≥╧┬╥╞╥╗▓╜
  For i = 7 To 1 Step -1
    frmMDI.mnuDBMRU(i + 1).Caption = "&" & i + 1 & " " & Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))
    frmMDI.mnuDBMRU(i + 1).Tag = frmMDI.mnuDBMRU(i).Tag
  Next

Finish:
  frmMDI.mnuDBMRU(1).Caption = "&1 " & gsDBName
  If Len(gdbCurrentDB.Connect) = 0 Then
    '┤ª└φ Access ├╗╙╨┴¼╜╙╫╓╖√┤«╡─╟Θ┐÷
    frmMDI.mnuDBMRU(1).Tag = gsMSACCESS
  Else
    frmMDI.mnuDBMRU(1).Tag = gdbCurrentDB.Connect
  End If
  frmMDI.mnuBarMRU.Visible = True
  For i = 1 To 8
    If Len(Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))) > 0 Then
      frmMDI.mnuDBMRU(i).Visible = True
    End If
  Next

  Exit Sub

AMErr:
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠┤≥╢╧ ODBC ┴¼╜╙╫╓╖√┤«╡─╕≈╕÷▓┐╖╓ú¼
'▓ó╜½╦ⁿ├╟╕│╓╡╕°╚½╛╓ ODBC ▒Σ┴┐
'------------------------------------------------------------
Sub GetODBCConnectParts(rsConnect As String)
  On Error Resume Next

  Dim i As Integer
  Dim sTmp As String

  '╛═╘┌ ODBC ╢╘╗░┐≥╖╡╗╪╓╡╡─╟Θ┐÷╧┬┤ª└φ┴¼╜╙╫╓╖√┤«
  If InStr(rsConnect, "=") Then
    i = 1
    While i <= Len(rsConnect) + 1
      If Mid(rsConnect, i, 1) = ";" Or i = Len(rsConnect) + 1 Then
        If Len(sTmp) > 0 And InStr(sTmp, "=") > 0 Then
          Select Case Mid(sTmp, 1, InStr(1, sTmp, "=") - 1)
            Case "DSN"
              gsODBCDatasource = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "DATABASE"
              gsODBCDatabase = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "DBQ"
              gsODBCDatabase = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "UID"
              gsODBCUserName = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "PWD"
              gsODBCPassword = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "Driver"
              gsODBCDriver = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            Case "Server"
              gsODBCServer = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
             Case Else
              '┐╒
          End Select
        End If
        sTmp = vbNullString
      Else
        sTmp = sTmp + Mid(rsConnect, i, 1)
      End If
      i = i + 1
    Wend
  End If
End Sub

'------------------------------------------------------------
'╒Γ╩╟╥╗╕÷╥╗░π╡─╫╙╣²│╠ú¼╦ⁿ░╤╥╗╕÷╝»║╧╓╨╡─├┐╥╗╧ε├√│╞
'╠φ╝╙╡╜┤½╚δ╡─┐╪╝■╓╨
'------------------------------------------------------------
Sub ListItemNames(rcCollection As Object, rnCtl As Control, bClearList As Integer)
  On Error GoTo LINErr

  Dim objTmp As Object
  Dim i As Integer

  If bClearList Then
    rnCtl.Clear
  End If

  For Each objTmp In rcCollection
    rnCtl.AddItem objTmp.Name
  Next

  Exit Sub

LINErr:
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╣╪▒╒╡▒╟░╩²╛▌┐Γú¼▓ó╟╥╓┤╨╨▒╪╥¬╡─╟σ│²
'║═┐╪╝■íó▓╦╡Ñ╡╚╡─╓╪╓├
'------------------------------------------------------------
Sub CloseCurrentDB()
  On Error GoTo DBCloseErr

  If gdbCurrentDB Is Nothing Then Exit Sub

  If gbDBChanged Then
    If MsgBox(MSG32, vbYesNo + vbQuestion) = vbYes Then
      gwsMainWS.CommitTrans
      gbDBChanged = False
    Else
      If MsgBox(MSG33, vbYesNo + vbQuestion) = vbYes Then
        gwsMainWS.Rollback
        gbDBChanged = False
      Else
        Beep
        MsgBox MSG34, 48
        Exit Sub
      End If
    End If
  End If

  frmMDI.Caption = "VisData"

  HideDBTools

  gbDBOpenFlag = False
  gbTransPending = False
  gsDBName = vbNullString
  gnReadOnly = False

  gdbCurrentDB.Close
  Set gdbCurrentDB = Nothing
  UnloadAllForms

  Exit Sub

DBCloseErr:
  ShowError
End Sub

'------------------------------------------------------------
'------------------------------------------------------------
Sub OpenLocalDB(bSilent As Boolean)
  On Error GoTo OpenError

  Dim sConnect As String
  Dim sDatabaseName As String
  Dim dbTemp As Database
  Dim sTmp As String

  sDatabaseName = gsDBName

  If Not bSilent Then
    Select Case gsDataType
      Case gsMSACCESS
        frmMDI.dlgCMD1.Filter = MSG49 & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG36
      Case gsDBASEIII, gsDBASEIV, gsDBASE5
        frmMDI.dlgCMD1.Filter = "Dbase ╩²╛▌┐Γ (*.dbf)|*.dbf" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG37
      Case gsFOXPRO20, gsFOXPRO25, gsFOXPRO26, gsFOXPRO30
        frmMDI.dlgCMD1.Filter = "FoxPro ╩²╛▌┐Γ (*.dbf)|*.dbf" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG38
      Case gsPARADOX3X, gsPARADOX4X, gsPARADOX5X
        frmMDI.dlgCMD1.Filter = "Paradox ╩²╛▌┐Γ (*.db)|*.db" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG39
      Case gsEXCEL50
        frmMDI.dlgCMD1.Filter = "Excel ╬─╝■ (*.xls)|*.xls" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG40
      Case gsBTRIEVE
        frmMDI.dlgCMD1.Filter = "Btrieve ╩²╛▌┐Γ (FILE.DDF)|FILE.DDF" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG41
      Case gsTEXTFILES
        frmMDI.dlgCMD1.Filter = "╬─▒╛╬─╝■ (*.txt)|*.txt" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG42
    End Select

    frmMDI.dlgCMD1.FilterIndex = 1
    frmMDI.dlgCMD1.FileName = gsDBName  '""
    frmMDI.dlgCMD1.CancelError = True
    frmMDI.dlgCMD1.Flags = FileOpenConstants.cdlOFNFileMustExist
    frmMDI.dlgCMD1.ShowOpen

    If Len(frmMDI.dlgCMD1.FileName) > 0 Then
      gsDBName = frmMDI.dlgCMD1.FileName
    Else
      Exit Sub
    End If
  Else
    gsDBName = sDatabaseName
  End If

  If Len(gsDBName) = 0 Then
    MsgBar vbNullString, False
    Exit Sub
  End If

  MsgBar MSG43, True
  Screen.MousePointer = vbHourglass

  '╔Φ╓├┴¼╜╙╫╓╖√┤«
  If gsDataType = gsMSACCESS Then
    sConnect = vbNullString
  Else
    sConnect = gsDataType
  End If

  '╬¬╣½╣▓╢╘╗░┐≥╖╡╗╪╡─╖╟ Microsoft Access ║═ Btrieve
  '╩²╛▌┐Γ╔Φ╓├╩²╛▌┐Γ├√│╞
  If gsDataType <> gsMSACCESS And gsDataType <> gsBTRIEVE And _
     gsDataType <> gsEXCEL50 And (Not bSilent) Then
    '╨Φ╥¬╬¬╒Γ╨⌐╩²╛▌┐Γ╚Ñ╡⌠╬─╝■├√
    sDatabaseName = StripFileName(gsDBName)
    gsDBName = sDatabaseName
  Else
    sDatabaseName = gsDBName
  End If

  GoTo OneMoreTry

GetPWD:
  Dim frmPWD As New frmDBPWD
  frmPWD.Show vbModal
  If Len(frmPWD.PWD) > 0 Then
    sConnect = ";pwd=" & frmPWD.PWD
    Unload frmPWD
    Set frmPWD = Nothing
    MsgBar MSG43, True
    Screen.MousePointer = vbHourglass
  Else
    '╚í╧√┴╦├▄┬δ╢╘╗░┐≥ú¼╦∙╥╘╨Φ╥¬═╦│÷
    Unload frmPWD
    Set frmPWD = Nothing
    Exit Sub
  End If

OneMoreTry:
  If (frmMDI.dlgCMD1.Flags And FileOpenConstants.cdlOFNReadOnly) = FileOpenConstants.cdlOFNReadOnly Then
    gnReadOnly = True
  Else
    gnReadOnly = False
  End If
  Set dbTemp = gwsMainWS.OpenDatabase(sDatabaseName, False, gnReadOnly, sConnect)
  If gbDBOpenFlag Then
    '▒ú┤µ╩²╛▌┐Γ├√│╞
    sTmp = gsDBName
    '╗╓╕┤╦ⁿ
    CloseCurrentDB
    gsDBName = sTmp
    If gbDBOpenFlag Then
      Beep
      MsgBox MSG35, 48
      Exit Sub
    End If
  End If

  '│╔╣ª
  frmMDI.Caption = "VisData:" & sDatabaseName
  Set gdbCurrentDB = dbTemp
  gbDBOpenFlag = True
  ShowDBTools
  RefreshTables Nothing
  gdbCurrentDB.QueryTimeout = glQueryTimeout

  AddMRU
  If gsDataType <> gsMSACCESS Then
    MsgBar MSG44, False
  End If
  Screen.MousePointer = vbDefault

  Exit Sub

AttemptRepair:
  Screen.MousePointer = vbHourglass
  MsgBar MSG45 & gsDBName, True
  DBEngine.RepairDatabase gsDBName
  Screen.MousePointer = vbDefault
  GoTo OneMoreTry

OpenError:
  Screen.MousePointer = vbDefault
  If Err = 3049 Then
    If MsgBox(Err.Description & vbCrLf & vbCrLf & MSG46, 4 + 48) = vbYes Then
      Resume AttemptRepair
    End If
  ElseIf Err = 3031 Then
    '├▄┬δ▒ú╗ñ╡─╩²╛▌┐Γ
    Resume GetPWD
  End If
  gbDBOpenFlag = False
  gsDBName = vbNullString
  gsDataType = vbNullString
  gsODBCDatabase = vbNullString
  gsODBCUserName = vbNullString
  gsODBCPassword = vbNullString
  gsODBCDriver = vbNullString
  gsODBCServer = vbNullString
  If Err <> 32755 And Err <> 3049 Then   '╝∞▓Θ╚í╧√╡─╣½╣▓╢╘╗░┐≥
    ShowError
  End If
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╙├╙┌╬¬▒╛╡╪ ISAM ╩²╛▌└α╨═┤┤╜¿╥╗╕÷╨┬─┐┬╝
'------------------------------------------------------------
Sub NewLocalISAM()
   On Error GoTo NewISAMErr

   Dim sNewName As String
   Dim d As Database

GetNewDirName:
   sNewName = InputBox(MSG47, , sNewName)
   If Len(sNewName) = 0 Then Exit Sub

   If Mid(sNewName, Len(sNewName), 1) <> "\" Then sNewName = sNewName & "\"

   MkDir Mid(sNewName, 1, Len(sNewName) - 1)

   gsDBName = sNewName
   OpenLocalDB True

   If gbDBOpenFlag Then
     ShowDBTools
     RefreshTables Nothing
   End If

  Exit Sub

NewISAMErr:
  If Err = 75 Then Resume Next  '▓╢╫╜─┐┬╝┤µ╘┌╡─╟Θ┐÷
  If Err = 76 Then
    MsgBox MSG65, vbExclamation
    '╧╓╘┌ú¼╘┘╩╘╥╗┤╬
    Resume GetNewDirName
  End If
  ShowError
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠┤╙╓≈ MDI ┤░╠σ╔╧╡─í░╤╣╦⌡í▒▓╦╡Ñ╤í╧ε╓╨╡≈╙├
'------------------------------------------------------------
Sub CompactDB(rnCompactVersion As Integer)
  On Error GoTo CompactAccErr

  Dim sOldName As String
  Dim sNewName As String
  Dim sNewName2 As String
  Dim nEncrypt As Integer

  '╗±╡├╥¬╤╣╦⌡╡─╬─╝■├√
  frmMDI.dlgCMD1.Filter = MSG49
  frmMDI.dlgCMD1.DialogTitle = MSG48
  frmMDI.dlgCMD1.FilterIndex = 1
  frmMDI.dlgCMD1.Flags = FileOpenConstants.cdlOFNHideReadOnly
  frmMDI.dlgCMD1.ShowOpen
  If Len(frmMDI.dlgCMD1.FileName) > 0 Then
    sOldName = frmMDI.dlgCMD1.FileName
  Else
    Exit Sub
  End If

  '╗±╡├╥¬╤╣╦⌡╡╜╡─╬─╝■├√
  frmMDI.dlgCMD1.DialogTitle = MSG51
  frmMDI.dlgCMD1.FilterIndex = 1
  frmMDI.dlgCMD1.FileName = vbNullString
  frmMDI.dlgCMD1.CancelError = True
  frmMDI.dlgCMD1.Flags = FileOpenConstants.cdlOFNOverwritePrompt + FileOpenConstants.cdlOFNHideReadOnly
  frmMDI.dlgCMD1.ShowSave
  If Len(frmMDI.dlgCMD1.FileName) > 0 Then
    sNewName = frmMDI.dlgCMD1.FileName
    If Dir(sNewName) <> vbNullString And sOldName <> sNewName Then
      Kill sNewName
    End If
  Else
    Exit Sub
  End If

  If MsgBox(MSG52, vbYesNo + vbQuestion) = vbYes Then
    nEncrypt = dbEncrypt
  Else
    nEncrypt = dbDecrypt
  End If

  Screen.MousePointer = vbHourglass
  MsgBar MSG53 & sOldName & " -> " & sNewName, True
  '╚τ╣√╧δ╕▓╕╟═¼╥╗╕÷╬─╝■ú¼╨Φ╥¬┤┤╜¿╥╗╕÷╨┬╡─ MDB
  '▓ó╘┌╤╣╦⌡│╔╣ª║≤╕ⁿ├√
  If sOldName = sNewName Then
    sNewName2 = sNewName '▒ú┤µ╨┬├√
    sNewName = Left(sNewName, Len(sNewName) - 1) & "N"
  End If

  DBEngine.CompactDatabase sOldName, sNewName, dbLangGeneral, rnCompactVersion + nEncrypt

  '╝∞▓Θ╘¡└┤ mdb ╡─╕▓╕╟
  If VBA.Right(sNewName, 1) = "N" Then
    Kill sNewName2             '╔╛╡⌠╛╔╡─
    Name sNewName As sNewName2 '░╤╨┬╡─╕─╬¬╘¡└┤╡─├√│╞
    sNewName = sNewName2       '╓╪╓├╬¬╒²╚╖╡─├√│╞
  End If

  MsgBar vbNullString, False
  Screen.MousePointer = vbDefault

  If MsgBox(MSG54, vbYesNo + vbQuestion) = vbYes Then
    If gbDBOpenFlag Then
      CloseCurrentDB
    End If
    gsDataType = gsMSACCESS
    gsDBName = sNewName
    OpenLocalDB True
  End If

  If gbDBOpenFlag Then
    ShowDBTools
    RefreshTables Nothing
  End If

  Exit Sub

CompactAccErr:
  If Err <> 32755 Then         '╙├╗º╚í╧√┴╦
    ShowError
  End If
End Sub

'------------------------------------------------------------
'╒Γ╕÷╫╙╣²│╠╫÷╥╗╨⌐╟σ│²╣ñ╫≈▓ó╣╪▒╒ VisData
'------------------------------------------------------------
Sub ShutDownVisData()
  On Error Resume Next

  Dim nRet As Integer

  '▒ú┤µ╦∙╙╨╡▒╟░ INI ╬─╝■╡─╔Φ╓├╓╡
  SaveINISettings

  If gbDBChanged Then
    If MsgBox(MSG32, vbYesNo + vbQuestion) = vbYes Then
      gwsMainWS.CommitTrans
    End If
  End If

  UnloadAllForms
  gdbCurrentDB.Close
  '╣╪▒╒░∩╓·╬─╝■
  nRet = OSWinHelp(frmMDI.hwnd, App.HelpFile, HelpConstants.cdlHelpQuit, 0)

  End

End Sub
Sub NewMDB(rnVersion As Integer)
  On Error GoTo NewAccErr

  Dim sNewName As String
  Dim db As Database

  '╗±╡├╤╣╦⌡╡╜╡─╬─╝■├√
  frmMDI.dlgCMD1.DialogTitle = MSG55
  frmMDI.dlgCMD1.FilterIndex = 1
  frmMDI.dlgCMD1.Filter = MSG49
  frmMDI.dlgCMD1.FileName = vbNullString
  frmMDI.dlgCMD1.CancelError = True
  frmMDI.dlgCMD1.Flags = FileOpenConstants.cdlOFNOverwritePrompt + FileOpenConstants.cdlOFNHideReadOnly
  frmMDI.dlgCMD1.ShowSave
  If Len(frmMDI.dlgCMD1.FileName) > 0 Then
    sNewName = frmMDI.dlgCMD1.FileName
    If InStr(sNewName, ".") = 0 Then
      '╚τ╣√╬┤╩╣╙├└⌐╒╣├√ú¼╠φ╝╙└⌐╒╣├√
      sNewName = sNewName & ".MDB"
    End If
    If Dir(sNewName) <> vbNullString Then
      Kill sNewName
    End If
  Else
    Exit Sub
  End If
  If Len(sNewName) = 0 Then Exit Sub

  Set db = CreateDatabase(sNewName, dbLangGeneral, rnVersion)
  db.Close

  gsDataType = gsMSACCESS
  gsDBName = sNewName
  OpenLocalDB True
  Exit Sub

NewAccErr:
  If Err <> 32755 Then         '╙├╗º╚í╧√┴╦
    ShowError
  End If
End Sub

Sub Export(rsFromTbl As String, rsToDB As String)

  On Error GoTo ExpErr

  Dim sConnect As String
  Dim sNewTblName As String
  Dim sDBName As String
  Dim nErrState As Integer
  Dim idxFrom As Index
  Dim idxTo As Index
  Dim sSQL As String              'sql ╫╓╖√┤«╡─╛╓▓┐┐╜▒┤
  Dim sField As String
  Dim sFrom As String
  Dim sTmp As String
  Dim i As Integer

  If gnDataType = gnDT_SQLDB Then
    Set gExpDB = gwsMainWS.OpenDatabase(vbNullString, 0, 0, "odbc;")
    If gExpDB Is Nothing Then Exit Sub
  End If

  MsgBar MSG56 & "'" & rsFromTbl & "'", True

  nErrState = 1
  Select Case gnDataType
    Case gnDT_MSACCESS
      sConnect = "[;database=" & rsToDB & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(rsToDB)
    Case gnDT_PARADOX3X
      sDBName = StripFileName(rsToDB)
      sConnect = "[Paradox 3.X;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsPARADOX3X)
    Case gnDT_PARADOX4X
      sDBName = StripFileName(rsToDB)
      sConnect = "[Paradox 4.X;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsPARADOX4X)
    Case gnDT_FOXPRO26
      sDBName = StripFileName(rsToDB)
      sConnect = "[FoxPro 2.6;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO26)
    Case gnDT_FOXPRO25
      sDBName = StripFileName(rsToDB)
      sConnect = "[FoxPro 2.5;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO25)
    Case gnDT_FOXPRO20
      sDBName = StripFileName(rsToDB)
      sConnect = "[FoxPro 2.0;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO20)
    Case gnDT_DBASEIV
      sDBName = StripFileName(rsToDB)
      sConnect = "[dBase IV;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsDBASEIV)
    Case gnDT_DBASEIII
      sDBName = StripFileName(rsToDB)
      sConnect = "[dBase III;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsDBASEIII)
    Case gnDT_BTRIEVE
      sConnect = "[Btrieve;database=" & rsToDB & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(rsToDB, 0, 0, gsBTRIEVE)
    Case gnDT_EXCEL50, gnDT_EXCEL40, gnDT_EXCEL30
      sConnect = "[Excel 5.0;database=" & rsToDB & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(rsToDB, 0, 0, gsEXCEL50)
    Case gnDT_SQLDB
      sConnect = "[" & gExpDB.Connect & "]."
    Case gnDT_TEXTFILE
      sDBName = StripFileName(rsToDB)
      sConnect = "[Text;database=" & StripFileName(rsToDB) & "]."
      Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsTEXTFILES)
  End Select
  If gnDataType = gnDT_MSACCESS Or gnDataType = gnDT_BTRIEVE Or _
     gnDataType = gnDT_SQLDB Or gnDataType = gnDT_EXCEL50 Or _
     gnDataType = gnDT_EXCEL40 Or gnDataType = gnDT_EXCEL30 Then
    With frmExpName
      .Label1.Caption = MSG57 & rsFromTbl & " ->"
      .Label2.Caption = MSG58 & rsToDB
      .txtTable.Text = rsFromTbl
    End With
    frmExpName.Show vbModal

    If Len(gExpTable) = 0 Then
      MsgBar vbNullString, False
      Exit Sub
    Else
      sNewTblName = gExpTable
    End If
  Else
    '╡├╡╜╬─╝■├√╡─▒φ▓┐╖╓
    '╚Ñ╡⌠┬╖╛╢
    For i = Len(rsToDB) To 1 Step -1
      If Mid(rsToDB, i, 1) = "\" Then
        Exit For
      End If
    Next
    sTmp = Mid(rsToDB, i + 1, Len(rsToDB))
    '╚Ñ╡⌠└⌐╒╣├√
    For i = 1 To Len(sTmp)
      If Mid(sTmp, i, 1) = "." Then
        Exit For
      End If
    Next
    sNewTblName = Left(sTmp, i - 1)
  End If
  Screen.MousePointer = vbHourglass
  If Len(rsFromTbl) > 0 Then
    gdbCurrentDB.Execute "select * into " & sConnect & StripOwner(sNewTblName) & " from " & StripOwner(rsFromTbl)

    If gnDataType <> gnDT_TEXTFILE Then
      nErrState = 2
      MsgBar MSG59 & " '" & sNewTblName & "'", True
      gExpDB.TableDefs.Refresh
      For Each idxFrom In gdbCurrentDB.TableDefs(rsFromTbl).Indexes
        Set idxTo = gExpDB.TableDefs(sNewTblName).CreateIndex(idxFrom.Name)
        With idxTo
          .Fields = idxFrom.Fields
          .Unique = idxFrom.Unique
          If gnDataType <> gnDT_SQLDB And gsDataType <> "ODBC" Then
            .Primary = idxFrom.Primary
          End If
        End With
        gExpDB.TableDefs(sNewTblName).Indexes.Append idxTo
      Next
    End If
    MsgBar vbNullString, False
    Screen.MousePointer = vbDefault
    MsgBox MSG60 & " '" & rsFromTbl & "'", 64
  Else
    sSQL = frmSQL.txtSQLStatement.Text
    sField = Mid(sSQL, 8, InStr(8, UCase(sSQL), "FROM") - 9)
    sFrom = " " & Mid(sSQL, InStr(UCase(sSQL), "FROM"), Len(sSQL))
    gdbCurrentDB.Execute "select " & sField & " into " & sConnect & sNewTblName & sFrom

    Screen.MousePointer = vbDefault
    MsgBar vbNullString, False
    MsgBox MSG61, 64
  End If

  Exit Sub

ExpErr:
  If Err = 3010 Then      '▒φ┤µ╘┌
    If MsgBox(MSG62, 32 + 1 + 256) = 1 Then
      gExpDB.TableDefs.Delete sNewTblName
      Resume
    Else
      Screen.MousePointer = vbDefault
      MsgBar vbNullString, False
      Exit Sub
    End If
  End If

  '╚τ╣√▓╗─▄┤┤╜¿╦≈╥²ú¼╔╛│²╨┬▒φ
  If nErrState = 2 Then
    gExpDB.TableDefs.Delete sNewTblName
  End If
  ShowError
End Sub

Sub Import(rsImpTblName As String)
  On Error GoTo ImpErr

  Dim sOldTblName As String, sNewTblName As String, sConnect As String
  Dim idxFrom As Index
  Dim idxTo As Index
  Dim nErrState As Integer
  Dim i As Integer

  sOldTblName = MakeTableName(rsImpTblName, False)
  sNewTblName = MakeTableName(rsImpTblName, True)

  Screen.MousePointer = vbHourglass
  MsgBar MSG63 & "'" & sNewTblName & "'", True

  nErrState = 1
  Select Case gnDataType
    Case gnDT_MSACCESS
      sConnect = "[;database=" & gImpDB.Name & "]."
    Case gnDT_PARADOX3X
      sConnect = "[Paradox 3.X;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsPARADOX3X)
    Case gnDT_PARADOX4X
      sConnect = "[Paradox 4.X;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsPARADOX4X)
    Case gnDT_FOXPRO26
      sConnect = "[FoxPro 2.6;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO26)
    Case gnDT_FOXPRO25
      sConnect = "[FoxPro 2.5;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO25)
    Case gnDT_FOXPRO20
      sConnect = "[FoxPro 2.0;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO20)
    Case gnDT_DBASEIV
      sConnect = "[dBase IV;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsDBASEIV)
    Case gnDT_DBASEIII
      sConnect = "[dBase III;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsDBASEIII)
    Case gnDT_BTRIEVE
      sConnect = "[Btrieve;database=" & gImpDB.Name & "]."
    Case gnDT_EXCEL50, gnDT_EXCEL40, gnDT_EXCEL30
      sConnect = "[Excel 5.0;database=" & gImpDB.Name & "]."
    Case gnDT_SQLDB
      sConnect = "[" & gImpDB.Connect & "]."
    Case gnDT_TEXTFILE
      sConnect = "[Text;database=" & StripFileName(rsImpTblName) & "]."
      Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsTEXTFILES)
  End Select
  gdbCurrentDB.Execute "select * into " & sNewTblName & " from " & sConnect & sOldTblName

  If gnDataType <> gnDT_TEXTFILE And gnDataType <> gnDT_EXCEL50 And _
     gnDataType <> gnDT_EXCEL40 And gnDataType <> gnDT_EXCEL30 Then
    nErrState = 2
    MsgBar gdbCurrentDB.RecordsAffected & " ╨╨╥╤╡╝╚δú¼╒²╘┌╬¬ '" & sNewTblName & "'┤┤╜¿╦≈╥²íú", True
    gdbCurrentDB.TableDefs.Refresh
    For Each idxFrom In gImpDB.TableDefs(sOldTblName).Indexes
      Set idxTo = gdbCurrentDB.TableDefs(sNewTblName).CreateIndex(idxFrom.Name)
      With idxTo
        .Fields = idxFrom.Fields
        .Unique = idxFrom.Unique
        If gnDataType <> gnDT_SQLDB And gsDataType <> gsSQLDB Then
          .Primary = idxFrom.Primary
        End If
      End With
      gdbCurrentDB.TableDefs(sNewTblName).Indexes.Append idxTo
    Next
  End If

  frmImpExp.lstTables.AddItem sNewTblName
'  frmTables.lstTables.AddItem sNewTblName
  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  MsgBox MSG64 & "'" & sNewTblName & "'.", 64

  Exit Sub

NukeNewTbl:
  On Error Resume Next  '╩º░▄╡─╟Θ┐÷
  gdbCurrentDB.TableDefs.Delete sNewTblName
  ShowError
  Exit Sub

ImpErr:
  '╚τ╣√▓╗─▄┤┤╜¿╦≈╥²ú¼╔╛│²╨┬▒φ
  If nErrState = 2 Then
    Resume NukeNewTbl
  End If
  ShowError
End Sub

Function MakeTableName(fname As String, newname As Integer) As String
  On Error Resume Next
  Dim i As Integer, t As Integer
  Dim tmp As String

  If gnDataType = gnDT_SQLDB And newname Then
    i = InStr(1, fname, ".")
    If i > 0 Then
      tmp = Mid(fname, 1, i - 1) & "_" & Mid(fname, i + 1, Len(fname))
    End If
  ElseIf InStr(fname, "\") > 0 Then
    '╚Ñ╡⌠┬╖╛╢
    For i = Len(fname) To 1 Step -1
      If Mid(fname, i, 1) = "\" Then
        Exit For
      End If
    Next
    tmp = Mid(fname, i + 1, Len(fname))
    i = InStr(1, tmp, ".")
    If i > 0 Then
      tmp = Mid(tmp, 1, i - 1)
    End If
  Else
    tmp = fname
  End If

  If newname Then
    If DupeTableName(tmp) Then
      t = 1
      While DupeTableName(tmp + CStr(t))
        t = t + 1
      Wend
      tmp = tmp + CStr(t)
    End If
  End If

  MakeTableName = tmp

End Function