diff options
Diffstat (limited to 'wizards/source/access2base/Recordset.xba')
| -rw-r--r-- | wizards/source/access2base/Recordset.xba | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba index 8638e0d9641b..698c6e4a1a08 100644 --- a/wizards/source/access2base/Recordset.xba +++ b/wizards/source/access2base/Recordset.xba @@ -16,6 +16,7 @@ REM ---------------------------------------------------------------------------- Private _Type As String ' Must be RECORDSET Private _Name As String ' Unique, generated +Private _This As Object Private _ParentName As String Private _ParentType As String Private _ParentDatabase As Object @@ -32,14 +33,24 @@ Private _EditMode As Integer ' dbEditxxx constants Private _BookmarkBeforeNew As Variant Private _BookmarkLastModified As Variant Private _IsClone As Boolean +Private _ManageChunks As Variant ' Array of ChunkDescriptors Private RowSet As Object ' com.sun.star.comp.dba.ORowSet +Type ChunkDescriptor + ChunksRequested As Boolean + FieldName As String + ChunkType As Integer ' vbString or vbByte + FileName As String + FileHandler As Object +End Type + REM ----------------------------------------------------------------------------------------------------------------------- REM --- CONSTRUCTORS / DESTRUCTORS --- REM ----------------------------------------------------------------------------------------------------------------------- Private Sub Class_Initialize() _Type = OBJRECORDSET _Name = "" + Set _This = Nothing _ParentName = "" Set _ParentDatabase = Nothing _ParentType = "" @@ -56,6 +67,7 @@ Private Sub Class_Initialize() _BookmarkBeforeNew = Null _BookmarkLastModified = Null _IsClone = False + Set _ManageChunks = Array() Set RowSet = Nothing End Sub ' Constructor @@ -296,6 +308,7 @@ Const cstThisSub = "Recordset.CancelUpdate" Select Case _EditMode Case dbEditNone Case dbEditAdd + _AppendChunkClose(True) If Not IsNull(_BookmarkBeforeNew) Then Select Case _BookmarkBeforeNew Case "_BOF_" : .beforeFirst() @@ -305,6 +318,7 @@ Const cstThisSub = "Recordset.CancelUpdate" End If Case dbEditInProgress .cancelRowUpdates() + _AppendChunkClose(True) End Select End With @@ -507,6 +521,7 @@ Dim i As Integer, bFound As Boolean, oFields As Object oObject._ParentName = _Name oObject._ParentType = _Type Set oObject._ParentDatabase = _ParentDatabase + Set oObject._ParentRecordset = _This Exit_Function: Set Fields = oObject @@ -673,6 +688,7 @@ Dim oObject As Object ._ParentName = _Name ._ParentType = _Type Set ._ParentDatabase = _ParentDatabase + Set ._This = oObject ._ForwardOnly = ( pvType = dbOpenForwardOnly ) ._PassThrough = ( pvOptions = dbSQLPassThrough ) ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly ) @@ -752,6 +768,7 @@ Const cstThisSub = "Recordset.Update" Case dbEditNone Goto Trace_Error_Update Case dbEditAdd + _AppendChunkClose(False) If .IsNew And .IsModified Then .insertRow() _BookmarkLastModified = .getBookmark() If Not IsNull(_BookmarkBeforeNew) Then @@ -762,6 +779,7 @@ Const cstThisSub = "Recordset.Update" End Select End If Case dbEditInProgress + _AppendChunkClose(False) If .IsModified Then .updateRow() _BookmarkLastModified = .getBookmark() @@ -793,6 +811,118 @@ REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------------------------------------------------- REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _AppendChunk(ByVal psFieldName As String, ByRef pvChunk As Variant, piChunkType) As Boolean +' Write chunk at the end of the file dedicated to the given field + + If _ErrorHandler() Then On Local Error GoTo Error_Function +Dim oFileAccess As Object +Dim i As Integer, oChunk As Object, iChunk As Integer, sRandom As String + + ' Do nothing if chunk meaningless + _AppendChunk = False + If IsNull(pvChunk) Then GoTo Exit_Function + If IsArray(pvChunk) Then + If UBound(pvChunk) < LBound(pvChunk) Then GoTo Exit_Function ' Empty array + End If + + ' Find or create relevant chunk entry + iChunk = -1 + For i = 0 To UBound(_ManageChunks) + Set oChunk = _ManageChunks(i) + If oChunk.FieldName = psFieldName Then + iChunk = i + Exit For + End If + Next i + If iChunk = -1 Then + _AppendChunkInit(psFieldName) + iChunk = UBound(_ManageChunks) + End If + + Set oChunk = _ManageChunks(iChunk) + With oChunk + If Not .ChunksRequested Then ' First chunk + .ChunksRequested = True + .ChunkType = piChunkType + sRandom = Right("000000" & Int(999999 * Rnd), 6) + .FileName = DoCmd._getTempDirectoryURL() & "/" & "A2B_TEMP_" & _Name & "_" & sRandom + Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") + .FileHandler = oFileAccess.openFileWrite(.FileName) + End If + .FileHandler.writeBytes(pvChunk) + End With + _AppendChunk = True + +Exit_Function: + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Recordset._AppendChunk", Erl) + GoTo Exit_Function +End Function ' AppendChunk V1.5.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _AppendChunkClose(ByVal pbCancel As Boolean) As Boolean +' Stores file content to database field(s) +' Called from Update() [pbCancel = False] or CancelUpdate() [pbCancel = True] + + If _ErrorHandler() Then On Local Error GoTo Error_Function +Dim oFileAccess As Object, oStream As Object, lFileLength As Long, oField As Object +Dim i As Integer, oChunk As Object + + _AppendChunkClose = False + For i = 0 To UBound(_ManageChunks) + Set oChunk = _ManageChunks(i) + With oChunk + If Not .ChunksRequested Then GoTo Exit_Function + If IsNull(.FileHandler) Then GoTo Exit_Function + .Filehandler.closeOutput + Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") + ' Copy file to field + If Not pbCancel Then + Set oStream = oFileAccess.openFileRead(.FileName) + lFileLength = oStream.getLength() + If lFileLength > 0 Then + Set oField = RowSet.getColumns.getByName(.FieldName) + Select Case .ChunkType + Case vbByte + oField.updateBinaryStream(oStream, lFileLength) +' Case vbString ' DOES NOT WORK FOR CHARACTER TYPES +' oField.updateCharacterStream(oStream, lFileLength) + End Select + End If + oStream.closeInput() + End If + If oFileAccess.exists(.FileName) Then oFileAccess.kill(.FileName) + End With + Next i + Set _ManageChunks = Array() + _AppendChunkClose = True + +Exit_Function: + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Recordset._AppendChunkClose", Erl) + GoTo Exit_Function +End Function ' AppendChunkClose V1.5.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _AppendChunkInit(psFieldName As String) As Boolean +' Initialize chunks manager + +Dim iSize As Integer + iSize = UBound(_ManageChunks) + 1 + ReDim Preserve _ManageChunks(0 To iSize) + Set _ManageChunks(iSize) = New ChunkDescriptor + With _ManageChunks(iSize) + .ChunksRequested = False + .FieldName = psFieldName + .FileName = "" + Set .FileHandler = Nothing + End With + +End Function ' AppendChunkInit V1.5.0 + +REM ----------------------------------------------------------------------------------------------------------------------- Public Sub _Initialize(ByVal Optional pvFilter As Variant, Optional poRowSet As Object) ' Initialize new recordset |