functiondataaccess.bas

金水区行政审批服务软件窗口系统

Attribute VB_Name = "FunctionDataAccess"
'*******************************说明*********************************************************
'*此处是所有操作数据库的自定义函数区                                                        *
'*详细的函数说明请看每个函数头部说明                                                        *
'*有时间可以把这些函数封装起来做DLL                                                         *
'*2003-07-23 dww am9:16                                                                     *
'********************************************************************************************
'定义此模块所需的的变量
'数据库连接对象，数据源对象
 Dim db As ADODB.Connection
 Dim rs As ADODB.Recordset
 Dim db1 As ADODB.Connection
 Dim rs1 As ADODB.Recordset
 Dim tempa As String
 Dim tempb As String
 Dim tempc As String
'============================================================================================
'此函数的功能是取出申请表名称和证书类型以及承诺时限
'输入参数：in_sDepartmentCode ，in_sItemCode分别接收单位代码和项目代码
'输出参数：out_sAppTabName，out_sCerticicationType， out_sAffirmatoryPeriod分别接收申请表名称
'证书类型和承诺时限
'详细描述：如申请表名称:M4101051900410060 证书类型:大中小，正副，单证已在界面中调用此函数
'编写时间：2003-06-06 dww pm 16:50
'更新时间：2003-07-26 dww pm13:01
'============================================================================================
Public Function GetAppTabNameAndCerticicationTypeAndAffirmatoryPeriod(in_sDepartmentcode As String, in_sItemCode As String, out_sAppTabName As String, out_sCerticicationType As String, out_sCerticicationName, out_sAffirmatoryPeriod As Integer, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
      On Error GoTo GetAppTabNameAndCerticicationTypeAndAffirmatoryPeriodErr
       GetAppTabNameAndCerticicationTypeAndAffirmatoryPeriod = False
       
       Set db = New ADODB.Connection
       Set rs = New ADODB.Recordset
       '===========================================================
       '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
        db.ConnectionString = frmShouJian.DBConectString
        db.Open
       '===========================================================
       rs.Open "select TblAppTab,CertificationType, AffirmatoryPeriod,CertificationName from " & gsItemStorageName & " where DepartmentCode= '" & in_sDepartmentcode & "'and Itemcode='" & in_sItemCode & "'", db, adOpenStatic, adLockReadOnly
       If Not rs.EOF Then
          If rs.Fields("TblAppTab").Value <> "" Then
              If rs.Fields("CertificationType").Value <> "" Then
                   '取得申请表名称，证书类型，承诺时限,证书名称
                   out_sAppTabName = rs.Fields("TblAppTab").Value
                   out_sCerticicationType = rs.Fields("CertificationType").Value
                   out_sAffirmatoryPeriod = rs.Fields("AffirmatoryPeriod").Value
                   out_sCerticicationName = rs.Fields("CertificationName").Value
              Else
                   out_sCerticicationType = "无"
              End If
           Else
                   out_sAppTabName = "空"
          End If
        End If
        
        tempa = ""
        tempb = ""
        '去掉尾随空格
        For i = 1 To Len(out_sAppTabName)
           If Mid(out_sAppTabName, i, 1) <> " " Then
           tempa = tempa + Mid(out_sAppTabName, i, 1)
           End If
        Next i
        '去掉尾随空格
        For i = 1 To Len(out_sCerticicationType)
            If Mid(out_sCerticicationType, i, 1) <> " " Then
            tempb = tempb + Mid(out_sCerticicationType, i, 1)
            End If
        Next i
        '最后的申请表名称和证书类型
        out_sAppTabName = tempa
        out_sCerticicationType = tempb
        rs.Close
        Set db = Nothing
        Set rs = Nothing
        GetAppTabNameAndCerticicationTypeAndAffirmatoryPeriod = True
GetAppTabNameAndCerticicationTypeAndAffirmatoryPeriodErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数的功能是取出某个单位的的所有项目
'输入参数：in_sDepartmentcode接收单位代码
'输出参数：out_sAllItemOfOwnDepartment，out_IsEmpty分别接收申项目数组和标志数组是否
'为空的标志变量
'详细描述：根据单位代码取得一个单位的所有项目现在可以取本单位的项目当然也可以去代理
'单位和并联单位的项目
'编写时间：2003-08-01 dww pm 16:50
'更新时间：2003-12-30 dww am 08:58
'============================================================================================
Public Function GetAllItemOfOwnDepartment(in_sDepartmentcode As String, out_sAllItemOfOwnDepartment() As String, out_isEmpty As Boolean, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
      On Error GoTo GetAllItemOfOwnDepartmentErr
       GetAllItemOfOwnDepartment = False
       out_isEmpty = True
       
       '定义循环变量和日期变量
       Dim i As Integer
       Dim mydate As String
       '定义SQL查询字符串
       Dim SQL As String
       '初始化变量SQL查询字符串的作用是保证项目不过期和按项目编号排列项目（现在按项目的显示顺序排列）
       mydate = Date
       SQL = " and ValidStart<='" & CDate(mydate) & "' and ValidEnd>='" & CDate(mydate) & "'" & " order by ItemDisplaySeq "
       '给对象变量初始化
       Set db = New ADODB.Connection
       Set rs = New ADODB.Recordset
       '===========================================================
       '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
        db.ConnectionString = frmShouJian.DBConectString
        db.Open
       '===========================================================
       rs.Open "select * from " & gsItemStorageName & " where DepartmentCode= '" & in_sDepartmentcode & "'" & SQL, db, adOpenStatic, adLockReadOnly
        If Not rs.EOF Then
           ReDim out_sAllItemOfOwnDepartment(rs.RecordCount - 1, 11)
           Do While i < rs.RecordCount
              '返回的数据包括项目名称，项目代码，办件类型，是否踏勘，承诺时限，是否收费，证书类型等等
              out_sAllItemOfOwnDepartment(i, 0) = Trim(rs.Fields("ItemName").Value)
              out_sAllItemOfOwnDepartment(i, 1) = Trim(rs.Fields("ItemCode").Value)
              out_sAllItemOfOwnDepartment(i, 2) = Trim(rs.Fields("TransactionTypeCode").Value)
              out_sAllItemOfOwnDepartment(i, 3) = Trim(rs.Fields("IsInvestigation").Value)
              out_sAllItemOfOwnDepartment(i, 4) = Trim(rs.Fields("AffirmatoryPeriod").Value)
              out_sAllItemOfOwnDepartment(i, 5) = Trim(rs.Fields("IsCharge").Value)
              out_sAllItemOfOwnDepartment(i, 6) = Trim(rs.Fields("CertificationType").Value)
              out_sAllItemOfOwnDepartment(i, 7) = Trim(rs.Fields("CertificationName").Value)
              out_sAllItemOfOwnDepartment(i, 8) = Trim(rs.Fields("DepartmentCode").Value)
              out_sAllItemOfOwnDepartment(i, 9) = Trim(rs.Fields("ChargeIsModify").Value)
              '-----------------------------------------------------------------------------
              '此部分程序做如下修改：取得踏勘时限和踏勘负责人主要为了初始化踏勘信息表
              '踏勘信息表中诸如：踏勘负责人，踏勘时限，踏勘开始时间和踏勘结束时间等是
              '固定显示为了减少用户输入初始化时候将取出这些固定信息2003-09-21 dww pm19:46
              If Trim(rs.Fields("InvestigationChargeOfPerson").Value) <> "" Then
              out_sAllItemOfOwnDepartment(i, 10) = Trim(rs.Fields("InvestigationChargeOfPerson").Value)
              Else
              out_sAllItemOfOwnDepartment(i, 10) = ""
              End If
              '-----------------------------------------------------------------------------
              If Trim(rs.Fields("InvestigationAffirmatoryPeriod").Value) <> "" Then
              out_sAllItemOfOwnDepartment(i, 11) = Trim(rs.Fields("InvestigationAffirmatoryPeriod").Value)
              Else
              out_sAllItemOfOwnDepartment(i, 11) = ""
              End If
              '-----------------------------------------------------------------------------
              '为了得到想要的数据处理结果，特将办件类型代码进行转换，但类型代码在增加的话需修改程序了
              Select Case out_sAllItemOfOwnDepartment(i, 2)
                     Case "1"
                        out_sAllItemOfOwnDepartment(i, 2) = "上报件"
                     Case "2"
                        out_sAllItemOfOwnDepartment(i, 2) = "即办件"
                     Case "3"
                        out_sAllItemOfOwnDepartment(i, 2) = "承诺件"
              End Select
              i = i + 1
              rs.MoveNext
           Loop
              out_isEmpty = False
        End If
    
        rs.Close
        Set db = Nothing
        Set rs = Nothing
        GetAllItemOfOwnDepartment = True
GetAllItemOfOwnDepartmentErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数的功能是取出收费标准表的的名称和IsCharge的值
'输入参数：in_sDepartmentCode, in_sItemCode分别接收单位代码和项目代码
'输出参数：out_sChargeStandTabName， out_sIsCharge,out_sIsInvestigation分别接收收费标准表的名
'          称,是否收费以及是否踏勘
'详细描述：如申请表名称:CharStan41010516004 IsCharge的值为0和1
'编写时间：2003-06-16 dww pm 16:05
'更新时间：2003-07-26 dww pm 13:55
'特别提示：为了减少读取数据库的次数，在这里在加上一个输出变量out_sIsInvestigation也即
'是否现场踏勘，如果此变量为“是”则需要现场踏勘现场踏勘信息部分将会变成可用状态，否则
'则是不可用的状态。因为它和判断一个项目是否收费是一样故在这里一并取出来减少读数据库的
'次数,2003-07-29 dww am9:11进行修改更新
'============================================================================================
Public Function GetChargeStandTabNameAndIsCharge(in_sDepartmentcode As String, in_sItemCode As String, out_sChargeStandTabName As String, out_sIsCharge As String, out_sIsInvestigation As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
      On Error GoTo GetChargeStandTabNameAndIsChargeErr
       GetChargeStandTabNameAndIsCharge = False
       
       Set db = New ADODB.Connection
       Set rs = New ADODB.Recordset
       '===========================================================
       '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
        db.ConnectionString = frmShouJian.DBConectString
        db.Open
       '===========================================================
       
       rs.Open "select TblChargeStand,IsCharge,IsInvestigation from " & gsItemStorageName & " where DepartmentCode= '" & in_sDepartmentcode & "'and Itemcode='" & in_sItemCode & "'", db, adOpenStatic, adLockReadOnly
       If Not rs.EOF Then
             '从项目表中取得收费标准表的名称和是否收费以及是否现场踏勘
             out_sChargeStandTabName = rs.Fields("TblChargeStand").Value
             out_sIsCharge = rs.Fields("IsCharge").Value
             out_sIsInvestigation = rs.Fields("IsInvestigation").Value
       End If
       '定义临时变量
       tempa = ""
       tempb = ""
       tempc = ""
       '去掉尾随空格
       For i = 1 To Len(out_sChargeStandTabName)
           If Mid(out_sChargeStandTabName, i, 1) <> " " Then
           tempa = tempa + Mid(out_sChargeStandTabName, i, 1)
           End If
       Next i
       For i = 1 To Len(out_sIsCharge)
            If Mid(out_sIsCharge, i, 1) <> " " Then
            tempb = tempb + Mid(out_sIsCharge, i, 1)
            End If
       Next i
       For i = 1 To Len(out_sIsInvestigation)
            If Mid(out_sIsInvestigation, i, 1) <> " " Then
            tempc = tempc + Mid(out_sIsInvestigation, i, 1)
            End If
       Next i
       '最后得到的收费标准表名称和是否收费字段的值
       out_sChargeStandTabName = tempa
       out_sIsCharge = tempb
       out_sIsInvestigation = tempc
       rs.Close
       '释放对象
       Set db = Nothing
       Set rs = Nothing
       GetChargeStandTabNameAndIsCharge = True
GetChargeStandTabNameAndIsChargeErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数功能是直接取出项目表中的数据，即项目指导界面所需要的数据
'输入参数：in_sDepartmentCode ,in_sItemCode分别接收单位代码和项目代码
'输出参数：out_sItemDirectionNeedData()接收符合条件的项目数据
'详细描述：从项目表中取得项目指导界面所需的数据这些数据包括：项目代码，项目名称，项目类型
'          项目性质，办事程序描述，申请材料描述，收费标准以及政策依据
'编写时间：2003-06-06 dww pm16:54
'更新时间：2003-07-26 dww pm14:12
'============================================================================================
Public Function GetItemDirectionNeedData(in_sDepartmentcode As String, in_sItemCode As String, out_sItemDirectionNeedData() As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo GetItemDirectionNeedDataErr
       GetItemDirectionNeedData = False
       
       Set db = New ADODB.Connection
       Set rs = New ADODB.Recordset
       '===========================================================
       '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
        db.ConnectionString = frmShouJian.DBConectString
        db.Open
       '===========================================================
       rs.Open "select * from " & gsItemStorageName & " where DepartmentCode= '" & in_sDepartmentcode & "'and Itemcode='" & in_sItemCode & "'", db, adOpenStatic, adLockReadOnly
       If Not rs.EOF Then
             ReDim out_sItemDirectionNeedData(0, 8)