小函数

 '提取TTF1模板文件
    Public Function ExtractTemplet(ByVal strSql As String, _
                                    ByVal ODBCName As String, _
                                    ByVal TTF1 As AxF1Book, _
                                    Optional ByVal ExtName As String = ".rar") As Boolean
        Dim adoCon As New ADODB.Connection()
        Dim adoRs As New ADODB.Recordset()
        Dim oleDa As New OleDb.OleDbDataAdapter()
        Dim Ds As New DataSet()
        Dim fs As FileStream
        Dim rarFiles() As FileInfo, rarFile As FileInfo
        Dim iCount As Int16
        Try
            adoCon.ConnectionString = ODBCName
            adoCon.CursorLocation = ADODB.CursorLocationEnum.adUseClient
            adoCon.Open()
            adoRs.Open(strSql, adoCon, 1, 3)
            oleDa.Fill(Ds.Tables.Add("Temp"), adoRs)
            adoRs.Close() : adoRs = Nothing
            adoCon.Close() : adoCon = Nothing
            Dim byteTemplet() As Byte '存储二进制数据文件
            If Ds.Tables.Item("Temp").Rows.Count <= 0 Then Return False
            '生成模板文件
            For iCount = 0 To Ds.Tables.Item("Temp").Rows.Count - 1
                fs = File.Create(dirInfo.FullName & "\" & Ds.Tables.Item("Temp").Rows(iCount).Item(0).ToString & ".rar")
                byteTemplet = Ds.Tables.Item("Temp").Rows(iCount).Item(1)
                fs.Write(byteTemplet, 0, byteTemplet.Length)
                fs.Close()
            Next

            '获取当前文件夹下所有的RAR文档
            rarFiles = dirInfo.GetFiles("*.rar")

            '释放文件并删除源RAR文件
            '因查看模板时一次只能看一个模板,不会产生一次查看
            '多个模板的情况,所以在For Each中如果读取模板成功
            '就退出For循环,如果读取失败则返回False
            For Each rarFile In rarFiles
                Shell("winrar x " & rarFile.FullName.ToString.Trim _
                     & Space(1) & rarFile.DirectoryName.ToString.Trim _
                     & Space(1) & "-o+" & Space(1) & "-inul") ' & Space(1) & "-ibck"
                Kill(rarFile.FullName.ToString)
                If ReadTemplet(TTF1, rarFile.DirectoryName & "\$_LCBBGS_$.vts") Then
                    Kill(rarFile.DirectoryName & "\$_LCBBGS_$.vts")
                    Exit For
                Else
                    Return False
                End If
            Next

            Return True
        Catch
            'MsgBox(Err.Description & Err.Erl)
            Return False
        Finally
            Ds.Dispose()
            oleDa.Dispose()
            GC.Collect()
        End Try
    End Function

posted on 2006-03-10 12:56  Sanle  阅读(191)  评论(0编辑  收藏  举报

导航