addfield.frm

《VB6数据库开发指南》所有的例程的源码

    'Iterate through the TableDefs collection of the database, searching for the
    'table name specified in
    For Each tbfTemp In dbfBiblio.TableDefs
        'If we find the table, iterate through the Fields collection,
        'adding each field and its field type to the Field List list box
        If tbfTemp.Name = txtTableName.Text Then
            For Each fldTemp In tbfTemp.Fields
                Select Case fldTemp.Type
                    Case dbBigInt
                        strFieldType = "BIGINT"
                    Case dbBinary
                        strFieldType = "BINARY"
                    Case dbBoolean
                        strFieldType = "BOOLEAN"
                    Case dbByte
                        strFieldType = "BYTE"
                    Case dbChar
                        strFieldType = "CHAR(" & fldTemp.FieldSize & ")"
                    Case dbCurrency
                        strFieldType = "CURRENCY"
                    Case dbDate
                        strFieldType = "DATE"
                    Case dbDecimal
                        strFieldType = "DECIMAL"
                    Case dbDouble
                        strFieldType = "DOUBLE"
                    Case dbFloat
                        strFieldType = "FLOAT"
                    Case dbGUID
                        strFieldType = "GUID"
                    Case dbInteger
                        strFieldType = "INTEGER"
                    Case dbLong
                        strFieldType = "LONG"
                    Case dbLongBinary
                        strFieldType = "LONGBINARY"
                    Case dbMemo
                        strFieldType = "LONGTEXT"
                    Case dbNumeric
                        strFieldType = "NUMERIC"
                    Case dbSingle
                        strFieldType = "SINGLE"
                    Case dbText
                        strFieldType = "TEXT"
                    Case dbTime
                        strFieldType = "TIME"
                    Case dbTimeStamp
                        strFieldType = "TIMESTAMP"
                    Case dbVarBinary
                        strFieldType = "VARBINARY"
                End Select
                lstFields.AddItem fldTemp.Name & " [" & strFieldType & "]"
            Next
        Exit For
        End If
    Next
End Sub
Sub FillTypeList()
    'Fill the Field Type combo box with types of available fields
    With cboFieldTypes
        .AddItem "Counter"
        .AddItem "Currency"
        .AddItem "Date/Time"
        .AddItem "Memo"
        .AddItem "Number: Byte"
        .AddItem "Number: Integer"
        .AddItem "Number: Long"
        .AddItem "Number: Single"
        .AddItem "Number: Double"
        .AddItem "OLE Object"
        .AddItem "Text"
        .AddItem "Yes/No"
    End With
End Sub

Private Sub cmdAddField_Click()
    Dim strFieldType As String, strSQL As String
    
    'Check first if the Field Name text box contains a legal name
    If LegalName(True) Then
        On Error GoTo BadAdd
            'If it does, check if the Field Type has been selected.
            If cboFieldTypes.ListIndex > -1 Then
                'If both criteria are satisfied, store the SQL field type
                'in the strFieldType string.
                Select Case cboFieldTypes.Text
                    Case "Counter"
                        strFieldType = "COUNTER"
                    Case "Currency"
                        strFieldType = "CURRENCY"
                    Case "Date/Time"
                        strFieldType = "DATETIME"
                    Case "Memo"
                        strFieldType = "LONGTEXT"
                    Case "Number: Byte"
                        strFieldType = "BYTE"
                    Case "Number: Integer"
                        strFieldType = "SHORT"
                    Case "Number: Long"
                        strFieldType = "LONG"
                    Case "Number: Single"
                        strFieldType = "SINGLE"
                    Case "Number: Double"
                        strFieldType = "DOUBLE"
                    Case "OLE Object"
                        strFieldType = "LONGBINARY"
                    Case "Text (25 chars)"
                        strFieldType = "TEXT(25)"
                    Case "Yes/No"
                        strFieldType = "BIT"
                End Select
                
                'Crate the ALTER TABLE statement
                strSQL = "ALTER TABLE [" & txtTableName.Text & "] ADD COLUMN [" & txtFieldName & "] " & strFieldType
                'Execute the SQL
                dbfBiblio.Execute (strSQL)
                'Add the new field to the Field List list box.
                lstFields.AddItem txtFieldName & " [" & strFieldType & "]"
                
                'Reset the Field Name and Field Type controls.
                txtFieldName = ""
                cboFieldTypes.ListIndex = -1
            Else
                MsgBox "You must select a field type.", vbExclamation
            End If
        On Error GoTo 0
    End If
Exit Sub

BadAdd:
    MsgBox Err.Description, vbExclamation
End Sub

Function LegalName(intAction As Boolean) As Boolean
    Dim i As Integer
    Dim recNameCheck As Recordset

    On Error GoTo IllegalName
        'If blank, raise an error.
        If Len(txtFieldName.Text) = 0 Then Err.Raise 32767
        'If it has a leading space, raise an error.
        If Left$(txtFieldName.Text, 1) = " " Then Err.Raise 32766
        'If it contains any of the characters in the IllegalCharacters constant,
        'raise an error
        For i = 1 To Len(IllegalCharacters)
            If InStr(txtFieldName.Text, Mid(IllegalCharacters, i, 1)) > 0 Then Err.Raise 32765
        Next i
        'If it contains any ANSI character from Chr$(0) to Chr$(31),
        '(you guessed it) raise an error.
        For i = 0 To 31
            If InStr(txtFieldName.Text, Chr(i)) > 0 Then Err.Raise 32764
        Next i
        
        If intAction Then
            'It's an add field; insure that the name doesn't already exist.  If so,
            'raise an error.
            For i = 0 To lstFields.ListCount - 1
                If txtFieldName.Text = lstFields.List(i) Then Err.Raise 32763
            Next i
        Else
            'It's a drop field; insure that the field being erased contains no data.
            'If so, raise an error
            Set recNameCheck = dbfBiblio.OpenRecordset("SELECT [" & txtFieldName.Text & _
                "] FROM [" & txtTableName.Text & "] WHERE [" & txtFieldName.Text & "] IS NOT NULL")
            If recNameCheck.RecordCount Then Err.Raise 32762
        End If
        
        'If they've managed to get through all that validation, the function
        'should be True, to indicate success.
        LegalName = True
    On Error GoTo 0
Exit Function

IllegalName:
    Dim strErrDesc As String
    'Build an error message based on the user-defined error that occurred.
    Select Case Err.Number
        Case 32767
            strErrDesc = "You must enter a field name."
        Case 32766
            strErrDesc = "The field name cannot begin with a space."
        Case 32765
            strErrDesc = "The field name contains the illegal character " & _
                Mid(IllegalCharacters, i, 1) & "."
        Case 32764
            strErrDesc = "The field name contains the control character " & _
                "with the ANSI value" & Str$(i) & "."
        Case 32763
            strErrDesc = "The field name " & txtFieldName.Text & _
                " already exists in the field name list."
        Case 32762
            strErrDesc = "The field name " & txtFieldName.Text & _
                " has data; it cannot be deleted."
        Case Else
            ' Visual Basic's default error message.
            strErrDesc = Err.Description
    End Select

    MsgBox strErrDesc, vbExclamation
    
    'The function indicates False, or failure.
    LegalName = False
Exit Function

End Function

Private Sub cmdRemoveField_Click()
    Dim strSQL As String, strTemp As String
    
    ' If the user has selected a field, remove it from the list.
    ' Otherwise, just ignore the click.
    If lstFields.ListIndex > -1 Then
        'Call the lstFields_Click event, to insure that txtFieldName is still populated.
        'The user might have erased it after selecting a field to delete.
        Call lstFields_Click
        If LegalName(False) Then
            'Build the ALTER TABLE statement
            strSQL = "ALTER TABLE [" & txtTableName.Text & "] DROP COLUMN [" & _
                txtFieldName.Text & "]"
            'Execute the SQL
            dbfBiblio.Execute (strSQL)
            'Delete the field from the Field List
            lstFields.RemoveItem lstFields.ListIndex
        End If
    End If
End Sub

Private Sub cmdClose_Click()
    End
End Sub


Private Sub lstFields_Click()
    Dim strTemp As String
    
    'If a field has been selected, extract the field's name from
    'the list entry and display it in the txtFieldName control.
    If lstFields.ListIndex > -1 Then
        strTemp = lstFields.List(lstFields.ListIndex)
        strTemp = Left(strTemp, InStr(strTemp, "[") - 2)
        txtFieldName.Text = strTemp
    End If
End Sub