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 :vb Code:
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
vb Code:
Private Type COPYDATASTRUCT dwData As Long cbData As Long lpData As Long End Type
'Edited
vb Code:
Private Type COPYDATASTRUCT dwData As Long cbData As Long lpData As Long cbDataShortName As Long lpDataShortName As Long End Type
'Original
vb Code:
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
vb Code:
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
vb Code:
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
vb Code:
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
vb Code:
Public Function filenameReceived(ByRef szFilename As String) Call lstFiles.AddItem(szFilename) End Function
'Edited
vb Code:
Public Function filenameReceived(ByRef szFilename As String, ByRef szFilenameShort As String) Call lstFiles.AddItem(szFilename) Call lstFiles.AddItem(szFilenameShort) End Function
'Edited-New Function
vb Code:
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
Attachment 75026
Attachment 75027

