How to call a Delphi DLL from VB6 - delphi

Given the following Delphil DLL declaration
function csd_HandleData(aBuf: PChar; aLen: integer): integer; stdcall;
what would be the VB6 declaration to use it?
I've tried a variety of declarations, e.g.
Declare Function csd_HandleData Lib "chsdet.dll" (ByVal aBuf As String, ByVal aLen As Integer)
Declare Function csd_HandleData Lib "chsdet.dll" (aBuf As Long, ByVal aLen As Integer)
Declare Function csd_HandleData Lib "chsdet.dll" (aBuf As Byte, ByVal aLen As Integer)
with the relevant code to suit the parameters, but nothing seems to work, i.e. the Delphi debugger says I have a too-largish value in aLen and a null string in aBuf.
I am working toward using a TypeLib to drive the connection, but was prototyping with Declares.

try
Declare Function csd_HandleData Lib "chsdet.dll" (ByVal aBuf As String,
ByVal aLen As Integer) As Integer
Seems you forgot the return value.

VB integer datatype is 16bit, so you should declare it as long which is equivalent to integer in Delphi and other languages.
Declare Function csd_HandleData Lib "chsdet.dll" (ByVal aBuf As String, ByVal aLen As long) as long

For those interested, here's the final IDL for the typelib for CHSDET. What impressed me (after re-discovering Matt Curland's EditTLB tool) was that I can put structures into a typelib, and VB handles them as if I'd declared them in the source code.
I've written to the author of ChsDet and perhaps this will end up as part of the standard distro.
// Generated .IDL file (by the OLE/COM Object Viewer)
//
// typelib filename: chsdet.tlb
[
uuid(316A83D7-8BF4-490E-BDDE-75EBC332C355),
version(1.0),
helpstring("Charset Detector - as the name says - is a stand alone executable module for automatic charset detection of a given text.\r\n\t\r\nIt can be useful for internationalisation support in multilingual applications such as web-script editors or Unicode editors.\r\n\t\r\nGiven input buffer will be analysed to guess used encoding. The result can be used as control parameter for charset conversation procedure.\r\n\t\r\nCharset Detector can be compiled (and hopefully used) for MS Windows (as dll - dynamic link library) or Linux.\r\n\t\r\nBased on Mozilla's i18n component - http://www.mozilla.org/projects/intl/. \r\n\r\nCharset Detector is open source project and distributed under Lesser GPL.\r\nSee the GNU Lesser General Public License for more details - http://www.opensource.org/licenses/lgpl-license.php\r\n\r\nNikolaj Yakowlew \xFFFFFFA9 2006-2008 \r\nTypeLib by Bruce M. Axtens, 2008.")
]
library CHSDET
{
// TLib : // Forward declare all types defined in this typelib
[
dllname("CHSDET.dll"),
version(1.0),
helpstring("Functions in CHSDET.DLL")
]
module CHSDETFunctions {
[entry(0x60000000), helpstring("Returns rAbout record (qv)")]
void _stdcall GetAbout([in, out] rAbout* AboutRec);
[entry(0x60000001), helpstring("Reset detector. Prepares for new analysis.")]
void _stdcall Reset();
[entry(0x60000002), helpstring("Analyse given buffer of specified length.
Return value is of eHandleDataErrors, either
NS_ERROR_OUT_OF_MEMORY (Unable to create internal objects) or NS_OK.
Function can be called more that one time to continue guessing. Charset Detector remembers last state until Reset called.")]
void _stdcall HandleData(
[in] BSTR aBuf,
[in] short aLen,
[out, retval] short* retVal);
[entry(0x60000003), helpstring("Returns either TRUE (Charset Detector is sure about text encoding.) or FALSE.
NB: If input buffer is smaller then 1K, Charset Detector returns FALSE.")]
void _stdcall IsDone([out, retval] short* retVal);
[entry(0x60000004), helpstring("Signal data end. If Charset Detector hasn't sure result (IsDone = FALSE) the best guessed encoding will be set as result.")]
void _stdcall DataEnd();
[entry(0x60000005), helpstring("Returns guessed charset as rCharsetInfo record")]
void _stdcall GetDetectedCharset([out, retval] rCharsetInfo* retVal);
[entry(0x60000006), helpstring("Returns all supported charsets in form "0x0A Name - CodePage"")]
void _stdcall GetKnownCharsets(
[in, out] long* sList,
[out, retval] long* retVal);
[entry(0x60000007), helpstring("Return eBOMKind value matching byte order mark (if any) of input data.")]
void _stdcall GetDetectedBOM([out, retval] eBOMKind* retVal);
[entry(0x60000008), helpstring("Remove CodePage from consideration as a possible match")]
void _stdcall DisableCharsetCP([in] long CodePage);
};
typedef [uuid(91694067-30AB-44A9-A210-F5602935475F)]
struct tagrAbout {
long lMajor;
long lMinor;
long lRelease;
long sAbout;
} rAbout;
typedef [uuid(3C8B7420-D40B-458B-8DE8-9B3D28607396)]
enum {
BOM_Not_Found = 0,
BOM_UCS4_BE = 1,
BOM_UCS4_LE = 2,
BOM_UCS4_2143 = 3,
BOM_UCS4_3412 = 4,
BOM_UTF16_BE = 5,
BOM_UTF16_LE = 6,
BOM_UTF8 = 7
} eBOMKind;
typedef [uuid(9B231DEF-93FB-440D-B06B-D760AECE09D0)]
struct tagrCharsetInfo {
long Name;
short CodePage;
long Language;
} rCharsetInfo;
typedef enum {
NS_OK = 0,
NS_ERROR_OUT_OF_MEMORY = -2147024882
} eHandleDataErrors;
};

I don't know what a PChar is in Delphi, is it just one character? ASCII?? Unicode?
An Integer is 16 bits in VB6, you'll have to declare aLen as Long, which can hold 32 bits.
You also have to declare the return type of the function, in this case you'll want to return a Long value too.
This will probably work:
Declare Function csd_HandleData Lib "chsdet.dll" (aBuf As Byte, ByVal aLen As Long) As Long

I don´t know exactly how Vb works but PChar is a pointer, so try to get the reference instead of the value.
Declare Function csd_HandleData Lib "chsdet.dll" (**ByReference <--guessing here :D** aBuf As String, ByVal aLen As Integer)

Related

I can't 'HRESULT Authorize()' through 'interface IiTunes'

Good day, everybady,
I work on Windows7 (64 bits) and try use COM / OLE object "iTunesApp Class". This object has installed with iTunes application.
My code is following
HRESULT hr;
CLSID clsid;
IiTunes *pIiTunes = nullptr;
//Apple.iTunes
CLSIDFromProgID(OLESTR("iTunes.Application.1"), &clsid);
hr = CoCreateInstance(clsid, nullptr, CLSCTX_LOCAL_SERVER, __uuidof(IiTunes), reinterpret_cast<LPVOID *>(&pIiTunes));
if (pIiTunes != nullptr)
{
VARIANT data[16];
OLECHAR ver[4096] = L"vaneustroev#gmail.com";
pIiTunes->Authorize(1, data, (BSTR*)ver);
}
Then (pIiTunes->Authorize(1, data, (BSTR*)ver); ) I've got exception '...exception from address 0x000007FEFF4E4FCA (oleaut32.dll) ...Violation of access rights at address 0x000007FEFF4E4FCA...'
I don't know which parameters for pIiTunes->Authorize() I must set
I don't know what is the value of parameters that must be set, but I know the types of these parameters.
First one is a int32, second is a VARIANT reference, third is a array of BSTR. VARIANTs must be initialized and cleared after use, BSTRs must be allocated (a BSTR is not a OLECHAR *) and freed after use.
So, beyond the real semantics of the method, you can call it like this:
VARIANT data;
VariantInit(&data); // undercovers, this will just zero the whole 16-bytes structure
// ... do something with data here
BSTR ver = SysAllocString(L"vaneustroev#gmail.com"); // you should check for null -> out of memory
pIiTunes->Authorize(1, &data, &ver);
// always free BSTRs and clear VARIANTS
SysFreeString(ver);
VariantClear(&data);
If you use Visual Studio, there are cool Compiler COM Support Classes that ease VARIANT and BSTR programming considerably, as you could rewrite all this like this:
_variant_t data;
_bstr_t ver = L"vaneustroev#gmail.com";
BSTR b = ver;
pIiTunes->Authorize(1, &data, &b);
Visual Studio also provides a library called ATL that has other wrappers. Using them is similar:
CComVariant data;
CComBSTR ver = L"vaneustroev#gmail.com";
BSTR b = ver;
pIiTunes->Authorize(1, &data, &b);

F# Passing Nulls to Unmanaged Imported DLL

In F# i'm using an external DLL (in this case SDL Graphics library) I'm importing the method I require as follows...
[<DllImport("SDL2.dll", CallingConvention = CallingConvention.Cdecl)>]
extern int SDL_QueryTexture(nativeint texture, uint32& format, int& access, int& w, int& h)
This works fine and I can successfully call the method using the following...
let result = SDLDefs.SDL_QueryTexture(textTexture, &format, &access, &w, &h)
The problem is that the native SDL methods accept null values for many pointer arguments. This is required in some scenarios (which function like overloaded methods). I can't find any way to call these methods from F# passing nulls.
For example, this fails with "does not have null as proper value"
let result = SDLDefs.SDL_QueryTexture(textTexture, &format, null, &w, &h)
I read about the attribute [AllowNullLiteral] but it seems like I can only apply it to types I define, and not pre-defined types which are used in my imported DLL.
Is there any way I can do this?
If you want to specify nulls, you need to use "raw pointers", which are represented by types nativeint and nativeptr<T>.
[<DllImport("SDL2.dll", CallingConvention = CallingConvention.Cdecl)>]
extern int SDL_QueryTexture(nativeint texture, uint32& format, nativeint access, int& w, int& h)
// Call without null
let access = 42
let pAccess = NativePtr.stackalloc<int> 1
NativePtr.write pAccess access
SQL_QueryTexture( textTexture, &format, NativePtr.toNativeInt pAccess, &w, &h )
let returnedAccess = NativePtr.read pAccess
// Call with null
SQL_QueryTexture( textTexture, &format, null, &w, &h )
NOTE: be careful with stackalloc. Allocating memory on the stack is quite handy, because you don't need to explicitly release it, but pointers to it will become invalid once you exit the current function. So you can only pass such pointers to an external function if you're sure that the function won't store the pointer and try to use it later.
If you need to pass a pointer to real heap memory that's not going anywhere, you'll need Marshal.AllocHGlobal. But don't forget to release! (or else :-)
let access = 42
let pAccess = Marshal.AllocHGlobal( sizeof<int> )
NativePtr.write (NativePtr.ofNativeInt pAccess) access
SQL_QueryTexture( textTexture, &format, pAccess, &w, &h )
Marshal.FreeHGlobal( pAccess )

Copying an address from a pointer to a different memory address

I have a C DLL with a number of functions I'm calling from Delphi. One of the functions (say Func1) returns a pointer to a struct - this all works fine. The structs created by calling Func1 are stored in a global pool within the DLL. Using a second function (Func2) I get a pointer to a block of memory containing an array of pointers, and I can access the array elements using an offset.
I need to be able copy the address in the returned pointer for a struct (from Func1) to any of the memory locations in the array (from Func2). The idea is that I can build arrays of pointers to pre-defined structs and access the elements directly from Delphi using pointer offsets.
I tried using:
CopyMemory(Pointer(NativeUInt(DataPointer) + offset), PStruct, DataSize);
where DataPointer is the start of my array and PStruct is returned from Func1, but that doesn't copy the address I need.
In .NET it works using Marshal.WriteIntPtr and looking at the underlying code for this using Reflector I think I need something trickier than CopyMemory. Anyone got any ideas for doing this in Delphi?
Edit: This is part of a wrapper around vector structures returned from the R language DLL. I have a base vector class from which I derive specific vector types. I've got the wrapper for the numeric vector working, so my base class looks fine and this is where I get DataPointer:
function TRVector<T>.GetDataPointer: PSEXPREC;
var
offset: integer;
h: PSEXPREC;
begin
// TVECTOR_SEXPREC is the vector header, with the actual data behind it.
offset := SizeOf(TVECTOR_SEXPREC);
h := Handle;
result := PSEXPREC(NativeUInt(h) + offset);
end;
Setting a value in a numeric vector is easy (ignoring error handling):
procedure TNumericVector.SetValue(ix: integer; value: double);
var
PData: PDouble;
offset: integer;
begin
offset := GetOffset(ix); // -- Offset from DataPointer
PData := PDouble(NativeUInt(DataPointer) + offset);
PData^ := value;
end;
For a string vector I need to (i) create a base vector of pointers with a pre-specified length as for the numeric vector (ii) convert each string in my input array to an R internal character string (CHARSXP) using the R mkChar function (iii) assign the address of the character string struct to the appropriate element in the base vector. The string array gets passed into the constructor of my vector class (TCharacterVector) and I then call SetValue (see below) for each string in the array.
I should have thought of PPointer as suggested by Remy but neither that or the array approach seem to work either. Below is the code using the array approach from Remy and with some pointer vars for checking addresses. I'm just using old-fashioned pointer arithmetic and have shown addresses displayed for a run when debugging:
procedure TCharacterVector.SetValue(ix: integer; value: string);
var
PData: PSEXPREC;
offset: integer;
offset2: integer;
PTest: PSEXPREC;
PPtr: Pointer;
PPtr2: Pointer;
begin
offset := GetOffset(ix);
PPtr := PPointer(NativeUInt(DataPointer) + offset); // $89483D8
PData := mkChar(value); // $8850258
// -- Use the following code to check that mkChar is working.
offset2 := SizeOf(TVECTOR_SEXPREC);
PTest := PSEXPREC(NativeUInt(PData) + offset);
FTestString := FTestString + AnsiString(PAnsiChar(PTest));
//PPointerList(DataPointer)^[ix] := PData;
//PPtr2 := PPointer(NativeUInt(DataPointer) + offset); // Wrong!
PPointerArray(DataPointer)^[ix] := PData;
PPtr2 := PPointerArray(DataPointer)^[ix]; // $8850258 - correct
end;
I'd have thought the address in PData ($8850258) would now be in PPtr2 but I've been staring at this so long I'm sure I'm missing something obvious.
Edit2: The code for SetValue used in R.NET is as follows (ignoring test for null string):
private void SetValue(int index, string value)
{
int offset = GetOffset(index);
IntPtr stringPointer = mkChar(value);
Marshal.WriteIntPtr(DataPointer, offset, stringPointer);
}
From reflector, Marshal.WriteIntPtr uses the following C:
public static unsafe void WriteInt32(IntPtr ptr, int ofs, int val)
{
try
{
byte* numPtr = (byte*) (((void*) ptr) + ofs);
if ((((int) numPtr) & 3) == 0)
{
*((int*) numPtr) = val;
}
else
{
byte* numPtr2 = (byte*) &val;
numPtr[0] = numPtr2[0];
numPtr[1] = numPtr2[1];
numPtr[2] = numPtr2[2];
numPtr[3] = numPtr2[3];
}
}
catch (NullReferenceException)
{
throw new AccessViolationException();
}
}
You say you want to copy the struct pointer itself into the array, but the code you have shown is trying to copy the struct data that the pointer is pointing at. If you really want to copy just the pointer itself, don't use CopyMemory() at all. Just assign the pointer as-is:
const
MaxPointerList = 255; // whatever max array count that Func2() allocates
type
TPointerList = array[0..MaxPointerList-1] of Pointer;
PPointerList = ^TPointerList;
PPointerList(DataPointer)^[index] := PStruct;
Your use of NativeUInt reveals that you are using a version of Delphi that likely supports the {$POINTERMATH} directive, so you can take advantage of that instead, eg:
{$POINTERMATH ON}
PPointer(DataPointer)[index] := PStruct;
Or, use the pre-existing PPointerArray type in the System unit:
{$POINTERMATH ON}
PPointerArray(DataPointer)[index] := PStruct;

Using a ByteBuffer to represent a string in a JNA call results in extra characters in the buffer

I'm calling a dll using JNA and code generated using Jnaerator. One of the methods requires an string, and the JNA signature takes a ByteBuffer.
I've tried allocating the ByteBuffer as direct (ByteBuffer.allocateDirect) and indirect (ByteBuffer.wrap) but in both cases some times the string that reaches the dll has additional random characters (e.g. ReceiptÚeœ ). The original byte[] is there (receipt = 52 65 63 65 69 70 74) but as well a variable number of additional random bytes (01 da 65 9c 19). Randomly the string is correct, with no additional bytes.
I've tried the equivalent code using BridJ instead of JNA (the method signature takes then a Pointer name) and it in that case it works fine. Unfortunately I can't switch to BridJ because I need to use the com.sun.jna.platform.win32 classes, unless I can generate a BridJ replacement for those (https://stackoverflow.com/questions/31658862/jnaerator-bridj-user32-missing-methods)
Native declaration:
HRESULT extern WINAPI WFSOpen ( LPSTR lpszLogicalName, HAPP hApp, LPSTR lpszAppID,DWORD dwTraceLevel, DWORD dwTimeOut, DWORD dwSrvcVersionsRequired, LPWFSVERSION lpSrvcVersion, LPWFSVERSION lpSPIVersion, LPHSERVICE lphService);
JNAerator JNA code:
//works
#Deprecated
NativeLong WFSOpen(Pointer lpszLogicalName, Pointer hApp, Pointer lpszAppID, int dwTraceLevel, int dwTimeOut, int dwSrvcVersionsRequired, WFSVERSION lpSrvcVersion, WFSVERSION lpSPIVersion, ShortByReference lphService);
//does not work
NativeLong WFSOpen(ByteBuffer lpszLogicalName, Pointer hApp, ByteBuffer lpszAppID, int dwTraceLevel, int dwTimeOut, int dwSrvcVersionsRequired, WFSVERSION lpSrvcVersion, WFSVERSION lpSPIVersion, ShortBuffer lphService);
Java call working (but deprecated)
Pointer m = new Memory(string.length() + 1); // WARNING: assumes ascii-only string
m.setString(0, string);
MsxfsLibrary.INSTANCE.WFSOpen(lpszLogicalName, lphApp.getValue(), lpszAppID, dwTraceLevel, dwTimeOut, dwSrvcVersionsRequired, lpSrvcVersion, lpSPIVersion, lphService);
Java call NOT working test A:
lpszLogicalName = ByteBuffer.wrap(bytes);
MsxfsLibrary.INSTANCE.WFSOpen(lpszLogicalName, lphApp.getValue(), lpszAppID, dwTraceLevel, dwTimeOut, dwSrvcVersionsRequired, lpSrvcVersion, lpSPIVersion, lphService);
Java call NOT working test B:
byte[] bytes = string.getBytes();
return ByteBuffer.wrap(bytes);
ByteBuffer bb = ByteBuffer.allocateDirect(bytes.length);
bb.put(bytes);
lpszLogicalName = bb.position(0);
msxfsLibrary.WFSOpen(lpszLogicalName, lphApp.getValue(), lpszAppID, dwTraceLevel, dwTimeOut, dwSrvcVersionsRequired, lpSrvcVersion, lpSPIVersion, lphService);
If you're referring to _wfsopen(), it's expecting a wide-character string. Either use WString, or configure your library to type-map String (see W32APIOptions.UNICODE_OPTIONS).
I think what's happening is that you are passing an array of bytes that contains your string but it is not null terminated string. You should create a byte array with an extra position. Set that las position to 0 and copy your string into that byte array.

C Unions in Delphi

I would like to translate some type definitions from winnt.h which contain some unions with bitfields. However, is this the correct way of doing it? I am particularly not sure about the union in _TP_CALLBACK_ENVIRON_V3.
typedef struct _UMS_SYSTEM_THREAD_INFORMATION {
ULONG UmsVersion;
union {
struct {
ULONG IsUmsSchedulerThread : 1;
ULONG IsUmsWorkerThread : 1;
} DUMMYSTRUCTNAME;
ULONG ThreadUmsFlags;
} DUMMYUNIONNAME;
} UMS_SYSTEM_THREAD_INFORMATION, *PUMS_SYSTEM_THREAD_INFORMATION;
typedef struct _TP_CALLBACK_ENVIRON_V3 {
TP_VERSION Version;
PTP_POOL Pool;
PTP_CLEANUP_GROUP CleanupGroup;
PTP_CLEANUP_GROUP_CANCEL_CALLBACK CleanupGroupCancelCallback;
PVOID RaceDll;
struct _ACTIVATION_CONTEXT *ActivationContext;
PTP_SIMPLE_CALLBACK FinalizationCallback;
union {
DWORD Flags;
struct {
DWORD LongFunction : 1;
DWORD Persistent : 1;
DWORD Private : 30;
} s;
} u;
TP_CALLBACK_PRIORITY CallbackPriority;
DWORD Size;
} TP_CALLBACK_ENVIRON_V3;
type
UMS_SYSTEM_THREAD_INFORMATION = record
UmsVersion: ULONG;
ThreadUmsFlags: ULONG;
case Integer of
0:(IsUmsSchedulerThread : ULONG);
1:(IsUmsWorkerThread : ULONG);
end;
PUMS_SYSTEM_THREAD_INFORMATION = ^UMS_SYSTEM_THREAD_INFORMATION;
TP_CALLBACK_ENVIRON_V3 = record
Version: TP_VERSION;
Pool: PTP_POOL;
CleanupGroup: PTP_CLEANUP_GROUP;
CleanupGroupCancelCallback: PTP_CLEANUP_GROUP_CANCEL_CALLBACK;
RaceDll: PVOID;
ActivationContext: PACTIVATION_CONTEXT; // Pointer
FinalizationCallback: PTP_SIMPLE_CALLBACK;
case Flags: DWORD of
1: (LongFunction: DWORD)
1: (Persistent: DWORD)
30: (Private: DWORD)
end;
CallbackPriority: TP_CALLBACK_PRIORITY;
Size: DWORD;
end;
PTP_CALLBACK_ENVIRON = ^TP_CALLBACK_ENVIRON_V3;
Those : something notations are bit fields. There is no direct Pascal equivalent.
However, since the three bitfields combined are a complete dword, a general outline for the equivalent becomes something like this:
type
_TP_CALLBACK_ENVIRON_V3 = record
...
FinalizationCallback: PTP_SIMPLE_CALLBACK;
case Integer of
1: (Flags: DWord);
2: (LongFunctionPersistentPrivate: DWord)
end;
As noted, the ':' notations are bit fields. There is no direct solution, but there is a simple way to translate them that makes them useful again. See my article that describes this. It uses a simple set of functions to get or set a number of bits and to shift them into place, and a clever way (I did not invent it, BTW) to declare them, using the rather unknown property index.
Take a look here: Pitfalls of converting
The idea came from a Stack Overflow answer.
FWIW, the article also describes how to handle unions in such translations.

Resources