VERSION 5.00
Begin VB.Form frmNew 
   Caption         =   "Create New Inform Database"
   ClientHeight    =   1995
   ClientLeft      =   2280
   ClientTop       =   1695
   ClientWidth     =   6225
   Icon            =   "frmNew.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   1995
   ScaleWidth      =   6225
   Begin VB.CommandButton cbCancel 
      Caption         =   "&Cancel"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   3375
      TabIndex        =   6
      Top             =   1440
      Width           =   1320
   End
   Begin VB.CommandButton cbOK 
      Caption         =   "&OK"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   4815
      TabIndex        =   5
      Top             =   1440
      Width           =   1320
   End
   Begin VB.TextBox txtFiledesc 
      Height          =   330
      Left            =   120
      TabIndex        =   3
      Top             =   915
      Width           =   6015
   End
   Begin VB.TextBox txtFilename 
      Height          =   330
      Left            =   120
      MaxLength       =   8
      TabIndex        =   0
      Top             =   255
      Width           =   1350
   End
   Begin VB.Label Label3 
      Caption         =   "Description"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   135
      TabIndex        =   4
      Top             =   705
      Width           =   1815
   End
   Begin VB.Label Label2 
      Caption         =   "Limit the name to 8 letters (a-z) please."
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   1575
      TabIndex        =   2
      Top             =   315
      Width           =   4065
   End
   Begin VB.Label Label1 
      Caption         =   "Name"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   135
      TabIndex        =   1
      Top             =   45
      Width           =   1815
   End
End
Attribute VB_Name = "frmNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Function GetAccessDriverName() As String
    Dim odbc As New ODBCTool.Dsn
    Dim DList() As String
    
    odbc.GetOdbcDriverList DList()

    For d = 0 To UBound(DList)
        If InStr(1, DList(d), "Access") > 0 Then
            GetAccessDriverName = DList(d)
            Exit For
        End If
    Next d
    Set odbc = Nothing
End Function

Public Sub CreateDSNEntry(strDSN As String, strFile As String, strDesc As String)
    Dim odbc As New ODBCTool.Dsn
    Dim rtnVal As Boolean
    Dim strDriver As String
    strDriver = GetAccessDriverName
    rtnVal = odbc.CreateDSN(strDSN, strDriver, "", "", "Admin", "", strDesc, True, "")
End Sub
Public Function GetDir() As String
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform")
    GetDir = objRegKey.Values("Path")
    Set objRegKey = Nothing
End Function

Private Sub cbCancel_Click()
    Unload Me
End Sub

Private Sub cbOK_Click()
    Dim strBaseFile As String
    Dim strFile As String
    Dim strFilename As String
    Dim strFiledesc As String
    Dim c As Integer
    Dim strDSN As String

    strFilename = LCase(frmNew.txtFilename)
    For c = 1 To Len(strFilename)
        If InStr(1, "abcdefghijklmnopqrstuvwxyz", Mid(strFilename, c, 1)) = 0 Then
            MsgBox "Filename must be 1 to 8 letters from a to z", , "Create New Inform Database"
            Exit Sub
        End If
    Next c
    strFilename = UCase(Left(strFilename, 1)) & Right(strFilename, Len(strFilename) - 1)
    strFiledesc = frmNew.txtFiledesc
    '
    ' Copy base database to new file
    '
    strBaseFile = GetDir & "VInform.mdb"
    strFile = GetDir & strFilename & ".mdb"

    FileCopy strBaseFile, strFile

    '
    ' Create DSN Entry
    '
    strDSN = "VInform." & strFilename

    CreateDSNEntry strDSN, strFile, strFiledesc

    '
    ' Register new database and set filename (DBQ) in ODBC entry
    '
    RegisterVFile strFilename, strDSN, strFile
    '
    ' Open new database
    '
    OpenDatabase strDSN

    Unload Me
End Sub
Public Function RegisterVFile(strName As String, strDSN As String, strFile As String)
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\Files")
    objRegKey.Values.Add strName, strDSN, RegValueType.rvString
    Set regobjkey = Nothing
    Set objRegKey = RegKeyFromString("\HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\" & strDSN)
    objRegKey.Values.Add "DBQ", strFile, RegValueType.rvString
    Set objRegKey = Nothing
End Function