functiondataaccess.bas

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

   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
   Exit Function
End Function
'============================================================================================
'此函数用来保存证书打印记录数据
'输入参数：In_sData(),In_TableName分别接收打证信息记录的主体数据数组，打证信息记录表名称
'          打证信息记录表主题数据也即打证信息记录表的所需要的数据
'输出参数：无输出参数
'详细描述：此函数将保存打证信息记录，因采用的保存方法和保存申请表的方法一样故在保存打证信息
'          之前必须进行数据收集也就是将所需要的数据返回到一个2维数组
'编写时间：2003-07-29 dww  am10:31
'更新时间：2003-07-29  dww am12:14
'============================================================================================
Public Function SaveCertificationPrintRecordData(In_sData() As String, in_TableName As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo SaveCertificationPrintRecordDataErr
   SaveCertificationPrintRecordData = False
   
   Dim iCols As Integer
   Dim lRows As Integer
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   Dim In_SQry As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName
   iCols = UBound(In_sData(), 2)
   lRows = UBound(In_sData(), 1)
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   
   Set rs = db.Execute(In_SQry)
   '通过SQL insert插入语句写数据，首先生成查询条件语句
   '查询语句前半部分生成
   In_sQryFront = "insert into " & in_TableName
   In_sQryFront = In_sQryFront & "("
   For lCurRow = 0 To lRows - 1
     If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
                In_sQryFront = In_sQryFront & LTrim(In_sData(lCurRow, 0)) & ","
       End If
       If lCurRow = lRows - 1 Then
                In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
       End If
     Else
         If lCurRow < lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ","
         End If
         If lCurRow = lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
         End If
     End If
   Next lCurRow
   '查询语句的后半部分语句生成
   In_sQryLast = In_sQryLast & "Values("
   For lCurRow = 0 To lRows - 1
    If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
    Else
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
   End If
   Next lCurRow
   '执行插入操作
   'Debug.Print In_sQryFront & In_sQryLast
    Set rs = db.Execute(In_sQryFront & In_sQryLast)
    SaveCertificationPrintRecordData = True
   '关闭对象连接
   'rs.Close有点小问题如果关闭写入操作就会出错
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   '写入数据成功的提示信息
   'MsgBox "你已成功的将数据写入数据库" + Chr(13) + Chr(10) + "恭喜你！", 48, "系统提示"
   'Exit Function
SaveCertificationPrintRecordDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
   Exit Function
End Function
'============================================================================================
'此函数的功能是去掉数组中的尾随空格
'输入参数：in_sArray()接收要去掉尾随空格的数组
'输出参数：out_sArray()接收已经去掉了尾随空格的数组
'详细描述：简单的说将申请表数据返回到一个2维数组后数组中有很多尾随空格，在保存申请表数据之前，
'          要将尾随空格去掉否则在写回申请表的时会出错候
'编写时间：2003-06-10 dww pm 20:01
'更新时间：2003-07-26 dww pm 15:31
'============================================================================================
Public Function DLtrim(in_sArray() As String, out_sArray() As String) As Boolean
        DLtrim = False
        
        Dim i As Integer
        Dim j As Integer
        Dim h As Integer
        ReDim out_sArray(UBound(in_sArray(), 1), UBound(in_sArray(), 2))
        For i = 0 To UBound(in_sArray(), 1)
          For j = 0 To UBound(in_sArray(), 2)
               For h = 1 To Len(in_sArray(i, j))
                    If Mid(in_sArray(i, j), h, 1) = " " Then
                           Exit For
                    Else
                        out_sArray(i, j) = out_sArray(i, j) + Mid(in_sArray(i, j), h, 1)
                    End If
               Next h
          Next j
       Next i
       DLtrim = True
End Function
'============================================================================================
'此函数的功能是去掉字符串中的尾随空格
'输入参数：in_strText接收要去掉尾随空格的字符串
'输出参数：out_strText接收已经去掉尾随空格的字符串
'详细描述：简单的说将数据库的表中数据返回到一个字符串中有很多尾随空格，如果不将尾随空格去掉
'在进行条件判断或其他操作时会出错。
'编写时间：2003-07-23 dww pm 11:20
'更新时间：2003-07-26 dww pm15:40
'============================================================================================
Public Function SLtrim(in_strText As String, out_strText As String) As Boolean
        Dim i As Integer
        SLtrim = False
        For i = 1 To Len(in_strText)
            If Mid(in_strText, i, 1) = " " Then
               Exit For
            Else
               out_strText = out_strText + Mid(in_strText, i, 1)
            End If
        Next i
       SLtrim = True
End Function
'============================================================================================
'以下函数将实现保存收费表数据的操作
'输入参数：In_sData,In_TableName分别接收要插入的收费表数据数据2维数组和收费表名称
'输出参数：out_SaveSuccess接收保存数据是否成功
'详细描述：最终将收费表的数据保存到数据库的收费表中去，收费表将以单位建立一个单位拥有
'          一个收费表命名如：tbl_TransactionCharge41010519004，这里收费表是指办件收费
'          表要和收费标准表分清楚
'编写时间：2003-06-10 dww pm 20:13
'更新时间：2003-07-26 dww pm 15:49
'============================================================================================
Public Function SaveChargeData(In_sData() As String, in_TableName As String, out_SaveSuccess As Boolean, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
  On Error GoTo SaveChargeDataErr
   SaveChargeData = False
   out_SaveSuccess = False
   Dim iCols As Integer
   Dim lRows As Long
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName
   iCols = UBound(In_sData(), 2)
   lRows = UBound(In_sData(), 1)
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   Set rs = db.Execute(In_SQry)
  '此出生成SQL语句及插入数据的语句inser into
   In_sQryFront = ""
   In_sQryFront = "insert into " & in_TableName & "(" & "是否收取,收费名称,收费标准,收费单位,收费件数,小计,DepartmentCode,ItemCode,ChargeItemCode,TransactionCode" & ")"
  '此处生成SQl语句插入数据的语句的后办部分
   Dim i As Integer
   '控制写数据的次数1行数据写一次，2行数据写2次
   'Debug.Print In_sQryFront
   For i = 0 To UBound(In_sData(), 1) - 1
     In_sQryLast = "Values("
     For lcurcol = 0 To iCols
          If lcurcol <= iCols - 1 Then
              In_sQryLast = In_sQryLast & "'" & In_sData(i, lcurcol) & "',"
          End If
          If lcurcol = iCols Then
              In_sQryLast = In_sQryLast & "'" & In_sData(i, lcurcol) & "')"
          End If
     Next lcurcol
    '通过执行SQL语句实现插入操作
    'Debug.Print In_sQryFront & In_sQryLast
     Set rs = db.Execute(In_sQryFront & In_sQryLast)
     In_sQryLast = ""
   Next i
   out_SaveSuccess = True
  '释放对象
   Set rs = Nothing
   Set db = Nothing
   SaveChargeData = True
   Exit Function
SaveChargeDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'以下的一组函数将实现保存办件表数据
'输入参数：In_sData() ,In_TableName要写的数据和要写的表名称
'输出参数：无输出参数
'详细描述：第一个函数将保存第一个阶段的数据也就是当保存完申请表后要保存的数据
'          如：TransactionCode,tbl_TransacitonProcedurte,tbl_SubmitApplicationMaterial
'          TransactioncodeIssueTime，TransactionGroupNumber,TransactionType
'          Departmentcode,Itemcode(8个字段)注意：在这里保存了保存了办事程序的表名
'          第二个函数将保存第二个阶段的数据也就是当保存完收费表后要保存的数
'          如: tbl_TransactionCharge , TransctionChargeTotal, TransacitonChargeAction
'          TransacitonChargeMean(4个字段)
'          第三个函数将保存第三个阶段的数据也就是在办件审核确定后的要保存数据
'          如：TransactionAdvice,TransactionAdviceMemory(2个字段)
'          第四个函数将保存第四个阶段的数据也就是在确定打证后要保存的数据
'          如： tbl_TransactionPrintRecord(1个字段)
'          具体函数命名如下：SaveTransacitonData1,SaveTransacitonData2,SaveTransacitonData3
'编写时间：2003-06-11 dww am11:22
'更新时间：2003-07-26 dww pm15:30
'============================================================================================
Public Function SaveTransacitonData1(In_sData() As String, in_TableName As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
 On Error GoTo SaveTransacitonData1Err
   SaveTransacitonData1 = False
   Dim iCols As Integer
   Dim lRows As Long
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName