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