在民间借贷软件开发中用到的电子文档存储技术

在近期投资公司管理系统项目的开发中，遇到了合同文件存储的问题。由于是C/S程序，可选择的方式不少，既可以用winsock，也可以用IIS，比较了一下，还是将文件直接存储到数据库较为安全。

语言为VB6，数据库为SQLSERVER，用C#实现的方式类似。

代码如下：

1、获得文件的扩展名

Private Function GetExtension(Filename As String) As String   

    Dim i, j, path, Ext As Integer
    For i = Len(Filename) To 1 Step -1
        If Mid(Filename, i, 1) = "." Then
           Ext = i
           Exit For
        End If
    Next i
    If Ext = 0 Then
        Exit Function
    End If
    GetExtension = Mid(Filename, Ext + 1, Len(Filename) - Ext)
 End Function

2、以流的形式保存至数据库

Private Sub SaveToDB(nID As Long)
    Dim cn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Dim Mstream As New ADODB.Stream
    Dim sql As String
    Dim MediaName As String
   
    On Error GoTo err
    MediaName = Trim$(txtPath.Text)
    Set cn = GetConn
    Rst.CursorLocation = adUseClient
    sql = "select ID,SaveValue from tbFileManage where ID=" & nID
    Rst.Open sql, cn, adOpenStatic, adLockPessimistic
    Mstream.Type = adTypeBinary
    Mstream.Open
    Mstream.LoadFromFile MediaName
    Rst.Fields("SaveValue").Value = Mstream.Read
    Rst.Update
    Rst.Close
    Set Rst = Nothing
    cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
   
    Exit Sub
err:
    If Rst.State <> adStateClosed Then Rst.Close
    Set Rst = Nothing
    If cn.State <> adStateClosed Then cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
End Sub

3、读取数据，生成临时文件后直接打开

Private Sub ReadFromDB(nID As Long, sFullPath As String)
    Dim cn As New ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Dim Mstream As ADODB.Stream
    Dim sql As String
    Dim tmpFile As String
   
    On Error GoTo err
    Set cn = GetConn
    sql = "select ID,SaveValue,FileType from tbFileManage where ID=" & nID
    Rst.CursorLocation = adUseClient
    Rst.Open sql, cn, adOpenStatic, adLockReadOnly
    If IsNull(Rst.Fields("SaveValue").Value) Then
        MsgBox "文档无内容", vbExclamation
        Rst.Close: Set Rst = Nothing
        cn.Close: Set cn = Nothing
        Exit Sub
    End If
   
    Set Mstream = New ADODB.Stream
    Mstream.Type = adTypeBinary
    Mstream.Open
    Mstream.Write Rst.Fields("SaveValue").Value
    tmpFile = sFullPath & GetGUID & "." & Rst.Fields("FileType").Value
    Mstream.SaveToFile tmpFile, adSaveCreateOverWrite
    Mstream.Close
    Set Mstream = Nothing
    Rst.Close
    cn.Close
    Set cn = Nothing
    Set Rst = Nothing
    ShellExecute Me.hwnd, "Open", tmpFile, "", App.path, 1
    Exit Sub
err:
    If Rst.State <> adStateClosed Then Rst.Close
    Set Rst = Nothing
    If cn.State <> adStateClosed Then cn.Close
    Set cn = Nothing
    Set Mstream = Nothing
    MsgBox err.Description
End Sub