suppliertroukdao.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 = "suppliertroukDAO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**************************************
'*    模 块 名 称 :联系目的、联系方式设置模块中的数据据库操作
'*    功 能 描 述 :联系目的、联系方式设置模块中的数据据库操作
'*    程序员姓名  : 石春晓
'*    最后修改人  : 石春晓
'*    最后修改时间:2005/10/10
'**************************************
Option Explicit
'**************************************
'*    功 能 描 述 :取得所有联系目的的列表
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function FindlxmdAll(recSet As ADODB.Recordset) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    FindlxmdAll = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxmd_findAll"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            FindlxmdAll = True
        Else
            FindlxmdAll = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    FindlxmdAll = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :新增一条联系目的数据
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  新增成功
'*                 False          -  新增失败
'**************************************
Public Function Newlxmd(recSet As ADODB.Recordset, _
                              xh As String, name As String, memo As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    Newlxmd = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxmd_add"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = xh              ' 参数
    cmdProc.Parameters(2) = name            ' 参数
    cmdProc.Parameters(3) = memo            ' 参数
    
    ' 执行命令 把查询到的结果放在recSet中
    MainForm.g_application.m_databaseCon.m_adoConnection.BeginTrans    ' 开始事务
    
    On Error GoTo Cwcl
       cmdProc.Execute

   
   MainForm.g_application.m_databaseCon.m_adoConnection.CommitTrans   ' 结束事务
    Exit Function
    
Cwcl:
    MainForm.g_application.m_databaseCon.m_adoConnection.RollbackTrans   ' 回滚事务
    Newlxmd = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :修改一条联系目的数据
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  新增成功
'*                 False          -  新增失败
'**************************************
Public Function Modifylxmd(recSet As ADODB.Recordset, _
                              xh As String, name As String, memo As String, lxmdid As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    Modifylxmd = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxmd_modify"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = xh              ' 参数
    cmdProc.Parameters(2) = name              ' 参数
    cmdProc.Parameters(3) = memo      ' 参数
    cmdProc.Parameters(4) = lxmdid      ' 参数
    ' 执行命令 把查询到的结果放在recSet中
    MainForm.g_application.m_databaseCon.m_adoConnection.BeginTrans    ' 开始事务
    
    On Error GoTo Cwcl
           cmdProc.Execute
           Modifylxmd = True

    MainForm.g_application.m_databaseCon.m_adoConnection.CommitTrans   ' 结束事务
    Modifylxmd = True
    Exit Function
    
Cwcl:
    MainForm.g_application.m_databaseCon.m_adoConnection.RollbackTrans   ' 回滚事务
    Modifylxmd = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :根据联系目的ID取得联系目的的列表
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function FindlxmdId(recSet As ADODB.Recordset, lxmdid As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    FindlxmdId = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxmd_findByld"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = lxmdid             ' 参数
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            FindlxmdId = True
        Else
            FindlxmdId = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    FindlxmdId = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :根据联系目的ID从表中删除一条联系目的记录
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function DeletelxmdId(recSet As ADODB.Recordset, houseId As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    DeletelxmdId = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxmd_delete"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = houseId             ' 参数
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            DeletelxmdId = True
        Else
            DeletelxmdId = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    DeletelxmdId = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :取得所有联系方式的列表
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function FindlxfsAll(recSet As ADODB.Recordset) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    FindlxfsAll = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxfs_findAll"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            FindlxfsAll = True
        Else
            FindlxfsAll = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    FindlxfsAll = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :新增一条联系方式数据
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  新增成功
'*                 False          -  新增失败
'**************************************
Public Function Newlxfs(recSet As ADODB.Recordset, _
                              xh As String, name As String, memo As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    Newlxfs = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxfs_add"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = xh              ' 参数
    cmdProc.Parameters(2) = name            ' 参数
    cmdProc.Parameters(3) = memo            ' 参数
    
    ' 执行命令 把查询到的结果放在recSet中
    MainForm.g_application.m_databaseCon.m_adoConnection.BeginTrans    ' 开始事务
    
    On Error GoTo Cwcl
       cmdProc.Execute

   
   MainForm.g_application.m_databaseCon.m_adoConnection.CommitTrans   ' 结束事务
    Exit Function
    
Cwcl:
    MainForm.g_application.m_databaseCon.m_adoConnection.RollbackTrans   ' 回滚事务
    Newlxfs = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :修改一条联系方式数据
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  新增成功
'*                 False          -  新增失败
'**************************************
Public Function Modifylxfs(recSet As ADODB.Recordset, _
                              xh As String, name As String, memo As String, lxfsid As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    Modifylxfs = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxfs_modify"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = xh              ' 参数
    cmdProc.Parameters(2) = name              ' 参数
    cmdProc.Parameters(3) = memo      ' 参数
    cmdProc.Parameters(4) = lxfsid      ' 参数
    ' 执行命令 把查询到的结果放在recSet中
    MainForm.g_application.m_databaseCon.m_adoConnection.BeginTrans    ' 开始事务
    
    On Error GoTo Cwcl
           cmdProc.Execute
           Modifylxfs = True

    MainForm.g_application.m_databaseCon.m_adoConnection.CommitTrans   ' 结束事务
    Modifylxfs = True
    Exit Function
    
Cwcl:
    MainForm.g_application.m_databaseCon.m_adoConnection.RollbackTrans   ' 回滚事务
    Modifylxfs = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :根据联系目的ID取得联系目的的列表
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function FindlxfsId(recSet As ADODB.Recordset, lxfsid As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    FindlxfsId = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxfs_findByld"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = lxfsid             ' 参数
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            FindlxfsId = True
        Else
            FindlxfsId = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    FindlxfsId = False
    Exit Function
End Function
'**************************************
'*    功 能 描 述 :根据联系目的ID从表中删除一条联系目的记录
'*    输 入 参 数 :无
'*    输 出 能 数 :True           -  数据库连接成功
'*                 False          -  数据库连接失败
'**************************************
Public Function DeletelxfsId(recSet As ADODB.Recordset, houseId As String) As Boolean
    
    Dim cmdProc As ADODB.Command          ' 执行存储过程的命令
    
    DeletelxfsId = False
    Set cmdProc = New ADODB.Command
    Set cmdProc.ActiveConnection = MainForm.g_application.m_databaseCon.m_adoConnection
    
    ' 执行存储过程的命令的设置
    cmdProc.CommandText = "lxfs_delete"     ' 指定存储过程的名子
    cmdProc.CommandType = adCmdStoredProc
    cmdProc.Parameters.Refresh
    cmdProc.Parameters(1) = houseId             ' 参数
    
    On Error GoTo Cwcl
    
    ' 执行命令 把查询到的结果放在recSet中
    With recSet
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open cmdProc
    End With
    
    With recSet
        If Not .EOF Then
            DeletelxfsId = True
        Else
            DeletelxfsId = False
        End If
    End With
    
    Exit Function
    
Cwcl:
    DeletelxfsId = False
    Exit Function
End Function