Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const MSG1 = "Execute Commit or Rollback First."
'ResMe Converted To A Property: Const MSG2 = "Closing Recordsets"
'ResMe Converted To A Property: Const MSG3 = "Table already exists, delete it?"
'ResMe Converted To A Property: Const MSG4 = "Enter New Table Name:"
'ResMe Converted To A Property: Const MSG5 = "Ready"
'ResMe Converted To A Property: Const MSG6 = ", please wait..."
'ResMe Converted To A Property: Const MSG7 = "Refreshing Table List"
'ResMe Converted To A Property: Const MSG8 = "Number: "
'ResMe Converted To A Property: Const MSG9 = "Display the Data Access Errors Collection?"
'ResMe Converted To A Property: Const MSG10 = "Can't Open a Table Object on an Attached Table, Use Dynaset?"
'ResMe Converted To A Property: Const MSG11 = "Opening Attached Table as Dynaset"
'ResMe Converted To A Property: Const MSG12 = "Opening Attached Table as Snapshot"
'ResMe Converted To A Property: Const MSG13 = "Opening Full Table"
'ResMe Converted To A Property: Const MSG14 = "Opening Single Table Dynaset"
'ResMe Converted To A Property: Const MSG15 = "Opening Single Table Snapshot"
'ResMe Converted To A Property: Const MSG16 = "Opening PassThru Snapshot"
'ResMe Converted To A Property: Const MSG17 = "Is this a SQLPassThrough Query?"
'ResMe Converted To A Property: Const MSG18 = "Enter Connect property value:"
'ResMe Converted To A Property: Const MSG19 = "Can't Open a Table Object from a QueryDef, Use Dynaset?"
'ResMe Converted To A Property: Const MSG20 = "Opening Query Snapshot"
'ResMe Converted To A Property: Const MSG21 = "Opening Query Dynaset"
'ResMe Converted To A Property: Const MSG22 = "SQL Statement"
'ResMe Converted To A Property: Const MSG23 = "Execute "
'ResMe Converted To A Property: Const MSG24 = " Query?"
'ResMe Converted To A Property: Const MSG25 = "Executing Query"
'ResMe Converted To A Property: Const MSG26 = "  [Not Updatable]"
'ResMe Converted To A Property: Const MSG27 = "Table already exists, Delete it?"
'ResMe Converted To A Property: Const MSG28 = "QueryDef already exists, Delete it?"
'ResMe Converted To A Property: Const MSG29 = "Enter Value for Parameter:"
'ResMe Converted To A Property: Const MSG30 = "There are no current data access errors!"
'ResMe Converted To A Property: Const MSG31 = "Can't show Errors at this time!"
'ResMe Converted To A Property: Const MSG32 = "Data has been changed, Commit it?"
'ResMe Converted To A Property: Const MSG33 = "RollBack All changes?"
'ResMe Converted To A Property: Const MSG34 = "Can't Close with Transactions Pending!"
'ResMe Converted To A Property: Const MSG35 = "You must Close First!"
'ResMe Converted To A Property: Const MSG36 = "Open Microsoft Access Database"
'ResMe Converted To A Property: Const MSG37 = "Open Dbase Database"
'ResMe Converted To A Property: Const MSG38 = "Open FoxPro Database"
'ResMe Converted To A Property: Const MSG39 = "Open Paradox Database"
'ResMe Converted To A Property: Const MSG40 = "Open Excel File"
'ResMe Converted To A Property: Const MSG41 = "Open Btrieve Database"
'ResMe Converted To A Property: Const MSG42 = "Open Text Database"
'ResMe Converted To A Property: Const MSG43 = "Opening Database"
'ResMe Converted To A Property: Const MSG44 = "NOTE: Use of Attached Tables is the Recommended Method"
'ResMe Converted To A Property: Const MSG45 = "Repairing "
'ResMe Converted To A Property: Const MSG46 = "Attempt to Repair it?"
'ResMe Converted To A Property: Const MSG47 = "Enter Directory Name for New ISAM Database:"
'ResMe Converted To A Property: Const MSG48 = "Select Microsoft Access Database to Compact"
'ResMe Converted To A Property: Const MSG49 = "Microsoft Access MDBs (*.mdb)|*.mdb"
'ResMe Converted To A Property: Const MSG50 = "|All Files (*.*)|*.*"
'ResMe Converted To A Property: Const MSG51 = "Select Microsoft Access Database to Compact to"
'ResMe Converted To A Property: Const MSG52 = "Encrypt Compacted Database?"
'ResMe Converted To A Property: Const MSG53 = "Compacting "
'ResMe Converted To A Property: Const MSG54 = "Open Newly Compacted Database?"
'ResMe Converted To A Property: Const MSG55 = "Select Microsoft Access Database to Create"
'ResMe Converted To A Property: Const MSG56 = "Exporting Table: "
'ResMe Converted To A Property: Const MSG57 = "Export "
'ResMe Converted To A Property: Const MSG58 = "in "
'ResMe Converted To A Property: Const MSG59 = "Creating Indexes:"
'ResMe Converted To A Property: Const MSG60 = "Successfully Exported:"
'ResMe Converted To A Property: Const MSG61 = "Successfully Exported SQL Statement."
'ResMe Converted To A Property: Const MSG62 = "Table already exists - overwrite?"
'ResMe Converted To A Property: Const MSG63 = "Importing Table: "
'ResMe Converted To A Property: Const MSG64 = "Successfully Imported:"
'ResMe Converted To A Property: Const MSG65 = "Invalid Directory Name!"
'>>>>>>>>>>>>>>>>>>>>>>>>


'api declarations
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%)

'Public object variables
Public gVDClass      As New VisDataClass
Public gnodDBNode    As Node        'current database node in treeview
Public gnodDBNode2   As Node        'backup of current database node in treeview
Public gwsMainWS     As Workspace   'main workspace object
Public gdbCurrentDB  As Database    'main database object
Public gbDBOpenFlag  As Integer     'flag to know if a db is open
Public gPropObject   As Object      'object to show properties on
Public gDataCtlObj   As Object      'Public data control object
Public gtdfTableDef  As TableDef    'Public tabledef used by frmTblStruct
Public gnFormType    As Integer     'form type chosen on main form
                                    '0 = data control
                                    '1 = no data control
                                    '2 = grid control
Public gnRSType      As Integer     'recordset type chosen on main form
                                    '0 = table
                                    '1 = dynaset
                                    '2 = snapshot

'Public database variables
Public gsDataType       As String   'data backend = connect string
                                    'for everything accept Access
Public gsDBName         As String   'current database name
Public gsODBCDatasource As String   'Public odbc values
Public gsODBCDatabase   As String   '       "
Public gsODBCUserName   As String   '       "
Public gsODBCPassword   As String   '       "
Public gsODBCDriver     As String   '       "
Public gsODBCServer     As String   '       "
Public gsTblName        As String   '
Public glQueryTimeout   As Long     '
Public glLoginTimeout   As Long     '
Public gsTableDynaFilter As String  '
Public gnReadOnly       As Integer  'database readonly flag

'other Public vars
Public gsZoomData       As String   'pass info to the zoom form

'multi user variables
Public gnMURetryCnt     As Integer
Public gnMUDelay        As Integer
Public gnMULocking      As Integer  'flag for pessimistic or optimistic locking

'Public find values used to pass info between
'the dynaset form and find dialog
Public gbFindFailed     As Boolean
Public gsFindExpr       As String
Public gsFindOp         As String
Public gsFindField      As String
Public gnFindType       As Integer
Public gbFromTableView  As Boolean

'Public seek values used to pass info between
'the table form and find dialog
Public gsSeekOperator   As String
Public gsSeekValue      As String

'Public flags
Public gbDBChanged      As Boolean   '
Public gbTransPending   As Boolean   'used for transaction management
Public gbFromSQL        As Boolean   'source of sql statement was SQL form
Public gbAddTableFlag   As Boolean   'new or design designator
Public gbSettingDataCtl As Boolean   'used to reset data control props

'Public vars used in the Import Export Code
Public gImpDB As Database
Public gExpDB As Database
Public gExpTable As String

'data backend types used as the connect string
'ResMe Converted To A Property: Public Const gsMSACCESS = "Microsoft Access"
'ResMe Converted To A Property: Public Const gsDBASEIII = "Dbase III;"
'ResMe Converted To A Property: Public Const gsDBASEIV = "Dbase IV;"
'ResMe Converted To A Property: Public Const gsDBASE5 = "Dbase 5.0;"
'ResMe Converted To A Property: Public Const gsFOXPRO20 = "FoxPro 2.0;"
'ResMe Converted To A Property: Public Const gsFOXPRO25 = "FoxPro 2.5;"
'ResMe Converted To A Property: Public Const gsFOXPRO26 = "FoxPro 2.6;"
'ResMe Converted To A Property: Public Const gsFOXPRO30 = "FoxPro 3.0;"
'ResMe Converted To A Property: Public Const gsPARADOX3X = "Paradox 3.X;"
'ResMe Converted To A Property: Public Const gsPARADOX4X = "Paradox 4.X;"
'ResMe Converted To A Property: Public Const gsPARADOX5X = "Paradox 5.X;"
'ResMe Converted To A Property: Public Const gsBTRIEVE = "Btrieve;"
'ResMe Converted To A Property: Public Const gsEXCEL30 = "Excel 3.0;"
'ResMe Converted To A Property: Public Const gsEXCEL40 = "Excel 4.0;"
'ResMe Converted To A Property: Public Const gsEXCEL50 = "Excel 5.0;"
'ResMe Converted To A Property: Public Const gsTEXTFILES = "Text;"
Public Const gsSQLDB = "ODBC;"

'import/export data types
Public gnDataType As gnDataTypes
Public Enum gnDataTypes
  gnDT_NONE = -1
  gnDT_MSACCESS = 0
  gnDT_DBASEIV = 1
  gnDT_DBASEIII = 2
  gnDT_FOXPRO26 = 3
  gnDT_FOXPRO25 = 4
  gnDT_FOXPRO20 = 5
  gnDT_PARADOX4X = 6
  gnDT_PARADOX3X = 7
  gnDT_BTRIEVE = 8
  gnDT_EXCEL50 = 9
  gnDT_EXCEL40 = 10
  gnDT_EXCEL30 = 11
  gnDT_TEXTFILE = 12
  gnDT_SQLDB = 13
End Enum

'Public constants
'ResMe Converted To A Property: Public Const APPNAME = "VisData6"
Public Const gsDEFAULT_DRIVER = "SQL Server"  'used for registerdatabase
Public Const gnEOF_ERR = 626                  '
Public Const gnFTBLS = 0                      '
Public Const gnFFLDS = 1                      '
Public Const gnFINDX = 2                      '
Public Const gnMAX_GRID_ROWS = 31999          '
Public Const gnMAX_MEMO_SIZE = 20000          '
Public Const gnGETCHUNK_CUTOFF = 50           '

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

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

Public Const gnCTLARRAYHEIGHT = 340&          '
Public Const gnSCREEN = 0                     'used to center forms on screen
Public Const gnMDIFORM = 1                    'used to center forms on frmMDI

'ResMe Converted To A Property: Public Const TABLE_STR = "Table"
'ResMe Converted To A Property: Public Const ATTACHED_STR = "Attached"
'ResMe Converted To A Property: Public Const QUERY_STR = "Query"
'ResMe Converted To A Property: Public Const FIELD_STR = "Field"
'ResMe Converted To A Property: Public Const FIELDS_STR = "Fields"
'ResMe Converted To A Property: Public Const INDEX_STR = "Index"
'ResMe Converted To A Property: Public Const INDEXES_STR = "Indexes"
'ResMe Converted To A Property: Public Const PROPERTY_STR = "Property"
'ResMe Converted To A Property: Public Const PROPERTIES_STR = "Properties"

'ResMe Converted To A Property: Public Const APP_CATEGORY = "Microsoft Visual Basic AddIns"

Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function LoadStringA Lib "user32" (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, ByVal nBufferMax As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

'LoadLibrary constants
Public Const LOAD_LIBRARY_AS_DATAFILE As Long = &H2

'GetLocaleInfo constants
Public Const LOCALE_SLANGUAGE = &H2
Public Const LOCALE_SABBREVLANGNAME = &H3

Private m_HelpServices As VsHelpServices.VsHelpServices
Private m_lcid  As Long
Private m_sHelpFile As String


Sub Main()
  frmMDI.Show
End Sub


'------------------------------------------------------------
'this function returns the type of querydef
'for the item selected in the querydefs
'list on the frmTables form
'------------------------------------------------------------
Function ActionQueryType(qdf As QueryDef) As String
  
  'check to see if it is an action query
  If (qdf.Type And dbQAction) = 0 Then
    ActionQueryType = vbNullString
    Exit Function
  End If
  
  'must be an action query type
  Select Case qdf.Type
    Case dbQCrosstab
      'WAS: ActionQueryType = "Cross Tab"
      ActionQueryType = LoadResString(S125_Cross_Tab)

    Case dbQDelete
      'WAS: ActionQueryType = "Delete"
      ActionQueryType = LoadResString(S158_Delete)

    Case dbQUpdate
      'WAS: ActionQueryType = "Update"
      ActionQueryType = LoadResString(S559_Update)

    Case dbQAppend
      'WAS: ActionQueryType = "Append"
      ActionQueryType = LoadResString(S48_Append)

    Case dbQMakeTable
      'WAS: ActionQueryType = "Make Table"
      ActionQueryType = LoadResString(S317_Make_Table)

    Case dbQDDL
      ActionQueryType = "DDL"
    Case dbQSQLPassThrough
      ActionQueryType = "SQLPassThrough"
    Case dbQSetOperation
      ActionQueryType = "Set Operation"
    Case dbQSPTBulk
      'WAS: ActionQueryType = "SPT Bulk"
      ActionQueryType = LoadResString(S505_SPT_Bulk)

    Case Else
      ActionQueryType = vbNullString
  End Select

End Function

'------------------------------------------------------------
'this functions adds [] to object names that might need
'them because they have spaces in them
'------------------------------------------------------------
Function AddBrackets(rObjName As String) As String
  'add brackets to object names w/ spaces in them
  If InStr(rObjName, " ") > 0 And Mid(rObjName, 1, 1) <> "[" Then
    AddBrackets = "[" & rObjName & "]"
  Else
    AddBrackets = rObjName
  End If
End Function

'------------------------------------------------------------
'this function checks to see if a transaction is pending
'and displays a message is one is
'------------------------------------------------------------
Function CheckTransPending(MSG As String) As Integer

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

End Function

'------------------------------------------------------------
'clear out the data fields on the table and dynasnap forms
'------------------------------------------------------------
Sub ClearDataFields(frm As Form, nCnt As Integer)
  Dim i As Integer

  'clear out the fields on the main form
  For i = 0 To nCnt - 1
    frm.txtFieldData(i).Text = vbNullString
  Next
End Sub

'------------------------------------------------------------
'this sub closes all frmDynaSnap, frmTableObj and frmDataGrid
'forms by looking for forms with a Tag set to "Recordset"
'------------------------------------------------------------
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

'------------------------------------------------------------
'this function copies data from one table to another
'from the frmCopyStruct form
'It demonstrates the use of transactions to speed up this
'type of operation
'------------------------------------------------------------
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

  'open both recordsets
  Set recRecordset1 = rFromDB.OpenRecordset(rFromName)
  Set recRecordset2 = rToDB.OpenRecordset(rToName)
  gwsMainWS.BeginTrans
  While recRecordset1.EOF = False
    recRecordset2.AddNew
    'this loop copies the data from each field to
    'the new table
'    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
    'this test will commit transactions every 1000 records
    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

'------------------------------------------------------------
'this function copies the structure of one table to
'a new table in the same or different database
'------------------------------------------------------------
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
  
  'search to see if table exists
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()
    
  'strip off owner if needed
  tblTableDefObj.Name = StripOwner(vToName)

  'create the fields
'  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

  'create the indexes
  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

  'append the new table
  vToDB.TableDefs.Append tblTableDefObj

  CopyStruct = True
  Exit Function

CSErr:
  ShowError
  CopyStruct = False
End Function

'------------------------------------------------------------
'this function fills a list or combo box with the
'tables (and querydefs) from the Tables form
'ItemData is set to 0 for a tabledef and 1 for a querydef
'------------------------------------------------------------
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
  
  'add the tabledefs
  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
  
  'add the querydefs
  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

'------------------------------------------------------------
'this function returns the numeric field type
'for the passed in string
'------------------------------------------------------------
Function GetFieldType(rFldType As String) As Integer
  'return field length
      ActionQueryType = LoadResString(S505_SPT_Bulk)
    GetFieldType = dbText
  Else
    Select Case rFldType
      ActionQueryType = LoadResString(S505_SPT_Bulk)
        GetFieldType = dbLong
      ActionQueryType = LoadResString(S505_SPT_Bulk)
        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
      'WAS: Case "Binary"
      Case LoadResString(S69_Binary)

        GetFieldType = dbLongBinary
      'WAS: Case "Memo"
      Case LoadResString(S319_Memo)

        GetFieldType = dbMemo
    End Select
  End If

End Function

'------------------------------------------------------------
'this function returns an appropriate field width for the
'field type passed in to be used for the control width on
'frmDynaSnap and frmTableObj forms
'------------------------------------------------------------
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

'------------------------------------------------------------
'this function returns the Registry setting for the
'passed in item and section
'------------------------------------------------------------
Function GetRegistryString(ByVal vsItem As String, ByVal vsDefault As String) As String
  GetRegistryString = GetSetting(APP_CATEGORY, APPNAME, vsItem, vsDefault)
End Function

'------------------------------------------------------------
'this sub hides the menus and toolbar that only apply
'when a database is open
'------------------------------------------------------------
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

'------------------------------------------------------------
'this sub displays the passed in message in the status
'bar on the bottom of the MDI form
'------------------------------------------------------------
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

'==================================================
' Routine: ObjectExists
'
' Purpose: Determine whether or not a member exists
'          same as MemberExists except that the 1st arg is declared
'          as an object to allow passing in collections such as
'          VBComponents, VBProjects, etc.
' Arguments:
'   pColl: Name of Collection to check in
'   sMemName: Name(key) of member to check for
' Outputs:
'   True: member exists in collection
'   False: member does not exist in the collection
' Maintenance: 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


'------------------------------------------------------------
'this sub refreshs any table list passed in as an object
'------------------------------------------------------------
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 this is called to refresh the database
  'window, bypass the old method of
  'filling a listbox with the table names
  If rListObject Is Nothing Then GoTo LoadTreeView

  rListObject.Clear
  If frmMDI.mnuPAllowSys.Checked Then
    'list all tables
    For Each tdf In gdbCurrentDB.TableDefs
      If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
        If Left(tdf.Connect, 1) = ";" Then
          'must be a Microsoft Access attached table
          'WAS: rListObject.AddItem tdf.Name & " -> Microsoft Access"
          rListObject.AddItem tdf.Name & LoadResString(S13_Microsoft_Access)

        Else
          'must be an ISAM attached table
          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
    'don't list system tables
    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
            'must be a Microsoft Access attached table
            'WAS: rListObject.AddItem tdf.Name & " -> Microsoft Access"
            rListObject.AddItem tdf.Name & LoadResString(S13_Microsoft_Access)

          Else
            'must be an ISAM attached table
            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
  'select the 1st item if there is any
  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

'------------------------------------------------------------
'this function returns the size of the field type
'passed in for use on the frmAddField form
'------------------------------------------------------------
Function SetFldProperties(rnType As Integer) As Integer
  'return field length
  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

'------------------------------------------------------------
'this sub shows the menus and toolbar that only apply
'when a database is open
'------------------------------------------------------------
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

  'set general items that apply/don't apply to MDBs
  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

  'set ODBC specific items
  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
  'show the 2 main child forms
  frmDatabase.Show
  frmSQL.Show
End Sub

'------------------------------------------------------------
'this sub displays the error message with it's Err code
'and prompts to show the Errors collection if it
'is a data access type error
'------------------------------------------------------------
Sub ShowError()
  Dim sTmp As String

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False

  'WAS: sTmp = "The following Error occurred:" & vbCrLf & vbCrLf
  sTmp = LoadResString(S542_The_following_Error) & vbCrLf & vbCrLf

  'add the error string
  sTmp = sTmp & Err.Description & vbCrLf
  'add the error number
  sTmp = sTmp & MSG8 & Err
  
  Beep
  'check to see if the error is from the db errors collection
  If DBEngine.Errors.Count > 0 Then
    If DBEngine.Errors(0).Number = Err Then
      'add the prompt to display the errors collection
      sTmp = sTmp & vbCrLf & vbCrLf & MSG9
      'beep and show the error
      If MsgBox(sTmp, vbYesNo + vbQuestion) = vbYes Then
        RefreshErrors
      End If
    Else
      MsgBox sTmp
    End If
  Else
    MsgBox sTmp
  End If

End Sub

'------------------------------------------------------------
'this function strips the attached table connect string off
'------------------------------------------------------------
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

'------------------------------------------------------------
'this function strips the [] off of data objects
'------------------------------------------------------------
Function StripBrackets(rsObjName As String) As String
  'add brackets to object names w/ spaces in them
  If Mid(rsObjName, 1, 1) = "[" Then
    StripBrackets = Mid(rsObjName, 2, Len(rsObjName) - 2)
  Else
    StripBrackets = rsObjName
  End If

End Function

'------------------------------------------------------------
'this function strips the file name from a path\file string
'------------------------------------------------------------
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

'------------------------------------------------------------
'this function strips the non ACSII chars off memo field
'data before displaying it (not sure this is always needed)
'------------------------------------------------------------
Function StripNonAscii(rvntVal As Variant) As String
  Dim i As Integer
  Dim sTmp As String

  'stubbed out to enable DBCS chars
  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

'------------------------------------------------------------
'strips the owner off of ODBC table names
'------------------------------------------------------------
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

'------------------------------------------------------------
'returns the true or false string
'------------------------------------------------------------
Function stTrueFalse(rvntTF As Variant) As String
  If rvntTF Then
    'WAS: stTrueFalse = "True"
    stTrueFalse = LoadResString(S552_True)

  Else
    'WAS: stTrueFalse = "False"
    stTrueFalse = LoadResString(S232_False)

  End If
End Function

'------------------------------------------------------------
'returns "" if a field is Null
'------------------------------------------------------------
Function vFieldVal(rvntFieldVal As Variant) As Variant
  If IsNull(rvntFieldVal) Then
    vFieldVal = vbNullString
  Else
    vFieldVal = CStr(rvntFieldVal)
  End If
End Function

'------------------------------------------------------------
'loads all saved Registry settings for VisData
'------------------------------------------------------------
Sub LoadRegistrySettings()
  On Error Resume Next
  
  Dim sTmp As String
  Dim x As Integer

  glQueryTimeout = Val(GetRegistryString("QueryTimeout", "5"))
  glLoginTimeout = Val(GetRegistryString("LoginTimeout", "20"))
  
  
  frmMDI.mnuPOpenOnStartup.Checked = Val(GetRegistryString("OpenOnStartup", "0"))
  frmMDI.mnuPAllowSys.Checked = Val(GetRegistryString("AllowSys", "0"))

  'get the most recently used databases
  For x = 1 To 8
    sTmp = GetRegistryString("MRUDatabase" & x, "")
    If Len(sTmp) > 0 Then
      frmMDI.mnuBarMRU.Visible = True
      'WAS: frmMDI.mnuDBMRU(x).Caption = "&" & x & " " & sTmp
      frmMDI.mnuDBMRU(x).Caption = LoadResString(S1_) & x & LoadResString(S0_) & sTmp

      frmMDI.mnuDBMRU(x).Visible = True
      sTmp = GetRegistryString("MRUConnect" & x, "")
      frmMDI.mnuDBMRU(x).Tag = sTmp
    End If
  Next

  'get the last used database out of the Registry
  gsDataType = GetRegistryString("DataType", vbNullString)
  gsDBName = GetRegistryString("DatabaseName", vbNullString)
  gsODBCDatasource = GetRegistryString("ODBCDatasource", vbNullString)
  gsODBCDatabase = GetRegistryString("ODBCDatabase", vbNullString)
  gsODBCUserName = GetRegistryString("ODBCUserName", vbNullString)
  gsODBCPassword = GetRegistryString("ODBCPassword", vbNullString)
  gsODBCDriver = GetRegistryString("ODBCDriver", vbNullString)
  gsODBCServer = GetRegistryString("ODBCServer", vbNullString)

  sTmp = GetRegistryString("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 = GetRegistryString("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

'------------------------------------------------------------
'saves current VisData values to the registry
'------------------------------------------------------------
Sub SaveRegistrySettings()
  On Error Resume Next

  Dim i As Integer
  
  SaveSetting APP_CATEGORY, APPNAME, "DataType", gsDataType
  SaveSetting APP_CATEGORY, APPNAME, "DatabaseName", gsDBName
  SaveSetting APP_CATEGORY, APPNAME, "ODBCDatasource", gsODBCDatasource
  SaveSetting APP_CATEGORY, APPNAME, "ODBCDatabase", gsODBCDatabase
  SaveSetting APP_CATEGORY, APPNAME, "ODBCUserName", gsODBCUserName
  SaveSetting APP_CATEGORY, APPNAME, "ODBCPassword", gsODBCPassword
  SaveSetting APP_CATEGORY, APPNAME, "ODBCDriver", gsODBCDriver
  SaveSetting APP_CATEGORY, APPNAME, "ODBCServer", gsODBCServer
  SaveSetting APP_CATEGORY, APPNAME, "QueryTimeout", glQueryTimeout
  SaveSetting APP_CATEGORY, APPNAME, "LoginTimeout", glLoginTimeout
  DBEngine.LoginTimeout = glLoginTimeout
  SaveSetting APP_CATEGORY, APPNAME, "ViewMode", gnFormType
  SaveSetting APP_CATEGORY, APPNAME, "RecordsetType", gnRSType
  
  SaveSetting APP_CATEGORY, APPNAME, "OpenOnStartup", IIf(frmMDI.mnuPOpenOnStartup.Checked, "-1", "0")
  SaveSetting APP_CATEGORY, APPNAME, "AllowSys", IIf(frmMDI.mnuPAllowSys.Checked, "-1", "0")

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

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

End Sub

'------------------------------------------------------------
'this sub will open the appropriate data type form and
'display the appropriate msg in the status bar based on
'user selected options on the main MDI form
'------------------------------------------------------------
Sub OpenTable(rName As String)
  On Error GoTo OpenTableErr

  Dim rsTmp As Recordset
  Dim rsADOTmp As ADODB.Recordset
  Dim conADOConn As ADODB.Connection
  Dim sTmp As String
  Dim nAttach As Integer
  Dim frmTmp As Form
  
  If gsDataType = gsMSACCESS Then   'look for attached tables if it's an 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         'reset to dynaset
      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)
    'WAS: sTmp = "Table:"
    sTmp = LoadResString(S527_Table)

  ElseIf gnRSType = gnRS_DYNASET Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenDynaset)
    'WAS: sTmp = "Dynaset:"
    sTmp = LoadResString(S182_Dynaset)

  ElseIf gnRSType = gnRS_SNAPSHOT Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot)
    'WAS: sTmp = "Snapshot:"
    sTmp = LoadResString(S503_Snapshot)

  ElseIf gnRSType = gnRS_PASSTHRU Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot, dbSQLPassThrough)
    'WAS: sTmp = "Passthrough Snapshot:"
    sTmp = LoadResString(S403_Passthrough_Snapsho)

  End If
  Screen.MousePointer = vbDefault
  
  If gnFormType = gnFORM_NODATACTL Then
    If gnRSType = gnRS_TABLE Then
      Set frmTmp = New frmTableObj
      'WAS: sTmp = "Table:"
      sTmp = LoadResString(S527_Table)

    Else
      Set frmTmp = New frmDynaSnap
    End If
    Set frmTmp.mrsFormRecordset = rsTmp
  ElseIf gnFormType = gnFORM_DATACTL Then
    Set frmTmp = New frmDataControl
    Set frmTmp.mrsFormRecordset = rsTmp
  ElseIf gnFormType = gnFORM_DATAGRID Then
    Set frmTmp = New frmDataGrid
    'need to convert the recordset to an ADO recordset
    Set conADOConn = New ADODB.Connection
    With conADOConn
      If Len(gsODBCDatasource) = 0 Then
        If gsDataType = gsMSACCESS Then
          .ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & gsDBName
        Else
          .ConnectionString = "Provider=MSDASQL;Data Source=" & gsDBName
        End If
      Else
        .ConnectionString = "PROVIDER=MSDASQL;" & Mid$(gdbCurrentDB.Connect, 6)
      End If
      .Open
    End With
    Set rsADOTmp = New ADODB.Recordset
    With rsADOTmp
      .Open rsTmp.Name, conADOConn, adOpenStatic, adLockOptimistic, adCmdTable
    End With
    Set frmTmp.mrsFormRecordset = rsADOTmp
  End If
  
  frmTmp.Caption = sTmp & rName
  frmTmp.Show

  MsgBar vbNullString, False
  
  Exit Sub
OpenTableErr:
  ShowError
End Sub

'------------------------------------------------------------
'opens a QueryDef with the user selected form type
'------------------------------------------------------------
Sub OpenQuery(rName As String, bTemp As Boolean)
  On Error GoTo OpenQueryErr

  Dim sTmp As String
  Dim rsTmp As Recordset
  Dim rsADOTmp As ADODB.Recordset
  Dim conADOConn As ADODB.Connection
  Dim qdfTmp As QueryDef
  Dim sQueryType As String
  Dim frmTmp As Form
  Dim nDoIt As Integer
  Dim bReturnsRows As Boolean
  Dim bTriedAlready As Boolean

  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
    'assume it is non row returning to begin with
    bReturnsRows = False
  Else
    Set qdfTmp = gdbCurrentDB.QueryDefs(rName)
    sQueryType = ActionQueryType(qdfTmp)
    If qdfTmp.Type <> dbQSQLPassThrough Then
      'not a sql pass through so we need to set ReturnsRecords
      If qdfTmp.Type = 0 Or qdfTmp.Type = dbQCrosstab Then
        bReturnsRows = True
      Else
        bReturnsRows = False
      End If
    Else
      'get it from the qdf if it is passthrough
      bReturnsRows = qdfTmp.ReturnsRecords
    End If
  End If
  
  If bReturnsRows And (gnRSType = gnRS_TABLE) Then
    Beep
    If MsgBox(MSG19, vbYesNo + vbQuestion) = vbYes Then
      frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed         'reset to recordset
    Else
      Exit Sub
    End If
  End If
  
  
  If bReturnsRows Then
    SetQDFParams qdfTmp
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
      Set frmTmp.mrsFormRecordset = rsTmp
    ElseIf gnFormType = gnFORM_DATACTL Then
      Set frmTmp = New frmDataControl
      If qdfTmp.Parameters.Count > 0 Then
        frmTmp.mbIsParameterized = True
      End If
      Set frmTmp.mrsFormRecordset = rsTmp
    ElseIf gnFormType = gnFORM_DATAGRID Then
      Set frmTmp = New frmDataGrid
      'need to convert the recordset to an ADO recordset
      Set conADOConn = New ADODB.Connection
      With conADOConn
        If Len(gsODBCDatasource) = 0 Then
          If gsDataType = gsMSACCESS Then
            .ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & gsDBName
          Else
            .ConnectionString = "Provider=MSDASQL;Data Source=" & gsDBName
          End If
        Else
          .ConnectionString = "PROVIDER=MSDASQL;" & Mid$(gdbCurrentDB.Connect, 6)
        End If
        .Open
      End With
      Set rsADOTmp = New ADODB.Recordset
      With rsADOTmp
        .Open rName, conADOConn, adOpenStatic, adLockOptimistic
      End With
      Set frmTmp.mrsFormRecordset = rsADOTmp
    End If
    
    If Len(qdfTmp.SQL) > 50 Then
      frmTmp.Caption = MSG22
    Else
      frmTmp.Caption = qdfTmp.SQL
    End If
    frmTmp.Show
    
  Else
    Screen.MousePointer = vbDefault
    If Len(sQueryType) > 0 Then
      nDoIt = MsgBox(MSG23 & sQueryType & MSG24, vbYesNo + vbQuestion)
    Else
      'no name so just try to execute it
      nDoIt = vbYes
    End If
    If nDoIt = vbYes Then
      SetQDFParams qdfTmp
      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 And (Not bTriedAlready) Then
    bTriedAlready = True
    'row returning so try to create recordset
    Resume MakeDynaset
  ElseIf Not bTriedAlready Then
    ShowError
  End If
  Screen.MousePointer = vbHourglass
  MsgBar vbNullString, False
End Sub

'------------------------------------------------------------
'this sub display all field data in the current row
'on the table and dynasnap forms
'------------------------------------------------------------
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

      sTmp = LoadResString(S527_Table)
   
  'check to see if a table w/ 0 indexes is in use
  If rec.Type = dbOpenTable Then
    If gdbCurrentDB(rec.Name).Indexes.Count = 0 Then
      bNoInd = True
    End If
  End If
   
  'check for an empty recordset
  If rec.RecordCount > 0 Then
    lCurrRec = (lCnt * (rec.PercentPosition * 0.01)) + 1
  End If
     
  'check BOF/EOF flag so we know if we
  'are sitting on a valid record
  If bNew Then
    If bNoInd Then
      sTmp = LoadResString(S527_Table)
    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
      sTmp = LoadResString(S527_Table)
      Else
        sCurrStat = lCurrRec & "/" & lCnt
      End If
      'place the data in the form fields
      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    'so we can try and display as much data as possible
End Sub

'------------------------------------------------------------
'this function checks to see if the passed in name exists
'in either the Tabledefs or Querydefs collection
'it found, it prompts to delete it and returns false
'if the user selects to delete it or true if not
'if not found, it returns 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

'------------------------------------------------------------
'this sub unloads all forms except for the
'SQL, Tables and MDI form
'------------------------------------------------------------
Sub UnloadAllForms()
  On Error Resume Next
  
  Dim i As Integer
  
  'close all forms except for the Tables and SQL forms
  For i = Forms.Count - 1 To 1 Step -1
    Unload Forms(i)
  Next
End Sub

'------------------------------------------------------------
'this sub walks the parameters collection in a parameterized
'query and prompts the user for a value for each parameter
'------------------------------------------------------------
Sub SetQDFParams(rqdf As QueryDef)
  On Error GoTo SPErr
  
  Dim prm As Parameter
  Dim sTmp As String
  
  For Each prm In rqdf.Parameters
    'get the value from the user
    sTmp = InputBox(MSG29, "'" & prm.Name & "':")
    'store the value
    prm.Value = CVar(sTmp)
  Next
  
  Exit Sub
    
SPErr:
  ShowError
End Sub

'------------------------------------------------------------
'this sub refreshs the Error form with the latest Errors
'------------------------------------------------------------
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

'------------------------------------------------------------
'this sub adds the just opened database to the most recently
'used list in the File menu
'------------------------------------------------------------
Sub AddMRU()
  On Error GoTo AMErr

  Dim i As Integer, j As Integer

  '1st look to see if it alread exists and swap it if it does
  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
        'WAS: frmMDI.mnuDBMRU(j).Caption = "&" & j & " " & Mid(frmMDI.mnuDBMRU(j - 1).Caption, 4, Len(frmMDI.mnuDBMRU(j - 1).Caption))
        frmMDI.mnuDBMRU(j).Caption = LoadResString(S1_) & j & LoadResString(S0_) & 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

  'wasn't there so move everything down one
  For i = 7 To 1 Step -1
    'WAS: frmMDI.mnuDBMRU(i + 1).Caption = "&" & i + 1 & " " & Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))
    frmMDI.mnuDBMRU(i + 1).Caption = LoadResString(S1_) & i + 1 & LoadResString(S0_) & Mid(frmMDI.mnuDBMRU(i).Caption, 4, Len(frmMDI.mnuDBMRU(i).Caption))

    frmMDI.mnuDBMRU(i + 1).Tag = frmMDI.mnuDBMRU(i).Tag
  Next

Finish:
  'WAS: frmMDI.mnuDBMRU(1).Caption = "&1 " & gsDBName
  frmMDI.mnuDBMRU(1).Caption = LoadResString(S18_1) & gsDBName

  If Len(gdbCurrentDB.Connect) = 0 Then
    'handle the Access case where there is no connect string
    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

'------------------------------------------------------------
'this sub breaks out the parts of a ODBC connect string
'and assigns them to the Public ODBC variables
'------------------------------------------------------------
Sub GetODBCConnectParts(rsConnect As String)
  On Error Resume Next
  
  Dim i As Integer
  Dim sTmp As String
  
  'process the connect string just in case the
  'values came from the ODBC dialogs
  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))
            'WAS: Case "Driver"
            Case LoadResString(S176_Driver)

              gsODBCDriver = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
            'WAS: Case "Server"
            Case LoadResString(S493_Server)

              gsODBCServer = Mid(sTmp, InStr(1, sTmp, "=") + 1, Len(sTmp))
             Case Else
              'nothing
          End Select
        End If
        sTmp = vbNullString
      Else
        sTmp = sTmp + Mid(rsConnect, i, 1)
      End If
      i = i + 1
    Wend
  End If
End Sub

'------------------------------------------------------------
'this is a generic sub that adds the name of each item
'in a collection to the passed in control
'------------------------------------------------------------
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

'------------------------------------------------------------
'this sub closes the current DB and performs any cleanup
'and resetting of controls, menus, etc.
'------------------------------------------------------------
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

  'WAS: frmMDI.Caption = "VisData"
  frmMDI.Caption = LoadResString(S585_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 DBs (*.dbf)|*.dbf" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG37
      Case gsFOXPRO20, gsFOXPRO25, gsFOXPRO26, gsFOXPRO30
        frmMDI.dlgCMD1.Filter = "FoxPro DBs (*.dbf)|*.dbf" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG38
      Case gsPARADOX3X, gsPARADOX4X, gsPARADOX5X
        frmMDI.dlgCMD1.Filter = "Paradox DBs (*.db)|*.db" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG39
      Case gsEXCEL50
        frmMDI.dlgCMD1.Filter = "Excel Files (*.xls)|*.xls" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG40
      Case gsBTRIEVE
        frmMDI.dlgCMD1.Filter = "Btrieve DBs (FILE.DDF)|FILE.DDF" & MSG50
        frmMDI.dlgCMD1.DialogTitle = MSG41
      Case gsTEXTFILES
        frmMDI.dlgCMD1.Filter = "Text Files (*.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

  'set the connect string
  If gsDataType = gsMSACCESS Then
    sConnect = vbNullString
  Else
    sConnect = gsDataType
  End If
  
  'set the database name for non Microsoft Access and Btrieve dbs that
  'came from the Common Dialog
  If gsDataType <> gsMSACCESS And gsDataType <> gsBTRIEVE And _
     gsDataType <> gsEXCEL50 And (Not bSilent) Then
    'need to strip off filename for these dbs
    sDatabaseName = StripFileName(gsDBName)
    gsDBName = sDatabaseName
  Else
    sDatabaseName = gsDBName
  End If

  gsODBCDatasource = vbNullString  'reset it

  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
    'they cancelled the pwd dialog so we need to exit
    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
    'save the db name
    sTmp = gsDBName
    'restore it
    CloseCurrentDB
    gsDBName = sTmp
    If gbDBOpenFlag Then
      Beep
      MsgBox MSG35, 48
      Exit Sub
    End If
  End If

  'success
  'WAS: frmMDI.Caption = "VisData:" & sDatabaseName
  frmMDI.Caption = LoadResString(S586_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
    'password protected database
    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   'check for common dialog cancelled
    ShowError
  End If
End Sub

'------------------------------------------------------------
'this sub is used to create a new directory for one
'of the local ISAM data types
'------------------------------------------------------------
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  'catch the case where dir exists
  If Err = 76 Then
    MsgBox MSG65, vbExclamation
    'now try again
    Resume GetNewDirName
  End If
  ShowError
End Sub

'------------------------------------------------------------
'this sub is called from the compact menu options
'on the main MDI form
'------------------------------------------------------------
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

  'get file name to compact
  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

  'get file name to compact to
  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
  'if they want to overwrite the same file, we need to create a new MDB
  'and rename after the compact is successful
  If sOldName = sNewName Then
    sNewName2 = sNewName 'save the new name
    sNewName = Left(sNewName, Len(sNewName) - 1) & "N"
  End If
  
  DBEngine.CompactDatabase sOldName, sNewName, dbLangGeneral, rnCompactVersion + nEncrypt
  
  'check for an overwrite of the original mdb
  If VBA.Right(sNewName, 1) = "N" Then
    Kill sNewName2             'nuke the old one
    Name sNewName As sNewName2 'rename the new one to the original name
    sNewName = sNewName2       'reset to the correct name
  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         'user cancelled
    ShowError
  End If
End Sub

'------------------------------------------------------------
'this sub does some cleanup and shuts down VisData
'------------------------------------------------------------
Sub ShutDownVisData()
  On Error Resume Next

  Dim nRet As Integer

  'save all the current Registry settings
  SaveRegistrySettings

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

  UnloadAllForms
  gdbCurrentDB.Close
  'close the help file
  ReleaseHelp
  
  End

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

  Dim sNewName As String
  Dim db As Database

  'get file name to compact to
  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
      'add an extension if the user didn't supply one
      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         'user cancelled
    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              'local copy of sql string
  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
      'WAS: .Label1.Caption = MSG57 & rsFromTbl & " ->"
      .Label1.Caption = MSG57 & rsFromTbl & LoadResString(S12_)

      .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
    'get the table part of the file name
    'strip off the path
    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))
    'strip off the extension
    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
    'WAS: MsgBox MSG60 & " '" & rsFromTbl & "'", 64
    MsgBox MSG60 & LoadResString(S2_) & rsFromTbl & LoadResString(S3_), 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      'table exists
    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
 
  'nuke the new table if the indexes couldn't be created
  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
    'WAS: MsgBar gdbCurrentDB.RecordsAffected & " Rows Imported, Creating Indexes for '" & sNewTblName & "'", True
    MsgBar gdbCurrentDB.RecordsAffected & LoadResString(S466_Rows_Imported_Creat) & 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
  'WAS: MsgBox MSG64 & "'" & sNewTblName & "'.", 64
  MsgBox MSG64 & LoadResString(S3_) & sNewTblName & LoadResString(S4_), 64


  Exit Sub

NukeNewTbl:
  On Error Resume Next  'just in case it fails
  gdbCurrentDB.TableDefs.Delete sNewTblName
  ShowError
  Exit Sub
 
ImpErr:
  'nuke the new table if the indexes couldn't be created
  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
    'strip off path
    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


'------------------------------------------------------------
' Purpose:      set the locale ID for HTML help resources
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub setHelpLocaleID(ByVal LCID As Long)
'------------------------------------------------------------
    m_lcid = LCID
End Sub

'------------------------------------------------------------
' Purpose:      set the filename of the help topic
' Param sName:  filename of help topic
'------------------------------------------------------------
Public Sub setHelpFile(ByVal sName As String)
'------------------------------------------------------------
    m_sHelpFile = sName
End Sub

'------------------------------------------------------------
' Public Sub DisplayTopic(ByVal toc As Long)
' Purpose:      displays the html topic identified by toc. Assumes helpfile has already been set
' Param sHelpFile: chm file you are looking up
' Param toc:    topic id to be displayed
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub DisplayTopic(ByVal toc As Long)
'------------------------------------------------------------
On Error GoTo errorHandle

    Debug.Assert Len(m_sHelpFile) > 0
    
    If Not initialiseHelp() Then Exit Sub
        
    m_HelpServices.DisplayTopicFromIdentifier m_sHelpFile, toc, VHS_Localize
        
errorHandle:
    ' html help throws up its own error if it can't display help
        
End Sub

'------------------------------------------------------------
' Public Sub KeywordSearch(sKey as string, lcid as long)
' Purpose:      performs a keyword search on the entire (installed) msdn.
' Param sKey:   keyword to be searched for
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub KeywordSearch(ByVal sKey As String)
'------------------------------------------------------------
On Error GoTo errorHandle

    If Not initialiseHelp() Then Exit Sub
    
    m_HelpServices.KeywordSearch sKey, 0, 0
    
errorHandle:
    ' html help throws up its own error if it can't display help
    
End Sub

'------------------------------------------------------------
' Public Sub ReleaseHelp
' Purpose:      cleans up m_HelpServices
'------------------------------------------------------------
Public Sub ReleaseHelp()
'------------------------------------------------------------
    Set m_HelpServices = Nothing
End Sub

'------------------------------------------------------------
' initialse the HTML help system
'------------------------------------------------------------
Private Function initialiseHelp() As Boolean
On Error GoTo errorHandle
    Dim helpInit As IVsHelpInit
    
    If m_HelpServices Is Nothing Then
        Set m_HelpServices = New VsHelpServices.VsHelpServices
        Set helpInit = m_HelpServices
        helpInit.LoadUIResources m_lcid
        DoEvents
    End If
    
    initialiseHelp = True

errorHandle:
    If Err <> 0 Then
        initialiseHelp = False
        MsgBox Err.Description
    End If
End Function

Public Function GetVbIdeLocale() As Long
'------------------------------------------------------------
    Dim hInstance   As Long
    Dim sLocale     As String
    Dim rc          As Long
    Const LOCALERESID = 2001
'------------------------------------------------------------
    hInstance = LoadLibraryEx("VB6IDE.DLL", 0&, LOAD_LIBRARY_AS_DATAFILE)
    If (hInstance <> 0) Then
        sLocale = String$(20, vbNullChar)
        rc = LoadStringA(hInstance, LOCALERESID, sLocale, Len(sLocale))
        If (rc > 0) Then
            GetVbIdeLocale = Val("&H" & sLocale)
        End If
        FreeLibrary hInstance
    End If
'------------------------------------------------------------
End Function




'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const MSG1 = "Execute Commit or Rollback First."
Property Get MSG1 As String
    'WAS: MSG1 = "Execute Commit or Rollback First."
    MSG1 = LoadResString(S222_Execute_Commit_or_R)

End Property

'This was: Const MSG2 = "Closing Recordsets"
Property Get MSG2 As String
    'WAS: MSG2 = "Closing Recordsets"
    MSG2 = LoadResString(S98_Closing_Recordsets)

End Property

'This was: Const MSG3 = "Table already exists, delete it?"
Property Get MSG3 As String
    'WAS: MSG3 = "Table already exists, delete it?"
    MSG3 = LoadResString(S517_Table_already_exist)

End Property

'This was: Const MSG4 = "Enter New Table Name:"
Property Get MSG4 As String
    'WAS: MSG4 = "Enter New Table Name:"
    MSG4 = LoadResString(S197_Enter_New_Table_Nam)

End Property

'This was: Const MSG5 = "Ready"
Property Get MSG5 As String
    'WAS: MSG5 = "Ready"
    MSG5 = LoadResString(S435_Ready)

End Property

'This was: Const MSG6 = ", please wait..."
Property Get MSG6 As String
    'WAS: MSG6 = ", please wait..."
    MSG6 = LoadResString(S11_please_wait)

End Property

'This was: Const MSG7 = "Refreshing Table List"
Property Get MSG7 As String
    'WAS: MSG7 = "Refreshing Table List"
    MSG7 = LoadResString(S444_Refreshing_Table_Li)

End Property

'This was: Const MSG8 = "Number: "
Property Get MSG8 As String
    'WAS: MSG8 = "Number: "
    MSG8 = LoadResString(S352_Number)

End Property

'This was: Const MSG9 = "Display the Data Access Errors Collection?"
Property Get MSG9 As String
    'WAS: MSG9 = "Display the Data Access Errors Collection?"
    MSG9 = LoadResString(S174_Display_the_Data_Ac)

End Property

'This was: Const MSG10 = "Can't Open a Table Object on an Attached Table, Use Dynaset?"
Property Get MSG10 As String
    'WAS: MSG10 = "Can't Open a Table Object on an Attached Table, Use Dynaset?"
    MSG10 = LoadResString(S82_Can_t_Open_a_Table_)

End Property

'This was: Const MSG11 = "Opening Attached Table as Dynaset"
Property Get MSG11 As String
    'WAS: MSG11 = "Opening Attached Table as Dynaset"
    MSG11 = LoadResString(S373_Opening_Attached_Ta)

End Property

'This was: Const MSG12 = "Opening Attached Table as Snapshot"
Property Get MSG12 As String
    'WAS: MSG12 = "Opening Attached Table as Snapshot"
    MSG12 = LoadResString(S374_Opening_Attached_Ta)

End Property

'This was: Const MSG13 = "Opening Full Table"
Property Get MSG13 As String
    'WAS: MSG13 = "Opening Full Table"
    MSG13 = LoadResString(S377_Opening_Full_Table)

End Property

'This was: Const MSG14 = "Opening Single Table Dynaset"
Property Get MSG14 As String
    'WAS: MSG14 = "Opening Single Table Dynaset"
    MSG14 = LoadResString(S382_Opening_Single_Tabl)

End Property

'This was: Const MSG15 = "Opening Single Table Snapshot"
Property Get MSG15 As String
    'WAS: MSG15 = "Opening Single Table Snapshot"
    MSG15 = LoadResString(S383_Opening_Single_Tabl)

End Property

'This was: Const MSG16 = "Opening PassThru Snapshot"
Property Get MSG16 As String
    'WAS: MSG16 = "Opening PassThru Snapshot"
    MSG16 = LoadResString(S379_Opening_PassThru_Sn)

End Property

'This was: Const MSG17 = "Is this a SQLPassThrough Query?"
Property Get MSG17 As String
    MSG17 = "Is this a SQLPassThrough Query?"
End Property

'This was: Const MSG18 = "Enter Connect property value:"
Property Get MSG18 As String
    'WAS: MSG18 = "Enter Connect property value:"
    MSG18 = LoadResString(S188_Enter_Connect_prope)

End Property

'This was: Const MSG19 = "Can't Open a Table Object from a QueryDef, Use Dynaset?"
Property Get MSG19 As String
    'WAS: MSG19 = "Can't Open a Table Object from a QueryDef, Use Dynaset?"
    MSG19 = LoadResString(S81_Can_t_Open_a_Table_)

End Property

'This was: Const MSG20 = "Opening Query Snapshot"
Property Get MSG20 As String
    'WAS: MSG20 = "Opening Query Snapshot"
    MSG20 = LoadResString(S381_Opening_Query_Snaps)

End Property

'This was: Const MSG21 = "Opening Query Dynaset"
Property Get MSG21 As String
    'WAS: MSG21 = "Opening Query Dynaset"
    MSG21 = LoadResString(S380_Opening_Query_Dynas)

End Property

'This was: Const MSG22 = "SQL Statement"
Property Get MSG22 As String
    MSG22 = "SQL Statement"
End Property

'This was: Const MSG23 = "Execute "
Property Get MSG23 As String
    'WAS: MSG23 = "Execute "
    MSG23 = LoadResString(S221_Execute)

End Property

'This was: Const MSG24 = " Query?"
Property Get MSG24 As String
    'WAS: MSG24 = " Query?"
    MSG24 = LoadResString(S430_Query)

End Property

'This was: Const MSG25 = "Executing Query"
Property Get MSG25 As String
    'WAS: MSG25 = "Executing Query"
    MSG25 = LoadResString(S223_Executing_Query)

End Property

'This was: Const MSG26 = "  [Not Updatable]"
Property Get MSG26 As String
    'WAS: MSG26 = "  [Not Updatable]"
    MSG26 = LoadResString(S598_Not_Updatable)

End Property

'This was: Const MSG27 = "Table already exists, Delete it?"
Property Get MSG27 As String
    'WAS: MSG27 = "Table already exists, Delete it?"
    MSG27 = LoadResString(S516_Table_already_exist)

End Property

'This was: Const MSG28 = "QueryDef already exists, Delete it?"
Property Get MSG28 As String
    'WAS: MSG28 = "QueryDef already exists, Delete it?"
    MSG28 = LoadResString(S431_QueryDef_already_ex)

End Property

'This was: Const MSG29 = "Enter Value for Parameter:"
Property Get MSG29 As String
    'WAS: MSG29 = "Enter Value for Parameter:"
    MSG29 = LoadResString(S207_Enter_Value_for_Par)

End Property

'This was: Const MSG30 = "There are no current data access errors!"
Property Get MSG30 As String
    'WAS: MSG30 = "There are no current data access errors!"
    MSG30 = LoadResString(S543_There_are_no_curren)

End Property

'This was: Const MSG31 = "Can't show Errors at this time!"
Property Get MSG31 As String
    'WAS: MSG31 = "Can't show Errors at this time!"
    MSG31 = LoadResString(S83_Can_t_show_Errors_a)

End Property

'This was: Const MSG32 = "Data has been changed, Commit it?"
Property Get MSG32 As String
    'WAS: MSG32 = "Data has been changed, Commit it?"
    MSG32 = LoadResString(S133_Data_has_been_chang)

End Property

'This was: Const MSG33 = "RollBack All changes?"
Property Get MSG33 As String
    'WAS: MSG33 = "RollBack All changes?"
    MSG33 = LoadResString(S461_RollBack_All_change)

End Property

'This was: Const MSG34 = "Can't Close with Transactions Pending!"
Property Get MSG34 As String
    'WAS: MSG34 = "Can't Close with Transactions Pending!"
    MSG34 = LoadResString(S80_Can_t_Close_with_Tr)

End Property

'This was: Const MSG35 = "You must Close First!"
Property Get MSG35 As String
    'WAS: MSG35 = "You must Close First!"
    MSG35 = LoadResString(S593_You_must_Close_Firs)

End Property

'This was: Const MSG36 = "Open Microsoft Access Database"
Property Get MSG36 As String
    'WAS: MSG36 = "Open Microsoft Access Database"
    MSG36 = LoadResString(S367_Open_Microsoft_Acce)

End Property

'This was: Const MSG37 = "Open Dbase Database"
Property Get MSG37 As String
    'WAS: MSG37 = "Open Dbase Database"
    MSG37 = LoadResString(S363_Open_Dbase_Database)

End Property

'This was: Const MSG38 = "Open FoxPro Database"
Property Get MSG38 As String
    'WAS: MSG38 = "Open FoxPro Database"
    MSG38 = LoadResString(S365_Open_FoxPro_Databas)

End Property

'This was: Const MSG39 = "Open Paradox Database"
Property Get MSG39 As String
    'WAS: MSG39 = "Open Paradox Database"
    MSG39 = LoadResString(S370_Open_Paradox_Databa)

End Property

'This was: Const MSG40 = "Open Excel File"
Property Get MSG40 As String
    'WAS: MSG40 = "Open Excel File"
    MSG40 = LoadResString(S364_Open_Excel_File)

End Property

'This was: Const MSG41 = "Open Btrieve Database"
Property Get MSG41 As String
    'WAS: MSG41 = "Open Btrieve Database"
    MSG41 = LoadResString(S361_Open_Btrieve_Databa)

End Property

'This was: Const MSG42 = "Open Text Database"
Property Get MSG42 As String
    'WAS: MSG42 = "Open Text Database"
    MSG42 = LoadResString(S372_Open_Text_Database)

End Property

'This was: Const MSG43 = "Opening Database"
Property Get MSG43 As String
    'WAS: MSG43 = "Opening Database"
    MSG43 = LoadResString(S375_Opening_Database)

End Property

'This was: Const MSG44 = "NOTE: Use of Attached Tables is the Recommended Method"
Property Get MSG44 As String
    'WAS: MSG44 = "NOTE: Use of Attached Tables is the Recommended Method"
    MSG44 = LoadResString(S351_NOTE_Use_of_Attache)

End Property

'This was: Const MSG45 = "Repairing "
Property Get MSG45 As String
    'WAS: MSG45 = "Repairing "
    MSG45 = LoadResString(S453_Repairing)

End Property

'This was: Const MSG46 = "Attempt to Repair it?"
Property Get MSG46 As String
    'WAS: MSG46 = "Attempt to Repair it?"
    MSG46 = LoadResString(S63_Attempt_to_Repair_i)

End Property

'This was: Const MSG47 = "Enter Directory Name for New ISAM Database:"
Property Get MSG47 As String
    'WAS: MSG47 = "Enter Directory Name for New ISAM Database:"
    MSG47 = LoadResString(S191_Enter_Directory_Nam)

End Property

'This was: Const MSG48 = "Select Microsoft Access Database to Compact"
Property Get MSG48 As String
    'WAS: MSG48 = "Select Microsoft Access Database to Compact"
    MSG48 = LoadResString(S486_Select_Microsoft_Ac)

End Property

'This was: Const MSG49 = "Microsoft Access MDBs (*.mdb)|*.mdb"
Property Get MSG49 As String
    MSG49 = "Microsoft Access MDBs (*.mdb)|*.mdb"
End Property

'This was: Const MSG50 = "|All Files (*.*)|*.*"
Property Get MSG50 As String
    MSG50 = "|All Files (*.*)|*.*"
End Property

'This was: Const MSG51 = "Select Microsoft Access Database to Compact to"
Property Get MSG51 As String
    'WAS: MSG51 = "Select Microsoft Access Database to Compact to"
    MSG51 = LoadResString(S487_Select_Microsoft_Ac)

End Property

'This was: Const MSG52 = "Encrypt Compacted Database?"
Property Get MSG52 As String
    'WAS: MSG52 = "Encrypt Compacted Database?"
    MSG52 = LoadResString(S185_Encrypt_Compacted_D)

End Property

'This was: Const MSG53 = "Compacting "
Property Get MSG53 As String
    'WAS: MSG53 = "Compacting "
    MSG53 = LoadResString(S104_Compacting)

End Property

'This was: Const MSG54 = "Open Newly Compacted Database?"
Property Get MSG54 As String
    'WAS: MSG54 = "Open Newly Compacted Database?"
    MSG54 = LoadResString(S369_Open_Newly_Compacte)

End Property

'This was: Const MSG55 = "Select Microsoft Access Database to Create"
Property Get MSG55 As String
    'WAS: MSG55 = "Select Microsoft Access Database to Create"
    MSG55 = LoadResString(S488_Select_Microsoft_Ac)

End Property

'This was: Const MSG56 = "Exporting Table: "
Property Get MSG56 As String
    'WAS: MSG56 = "Exporting Table: "
    MSG56 = LoadResString(S230_Exporting_Table)

End Property

'This was: Const MSG57 = "Export "
Property Get MSG57 As String
    'WAS: MSG57 = "Export "
    MSG57 = LoadResString(S226_Export)

End Property

'This was: Const MSG58 = "in "
Property Get MSG58 As String
    'WAS: MSG58 = "in "
    MSG58 = LoadResString(S291_in)

End Property

'This was: Const MSG59 = "Creating Indexes:"
Property Get MSG59 As String
    'WAS: MSG59 = "Creating Indexes:"
    MSG59 = LoadResString(S121_Creating_Indexes)

End Property

'This was: Const MSG60 = "Successfully Exported:"
Property Get MSG60 As String
    'WAS: MSG60 = "Successfully Exported:"
    MSG60 = LoadResString(S509_Successfully_Export)

End Property

'This was: Const MSG61 = "Successfully Exported SQL Statement."
Property Get MSG61 As String
    MSG61 = "Successfully Exported SQL Statement."
End Property

'This was: Const MSG62 = "Table already exists - overwrite?"
Property Get MSG62 As String
    'WAS: MSG62 = "Table already exists - overwrite?"
    MSG62 = LoadResString(S515_Table_already_exist)

End Property

'This was: Const MSG63 = "Importing Table: "
Property Get MSG63 As String
    'WAS: MSG63 = "Importing Table: "
    MSG63 = LoadResString(S290_Importing_Table)

End Property

'This was: Const MSG64 = "Successfully Imported:"
Property Get MSG64 As String
    'WAS: MSG64 = "Successfully Imported:"
    MSG64 = LoadResString(S510_Successfully_Import)

End Property

'This was: Const MSG65 = "Invalid Directory Name!"
Property Get MSG65 As String
    'WAS: MSG65 = "Invalid Directory Name!"
    MSG65 = LoadResString(S303_Invalid_Directory_N)

End Property

'This was: Public Const gsMSACCESS = "Microsoft Access"
Public Property Get gsMSACCESS As String
    'WAS: gsMSACCESS = "Microsoft Access"
    gsMSACCESS = LoadResString(S321_Microsoft_Access)

End Property

'This was: Public Const gsDBASEIII = "Dbase III;"
Public Property Get gsDBASEIII As String
    'WAS: gsDBASEIII = "Dbase III;"
    gsDBASEIII = LoadResString(S152_Dbase_III)

End Property

'This was: Public Const gsDBASEIV = "Dbase IV;"
Public Property Get gsDBASEIV As String
    'WAS: gsDBASEIV = "Dbase IV;"
    gsDBASEIV = LoadResString(S154_Dbase_IV)

End Property

'This was: Public Const gsDBASE5 = "Dbase 5.0;"
Public Property Get gsDBASE5 As String
    'WAS: gsDBASE5 = "Dbase 5.0;"
    gsDBASE5 = LoadResString(S150_Dbase_5_0)

End Property

'This was: Public Const gsFOXPRO20 = "FoxPro 2.0;"
Public Property Get gsFOXPRO20 As String
    'WAS: gsFOXPRO20 = "FoxPro 2.0;"
    gsFOXPRO20 = LoadResString(S263_FoxPro_2_0)

End Property

'This was: Public Const gsFOXPRO25 = "FoxPro 2.5;"
Public Property Get gsFOXPRO25 As String
    'WAS: gsFOXPRO25 = "FoxPro 2.5;"
    gsFOXPRO25 = LoadResString(S265_FoxPro_2_5)

End Property

'This was: Public Const gsFOXPRO26 = "FoxPro 2.6;"
Public Property Get gsFOXPRO26 As String
    'WAS: gsFOXPRO26 = "FoxPro 2.6;"
    gsFOXPRO26 = LoadResString(S267_FoxPro_2_6)

End Property

'This was: Public Const gsFOXPRO30 = "FoxPro 3.0;"
Public Property Get gsFOXPRO30 As String
    'WAS: gsFOXPRO30 = "FoxPro 3.0;"
    gsFOXPRO30 = LoadResString(S268_FoxPro_3_0)

End Property

'This was: Public Const gsPARADOX3X = "Paradox 3.X;"
Public Property Get gsPARADOX3X As String
    'WAS: gsPARADOX3X = "Paradox 3.X;"
    gsPARADOX3X = LoadResString(S399_Paradox_3_X)

End Property

'This was: Public Const gsPARADOX4X = "Paradox 4.X;"
Public Property Get gsPARADOX4X As String
    'WAS: gsPARADOX4X = "Paradox 4.X;"
    gsPARADOX4X = LoadResString(S401_Paradox_4_X)

End Property

'This was: Public Const gsPARADOX5X = "Paradox 5.X;"
Public Property Get gsPARADOX5X As String
    'WAS: gsPARADOX5X = "Paradox 5.X;"
    gsPARADOX5X = LoadResString(S402_Paradox_5_X)

End Property

'This was: Public Const gsBTRIEVE = "Btrieve;"
Public Property Get gsBTRIEVE As String
    'WAS: gsBTRIEVE = "Btrieve;"
    gsBTRIEVE = LoadResString(S76_Btrieve)

End Property

'This was: Public Const gsEXCEL30 = "Excel 3.0;"
Public Property Get gsEXCEL30 As String
    'WAS: gsEXCEL30 = "Excel 3.0;"
    gsEXCEL30 = LoadResString(S213_Excel_3_0)

End Property

'This was: Public Const gsEXCEL40 = "Excel 4.0;"
Public Property Get gsEXCEL40 As String
    'WAS: gsEXCEL40 = "Excel 4.0;"
    gsEXCEL40 = LoadResString(S215_Excel_4_0)

End Property

'This was: Public Const gsEXCEL50 = "Excel 5.0;"
Public Property Get gsEXCEL50 As String
    'WAS: gsEXCEL50 = "Excel 5.0;"
    gsEXCEL50 = LoadResString(S217_Excel_5_0)

End Property

'This was: Public Const gsTEXTFILES = "Text;"
Public Property Get gsTEXTFILES As String
    'WAS: gsTEXTFILES = "Text;"
    gsTEXTFILES = LoadResString(S541_Text)

End Property

'This was: Public Const APPNAME = "VisData6"
Public Property Get APPNAME As String
    APPNAME = "VisData6"
End Property

'This was: Public Const TABLE_STR = "Table"
Public Property Get TABLE_STR As String
    TABLE_STR = "Table"
End Property

'This was: Public Const ATTACHED_STR = "Attached"
Public Property Get ATTACHED_STR As String
    ATTACHED_STR = "Attached"
End Property

'This was: Public Const QUERY_STR = "Query"
Public Property Get QUERY_STR As String
    QUERY_STR = "Query"
End Property

'This was: Public Const FIELD_STR = "Field"
Public Property Get FIELD_STR As String
    FIELD_STR = "Field"
End Property

'This was: Public Const FIELDS_STR = "Fields"
Public Property Get FIELDS_STR As String
    FIELDS_STR = "Fields"
End Property

'This was: Public Const INDEX_STR = "Index"
Public Property Get INDEX_STR As String
    INDEX_STR = "Index"
End Property

'This was: Public Const INDEXES_STR = "Indexes"
Public Property Get INDEXES_STR As String
    INDEXES_STR = "Indexes"
End Property

'This was: Public Const PROPERTY_STR = "Property"
Public Property Get PROPERTY_STR As String
    PROPERTY_STR = "Property"
End Property

'This was: Public Const PROPERTIES_STR = "Properties"
Public Property Get PROPERTIES_STR As String
    PROPERTIES_STR = "Properties"
End Property

'This was: Public Const APP_CATEGORY = "Microsoft Visual Basic AddIns"
Public Property Get APP_CATEGORY As String
    'WAS: APP_CATEGORY = "Microsoft Visual Basic AddIns"
    APP_CATEGORY = LoadResString(S324_Microsoft_Visual_Ba)

End Property