VB6. Как обойти ошибку Out of memory?

''' Источник: http://www.vbforums.com/showthread.php?287495-load-a-picture-box-control-from-memory
 
Public Enum CBoolean   ' enum members are Long data types
  CFalse = 0
  CTrue = 1
End Enum
 
Public Const S_OK = 0    ' indicates successful HRESULT
 
Declare Function CreateStreamOnHGlobal Lib "ole32" _
                              (ByVal hGlobal As Long, _
                              ByVal fDeleteOnRelease As CBoolean, _
                              ppstm As Any) As Long
 
Declare Function OleLoadPicture Lib "olepro32" _
                              (pStream As Any, _
                              ByVal lSize As Long, _
                              ByVal fRunmode As CBoolean, _
                              riid As GUID, _
                              ppvObj As Any) As Long
 
Public Type GUID    ' 16 bytes (128 bits)
  dwData1 As Long      ' 4 bytes
  wData2 As Integer     ' 2 bytes
  wData3 As Integer     ' 2 bytes
  abData4(7) As Byte   ' 8 bytes, zero based
End Type
 
Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
 
Public Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
 
Public Const GMEM_MOVEABLE = &H2
 
Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
 
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
 
Public Type OPENFILENAME  '  ofn
  lStructSize As Long
  hWndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
 
Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
        Dim nLow As Long
        Dim cbMem  As Long
        Dim hMem  As Long
        Dim lpMem  As Long
        Dim IID_IPicture As GUID
        Dim istm As stdole.IUnknown '  IStream
        Dim ipic As IPicture
  
        ' Get the size of the picture's bits
 
100     nLow = LBound(abPic)
        
110     cbMem = (UBound(abPic) - nLow) + 1
  
        ' Allocate a global memory object
120     hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
 
130     If hMem Then
    
            ' Lock the memory object and get a pointer to it.
140         lpMem = GlobalLock(hMem)
 
150         If lpMem Then
      
                ' Copy the picture bits to the memory pointer and unlock the handle.
160             MoveMemory ByVal lpMem, abPic(nLow), cbMem
170             Call GlobalUnlock(hMem)
      
                ' Create an ISteam from the pictures bits (we can explicitly free hMem
                ' below, but we'll have the call do it...)
180             If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
190                 If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
          
                        ' Create an IPicture from the IStream (the docs say the call does not
                        ' AddRef its last param, but it looks like the reference counts are correct..)
200                     Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, _
                                IID_IPicture, PictureFromBits)
          
                    End If   ' CLSIDFromString
                End If   ' CreateStreamOnHGlobal
            End If   ' lpMem
    
            '    Call GlobalFree(hMem)
        End If   ' hMem
      
    End Function

Sub loadPic()
Dim BBuf() As Byte
 
    HomeDir$ = App.Path
    myName$ = App.EXEName + ".exe"
    
    fi% = FreeFile
    Open HomeDir$ + "\" + myName$ For Binary Access Read As #fi%
    
    LF& = LOF(fi%)         '::: Определяем собственную длину
    
    ttl$ = Space$(4)       '::: Буфер для сигнатуры
    
    Seek #fi%, (LF& - 3)   '::: становимся на начало сигнатуры
    Get #fi%, , ttl$       '::: читаем сигнатуру
    
    If ttl$ = "TAIL" Then  '::: Сигнатура правильная
    
       Seek #fi%, LF& - 7  '::: станем на поле длины
       Get #fi%, , LL&     '::: получили длину хвоста
       
       ReDim BBuf(1 To LL&) As Byte '::: буфер для чтения хвоста
       
       Seek #fi%, (LF& - LL& - 7) '::: станем на начало блока данных
       
       Get #fi%, , BBuf     '::: Читаем блок данных
       
       Close #fi%
       
       Form1.Image1.Picture = PictureFromBits(BBuf)
    
    Else
    
       Close #fi%
    
       MsgBox "Блок данных не найден!"
    
    End If
 
End Sub

' //
' // Test CEmbeddedFiles class usage
' //
 
Option Explicit
 
Sub Main()
    Dim cEmb    As CEmbeddedFiles
    Dim lIndex  As Long
    Dim vData   As Variant
    Dim bData() As Byte
    Dim lHex    As Long
    Dim sHex    As String
    
    Set cEmb = New CEmbeddedFiles
    
    cEmb.Initialize App.hInstance
    
    Open "dump.txt" For Output As #1
    
    For lIndex = 0 To cEmb.FilesCount - 1
    
        Print #1, "File: "; lIndex
        Print #1, "Name: "; cEmb.FileName(lIndex)
        
        If IsObject(cEmb.FileData(cEmb.FileName(lIndex))) Then
            
            Print #1, "Type: Object"
            
        Else
        
            bData = cEmb.FileData(cEmb.FileName(lIndex))
            Print #1, "Type: Binary"
            
            If Not Not bData Then
            
                Print #1, "Size: "; UBound(bData) + 1
                
                Print #1, "First 16 bytes:"
                
                For lHex = 0 To IIf(UBound(bData) > 15, 15, UBound(bData))
                    
                    sHex = Hex$(bData(lHex))
                    
                    If Len(sHex) = 1 Then sHex = "0" & sHex
                    
                    Print #1, sHex; " ";
                    
                Next
                
                Print #1, ""
                
            Else
                Print #1, "Size: 0"
            End If
            
        End If
 
    Next
    
End Sub