Out Of memory Error

[justgreat]

The code posted here works good, it takes a filename received from command and send it to the previous instance of the application.....

I am making some changes on it, and i am getting an error "Out Of Memory" ... if i try with the exe, it crashes and close, and if i am on the IDE, and i run with compile, i get an error "Out Of Memory" and the IDE stop responding


to make it easiar to identify the problem, i removed all the changes i made and kept the only ones causing the error...So here what i am trying to do is instead of sending
the file name only, i try to send another string wich is the short name of the file

Attached the original Code and the Edited one...Anyway here are the difference between both :


The error occurs on the Edited version , at the Function WndProc
line :

ReDim bDataArrShort(tData.cbDataShortName - 1)

As it seems here the value of the tData.cbDataShortName is too big, while when we send it at the sendStringToPrimaryInstance, it's value is the lenght so why here we receive it that big ? maybe if you have an answer to this question this will solve the problem

here are the original and edited version of the code (the original works good)

'Original

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
    
End Type

'Edited

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
  
    cbDataShortName As Long
    lpDataShortName As Long
 
End Type

'Original

Public Function sendStringToPrimaryInstance(ByRef szData As String, ByVal hWndSubordinate As Long, ByVal hWndPrimary As Long)
    Dim tData As COPYDATASTRUCT, bDataArr() As Byte, lRet As Long
    
    '--Convert (UNICODE) String to (ANSI) so it faster for Windows to marshall the data across processes
    '--Note that UNICODE support dies here
    bDataArr = StrConv(szData, vbFromUnicode)
    
    '--Setup the COPYDATA Struct
    tData.dwData = hWndSubordinate      '--HWND of Sender
    tData.cbData = UBound(bDataArr) + 1 '--Length Of data
    tData.lpData = VarPtr(bDataArr(0))  '--Pointer to the data
    '--Sendit to the primary instance
    lRet = SendMessage(hWndPrimary, WM_COPYDATA, hWndSubordinate, tData)
End Function

'Edited

Public Function sendStringToPrimaryInstance(ByRef szData As String, ByVal hWndSubordinate As Long, ByVal hWndPrimary As Long)
    Dim tData As COPYDATASTRUCT, bDataArr() As Byte, lRet As Long
    Dim bDataArrShort() As Byte
    
    Dim ShortFileName As String
    ShortFileName = GetDirOrShortFileName(szData)
    
    '--Convert (UNICODE) String to (ANSI) so it faster for Windows to marshall the data across processes
    '--Note that UNICODE support dies here
    bDataArr = StrConv(szData, vbFromUnicode)
    
    '--Setup the COPYDATA Struct
    tData.dwData = hWndSubordinate      '--HWND of Sender
    tData.cbData = UBound(bDataArr) + 1 '--Length Of data
    tData.lpData = VarPtr(bDataArr(0))  '--Pointer to the data
    '--Sendit to the primary instance
    
    bDataArrShort = StrConv(ShortFileName, vbFromUnicode)
    
    'UBound(bDataArrShort) + 1  ==> giving the right value wich is the length of the ShortFileName
    tData.cbDataShortName = UBound(bDataArrShort) + 1
    tData.lpDataShortName = VarPtr(bDataArrShort(0))
 
     
    lRet = SendMessage(hWndPrimary, WM_COPYDATA, hWndSubordinate, tData)
End Function

'Original

Public Function WndProc(ByVal hWnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim szFilename As String, bDataArr() As Byte, tData As COPYDATASTRUCT
    
    If (uiMsg = WM_COPYDATA) Then
        '--Grab the COPYDATA struct from the pointer lParam
        Call CopyMemory(tData, ByVal lParam, Len(tData))
        '--Make sure its the required COPYDATA struct by making sure wParam == tData.dwData
        If (tData.dwData = wParam) Then
            '--Create a buffer the size of the data
            ReDim bDataArr(tData.cbData - 1)
            '--Copy data into the buffer
            Call CopyMemory(bDataArr(0), ByVal tData.lpData, tData.cbData)
            '--Create ANSI String from Byte Array
            szFilename = bDataArr
            '--Convert ANSI String into UNICODE so VB understands it
            szFilename = StrConv(szFilename, vbUnicode)
            '--Call the handler and pass it the filename passed
            Call Interaction.CallByName(m_pDisp, FUNC_PROC, VbMethod, szFilename)
            '--We handled the message!
            WndProc = 1
        Else
            '--We dont care
            WndProc = 0
        End If
    Else
        'Default impl.
        WndProc = CallWindowProc(m_lPrevProc, hWnd, uiMsg, wParam, lParam)
    End If
End Function

'Edited

Public Function WndProc(ByVal hWnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim szFilename As String, bDataArr() As Byte, tData As COPYDATASTRUCT
    Dim szFilenameShort As String, bDataArrShort() As Byte
    
    
    If (uiMsg = WM_COPYDATA) Then
        '--Grab the COPYDATA struct from the pointer lParam
        Call CopyMemory(tData, ByVal lParam, Len(tData))
        '--Make sure its the required COPYDATA struct by making sure wParam == tData.dwData
        If (tData.dwData = wParam) Then
            '--Create a buffer the size of the data
            ReDim bDataArr(tData.cbData - 1)
            '--Copy data into the buffer
            Call CopyMemory(bDataArr(0), ByVal tData.lpData, tData.cbData)
            '--Create ANSI String from Byte Array
            szFilename = bDataArr
            '--Convert ANSI String into UNICODE so VB understands it
            szFilename = StrConv(szFilename, vbUnicode)
            '--Call the handler and pass it the filename passed
            
            
             'Added Code
             
             'Here it's getting out of memory !
            ReDim bDataArrShort(tData.cbDataShortName - 1)
             
            Call CopyMemory(bDataArrShort(0), ByVal tData.lpDataShortName, tData.cbDataShortName)
             
            szFilenameShort = bDataArrShort
            
            szFilenameShort = StrConv(szFilenameShort, vbUnicode)
             
             
            Call Interaction.CallByName(m_pDisp, FUNC_PROC, VbMethod, szFilename, szFilenameShort)
            '--We handled the message!
            
        
            WndProc = 1
        Else
            '--We dont care
            WndProc = 0
        End If
    Else
        'Default impl.
        WndProc = CallWindowProc(m_lPrevProc, hWnd, uiMsg, wParam, lParam)
    End If
End Function

'Original

Public Function filenameReceived(ByRef szFilename As String)
    Call lstFiles.AddItem(szFilename)
End Function

'Edited

Public Function filenameReceived(ByRef szFilename As String, ByRef szFilenameShort As String)
    Call lstFiles.AddItem(szFilename)
    Call lstFiles.AddItem(szFilenameShort)
End Function

'Edited-New Function

Public Function GetDirOrShortFileName(ByVal ScanString As String) As String
 
'This function works well 
 
    Dim intPos As Integer
    Dim intPosSave As Integer
    
    intPos = 1
    Do
        intPos = InStr(intPos, ScanString, "\")
        If intPos = 0 Then
            Exit Do
        Else
            intPos = intPos + 1
            intPosSave = intPos - 1
        End If
    Loop
    
     
    GetDirOrShortFileName = Mid(ScanString, intPosSave + 1, Len(ScanString) - intPosSave)
    
 
End Function

thanks again to all for your support till now , your advides till now helped me a lot to advance in my appliction


X3 Passing Filenames.zip

X3 Passing Filenames_Edited.zip