clsvendor.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsVendor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mintNumber As Integer
Private mstrCompany As String
Private mstrAddress As String
Private mstrFEIN As String
Private mstrDelimitedString As String
Property Let DelimitedString(strInput As String)
    Dim strDelimiter As String, strTextNumber As String
    Dim intEnd As Integer, intField As Integer, intStart As Integer
    Dim I As Integer
    
    strDelimiter = Chr$(9): mstrDelimitedString = strInput
    intStart = 1: intField = 1

    Do
        intEnd = InStr(intStart, strInput, strDelimiter)
        If intEnd = 0 Then intEnd = Len(strInput) + 1

        Select Case intField
            Case 1
                strTextNumber = ExtractField(intStart, intEnd)
                If IsNumeric(strTextNumber) Then
                    If strTextNumber >= 1 And strTextNumber <= 32767 Then
                        mintNumber = Val(strTextNumber)
                    Else
                        mintNumber = 0
                    End If
                Else
                    mintNumber = 0
                End If
            Case 2
                mstrCompany = ExtractField(intStart, intEnd)
            Case 3
                mstrAddress = ExtractField(intStart, intEnd)
            Case 4
                mstrFEIN = ExtractField(intStart, intEnd)
        End Select

        intStart = intEnd + 1: intField = intField + 1
    Loop While intEnd < Len(strInput) And intField <= 4
End Property
Public Function StoreNewItem(recTemp As Recordset) As Boolean
    On Error GoTo StoreNewError
        recTemp.AddNew
        If WriteItem(recTemp) Then
            recTemp.Update
        Else
            GoTo StoreNewError
        End If
    
        StoreNewItem = True
    On Error GoTo 0
Exit Function

StoreNewError:
    StoreNewItem = False
    Exit Function

End Function

Private Function WriteItem(recTemp As Recordset) As Boolean
    On Error GoTo WriteItemError
        recTemp("Vendor Number") = mintNumber
        recTemp("Name") = mstrCompany
        recTemp("Address") = mstrAddress
        recTemp("FEIN") = mstrFEIN
        WriteItem = True
    On Error GoTo 0
Exit Function

WriteItemError:
    WriteItem = False
    Exit Function
End Function

Private Function ExtractField(intStart As Integer, intEnd As Integer)
    ExtractField = Mid$(mstrDelimitedString, intStart, (intEnd - intStart))
End Function

Property Get Number() As Integer
    Number = mintNumber
End Property

Property Get Company() As String
    Company = mstrCompany
End Property

Property Get Address() As String
    Address = mstrAddress
End Property

Property Get FEIN() As String
    FEIN = mstrFEIN
End Property