hwbms.cls

用vb和SQLSERVER编译的关于数据库的源程序例子。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Hwbms"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim OHwbms As Collection

Public Property Get Name() As String
   Name = "Hwbms"
End Property

Private Sub Class_Initialize()
   Set OHwbms = New Collection
End Sub

Public Sub Add(OHwbm As Hwbm, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vHwbm As Hwbm
   For Each vHwbm In OHwbms
      If mKey < vHwbm.HwbmKey Then
         mKey = vHwbm.HwbmKey
      End If
   Next
   OHwbm.HwbmKey = mKey + 1
   If Needsave = 1 Then
      OHwbm.Save
   End If
   OHwbms.Add Item:=OHwbm, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim OHwbm As Hwbm
   Set OHwbm = Item(Vindex)
   If Needdel = 1 And OHwbm.HwbmId = 1 Then
      OHwbm.Del
   End If
   OHwbms.Remove (Vindex)
   Set OHwbm = Nothing
   
End Sub

Public Property Get Count() As Integer
   Count = OHwbms.Count
End Property

Public Function Item(Vindex) As Hwbm
Attribute Item.VB_UserMemId = 0
   Set Item = OHwbms.Item(Vindex)
End Function

Public Sub ClearAll()
   Dim i, Vcount As Integer
   Vcount = OHwbms.Count
   For i = 1 To Vcount
      OHwbms.Remove (1)
   Next
End Sub

Public Sub Fillbydb()
   Dim OHwbm As Hwbm
   Dim Conn As ADODB.Connection
   Dim Rs As ADODB.Recordset
   Dim mKey As Integer
On Error GoTo Errorhandle

   Set Conn = New ADODB.Connection
   Conn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=fiterp;Data Source=ERP002"
   Conn.Open
   Conn.CursorLocation = adUseClient

   ClearAll
   Set Rs = Conn.Execute("SELECT HWBMFLCODE,HWBMCODE,HWBMMC,HWBMPRICE,HWBMDAT FROM HWBMREC ORDER BY HWBMFLCODE,HWBMCODE")
   mKey = 1
   Do Until Rs.EOF
      Set OHwbm = New Hwbm
      OHwbm.HwbmKey = mKey
      OHwbm.BatchLet Rs!HwBmFlCode, Rs!HwBmCode, Rs!HwBmMc, Rs!HwBmPrice, Rs!HwBmDat
      OHwbms.Add Item:=OHwbm, Key:=CStr(mKey)
      Rs.MoveNext
      mKey = mKey + 1
   Loop
   
   Rs.Close
   Set Rs = Nothing
   Set Conn = Nothing

Exit Sub
Errorhandle:
   If Not Rs Is Nothing Then
     Rs.Close
   End If
   Set Rs = Nothing
   Set Conn = Nothing
End Sub

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
  Set NewEnum = OHwbms.[_NewEnum]
End Function

Private Sub Class_Terminate()
   ClearAll
   Set OHwbms = Nothing
End Sub