khs.cls

来自「制造业产供销与往来系统源码」· CLS 代码 · 共 123 行

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

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

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

Public Sub Add(OKh As Kh, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vKh As Kh
   For Each vKh In OKhs
      If mKey < vKh.KhKey Then
         mKey = vKh.KhKey
      End If
   Next
   OKh.KhKey = mKey + 1
   If Needsave = 1 Then
      OKh.Save
   End If
   OKhs.Add Item:=OKh, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim OKh As Kh
   Set OKh = Item(Vindex)
   If Needdel = 1 And OKh.KhId = 1 Then
      OKh.Del
   End If
   OKhs.Remove (Vindex)
   Set OKh = Nothing
   
End Sub

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

Public Function Item(Vindex) As Kh
Attribute Item.VB_UserMemId = 0
   Set Item = OKhs.Item(Vindex)
End Function

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

Public Sub Fillbydb(Optional mWhereStr As String = "")
   Dim OKh As Kh
   Dim Rs As DbRs
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll

   mSqlStr = "SELECT KHTYPE,KhCODE,KhMC,KhTel,KHFAX,KHEMAIL,KHWWW,KHADD,KHPCODE,KHLINKMAN,KhISSTOP,"
   mSqlStr = mSqlStr & "KH_CWBZCODE=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=KH_CWBZNO),''),KH_CWBZNO,"
   mSqlStr = mSqlStr & "KH_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=KH_CWSMNO),''),KH_CWSMNO,"
   mSqlStr = mSqlStr & "KhNO FROM KHREC"
      
   If mWhereStr <> "" Then
      mSqlStr = mSqlStr & " WHERE " & mWhereStr
   End If
   
   mSqlStr = mSqlStr & " ORDER BY KHCODE"
   
   Set Rs = New DbRs
   Rs.Fillbydb mSqlStr
      
   Rs.MoveFirst
   
   mKey = 1
   Do Until Rs.EOF
      Set OKh = New Kh
      OKh.KhKey = mKey
      OKh.BatchLet Rs!KhType, Rs!KhCode, Rs!KhMc, Rs!KhTel, Rs!KhFax, Rs!KhEmail, Rs!KhWww, Rs!KhAdd, Rs!KhPCode, Rs!KhLinkMan, Rs!Kh_CwBzCode, Rs!Kh_CwBzno, Rs!Kh_CwSmCode, Rs!Kh_CwSmno, Rs!KhIsStop, Rs!KhNo
      OKhs.Add Item:=OKh, Key:=CStr(mKey)
      Rs.MoveNext
      mKey = mKey + 1
   Loop
   
   Set Rs = Nothing

Exit Sub
Errorhandle:
   Set Rs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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