Using Delphi, I need to access a OleVariant containing one or more records in an array.
The method I call returns a VT_ARRAY of VT_RECORD, and the records themselves are defined as:
struct StreamTimeInfo {
unsigned int PID;
LONGLONG PTS;
LONGLONG TimeStamp;
};
My code is like this:
procedure Test;
type
TStreamInfo = record
PID: Cardinal;
PTS: Int64;
TimeStamp: Int64;
end;
var
Value: OleVariant
StreamTime: TStreamInfo;
begin
GetValue(Value); // Value holds a VT_ARRAY of VT_RECORD
// How should I access the array of records in Delphi?
// I've tried this to get to the first element:
StreamTime := TStreamInfo(TVarData(Value).VPointer^);
end;
I do not understand how to access the records from Delphi.
Any input is greatly appreciated.
I've never done this before, but I think this should work.
type
TStreamInfoArray = array [0..MaxArrayCount-1] of TStreamInfo;
PStreamInfoArray = ^TStreamInfoArray;
var
Value: Variant;
p: PStreamInfoArray;
StreamInfo: TStreamInfo;
begin
GetValue(Value);
p := PStreamInfoArray(VarArrayLock(Value));
try
StreamInfo := p^[Index];
finally
VarArrayUnlock(Value);
end;
end;
For future reference and for others, here is the final working code:
// Original C-Source definition of StreamTimeInfo
// import "oaidl.idl";
// import "ocidl.idl";
// [uuid(A5AA2ACD-BEA0-4570-9232-D8301A6DAE0F)]
// struct StreamTimeInfo {
// unsigned int PID;
// LONGLONG PTS;
// LONGLONG TimeStamp;
// };
// cpp_quote("typedef struct StreamTimeInfo StreamTimeInfo;")
procedure GetStreamTimes;
type
TStreamTimeInfo = record
PID: Cardinal;
PTS: Int64;
TimeStamp: Int64;
end;
TStreamTimeInfoArray = array[0..31] of TStreamTimeInfo;
PStreamTimeInfoArray = ^TStreamTimeInfoArray;
var
Value: OleVariant;
SizeOfArray: Integer;
PtrToArray: PStreamTimeInfoArray;
begin
GetValue(EMPGPDMX_STREAMTIMES, Value);
if VarArrayDimCount(Value) = 1 then
begin
SizeOfArray := 1 + VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1);
PtrToArray := PStreamTimeInfoArray(VarArrayLock(Value));
try
for I := 0 to SizeOfArray - 1 do
begin
StreamTimeInfo := PtrToArray^[I];
// Usage Sample:
// FStatus.StreamTimePID[I] := StreamTimeInfo.PID;
// FStatus.StreamTimePTS[I] := StreamTimeInfo.PTS;
// FStatus.StreamTimeTS[I] := StreamTimeInfo.TimeStamp;
end;
finally
VarArrayUnlock(Value);
end;
end;
end;
Related
I used the code below to get a list of Windows services. It works well for Delphi 10.2.3 and earlier:
uses WinSvc;
//-------------------------------------
// Get a list of services
//
// return TRUE if successful
//
// sMachine:
// machine name, ie: \SERVER
// empty = local machine
//
// dwServiceType
// SERVICE_WIN32,
// SERVICE_DRIVER or
// SERVICE_TYPE_ALL
//
// dwServiceState
// SERVICE_ACTIVE,
// SERVICE_INACTIVE or
// SERVICE_STATE_ALL
//
// slServicesList
// TStrings variable to storage
//
function ServiceGetList(
sMachine : string;
dwServiceType,
dwServiceState : DWord;
slServicesList : TStrings )
: boolean;
const
//
// assume that the total number of
// services is less than 4096.
// increase if necessary
cnMaxServices = 4096;
type
TSvcA = array[0..cnMaxServices]
of TEnumServiceStatus;
PSvcA = ^TSvcA;
var
//
// temp. use
j : integer;
//
// service control
// manager handle
schm : SC_Handle;
//
// bytes needed for the
// next buffer, if any
nBytesNeeded,
//
// number of services
nServices,
//
// pointer to the
// next unread service entry
nResumeHandle : DWord;
//
// service status array
ssa : PSvcA;
begin
Result := false;
// connect to the service
// control manager
schm := OpenSCManager(
PChar(sMachine),
Nil,
SC_MANAGER_ALL_ACCESS);
// if successful...
if(schm > 0)then
begin
nResumeHandle := 0;
New(ssa);
EnumServicesStatus(
schm,
dwServiceType,
dwServiceState,
ssa^[0],
SizeOf(ssa^),
nBytesNeeded,
nServices,
nResumeHandle );
//
// assume that our initial array
// was large enough to hold all
// entries. add code to enumerate
// if necessary.
//
for j := 0 to nServices-1 do
begin
slServicesList.
Add( StrPas(
ssa^[j].lpDisplayName ) );
end;
Result := true;
Dispose(ssa);
// close service control
// manager handle
CloseServiceHandle(schm);
end;
end;
To get a list of all Windows services into a ListBox named ListBox1:
ServiceGetList( '',
SERVICE_WIN32,
SERVICE_STATE_ALL,
ListBox1.Items );
I tried to use the same code in Delphi 10.4 and Delphi 11, but there is a problem with the EnumServicesStatus function:
[dcc32 Error] Unit1.pas(145): E2010 Incompatible types: 'LPENUM_SERVICE_STATUSW' and '_ENUM_SERVICE_STATUSW'
When I tried LPENUM_SERVICE_STATUSW instead TEnumServiceStatus:
type
TSvcA = array[0..cnMaxServices]
of LPENUM_SERVICE_STATUSW;// instead TEnumServiceStatus;
I got an 'access violation' error.
Maybe the point is in the external function in Winapi.WinSvc.pas:
function EnumServicesStatus; external advapi32 name 'EnumServicesStatusW';
It is not a good idea to pre-allocate such a large array. You can't assume how many services the PC actually has installed. Let EnumServicesStatus() tell you how much to allocate for the array.
Also, you have to account for the possibility that you may have to call EnumServicesStatus() multiple times to get all of the statuses.
Now, regarding the compiler issue - the actual EnumServiceStatus() API wants a pointer to an array of ENUM_SERVICE_STATUS records (aliased as TEnumServiceStatus in the WinSvc unit), not an array of LPENUM_SERVICE_STATUS pointers. In earlier versions of Delphi, the Winsvc unit declared EnumServiceStatusW() to take a var reference to the 1st ENUM_SERVICE_STATUS in the array. But apparently it has since been re-declared to instead take a pointer to the 1st ENUM_SERVICE_STATUS, to match the actual API.
So, with that said, try something more like this:
uses
WinSvc;
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF CompilerVersion >= 34}
{$DEFINE lpServices_Param_Is_Pointer}
{$IFEND}
{$ENDIF}
function ServiceGetList(
const sMachine : string;
dwServiceType,
dwServiceState : DWord;
slServicesList : TStrings )
: Boolean;
var
j : integer;
schm : SC_Handle;
nBytesNeeded,
nServices,
nResumeHandle : DWord;
buffer : array of Byte;
ssa, ss : PEnumServiceStatus;
begin
Result := False;
schm := OpenSCManager(
PChar(sMachine),
nil,
SC_MANAGER_CONNECT or SC_MANAGER_ENUMERATE_SERVICE);
if (schm <> 0) then
try
nResumeHandle := 0;
if not EnumServicesStatus(
schm,
dwServiceType,
dwServiceState,
{$IFDEF lpServices_Param_Is_Pointer}nil{$ELSE}PEnumServiceStatus(nil)^{$ENDIF},
0,
nBytesNeeded,
nServices,
nResumeHandle) then
begin
if (GetLastError() <> ERROR_INSUFFICIENT_BUFFER) and (GetLastError() <> ERROR_MORE_DATA) then
begin
Exit;
end;
SetLength(buffer, nBytesNeeded);
ssa := PEnumServiceStatus(buffer);
if not EnumServicesStatus(
schm,
dwServiceType,
dwServiceState,
ssa{$IFNDEF lpServices_Param_Is_Pointer}^{$ENDIF},
Length(buffer),
nBytesNeeded,
nServices,
nResumeHandle) then
begin
Exit;
end;
end;
if (nServices > 0) then
begin
ss := ssa;
for j := 0 to nServices-1 do
begin
slServicesList.Add(ss.lpDisplayName);
Inc(ss);
end;
end;
finally
CloseServiceHandle(schm);
end;
Result := True;
end;
I have a unit in which there are multiple variables that has to be same sized vectors.
However I do not know the length of this array before i parse the file.
So I want to have a dynamic array that is "global" for the whole unit and then i can
The code below shows the issue as well as the solution I have now. The solution I have now is to assign a maximum value to be the length of the array.
unit xyz;
interface
uses
abc
const
maxval=50;
type
vectorofdouble = [1...maxval] of double; // I want to change this to dynamic array
type
T_xyz = object
public
NP: integer;
private
var1: vectorofdouble;
var2: vectorofdouble;
public
number: integer;
var3: vectorofdouble;
private
procedure Create();
function func1(etc): integer;
public
procedure ReadFile(const FileName, inputs: string);
end;
implementation
procedure T_xyz.ReadFile();
////////
Read(F,np)
//SetLength(vectorofdouble, np) // DOES NOT WORK
for i := 0 to maxval // I DONT WANT TO LOOP UP TO MAXVAL
begin
var1[i] := 0
end;
procedure T_xyz.func1(etc);
////////
do stuff
for i := 0 to maxval // I DONT WANT TO LOOP UP TO MAXVAL
begin
var2[i] := 0
end;
end;
end.
You want to use a dynamic array instead of a fixed-length array. You do that by using
array of <Type>
instead of
array[<Low>..<High>] of <Type>
Then SetLength() will work, but you need to pass it a dynamic array variable instead of a type.
Try this:
unit xyz;
interface
uses
abc;
type
vectorofdouble = array of double;
type
T_xyz = object
public
NP: integer;
private
var1: vectorofdouble;
var2: vectorofdouble;
public
number: integer;
var3: vectorofdouble;
private
procedure Create();
function func1(etc): integer;
public
procedure ReadFile(const FileName, inputs: string);
end;
implementation
procedure T_xyz.ReadFile();
var
i: integer;
begin
Read(F, NP);
SetLength(var1, NP);
for i := 0 to NP-1 do
begin
var1[i] := 0;
end;
end;
procedure T_xyz.func1(etc);
begin
for i := Low(var2) to High(var2) do
begin
var2[i] := 0;
end;
end;
end.
You must pass the array to SetLength rather than the type. So instead of
SetLength(vectorofdouble, np)
you must use
SetLength(var1, np)
I have several hardcoded validations like these:
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if lFuncID in [FUNCT_1,FUNCT_2,FUNCT_3] then ...
if not (lListType in [cLstAct..cLstOrg,cLstClockAct]) then ...
if not (lPurpose in [0..2]) then ...
that I want to replace with a common method like
function ValidateInSet(AIntValue: integer; AIntSet: ###): Boolean;
begin
Result := (AIntValue in AIntSet);
if not Result then ...
end;
but what type to choose for AIntSet?
Currently the values to be tested throughout the code go up to a const value 232 (so I can e.g. use a TByteSet = Set of Byte), but I can foresee that we will bump into the E1012 Constant expression violates subrange bounds when the constant values exceed 255.
My Google-fu fails me here...
(Currently on Delphi Seattle Update 1)
Use a dictionary, TDictionary<Integer, Integer>. The value is irrelevant and you only care about the key. If the dictionary contains a specific key then that key is a member of the set. Use AddOrSetValue to add a member, Remove to delete a member and ContainsKey to test membership.
The point of using a dictionary is that it gives you O(1) lookup.
You don't want to use this type directly as a set. You should wrap it in a class that just exposes set like capabilities. An example of that can be found here: https://stackoverflow.com/a/33530037/505088
You can use an array of Integer:
function ValidateInSet(AIntValue: integer; AIntSet: array of Integer): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(AIntSet) to High(AIntSet) do
begin
if AIntSet[I] = AIntValue then
begin
Result := True;
Break;
end;
end;
if not Result then ...
end;
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if ValidateInSet(lFuncID, [FUNCT_1, FUNCT_2, FUNCT_3]) then ...
if not ValidateInSet(lListType, [cLstAct, 2, 3, cLstOrg, cLstClockAct]) then ...
if not ValidateInSet(lPurpose, [0, 1, 2]) then ...
If you are on a recent Delphi version, you can use TArray<Integer>.
function ValidateInSet(AIntValue: integer; const AIntSet: TArray<Integer>): Boolean;
var
N: Integer;
begin
{ option1 : if AIntSet is always sorted }
result := TArray.BinarySearch(AIntSet, AIntValue, N);
{ option 2: works for any array }
result := false;
for N in AIntSet do begin
if AIntValue = N then begin
result := true;
Break;
end;
end;
if not Result then begin
// ...
end;
end;
Calling is merely the same as with a set (except for ranges):
if ValidateInSet(lFuncID, [FUNCT_1,FUNCT_2,FUNCT_3]) then begin
end;
The direct answer would be TBits class
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TBits.Bits
Note: This can only be used starting with Delphi XE4 though - http://qc.embarcadero.com/wc/qcmain.aspx?d=108829
However for your "Set of integers" it in most inflated case would take 2^31 / 8 bytes of memory (because negative values of integer would not be even considered), and that would be a lot...
So I hope you would never really want to have a set of the whole integer. Or you should invest into Sparse Arrays instead.
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := (AIntValue >= 0) and (AIntValue < AIntSet.Size);
if Result then
Result := AIntSet.Bits[AIntValue];
if not Result then ...
v-a-l-i-d-a-t-e
end;
or rather
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if .... then exit; // Validation criterion #4
if .... then exit; // Validation criterion #5
if .... then exit; // Validation criterion #6
Result := true;
end;
or perhaps
TSetTestCriterion = TFunc<Integer, Boolean>;
TSetTestCriteria = TArray<TFunc<Integer, Boolean>>;
function ValidateInSet(const AIntValue: integer;
const AIntSet: TBits; const Tests: TSetTestCriteria = nil): Boolean;
var ExtraTest: TSetTestCriterion;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if Tests <> nil then // Validation criteria #4, #5, #6, ...
for ExtraTest in Tests do
if not ExtraTest(AIntValue) then exit;
Result := true;
end;
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.SysUtils.TFunc
Now - just for demo, in real app you would create those set and array once and cache for long (forever, or at least unless the configuration change would demand rebuilding them).
Type FuncIDs = ( FUNCT_3 = 3, FUNCT_2 = 127, FUNCT_1 = 224);
var MysticGlobalFlag: Boolean;
function ValidateFuncID( const lFuncID: FuncIDs): Boolean;
var map: TBits;
begin
map := TBits.Create;
try
map.Size := High(lFuncID) + 1;
map.Bits[ Ord(Func_1) ] := True;
map.Bits[ Ord(Func_2) ] := True;
map.Bits[ Ord(Func_3) ] := True;
Result := ValidateInSet( Ord(lFuncID), map,
TSetTestCriteria.Create(
function( lFuncID: integer) : Boolean
begin
Result := MysticGlobalFlag or (lFuncID <> Ord(FuncIDs.FUNC_2))
end
,
function( lFuncID: integer) : Boolean
begin
Result := (lFuncID <> Ord(FuncIDs.FUNC_3)) or (DayOfTheWeek(Now()) = 4)
end
)
);
finally
map.Destroy;
end;
if not Result then // from the original question code
... // seems like a placeholder for error handling or object creation and registration
end;
All, I know it's years since people answered this, but here is a new solution using Delphi generics: -
interface
uses
System.Generics.Defaults;
type
TUtilityArray<T> = class
public
class function Contains(const x : T; const an_array : array of T) : boolean;
end;
implementation
class function TUtilityArray<T>.Contains(const x: T; const an_array: array of T): boolean;
var
y : T;
l_comparer : IEqualityComparer<T>;
begin
Result := false;
l_comparer := TEqualityComparer<T>.Default;
for y in an_array do
begin
if l_comparer.Equals(x, y) then
begin
Result := true;
break;
end;
end;
end;
end.
To use include the class, then write if(TUtilityArray<integer>.Contains(some integer value, [value1, value2 etc.])) then .... An added benefit of this method is that it works for other primitives as well.
I want to send a record, that right now have only a string on it, but I will add more variables. Is the first time I work with records, so this maybe is a silly question. But, why this works:
type
TDataPipe = record
WindowTitle: String[255];
end;
var
Data: TDataPipe;
copyDataStruct : TCopyDataStruct;
begin
Data.WindowTitle:= String(PChar(HookedMessage.lParam));
copyDataStruct.dwData := 0;
copyDataStruct.cbData := SizeOf(Data);
copyDataStruct.lpData := #Data;
SendMessage(FindWindow('TForm1', nil), WM_COPYDATA, Integer(hInstance), Integer(#copyDataStruct));
end;
Receiving side:
type
TDataPipe = record
WindowTitle: String[255];
end;
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
sampleRecord : TDataPipe;
begin
sampleRecord.WindowTitle:= TDataPipe(Msg.CopyDataStruct.lpData^).WindowTitle;
Memo1.Lines.Add(sampleRecord.WindowTitle);
end;
Why if on the record, I use:
WindowTitle: String; //removed the fixed size
and on the sending side I use:
Data.WindowTitle:= PChar(HookedMessage.lParam); //removed String()
it simply doesn't go?
I get access violations / app freeze...
The scenario is: sending side is a DLL hooked using SetWindowsHookEx, receiving side a simple exe that loaded / called SetWindowsHookEx...
A String[255] is a fixed 256-byte block of memory, where the character data is stored directly in that memory. As such, it is safe to pass as-is across process boundaries without serialization.
A String, on the other hand, is a dynamic type. It just contains a pointer to character data that is stored elsewhere in memory. As such, you can't pass a String as-is across process boundaries, all you would be passing is the pointer value, which has no meaning to the receiving process. You have to serialize String data into a flat format that can safely by passed to, and deserialized by, the receiving process. For example:
Sending side:
type
PDataPipe = ^TDataPipe;
TDataPipe = record
WindowTitleLen: Integer;
WindowTitleData: array[0..0] of Char;
//WindowTitleData: array[0..WindowTitleLen-1] of Char;
end;
var
Wnd: HWND;
s: String;
Data: PDataPipe;
DataLen: Integer;
copyDataStruct : TCopyDataStruct;
begin
Wnd := FindWindow('TForm1', nil);
if Wnd = 0 then Exit;
s := PChar(HookedMessage.lParam);
DataLen := SizeOf(Integer) + (SizeOf(Char) * Length(s));
GetMem(Data, DataLen);
try
Data.WindowTitleLen := Length(s);
StrMove(Data.WindowTitleData, PChar(s), Length(s));
copyDataStruct.dwData := ...; // see notes further below
copyDataStruct.cbData := DataLen;
copyDataStruct.lpData := Data;
SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(#copyDataStruct));
finally
FreeMem(Data);
end;
end;
Receiving side:
type
PDataPipe = ^TDataPipe;
TDataPipe = record
WindowTitleLen: Integer;
WindowTitleData: array[0..0] of Char;
//WindowTitleData: array[0..WindowTitleLen-1] of Char;
end;
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
Data: PDataPipe;
s: string;
begin
Data := PDataPipe(Msg.CopyDataStruct.lpData);
SetString(s, Data.WindowTitleData, Data.WindowTitleLen);
Memo1.Lines.Add(s);
end;
That being said, in either situation, you really should be assigning your own custom ID number to the copyDataStruct.dwData field. The VCL itself uses WM_COPYDATA internally, so you don't want to get those messages confused with yours, and vice versa. You can use RegisterWindowMessage() to create a unique ID to avoid conflicts with IDs used by other WM_COPYDATA users:
var
dwMyCopyDataID: DWORD;
...
var
...
copyDataStruct : TCopyDataStruct;
begin
...
copyDataStruct.dwData := dwMyCopyDataID;
...
end;
...
initialization
dwMyCopyDataID := RegisterWindowMessage('MyCopyDataID');
var
dwMyCopyDataID: DWORD;
...
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
...
begin
if Msg.CopyDataStruct.dwData = dwMyCopyDataID then
begin
...
end else
inherited;
end;
...
initialization
dwMyCopyDataID := RegisterWindowMessage('MyCopyDataID');
Lastly, the WPARAM parameter of WM_COPYDATA is an HWND, not an HINSTANCE. If the sender does not have its own HWND, just pass 0. Do not pass your sender's HInstance variable.
Preparation:
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited;
StrCopy(Params.WinClassName, PChar(SingleInstClassName)); // Copies a null-terminated string. StrCopy is designed to copy up to 255 characters from the source buffer into the destination buffer. If the source buffer contains more than 255 characters, the procedure will copy only the first 255 characters.
end;
Sender:
procedure TAppData.ResurectInstance(Arg: string);
VAR
Window: HWND;
DataToSend: TCopyDataStruct;
begin
Arg:= Trim(Arg);
{ Prepare the data you want to send }
DataToSend.dwData := CopyDataID; // CopyDataID = Unique ID for my apps
DataToSend.cbData := Length(Arg) * SizeOf(Char);
DataToSend.lpData := PChar(Arg);
{ We should never use PostMessage() with the WM_COPYDATA message because the data that is passed to the receiving application is only valid during the call. Finally, be aware that the call to SendMessage will not return until the message is processed.}
Window:= WinApi.Windows.FindWindow(PWideChar(SingleInstClassName), NIL); // This is a copy of cmWindow.FindTopWindowByClass
SendMessage(Window, WM_COPYDATA, 0, LPARAM(#DataToSend));
end;
Receiver:
procedure TMainForm.WMCopyData(var Msg: TWMCopyData);
VAR
FileName: string;
begin
{ Receives filename from another instance of this program }
if (Msg.CopyDataStruct.dwData = AppData.CopyDataID) { Only react on this specific message }
AND (Msg.CopyDataStruct.cbData > 0) { Do I receive an empty string? }
then
begin
SetString(FileName, PChar(Msg.CopyDataStruct.lpData), Msg.CopyDataStruct.cbData div SizeOf(Char));
msg.Result:= 2006; { Send something back as positive answer }
AppData.Restore;
...
end
else
inherited;
end;
I need call a DLL file in my delphi code, here is the code snippet of the DLL Head file:
#define BookInfoDLL __declspec(dllexport)
struct _BookTime
{
unsigned char day;
unsigned char month;
unsigned short year;
};
struct _stBookData
{
unsigned char encrypt;
_BookTime bkTime;
unsigned int PageCount;
};
int BookInfoDLL UpdateBooks(const char * const pBookID,
const char cBookTypeWord,
const _stBookData * const pBookData,
const int nBookDataCounter);
I need invoke the dll function "UpdateBooks" in my delphi code.
How can I convert those code into delphi? Thank you!
Use h2pas! Although it is a freepascal tool, it should produce Delphi compatible code.
Snippet for non-managed Delphi code (not tested, but compiles and changed according suggestions in comments):
interface
type
TBookTime = packed record
day : byte; // unsigned 8-bit
month : byte;
year : word; // unsigned 16-bit
end;
TBookData = packed record
encrypt : byte;
bkTime : TBookTime;
PageCount : LongWord; // unsigned 32-bit
end;
TBookDataPtr = ^TBookData;
function UpdateBooks(
pBookID : PChar;
cBookTypeWord : byte;
pBookData : TBookDataPtr;
nBookDataCounter : integer
) : integer; stdcall; external 'dll_file_name.dll' name 'UpdateBooks';
implementation
// ...
end;
Simple call UpdateBooks(...) from delphi code.
Update: code changed, thanks for commenting!
Below is snippets for sample calls ...
Common functions and constants for all snippets:
// --- Test data fill utility and constants -----------------------------------
const
BOOK_ID = 'Test Book ID';
BOOK_TYPE_WORD = 'T';
BOOK_DATA_COUNT = 5;
procedure FillTestBookData(pBookData : TBookDataPtr; iTestNum : integer);
begin
if(pBookData = nil) then exit;
pBookData^.encrypt := iTestNum;
pBookData^.bkTime.day := iTestNum;
pBookData^.bkTime.month := iTestNum;
pBookData^.bkTime.year := 2000 + iTestNum;
pBookData^.PageCount := iTestNum;
end;
Calling function in common Delphi style:
// --- Test procedure in Delphi style -----------------------------------------
procedure TestBookUpdate_DelphiStyle;
var
bookArray : array of TBookData;
iBookNumber : integer;
begin
SetLength(bookArray, BOOK_DATA_COUNT);
try
for iBookNumber := Low(bookArray) to High(bookArray) do begin
FillTestBookData( #(bookArray[iBookNumber]), iBookNumber );
end;
UpdateBooks(
PChar(BOOK_ID), ord(BOOK_TYPE_WORD),
#(bookArray[Low(bookArray)]), BOOK_DATA_COUNT
);
finally
SetLength(bookArray, 0); // no explicit requirement to include in code
end;
end;
Bonus: same test calls in C-style and Pascal-style :-)
// --- Test procedure in Old Delphi (plain Pascal) style ----------------------
type
TBookDataOldArray = array[0..0] of TBookData;
TBookDataOldArrayPtr = ^TBookDataOldArray;
// Store range checking compiler option state
{$IFOPT R+}
{$DEFINE RANGE_CHECK_ON}
{$ENDIF}
procedure TestBookUpdate_OldDelphiStyle;
var
bookArrayPtr : TBookDataOldArrayPtr;
iBookNumber : integer;
begin
GetMem(bookArrayPtr, BOOK_DATA_COUNT*sizeof(TBookData));
try
// Disable range checking compiler option
{$R-}
for iBookNumber := 0 to BOOK_DATA_COUNT - 1 do begin
FillTestBookData(#(bookArrayPtr^[iBookNumber]), iBookNumber);
end;
// Restore range checking compiler option if turned on before disabling
{$IFDEF RANGE_CHECK_ON}{$R+}{$ENDIF}
UpdateBooks(
PChar(BOOK_ID), ord(BOOK_TYPE_WORD), TBookDataPtr(bookArrayPtr), BOOK_DATA_COUNT
);
finally
FreeMem(bookArrayPtr);
end;
end;
// --- Test procedure in C style ---------------------------------------------
procedure TestBookUpdate_CStyle;
var
bookArrayPtr : TBookDataPtr;
curBookPtr : TBookDataPtr;
curBookNumber : integer;
begin
bookArrayPtr := AllocMem( BOOK_DATA_COUNT * sizeof(TBookData) );
try
curBookNumber := 0;
curBookPtr := bookArrayPtr;
while(curBookNumber < BOOK_DATA_COUNT) do begin
FillTestBookData( curBookPtr, curBookNumber );
inc(curBookNumber);
inc(curBookPtr, 1);
// Another pointer increment solution is :
// curBookPtr := PChar(curBookPtr) + sizeof(TBookData);
end;
UpdateBooks( PChar(BOOK_ID), ord(BOOK_TYPE_WORD), bookArrayPtr, BOOK_DATA_COUNT );
finally
FreeMem(bookArrayPtr);
end;
end;
I have ended my first C header conversion yesterday. The articles and tools from TeamB member Rudy Velthuis were very, very helpful for me, specially
Pitfalls of converting
Conversion Helper Package