hwbm.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 = "Hwbm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim Conn As ADODB.Connection

Dim m_HwBmFlCode As String
Dim m_HwBmCode As String
Dim m_HwBmMc As String
Dim m_HwBmPrice As Double
Dim m_HwBmDat As Date

Public Property Get HwBmFlCode() As String
   HwBmFlCode = m_HwBmFlCode
End Property

Public Property Get HwBmCode() As String
   HwBmCode = m_HwBmCode
End Property

Public Property Get HwBmMc() As String
   HwBmMc = m_HwBmMc
End Property

Public Property Get HwBmPrice() As Double
   HwBmPrice = m_HwBmPrice
End Property

Public Property Get HwBmDat() As Date
   HwBmDat = m_HwBmDat
End Property

Public Property Let HwBmFlCode(vHwBmFlCode As String)

   If Trim(vHwBmFlCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物分类码不能为空！"
      Exit Property
   End If
   
   Dim Rs As ADODB.Recordset
   Set Rs = New ADODB.Recordset
   Set Rs.ActiveConnection = Conn
   Rs.Open "SELECT * FROM HWFLREC WHERE HWFLCODE='" & vHwBmFlCode & "'"
   
   If Rs.EOF Then
      Rs.Close
      Set Rs = Nothing
      Err.Raise vbObjectError + 1, , "选择的货物分类码不存在！"
      Exit Property
   End If
   
   Rs.Close
   Set Rs = Nothing
   
   m_HwBmFlCode = vHwBmFlCode
   
End Property

Public Property Let HwBmCode(vHwBmCode As String)

   If Trim(vHwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   
   Dim Rs As ADODB.Recordset
   Set Rs = New ADODB.Recordset
   Set Rs.ActiveConnection = Conn
   
   Rs.Open "SELECT * FROM HWBMREC WHERE HWBMCODE='" & vHwBmCode & "'"
   
   If Not Rs.EOF Then
      Rs.Close
      Set Rs = Nothing
      Err.Raise vbObjectError + 1, , "货物编码已经存在！"
      Exit Property
   End If
   
   Rs.Close
   Set Rs = Nothing
   
   m_HwBmCode = vHwBmCode
   
End Property

Public Property Let HwBmMc(vHwBmMc As String)

   If Trim(vHwBmMc) = "" Then
      Err.Raise vbObjectError + 1, , "货物名称不能为空！"
      Exit Property
   End If
   
   m_HwBmMc = vHwBmMc
   
End Property

Public Property Let HwBmPrice(vHwBmPrice As Double)

   If vHwBmPrice < 0 Then
      Err.Raise vbObjectError + 1, , "货物单价不能小于零！"
      Exit Property
   End If
   
   m_HwBmPrice = vHwBmPrice
   
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
   
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = Conn
   
   Cmd.CommandText = "{CALL VBSQLPROADD(?,?,?,?)}"
   Cmd(0) = m_HwBmFlCode
   Cmd(1) = m_HwBmCode
   Cmd(2) = m_HwBmMc
   Cmd(3) = m_HwBmPrice
   Cmd.Execute
   
   Set Cmd = Nothing

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

Private Sub Class_Initialize()

   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
   
End Sub

Private Sub Class_Terminate()

   Set Conn = Nothing

End Sub