I tried to use a C DLL function in VBA but when it is called, Excel crashes. In VBA the function is declared like this:
Public Declare Function HR8_CONNECT Lib "D:xxxxx.dll" _
(ByVal PortCom As Byte, ByVal Mode As Byte, ByVal Config As Byte, ByVal Dbg As Byte, ByVal context As String) As Byte
I have a problem with context parameter I think which is a pointer to an unsigned char. See next the header of C function
extern "C" __declspec(dllimport) UCHAR HR8_CONNECT(UCHAR, UCHAR, UCHAR, UCHAR, UCHAR*);
I tried a lot of variants for passing the pointer like byval string, byref byte, etc ... but Excel is crashing every time.
Did you try to create a variable for every parameters and after call C function?
I experiment more or less similar issue and that came from a parameter send by pointer who was not directly declared.
Dim paramPortCom As Byte;
Dim paramMode As Byte;
Dim paramConfig As Byte;
Dim paramDbg As Byte;
Dim paramContext As String;
Dim resultFn As Byte;
' Set value into each variable
paramPortCom := 123;
...
' Call C function
resultFn := HR8_CONNECT(paramPortCom, ...);
Related
I am using these two functions to read a value from a multidimensional safearray
Private Declare Sub SafeArrayGetElement Lib "OleAut32.dll" ( _
ByVal pSafeArray As LongPtr, _
ByRef rgIndices As Long, _
ByRef dataBuffer As Any)
Private Declare Function SafeArrayGetElemsize Lib "OleAut32.dll" (ByVal pSafeArray As LongPtr) As Long
SafeArrayGetElement
SafeArrayGetElemsize
This is an example of how I use them:
Dim arr(1 to 2, 1 to 4) As Long 'or Integer, String, Object etc. Any datatype
Dim indices() As Long
ReDim indices(1 to CountOfDimensons(arr)) 'here arr is a 2D array so there are two indices
indices(1) = 1
indices(2) = 3
Dim resultBuffer() As Byte 'somewhere to read the data from the array into, big enough to hold whatever that is
ReDim resultBuffer(1 to SafeArrayGetElemsize(ArrPtr(arr)))
SafeArrayGetElement ArrPtr(arr), indices(1), resultBuffer(1) 'equivalent to resultBuffer = arr(1,3)
Now I have a resultBuffer with some data, and I can use VarType(arr) xor vbArray to get the vartype of the data. It could be Long, Integer, Variant etc...
How can I use those two pieces of information to create a variant? My idea was to have a big select case statement on the varType, declare variables of each type. Then use memcopy to hydrate those variables. Then assign their values to a new variant. However this is very over complicated. There must be an easier way to initialise a variant from some data.
Basically cast the void* to a long* or variant* etc. and then copy that into a Variant?
I write VB.NET class for implement CH341DLL.DLL functionality. The method CH341StreamI2C() is used for stream write and read into device. This way I've imported the method CH341StreamI2C() from DLL:
<DllImport("CH341DLL.DLL", SetLastError:=True, CallingConvention:=CallingConvention.StdCall)>
Private Shared Function CH341StreamI2C(ByVal iIndex As Integer, ByVal iWriteLength As Integer, ByRef iWriteBuffer As IntPtr, ByVal iReadLength As Integer, ByRef oReadBuffer As IntPtr) As Boolean
End Function
For check how this method works, I use I2C humidity and temperature sensor HTU21D. It's IIC address is 40h, and register where temperature is getting is E3h. So I invoke method CH341StreamI2C() like this:
Dim writeBuffer as Byte() = {&H40, &hE3} 'Address+Command
Dim s As String = Encoding.Unicode.GetString(writeBuffer)
Dim writeBufPtr As IntPtr = Marshal.StringToHGlobalAuto(s) 'Get pointer for write buffer
Dim wLen As Integer = writeBuffer.Length
Dim readBufPtr As IntPtr = IntPtr.Zero 'Init read pointer
Dim rLen as Integer = 3 'Sensor must return 3 bytes
Dim res As Boolean = CH341StreamI2C(0, wLen, writeBufPtr, rLen, readBufPtr)
I use logic analyzer to see what is on the SDA and SCL lines. And result is unpredictable. For example, if call previous code 4 times, that's the result:
It's seen, that physically CH341 device writes unpredictable values in the line. This is not DLL error, because other applications use this method and the result is correct. For note, other methods, e.g. CH341ReadI2C() and CH341WriteI2C(), that reads/writes only one byte per time, acts correct in my code.
What is the probably reason of the such behavior? May be, I've marshalled write buffer incorrect? How is the right way to do this?
If this is what you're using, the original declaration is:
BOOL WINAPI CH341StreamI2C(ULONG iIndex, ULONG iWriteLength, PVOID iWriteBuffer, ULONG iReadLength, PVOID oReadBuffer);
Since the buffer parameters are PVOIDs, you should be able to just marshal them directly to byte arrays:
<DllImport("CH341DLL.DLL", SetLastError:=True, CallingConvention:=CallingConvention.StdCall)>
Private Shared Function CH341StreamI2C(ByVal iIndex As Integer, ByVal iWriteLength As Integer, ByVal iWriteBuffer As Byte(), ByVal iReadLength As Integer, ByVal oReadBuffer As Byte()) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Arrays are reference types (classes) which means you always refer to them via their memory pointer. Thus when you pass them to a function (P/Invoked or not) you're actually passing the array's pointer, rather than the array itself. This is really helpful when P/Invoking since it often lets you pass the arrays as-is.
) I am trying to send a short text from a VB app to Delphi app.. here is the
VB Code: Sender Program "Sender"
Public Class SendData
Const WM_COPYDATA = &H4A
Public Structure CopyDataStruct
Public dwData As Integer
Public cbData As Integer
Public lpData As String
End Structure
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As _
CopyDataStruct) As Long
Private Sub SendData(ByVal cds)
Dim iHwnd As Long
Dim SS As String = "Test String less than 30 Char"
Dim cds As CopyDataStruct
cds.dwData = 0
cds.cbData = Len(SS)
cds.lpData = SS
iHwnd = FindWindow(0&, "Receive")
SendMessage(iHwnd, &H4A, Me.Handle, cds)
End Sub
here is the Delphi Code: Receiver program "Receive"
procedure TForm1.HandleCopyDataString(copyDataStruct: PCopyDataStruct);
var
s : string;
begin
s := PChar(CopyDataStruct.lpData);
cdMemo.Lines.Add(Format('Received data "%s" at %s',[s, TimeToStr(Now)]));
end;
procedure TForm1.WMCopyData(var Msg: TWMCopyData) ;
var
s : string;
sText: array[0..255] of Char;
copyDataType : TCopyDataType;
begin
copyDataType := TCopyDataType(Msg.CopyDataStruct.dwData);
s := PChar(Msg.CopyDataStruct.dwData);
Form1.cdMemo.Lines.Add(Format('Data from: %d',[msg.From]));
HandleCopyDataString(Msg.CopyDataStruct);
case Msg.CopyDataStruct.dwData of 0: //we are being sent a string
begin
StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
Form1.Label1.Caption := sText;
end;
end;
end;
What am I doing wrong here? It is possible to send strings from VB to Delphi programs using WM_COPYDATA command, and SendMessage function?
please help me :-)
F
There are a few things wrong with your Delphi code.
The dwData field holds an integer, but you type-cast it to PChar, a pointer, and then assign it to your string. That's not the field where you stored your string data. That's lpData.
The string you pass is not null-terminated. The OS only promises to copy exactly as many bytes as you specify in the cbData field. That's not necessarily a problem, but you need to be aware of it when you read the string later. To assign s to hold the string copied from the other process, use SetString like this:
SetString(s, PAnsiChar(Msg.CopyDataStruct.lpData), Msg.CopyDataStruct.cbData);
You haven't shown what TCopyDataType is, but if it's anything other than an integer or integer-subrange type, you're using it wrong. The dwData field is already a DWord, so you can use it wherever a numeric value is expected.
You're calling StrLCopy wrong. The third parameter should be the size of the destination buffer, not the source. It's meant to prevent buffer overflows by not copying more characters than will fit in the destination. The function expects to be able to detect the size of the source buffer by finding the terminating null character (but we already established that that won't be available). You could fix it like this:
StrLCopy(sText, Msg.CopyDataStruct.lpData,
Min(Length(sText), Msg.CopyDataStruct.cbData));
(Min is in the Math unit.)
While searching in the net i got few lines of code in VB for extracting an image from EMF File.
I tried to convert that into Delphi but doesnt work.
Help me in converting this code to delphi.
Public Function CallBack_ENumMetafile(ByVal hdc As Long, _
ByVal lpHtable As Long, _
ByVal lpMFR As Long, _
ByVal nObj As Long, _
ByVal lpClientData As Long) As Long
Dim PEnhEMR As EMR
Dim PEnhStrecthDiBits As EMRSTRETCHDIBITS
Dim tmpDc As Long
Dim hBitmap As Long
Dim lRet As Long
Dim BITMAPINFO As BITMAPINFO
Dim pBitsMem As Long
Dim pBitmapInfo As Long
Static RecordCount As Long
lRet = PlayEnhMetaFileRecord(hdc, ByVal lpHtable, ByVal lpMFR, ByVal nObj)
RecordCount = RecordCount + 1
CopyMemory PEnhEMR, ByVal lpMFR, Len(PEnhEMR)
Select Case PEnhEMR.iType
Case 1 'header
RecordCount = 1
Case EMR_STRETCHDIBITS
CopyMemory PEnhStrecthDiBits, ByVal lpMFR, Len(PEnhStrecthDiBits)
pBitmapInfo = lpMFR + PEnhStrecthDiBits.offBmiSrc
CopyMemory BITMAPINFO, ByVal pBitmapInfo, Len(BITMAPINFO)
pBitsMem = lpMFR + PEnhStrecthDiBits.offBitsSrc
tmpDc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
hBitmap = CreateDIBitmap(tmpDc, _
BITMAPINFO.bmiHeader, _
CBM_INIT, _
ByVal pBitsMem, _
BITMAPINFO, _
DIB_RGB_COLORS)
lRet = DeleteDC(tmpDc)
End Select
CallBack_ENumMetafile = True
End Function
What you've posted is an instance of an EnumMetaFileProc callback function, so we'll start with the signature:
function Callback_EnumMetafile(
hdc: HDC;
lpHTable: PHandleTable;
lpMFR: PMetaRecord;
nObj: Integer;
lpClientData: LParam
): Integer; stdcall;
It begins by declaring a bunch of variables, but I'll skip that for now since I don't know which ones we'll really need, and VB has a more limited type system than Delphi. I'm going to declare them as we need them; you can move them all to the top of the function yourself.
Next comes a call to PlayEnhMetaFileRecord using most of the same parameters that were passed into the callback function. The function returns a Bool, but then the code ignores it, so let's not bother with lRet.
PlayEnhMetaFileRecord(hdc, lpHtable, lpMFR, nObj);
Next we initialize RecordCount. It's declared static, which means it retains its value from one call to the next. That looks a little dubious; it should probably be passed in as a pointer in the lpClientData parameter, but let's not veer too far from the original code for now. Delphi does static variables with typed constants, and they need to be modifiable, so we'll use the $J directive:
{$J+}
const
RecordCount: Integer = 0;
{$J}
Inc(RecordCount);
Next we mcopy some of the meta record into another variable:
var
PEnhEMR: TEMR;
CopyMemory(#PEnhEMR, lpMFR, SizeOf(PEnhEMR));
It looks a little strange to copy the TMetaRecord structure onto a TEMR structure since they aren't really similar, but again, I don't want to veer from the original code too much.
Next is a case statement on the iType field. The first case is when it's 1:
case PEnhEMR.iType of
1: RecordCount := 1;
The next case is that it's emr_StretchDIBits. It copies more of the meta record, and then assigns some other pointers to refer to subsections of the main data structure.
var
PEnhStretchDIBits: TEMRStretchDIBits;
BitmapInfo: TBitmapInfo;
pBitmapInfo: Pointer;
pBitsMem: Pointer;
emr_StretchDIBits: begin
CopyMemory(#PEnhStrecthDIBits, lpMFR, SizeOf(PEnhStrecthDIBits));
pBitmapInfo := Pointer(Cardinal(lpMFR) + PEnhStrecthDiBits.offBmiSrc);
CopyMemory(#BitmapInfo, pBitmapInfo, SizeOf(BitmapInfo));
pBitsMem := Pointer(Cardinal(lpMFR) + PEnhStrecthDiBits.offBitsSrc);
Then comes what seems to be the real meat of the function, where we create a display context and a bitmap to go with it using the DIBits extracted using the previous code.
var
tmpDc: HDC;
hBitmap: HBitmap;
tmpDc := CreateDC('DISPLAY', nil, nil, nil);
hBitmap := CreateDIBitmap(tmpDc, #BitmapInfo.bmiHeader, cbm_Init,
pBitsMem, #BitmapInfo, dib_RGB_Colors);
DeleteDC(tmpDc);
end; // emr_StretchDIBits
end; // case
Finally, we assign a return value to the callback function:
Result := 1;
So, there's your translation. Wrap it in a begin-end block, remove my commentary, and move all the variable declarations to the top, and you should have Delphi code that's equivalent to your VB code. However, all this code ultimately does is generate memory leaks. The hBitmap variable is local to the function, so the bitmap handle it holds is leaked as soon as this function returns. I assume the VB code works for you, though, so I guess you have some other plans for what to do with it.
If you're working with metafiles, have you considered using the TMetafile class in the Graphics unit? It might make your life easier.
I have written my own function, which in C would be declared like this, using standard Win32 calling conventions:
int Thing( char * command, char * buffer, int * BufSize);
I have the following amount of Visual Basic code figured out, which should import the DLL file and call this function, wrapping it up to make it easy to call Thing("CommandHere",GetDataBackHere).
UPDATE: This code is now a working solution, as shown here:
Imports Microsoft.VisualBasic
Imports System.Runtime.InteropServices
Imports System
Imports System.Text
Namespace dllInvocationSpace
Public Class dllInvoker
' I tried attributes, but I could not make it build:
' <DllImport("thing1.dll", False, CallingConvention.Cdecl, CharSet.Ansi, "Thing", True, True, False, True)>
Declare Ansi Function Thing Lib "thing1.dll" (ByVal Command As String, ByRef Buffer As StringBuilder, ByRef BufferLength As Integer) As Integer
' This part contributed by helpful user:
Shared Function dllCall(ByVal Command As String, ByRef Results As String) As Integer
Dim Buffer As StringBuilder = New StringBuilder(65536)
Dim Length As Integer = Buffer.Capacity
Dim retCode As Integer = Thing(Command, Buffer, Length)
Results = Buffer.ToString()
'Debug.Assert(Results.Length = Length) ' This assertion is not true for me
Return retCode
End Function
End Class
End Namespace
I got the code to build by following the help received here, and then I had forgot the As Return Type (which got me a MarshalDirectiveException PInvokeRestriction). Then I had an assertion failure inside my DLL, which lead to an SEHException. Once fixed, this works BEAUTIFULLY. Thank you folks. There are newsgroups where people are saying this can not be done, that Visual Basic only loads managed DLL assemblies (which I guess is the normal thing most Visual Basic users are used to).
It depends on how you use the buffer argument in your C code. If you only pass a string from your VB.NET code to your C code then declaring it ByVal String is good enough. If however you let the C code return a string in the buffer then you have to declare it ByVal StringBuilder and initialize it properly before the call. For example:
Public Class dllInvoker
Declare Ansi Function Thing Lib "Thing1.dll" (ByVal Command As String, ByVal Buffer As StringBuilder, ByRef BufferLength As Integer) As Integer
Shared Function dllCall(ByVal Command As String, ByRef Results As String) As Integer
Dim Buffer As StringBuilder = New StringBuilder(65536)
Dim Length As Integer = Buffer.Capacity
Dim retCode As Integer = Thing(Command, Buffer, Length)
Results = Buffer.ToString()
Debug.Assert(Results.Length = Length)
Return retCode
End Function
End Class
Note the ambiguity in the returned Length value.
You cannot convert a StringBuilder instance to a string instance, instead, use the 'ToString' method to convert it back to the string type...here's the portion of the code in the dllCall function...
retCode = Thing(Command, Buffer, bufsz)
Results = Buffer.ToString();