cwbz.cls

制造业产供销与往来系统源码,包括进销存及全部控件！

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

Dim M_CwbzCode As String
Dim M_CwbzMc As String
Dim M_CwbzExra As Double
Dim M_CwbzIsStop As Integer
Dim M_CwbzNo As Double

Dim M_Cwbz_id As Integer
Dim M_Cwbz_Key As Long

Private Sub Class_Initialize()

M_Cwbz_id = -1

End Sub

Public Property Get CwbzCode() As String

CwbzCode = M_CwbzCode

End Property

Public Property Get CwbzMc() As String

CwbzMc = M_CwbzMc

End Property

Public Property Get CwbzExra() As Double

CwbzExra = M_CwbzExra

End Property

Public Property Get CwbzIsStop() As Integer

CwbzIsStop = M_CwbzIsStop

End Property

Public Property Get CwbzNo() As Double

CwbzNo = M_CwbzNo

End Property

Public Property Get Cwbz_id() As Integer

    Cwbz_id = M_Cwbz_id

End Property

Public Property Get Cwbz_Key() As Long

    Cwbz_Key = M_Cwbz_Key

End Property

Public Property Let CwbzCode(VCwbzCode As String)

If Trim(VCwbzCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="币种不能为空！"
   Exit Property
End If

If VCwbzCode <> M_CwbzCode Then
    If M_Cwbz_id = -1 Or VCwbzCode <> M_CwbzCode Then
       If gPublicFunction.ExistFlg("FROM CWBZREC WHERE CwbzCode='" + VCwbzCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有币种:" & VCwbzCode
          Exit Property
       End If
    End If
End If
    
M_CwbzCode = VCwbzCode

End Property

Public Property Let CwbzMc(VCwbzMc As String)

If Trim(VCwbzMc) = "" Then
   Err.Raise vbObjectError + 1, , "币种名称不能为空！"
   Exit Property
End If

If VCwbzMc <> M_CwbzMc Then
    If M_Cwbz_id = -1 Or VCwbzMc <> M_CwbzMc Then
       If gPublicFunction.ExistFlg("FROM CwbzREC WHERE CwbzMc='" + VCwbzMc + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有币种:" & VCwbzMc
          Exit Property
       End If
    End If
    M_CwbzMc = VCwbzMc
End If

End Property

Public Property Let CwbzExra(VCwbzExra As Double)

If VCwbzExra <= 0 Then
   Err.Raise vbObjectError + 1, , "汇率不能小于等于零！"
   Exit Property
End If

M_CwbzExra = VCwbzExra

End Property

Public Property Let CwbzIsStop(VCwbzIsStop As Integer)

If VCwbzIsStop <> 0 And VCwbzIsStop <> 1 Then
   Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
   Exit Property
End If

M_CwbzIsStop = VCwbzIsStop

End Property

Public Property Let Cwbz_id(vCwbz_id As Integer)

M_Cwbz_id = vCwbz_id

End Property

Public Property Let Cwbz_Key(vCwbz_Key As Long)

M_Cwbz_Key = vCwbz_Key

End Property

Public Sub DbSave()
   Dim Cmd As ADODB.Command
   Dim mSqlStr As String
On Error GoTo ErrorHandle


   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If M_Cwbz_id = -1 Then
   
       Cmd.CommandText = "{CALL CwbzREC_INSERT(?,?,?,?,?)}"
       
       Cmd.Parameters(0) = M_CwbzCode
       Cmd.Parameters(1) = M_CwbzMc
       Cmd.Parameters(2) = M_CwbzExra
       Cmd.Parameters(3) = M_CwbzIsStop
       Cmd.Parameters(4).Direction = adParamOutput
       
       Cmd.Execute
       
       M_Cwbz_id = 1
   
       M_CwbzNo = Cmd.Parameters(4)
      
   Else
   
       Cmd.CommandText = "{CALL CwbzREC_UPDATE(?,?,?,?,?)}"
       
       Cmd(0) = M_CwbzNo
       
       Cmd(1) = M_CwbzCode
       Cmd(2) = M_CwbzMc
       Cmd(3) = M_CwbzExra
       Cmd(4) = M_CwbzIsStop
       
       Cmd.Execute
   
   End If
   
   Set Cmd = Nothing

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

Public Sub DbDel()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "CWBZREC", "CWBZNO", CStr(M_CwbzNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{call Cwbzrec_delete(?)}"
   
   Cmd.Parameters(0) = M_CwbzNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   Set Cmd = Nothing

Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
End Sub

Public Function Requery(VCwbzCode As String) As Integer
   Dim Rs As DbRs
On Error GoTo ErrorHandle

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select CwbzCode,CwbzMc,CwbzExra,CWBZISSTOP,CwbzNo from Cwbzrec where CwbzCode='" + VCwbzCode + "'")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!CwbzCode, Rs!CwbzMc, Rs!CwbzExra, Rs!CwbzIsStop, Rs!CwbzNo
   End If
 
   Set Rs = Nothing

Exit Function
ErrorHandle:
   Set Rs = Nothing
End Function

Public Sub BatchLet(ParamArray Properties())

M_CwbzCode = Properties(0)
M_CwbzMc = Properties(1)
M_CwbzExra = Properties(2)
M_CwbzIsStop = Properties(3)
M_CwbzNo = Properties(4)

M_Cwbz_id = 1

End Sub

Public Property Get Name() As String

Name = "Cwbz"

End Property