I want to upgrade my application from Indy 9 to 10 with Delphi 2007.
In this thread there is a call to Indy9 TIdUDPBase.SendBuffer but this won't compile in Indy10 as the method parameter don't exists. The third parameter aBuffer is a var parameter and I didn't find any such method signature in Indy10.
Any alternative method to call ?
procedure TSenderThread.Execute;
var
vTimeData: TTimeDataRecord;
I: Integer;
FElapsed: Int64;
FTimerElappsed,
vLastTimerElappsed: Int64;
begin
vTimeData.Size := SizeOf(TTimeDataRecord);
vTimeData.ClientCount := 1;
Priority := tpHighest;
FIdUDPClient := TIdUDPClient.Create(nil);
FIdUDPClient.BroadcastEnabled := True;
try
while not (Terminated or Application.Terminated) do
begin
Sleep(1000);
//Measure Time frame
vLastTimerElappsed := FTimerElappsed;
QueryPerformanceCounter(FTimerElappsed);
FElapsed := ((FTimerElappsed-vLastTimerElappsed)*1000000) div FFrequency;
vTimeData.TotalTimeFrame := FElapsed;
if FRunning then
begin
FElapsed := ((FTimerElappsed-FStart)*1000000) div FFrequency;
vTimeData.CurrentMessageTime := FElapsed;
end
else
vTimeData.CurrentMessageTime := 0;
//Copy Values
vTimeData.AccumulatedTime := InterlockedExchange(TimeData.AccumulatedTime,0);
vTimeData.MessageCount := InterlockedExchange(TimeData.MessageCount,0);
for I := 0 to TimeClassMax do
vTimeData.TimeClasses[I] := InterlockedExchange(TimeData.TimeClasses[I],0);
// Calls procedure TIdUDPBase.SendBuffer(AHost: string; const APort: Integer; var ABuffer; const AByteCount: integer);
// This is changed in Indy10, unable to compile
FIdUDPClient.SendBuffer('255.255.255.255', UIPerfPort, vTimeData, TimeData.Size);
end;
finally
FreeAndNil(FIdUDPClient);
end;
end;
EDIT:
vTimeData is basically an array of integers.
TTimeDataRecord = record
Size: Integer; //Size of record structure is transfered and compared for safty reasons.
ClientCount: Integer;
AccumulatedTime: Integer; //This is the accumulated time busy in microseconds
CurrentMessageTime: Integer; //This is the time the current message has been processed. If several computers report a high value at the same time it indicates a freeze!
TotalTimeFrame: Integer; //This is the total time measured in microseconds
MessageCount: Integer;
TimeClasses: array [0..TimeClassMax] of Integer;
end;
you have a method with same name
procedure TIdUDPClient.SendBuffer(const AHost: string; const APort: TIdPort;
const ABuffer: TIdBytes);
Instead of an untyped buffer it expects an array of bytes. What is your data like? You just need to write your data as an array of bytes. Something like:
var
Buffer: TIdBytes;
begin
SetLength(Buffer, YourSizeOfData);
Move(YourData, Buffer[0], YourSizeOfData);
FIdUDPClient.SendBuffer('255.255.255.255', UIPerfPort, Buffer);
end;
But as I said it depends on the type of the data. The approach is ok however.
EDIT:
Now that I can see that you have a record you have two options:
Just move the whole record to array of bytes.
Move(#aRecord, Buffer[0], (6 + TimeClassMax) * SizeOf(Integer));
Have a CopyToBytes method in your record that does the actual copy. More general I guess.
TTimeDataRecord = record
Size: Integer; //Size of record structure is transfered and compared for safty reasons.
ClientCount: Integer;
AccumulatedTime: Integer; //This is the accumulated time busy in microseconds
CurrentMessageTime: Integer; //This is the time the current message has been processed. If several computers report a high value at the same time it indicates a freeze!
TotalTimeFrame: Integer; //This is the total time measured in microseconds
MessageCount: Integer;
TimeClasses: array [0..TimeClassMax] of Integer;
procedure CopyToBytes(var Buffer: TIdBytes);
end
Implementation of the CopyToBytes
procedure TTimeDataRecord.CopyToBytes(var Buffer: TIdBytes);
begin
// copy the data however you see fit
end;
Related
The value of iRecords variable no change after execute DbiWriteBlock function. Please explain this to me. Thanks!
This is my code:
procedure TMainForm.btnBDICheckClick(Sender: TObject);
var
Table : TTable;
PTable : PByte;
RecordSize : Integer;
RecordCount : Integer;
iRecords : Integer;
begin
Table := TTable.Create(Self);
Table.DatabaseName := 'D:\Temp';
Table.TableName := 'SrcTable.db';
Table.Active := True;
RecordSize := Table.RecordSize;
RecordCount := Table.RecordCount;
PTable := nil;
iRecords := 0;
GetMem(PTable, RecordSize * RecordCount);
DbiWriteBlock(Table.Handle, iRecords, PTable);
// iRecords = 0 at here
Table.Close;
end;
Variable iRecords is a pointer to the number of records to be written. On output, iRecords will have the actual number of records written. Your code should look like this:
procedure TMainForm.btnBDICheckClick(Sender: TObject);
var
Table : TTable;
PTable : PByte;
RecordSize : Integer;
RecordCount : Integer;
iRecords : Integer;
begin
Table := TTable.Create(Self);
Table.DatabaseName := 'D:\Temp';
Table.TableName := 'SrcTable.db';
Table.Active := True;
RecordSize := Table.RecordSize;
RecordCount := Table.RecordCount;
//PTable := nil;
//iRecords := 0;
iRecords := RecordCount;
GetMem(PTable, RecordSize * RecordCount);
DbiWriteBlock(Table.Handle, iRecords, PTable);
Table.Close;
ShowMessage('Records: ' + IntToStr(iRecords));
end;
With this code you will add empty records. Use DbiInitRecord() and DbiPutField() to fill field values.
Below is the documentation about the DbiWriteBlock function (from BDE help file):
Function definition:
function DbiWriteBlock (hCursor: hDBICur; var iRecords: Longint; pBuf: Pointer): DBIResult stdcall;
Description:
DbiWriteBlock writes a block of records to the table associated with
hCursor.
Parameters:
hCursor Type: hDBICur (Input) Specifies the cursor handle to the table.
piRecords Type: pUINT32 (Input/Output) On input, piRecords is a pointer to the number of records to write. On output, pointer to the client variable that receives the actual number of records written. The number actually written may be less than requested if an integrity violation or other error occurred.
pBuf Type: pBYTE (Input) Pointer to the buffer containing the records to be written.
Usage:
This function is similar to calling DbiAppendRecord for the specified
number of piRecords. DbiWriteBlock can access data in blocks larger
than 64Kb, depending on the size you allocate for the buffer.
Note:
This function cannot be used if the records contain non-empty BLOBs.
Paradox:
This function verifies any referential integrity requirements or
validity checks that may be in place. If either fails, the write
operation is canceled.
Completion state:
The cursor is positioned at the last record that was inserted.
Result:
DbiResult Meaning
DBIERR_NONE The block of records contained in pBuf has been successfully written to the table specified by hCursor.
DBIERR_INVALIDHNDL The specified cursor handle is invalid or NULL, or piRecords is NULL, or pBuf is NULL.
DBIERR_TABLEREADONLY The table is opened read-only; cannot write to it.
DBIERR_NOTSUFFTABLERIGHTS Insufficient table rights to insert a record. (Paradox only.)
DBIERR_NODISKSPACE Insertion failed due to insufficient disk space.
Example from Delphi 7 help:
procedure fDbiWriteBlock(Customer: TTable; var RecordsToInsert: Longint);
var
pRecordsBuf, pTmpBuf: pBYTE;
Rec: Longint;
CustNo: Double;
begin
Randomize;
GetMem(pRecordsBuf, Customer.RecordSize * RecordsToInsert);
pTmpBuf := pRecordsBuf;
try
for Rec := 1 to RecordsToInsert do begin
CustNo := Random(1000000);
// Iterate through the entire record buffer filling each
// individual record with information
with Customer do begin
Check(DbiInitRecord(Handle, pTmpBuf));
Check(DbiPutField(Handle, FieldByName('CustNo').Index + 1, pTmpBuf,
pBYTE(#CustNo)));
Check(DbiPutField(Handle, FieldByName('Company').Index + 1, pTmpBuf,
PChar('INPRISE Corporation')));
Inc(pTmpBuf, RecordSize);
end;
end;
Check(DbiWriteBLock(Customer.Handle, RecordsToInsert, pRecordsBuf));
finally
FreeMem(pRecordsBuf, Customer.RecordSize * RecordsToInsert);
end;
end
// Get a list of accounts in a domain separated by \x00 and ended by \x00\x00
Function GetUserList(AName: PAnsiChar; Var List; Size: Longint): Longint; StdCall;
I need to call the above from XE6.
Would someone be kind enough to post an example of how I can
get this buffer, and put it to a stream or a string.
The variable "List" is supposed to fill up some buffer, which I can read
off the list of users.
After trying for a couple of options, I have tried all options such as:
thanks!
var
Buffer: array of Byte;
iCount : Integer;
sName : AnsiString;
begin
...
SetLength(Buffer, 4096);
iCount := GetUserListTest(PAnsiChar(sName)#Buffer[0], Length(Buffer)); // cannot
// iCount := GetUserList(PAnsiChar(sName), Buffer, Length(Buffer));
That is not a Win32 API function, so it must be a third-party function. Ask the vendor for an example.
A var parameter expects you to pass a variable to it. The var receives the address of the variable. #Buffer[0] does not satisfy that requirement, as # returns a Pointer, and then the var ends up with the address of the pointer itself, not the address of the variable being pointed at. The function is expecting a pointer to a buffer. By using a var to receive that pointer, you need to drop the # and pass the first array element, so that the address of that element (effectively the address of the buffer) will be passed to the function, eg:
iCount := GetUserList(PAnsiChar(sName), Buffer[0], iCount);
Alternatively, you can use this syntax instead, which will pass the same address of the first element:
iCount := GetUserList(PAnsiChar(sName), PByte(Buffer)^, iCount);
Now, with that said, chances are that the function may allow you to query it for the necessary array size so you can allocate only what is actually needed (but check the documentation to be sure, I'm making an assumption here since you have not said otherwise)), eg:
procedure GetDomainUsers(const Domain: AnsiString; Users: TStrings);
var
Buffer: array of AnsiChar;
iCount : Integer;
User: PAnsiChar;
begin
// this call ASSUMES the function returns the needed
// bytecount when given a NULL/empty array - check
// the documentation!!!
iCount := GetUserList(PAnsiChar(Domain), PAnsiChar(nil)^, 0);
if iCount > 0 then
begin
SetLength(Buffer, iCount);
iCount := GetUserList(PAnsiChar(Domain), Buffer[0]{or: PAnsiChar(Buffer)^}, iCount);
end;
if iCount > 0 then
begin
Users.BeginUpdate;
try
User := PAnsiChar(Buffer);
while User^ <> #0 do
begin
Users.Add(User);
Inc(User, StrLen(User)+1);
end;
finally
Users.EndUpdate;
end;
end;
end;
If that does not work, then you will have to pre-allocate a large array:
procedure GetDomainUsers(const Domain: AnsiString; Users: TStrings);
var
Buffer: array of AnsiChar;
User: PAnsiChar;
begin
SetLength(Buffer, 1024);
if GetUserList(PAnsiChar(Domain), Buffer[0]{or: PAnsiChar(Buffer)^}, Length(Buffer)) > 0 then
begin
Users.BeginUpdate;
try
User := PAnsiChar(Buffer);
while User^ <> #0 do
begin
Users.Add(User);
Inc(User, StrLen(User)+1);
end;
finally
Users.EndUpdate;
end;
end;
end;
I use the CiaComPort in Delphi5, and I have a problem. I send a command to the device. I use the Send(Buffer: Pointer; Len: integer): cardinal function.
procedure TFormMain.CiaComportraParancsotKuld(CNev, Szoveg: WideString; NyoId, PortSzam: Integer);
var
Kar: PChar;
Szam: Integer;
Parancs: WideString;
begin
Parancs := #$0002+'~JS0|'+CNev+'|0|'+Szoveg+#$0003;
Kar := PChar(Parancs);
Szam := length(Parancs)*2;
FormMain.CiaComPort1.Open := True;
FormMain.CiaComPort1.Send(Kar, Szam);
FormMain.CiaComPort1.Open := False;
end;
This procedure is fine, but when I send the command, unfortunately I don't see the coming characters from the device, because In my opinion I do not use the CiaComPort1DataAvailable(Sender: TObject) well.
//Receive(Buffer: Pointer; Len: integer): cardinal
procedure TForm1.CiaComPort1DataAvailable(Sender: TObject);
var
Kar: PChar;
Szam: Integer;
Parancs: WideString;
begin
Szam := RxCount;
Parancs := WideString(Receive(Kar, Szam)); //I think that's not good.
Memo1.Lines.Add(Parancs);
end;
Unfortunately I can't read the buffer. Do you have any ideas?
Evidently, RxCount tells you how many bytes you received. The Receive function expects you to give it a buffer, and then it will fill that buffer, up to the size you tell it. In your code, you've provided the size, but you haven't provided a buffer. You need to allocate space for the buffer. If you use the WideString as your buffer, then you allocate space with SetLength:
Szam := RxCount;
SetLength(Parancs, Szam div 2);
Receive(PWideChar(Parancs), Szam);
I don't know what the return value of Receive means, so I have not demonstrated its use here. I'm sure if you check the documentation, you can learn what it's for.
i use to send a data on two separate process but it fails. it works only under same process... this is concept.
//-----------------------------------------------------------------------------------
MainApps
//-----------------------------------------------------------------------------------
Type
PMyrec = ^TMyrec;
TMyrec = Record
name : string;
add : string;
age : integer;
end;
:OnButtonSend
var aData : PMyrec;
begin
new(aData);
aData.Name := 'MyName';
aData.Add := 'My Address';
aData.Age : 18;
SendMessage(FindWindow('SubApps'),WM_MyMessage,0,Integer(#aData));
end;
//-----------------------------------------------------------------------------------
SubApps
//-----------------------------------------------------------------------------------
Type
PMyrec = ^TMyrec;
TMyrec = Record
name : string;
add : string;
age : integer;
end;
:OnCaptureMessage
var
aData : PMyrec;
begin
aData := PMyrec(Msg.LParam);
showmessage(aData^.Name);
end;
You're right. Addresses only have meaning within a single process. The PMyRec value you create in the first process is just a garbage address in the target process.
To send an arbitrary block of memory to another process via a window message, you should use the wm_CopyData message. You give that message the address of the data and the size, and the OS takes care of copying it into the target process's address space.
Since your data includes a string, which is represented internally as a another pointer, it won't be enough to just copy the 12 bytes of your record. You'll need to allocate additional memory to hold the record and the string data in a single block of memory so wm_CopyData can copy it and the target process can read it.
Here's one way to do it, using a stream to collect the data into a single block of memory.
procedure SendRecord(Source, Target: HWnd; const Rec: TMyRec);
var
Buffer: TMemoryStream;
Len: Integer;
CopyData: TCopyDataStruct;
begin
Buffer := TMemoryStream.Create;
try
Len := Length(Rec.name);
Buffer.Write(Len, SizeOf(Len));
if Len > 0 then
Buffer.Write(Rec.name[1], Len * SizeOf(Char));
Len := Length(Rec.add);
Buffer.Write(Len, SizeOf(Len));
if Len > 0 then
Buffer.Write(Rec.add[1], Len * SizeOf(Char));
Buffer.Write(Rec.age, SizeOf(Rec.age));
CopyData.dwData := 0;
CopyData.cbData := Buffer.Size;
CopyData.lpData := Buffer.Memory;
SendMessage(Target, wm_CopyData, Source, LParam(#CopyData));
finally
Buffer.free;
end;
end;
We write the lengths of the strings in addition to the strings' characters so that the recipient knows how many characters belong to each one. The recipient's code will look like this:
procedure TBasicForm.WMCopyData(var Message: TWMCopyData);
var
Rec: TMyRec;
Len: Integer;
Buffer: TStream;
begin
Buffer := TReadOnlyMemoryStream.Create(
Message.CopyDataStruct.lpData, Message.CopyDataStruct.cbData);
try
if Message.CopyDataStruct.dwData = 0 then begin
Buffer.Read(Len, SizeOf(Len));
SetLength(Rec.name, Len);
if Len > 0 then
Buffer.Read(Rec.name[1], Len * SizeOf(Char));
Buffer.Read(Len, SizeOf(Len));
SetLength(Rec.add, Len);
if Len > 0 then
Buffer.Read(Rec.add[1], Len * SizeOf(Len));
Buffer.Read(Rec.age, SizeOf(Rec.age));
// TODO: Do stuff with Rec here.
Message.Result := 1;
end else
inherited;
finally
Buffer.Free;
end;
end;
I've used the non-standard TReadOnlyMemoryStream since it makes everything easier. Here's a simple implementation for it:
type
TReadOnlyMemoryStream = class(TCustomMemoryStream)
public
constructor Create(Mem: Pointer; Size: LongInt);
function Write(const Buffer; Count: LongInt): LongInt; override;
end;
constructor TReadOnlyMemoryStream.Create;
begin
inherited Create;
SetPointer(Mem, Size);
end;
function TReadOnlyMemoryStream.Write;
begin
Result := 0;
end;
I'm kindly asking you to help me with this problem:
There's a byte array (data: PByte) containing DIB data AND DIBHeader:
TDibHeader = record
size: Cardinal;
width: Integer;
height: Integer;
planes: Word;
bits: Word;
compression: Cardinal;
image_size: Cardinal;
x_res: Integer;
y_res: Integer;
n_colors: Cardinal;
important_colors: Cardinal;
end;
How to convert DIB to TBitmap while keeping the CPU usage low ?
I've tried http://files.codes-sources.com/fichier.aspx?id=43989&f=GdipApi.pas with no success.
I've assigned DIB to an Memory Stream:
DibMemStream.Clear;
DibMemStream.SetSize(header.image_size);
MoveMemory(DibMemStream.Memory,DibBuffer,header.image_size);
I suppose there should be DIB header written somewhere before Bitmap.LoadFromMemoryStream(DibMemStream). Not sure where.
Any ideas please ?
Thank you !
I have used the following scheme to convert in-memory images to TBitmap:
1) Fill TBMPHeader structure
TBMPHeader = packed record
bmfHeader: TBitmapFileHeader;
bmiHeader: TBitmapInfoHeader;
bmiColors: {depends on image format, may be absent};
end;
2) Write BMPHeader + Image Data to MemoryStream
3) Load TBitmap from MemoryStream using TBitmap.LoadFromStream
You seems to have bmiHeader structure filled already. Add bmfHeader and (maybe) bmiColors.
Here is the code I used to convert 256-color grayscale in-memory images to TBitmap (many years ago, sorry, so no details):
procedure TksImage.CopyToBitmap(Bitmap: TBitmap);
var
Stream: TStream;
begin
Stream:= TMemoryStream.Create;
try
SaveToStream(Stream);
Stream.Position:= 0;
Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TksImage.SaveToStream(Stream: TStream);
type
TBMPHeader = packed record
bmfHeader: TBitmapFileHeader;
bmiHeader: TBitmapInfoHeader;
bmiColors: array[0..255] of TRGBQuad;
end;
var
BMPHeader: TBMPHeader;
N: LongWord;
I: Integer;
begin
FillChar(BMPHeader, SizeOf(BMPHeader), 0);
with BMPHeader.bmfHeader do begin
bfType:= $4D42; {'BM'}
bfOffBits:= SizeOf(BMPHeader);
if FChannels = 4 then Dec(bfOffBits, SizeOf(BMPHeader.bmiColors));
bfSize:= bfOffBits + LongWord(FImageSize);
end;
with BMPHeader.bmiHeader do begin
biSize:= SizeOf(BMPHeader.bmiHeader);
biWidth:= FWidth;
biHeight:= FHeight;
biPlanes:= 1;
biBitCount:= 8 * FChannels;
biCompression:= BI_RGB;
biSizeImage:= FImageSize;
{((((biWidth * biBitCount) + 31) and not 31) shr 3) * biHeight;}
end;
N:= 0;
for I:= 0 to 255 do begin
LongWord(bmpHeader.bmiColors[I]):= N;
Inc(N, $010101);
end;
Stream.Write(BMPHeader, BMPHeader.bmfHeader.bfOffBits);
Stream.Write(FImageData^, FImageSize);
end;
It's been a long time since I did any Delphi coding and I've not been able to test this, but if you can provide a handle to the DIB, there's a function - hDIBToTBitmap1() - that should do the trick in this link:
http://www.efg2.com/Lab/Library/Delphi/Graphics/LeadToolsConversions.TXT