gyzccare.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 = "GyzcCare"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim cmmMy As New ADODB.Command
Dim rstMy As New ADODB.Recordset

    Function checkComboBox(cmbMy As ComboBox) As Boolean
      checkComboBox = False
    If cmbMy.Tag = "" Then
    checkComboBox = True
    Exit Function
    End If
       End Function
 Function AddCare(ByVal BH As String, ByVal CodeID As String, ByVal MyName As String, ByVal ModeID As String, _
 ByVal Je As String, ByVal GG As String, ByVal Sl As String, ByVal Jldw As String, ByVal DwBmID As String, _
 ByVal JZYEAR As String, ByVal JZMONTH As String, ByVal GzZq As String, ByVal Bz As String, ByVal UseState As String) As Boolean
        On Error GoTo err:
        AddCare = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdStoredProc
        cmmMy.CommandText = "AddGyzcCare"
        cmmMy.Parameters(1).Value = BH
        cmmMy.Parameters(2).Value = CodeID
        cmmMy.Parameters(3).Value = MyName
        cmmMy.Parameters(4).Value = ModeID
        cmmMy.Parameters(5).Value = Je
        cmmMy.Parameters(6).Value = GG
        cmmMy.Parameters(7).Value = Sl
        If Jldw <> "" Then
        cmmMy.Parameters(8).Value = Jldw
        Else
              cmmMy.Parameters(8).Value = Null
        End If
        cmmMy.Parameters(9).Value = DwBmID
        
                If JZYEAR <> "" Then
        cmmMy.Parameters(10).Value = Jldw
        Else
              cmmMy.Parameters(10).Value = Null
        End If
       
                     If JZMONTH <> "" Then
        cmmMy.Parameters(11).Value = Jldw
        Else
              cmmMy.Parameters(11).Value = Null
        End If
        If GzZq = "" Then
        cmmMy.Parameters(12).Value = Null
        Else
        cmmMy.Parameters(12).Value = GzZq
        End If
        cmmMy.Parameters(13).Value = Bz
        cmmMy.Parameters(14).Value = UseState
     
        cmmMy.Execute
        AddCare = True
        sqlconn.Close
        Exit Function
        
err:
AddCare = False
        If err.Number = -2147217873 Then
        MsgBox "输入卡号重复", vbInformation, "提示"
        err.clear
        Else
        MsgBox err.Description
       End If
        
        
           End Function
     Function DeleteCare(ByVal str1 As String) As Boolean
        On Error GoTo err:
        DeleteCare = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdText
        cmmMy.CommandText = str1
       cmmMy.Execute
        sqlconn.Close
        DeleteCare = True
        Exit Function
        
err:
DeleteCare = False
   
        MsgBox err.Description, vbInformation, "提示"
        err.clear
       
        
        
           End Function
     Function UpdataCare(ByVal str1 As String, ByVal str2 As String, ByVal str3 As String, ByVal str4 As String, _
 ByVal str5 As String, ByVal str6 As String, ByVal str7 As String, ByVal str8 As String, ByVal str9 As String, ByVal str10 As String, ByVal str11 As String, ByVal str12 As String) As Boolean
        On Error GoTo err:
        UpdataCare = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdStoredProc
        cmmMy.CommandText = "UpdataGyzcCare"
        cmmMy.Parameters(1).Value = str1
        cmmMy.Parameters(2).Value = str2
        cmmMy.Parameters(3).Value = str3
        cmmMy.Parameters(4).Value = str4
        cmmMy.Parameters(5).Value = str5
        cmmMy.Parameters(6).Value = str6
        cmmMy.Parameters(7).Value = str7
        cmmMy.Parameters(8).Value = str8
        cmmMy.Parameters(9).Value = str9
    If str10 <> "" Then
        cmmMy.Parameters(10).Value = str10
        Else
        cmmMy.Parameters(10).Value = Null
        End If
        cmmMy.Parameters(11).Value = str11
      cmmMy.Parameters(12).Value = str12
        cmmMy.Execute
        UpdataCare = True
        sqlconn.Close
        Exit Function
err:
 UpdataCare = False
         MsgBox err.Description, vbInformation, "提示"
        err.clear
         
        End Function
  Function AddGrid(ByVal strSql As String, ByVal mygrid As MSHFlexGrid)
          sqlconn_open
         mygrid.clear
        
         cmmMy.ActiveConnection = sqlconn
         cmmMy.CommandText = strSql
       
         Set rstMy = cmmMy.Execute
   
         Set mygrid.DataSource = rstMy
         mygrid.Row = 0
         For i = 0 To mygrid.Cols - 1
         mygrid.col = i
               mygrid.CellAlignment = 5
        Next


         mygrid.ColAlignment(5) = 1
         mygrid.ColWidth(0) = 1000
         mygrid.ColWidth(1) = 3000
         mygrid.ColWidth(2) = 3000
         mygrid.ColWidth(3) = 3000
         mygrid.ColWidth(4) = 2000
         mygrid.ColWidth(5) = 1500
         mygrid.ColWidth(6) = 1000
         mygrid.ColWidth(7) = 2000
         mygrid.ColWidth(8) = 1500
         mygrid.ColWidth(9) = 1300
         mygrid.ColWidth(10) = 1300
         mygrid.ColWidth(11) = 1300
         mygrid.ColWidth(12) = 3000
         mygrid.ColWidth(13) = 1300
         sqlconn.Close
    End Function
Function CareLess(str1 As String, str2 As String, str3 As String) As Boolean
 On Error GoTo err:
        CareLess = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdStoredProc
        cmmMy.CommandText = "LessGyzcCare"
        cmmMy.Parameters(1).Value = str1 '"@BH"
        cmmMy.Parameters(2).Value = str2 '"@ModeName"
        cmmMy.Parameters(3).Value = str3 '"@yszq
       cmmMy.Execute
      CareLess = True
        sqlconn.Close
        Exit Function
err:
 CareLess = False
         MsgBox err.Description, vbInformation, "提示"
        err.clear
         
        End Function
 Function Cancelless(ByVal str1 As String) As Boolean

 On Error GoTo err:
        Cancelless = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdText
        cmmMy.CommandText = "update GyzcCare set mode1= null,CzFlag=1 ,YsZq=null where BH=" & "'" & str1 & "'"
        cmmMy.Execute
       Cancelless = True
        sqlconn.Close
        Exit Function
err:
  Cancelless = False
         MsgBox err.Description, vbInformation, "提示"
        err.clear
         
        End Function
Function CareZy(ByVal str1 As String, ByVal str2 As String, ByVal str3 As String, ByVal str4 As String) As Boolean
 On Error GoTo err:
        CareZy = False
        sqlconn_open
        cmmMy.ActiveConnection = sqlconn
        cmmMy.CommandType = adCmdText
        cmmMy.CommandType = adCmdStoredProc
        cmmMy.CommandText = "ZyGyzcCare"
         cmmMy.Parameters(1).Value = str1 '"@BH"
        cmmMy.Parameters(2).Value = str2 '"@OutBm"
        cmmMy.Parameters(3).Value = str3 '"@InBm"
        cmmMy.Parameters(4).Value = str4 '"@Sj"
        cmmMy.Execute
  CareZy = True
        sqlconn.Close
        Exit Function
err:
  CareZy = False
         MsgBox err.Description, vbInformation, "提示"
        err.clear
End Function
Function AddDataComboBox(ByVal strSql As String, myComboBox As ComboBox)
Call sqlconn_open
 cmmMy.ActiveConnection = sqlconn
 cmmMy.CommandType = adCmdText
 cmmMy.CommandText = strSql
 Set rstMy = cmmMy.Execute
 While Not rstMy.EOF()
       myComboBox.AddItem (rstMy(1).Value)
       myComboBox.ItemData(myComboBox.NewIndex) = rstMy.Fields(0).Value
       rstMy.MoveNext
 Wend
 sqlconn.Close
    End Function