如何使用 VB6 将文件上传到 Oracle BLOB 字段？

Question

我想使用 VB6 从磁盘获取一个文件并将其上传到 Oracle BLOB 字段。 我怎样才能做到这一点？

Answer 1

回答我自己的问题，供参考：

Public Function SaveFileAsBlob(fullFileName As String, documentDescription As String) As Boolean

    'Upload a binary file into the database as a BLOB
    'Based on this example: http://www.codeguru.com/forum/printthread.php?t=337027

    Dim rstUpload As ADODB.Recordset
    Dim pkValue AS Long
    On Error GoTo ErrorHandler

    Screen.MousePointer = vbHourglass        

    'Create a new record (but leave document blank- we will update the doc in a moment)
    'the where clause ensures *no* result set; we only want the structure
    strSQL = "SELECT DOC_NUMBER, DOC_DESC, BLOB_FIELD " & _
      " FROM MY_TABLE " & _
      " WHERE PRIMARY_KEY = 0" 
    pkValue = GetNextPKValue

    Set rstUpload = New ADODB.Recordset
    With rstUpload
      .CursorType = adOpenKeyset
      .LockType = adLockOptimistic
      .Open strSQL, myConn
      .AddNew Array("DOC_NUMBER", "DOC_DESC"), _
              Array(pkValue, documentDescription)
      .Close
    End With

    'They may have the document open in an external application.  Create a copy and work with that copy
    Dim tmpFileName As String
    tmpFileName = GetTempPath & ExtractFileName(fullFileName)
    'if the tmp file exists, delete it
    If Len(Dir(tmpFileName)) > 0 Then
      Kill tmpFileName
    End If

    'see this URL for info about this subroutine:
    'http://stackoverflow.com/questions/848087/how-can-i-copy-an-open-file-using-vb6
    CopyFileEvenIfOpen fullFileName, tmpFileName

    'Now that our record is inserted, update it with the file from disk
    Set rstUpload = Nothing
    Set rstUpload = New ADODB.Recordset
    Dim st As ADODB.Stream
    rstUpload.Open "SELECT BLOB_FIELD FROM MY_TABLE WHERE PRIMARY_KEY = " & pkValue
      , myConn, adOpenDynamic, adLockOptimistic
    Set st = New ADODB.Stream
    st.Type = adTypeBinary
    st.Open
    st.LoadFromFile (tmpFileName)
    rstUpload.Fields("BLOB_FIELD").Value = st.Read
    rstUpload.Update

    'Now delete the temp file we created
    Kill (tmpFileName)

    DocAdd = True
ExitPoint:
    On Error Resume Next
    rstUpload.Close
    st.Close
    Set rstUpload = Nothing
    Set st = Nothing
    Screen.MousePointer = vbDefault
    Exit Function
ErrorHandler:
    DocAdd = False
    Screen.MousePointer = vbDefault
    MsgBox "Source: " & Err.Source & vbCrLf & "Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, _
         "DocAdd Error"
    Resume ExitPoint
End Function