I have problem with sockets.
If i send more then two lines of text using TClientSocket then server receives one line instead of two.
Client part:
ClientSocket1.Socket.SendText(Edit1.Text);//Text is 'Line1'
ClientSocket1.Socket.SendText(Edit2.Text);//Text is 'Line2'
Server part:
var
s: String;
begin
s := Socket.ReceiveText;
Memo1.Lines.Add(S);
The Memo1 created line is 'Line1Line2'
Why?
Sorry for my english!
SendText does not send a CRLF. If you need to send a new line, you'll have to do it explicitly:
ClientSocket1.Socket.SendText(Edit1.Text + #13#10);
ClientSocket1.Socket.SendText(Edit2.Text + #13#10);
TClientSocket and TServerSocket implement TCP/IP, which is a byte stream that has no concept of message boundaries (unlike UDP, which does). When you call SendText(), it just dumps the String contents as-is onto the socket. When you call ReceiveText(), it returns whatever is currently in the socket buffer at that moment. That is why you see the server receive 'Line1Line2'. If you want to differentiate between the two lines, then you need to send a delimiter between them, such as a CRLF sequence, and then your server code needs to be updated to look for that. Since TCP/IP is a byte stream, there is no guaranteed 1-to-1 relationship between writes and reads. Case in point, you wrote 5 bytes followed by 5 bytes, but the server received 10 bytes all at once. So your reading code needs to buffer everything it receives and then you can check your buffer for the data you are looking for, eg:
Client:
ClientSocket1.Socket.SendText(Edit1.Text + #13#10);
ClientSocket1.Socket.SendText(Edit2.Text + #13#10);
Server:
procedure TForm1.ServerSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TMemoryStream.Create;
end;
procedure TForm1.ServerSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TMemoryStream(Socket.Data).Free;
Socket.Data := nil;
end;
procedure TForm1.ServerSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
Strm: TMemoryStream;
RecvLen: Integer;
StrmSize, I: Int64;
Ptr: PByte;
B: Byte;
s: AnsiString;
begin
Strm := TMemoryStream(Socket.Data);
RecvLen := Socket.ReceiveLength;
if RecvLen <= 0 then Exit;
StrmSize := Strm.Size;
Strm.Size := StrmSize + RecvLen;
Ptr := PByte(Strm.Memory);
Inc(Ptr, Strm.Position);
RecvLen := Socket.ReceiveBuf(Ptr^, RecvLen);
if RecvLen <= 0 then
begin
Strm.Size := StrmSize;
Exit;
end;
Strm.Size := StrmSize + RecvLen;
while (Strm.Size - Strm.Position) >= 2 do
begin
Strm.ReadBuffer(B, 1);
if B <> 13 then Continue;
Strm.ReadBuffer(B, 1);
if B <> 10 then
begin
if B = 13 then
begin
Strm.Seek(-1, soCurrent);
Continue;
end;
end;
SetString(s, PAnsiChar(Strm.Memory), Strm.Position-2);
StrmSize := Strm.Size - Strm.Position;
if StrmSize then
begin
Strm.Clear;
end else
begin
Ptr := PByte(Strm.Memory);
Inc(Ptr, Strm.Position);
Move(Ptr^, Strm.Memory^, StrmSize);
Strm.Size := StrmSize;
Strm.Position := 0;
end;
Memo1.Lines.Add(S);
end;
end;
You need to add a CRLF or newline to Edit1.Text and Edit2.Text
Related
I made a simple file transfer program with indy udp socket but there was a problem.
Since UDP does not guarantee the order of data, so I tried making udp reliable manually.
At first, I made a TPacket record which includes Serial Number,Next Number,
Index Number and array of byte(data).
Serial Number is the ID of the packet.
Next Number is the Serial Number of which the receiver needs to receive packet next.
Index Number is the index of the packet, which is used for sorting the packets when the sender sends many packets at once.
The sender divides the data into packets in the fixed length, and sends the total count of packets.
After that the sender tries sending the packets gradually: sends the count of packets, sends the packets, receives the index of error packets, re-sends the error packets.
(The receiver receives the packets and sorts the packets with index and if the missed packets exist the receiver sends the indexes of the missed packets.)
I tried sending a large file.
It works good in local(localhost, hotspot), but it sometimes stops when connected over network.(through AP,internet)
I debugged my app and I found there was a mismatch of Sending-Receiving(in the source, "SendAck" and "RecvAck")(e.g. the sender sends the count of packet and the receiver sends the indexes of error packets... the receiver should have received the count of packet.)
My Source(omitted some parts) :
unit UUDPHelper;
interface
uses
System.Classes, System.Generics.Collections, IdUDPClient, IdUDPServer, System.SysUtils,
System.Math, IdGlobal, IdSocketHandle, UCode, IdExceptionCore, IdStack,
System.Generics.Defaults, System.DateUtils;
type
TPacket = record
Serial:Int64;
Next:Int64;
Index:Int64;
data:TBytes;
end;
TIdAck = (IA_OK = 1,IA_FAIL);
EReadTimeout = class(Exception) end;
TUDPClient = class(TIdUDPClient)
private
RNum:Int64;
SNum:Int64;
function ReceiveBuffer:TBytes; overload;
function StreamToPackets(Stream:TMemoryStream):TList<TPacket>;
procedure SendAck(Ack:Int64);
function RecvAck(Timeout:Int64 = -1):Int64;
public
constructor Create(AOwner:TComponent);
procedure AtConnected(Sender:TObject);
procedure AtDisconnected(Sender:TObject);
procedure Signal; overload;
procedure Signal(Code:TCode); overload;
procedure DisconnectSignal;
procedure ConnectSignal;
procedure WriteInt64(value:Int64);
procedure WriteString(str:string);
procedure WriteStream(Stream:TMemoryStream);
function ReadInt64():Int64;
function ReadString():string;
procedure ReadStream(var Stream:TMemoryStream);
end;
TIPNum = record
IP:string;
RNum:Int64;
SNum:Int64;
end;
TUDPRead = reference to procedure(const AData:TBytes; ABinding:TIdSocketHandle);
TUDPServer = class(TIdUDPServer)
private
IPNumList:TList<TIPNum>;
function ReceiveBuffer(ABinding:TIdSocketHandle):TBytes;
procedure SetRNum(RNum:Int64; Idx:Integer);
procedure SetSNum(SNum:Int64; Idx:Integer);
procedure SendAck(Ack:Int64; ABinding:TIdSocketHandle);
function RecvAck(ABinding:TIdSocketHandle; Timeout:Int64 = -1):Int64;
public
AtUDPRead:TUDPRead;
constructor Create(AOwner:TComponent);
destructor Destroy;
procedure InUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
function FindIPNum(IP:string):Integer;
function GetIPNum(IP:string):TIPNum;
procedure ClearIPNum;
function StreamToPackets(Stream:TMemoryStream; IP:string):TList<TPacket>;
procedure WriteInt64(value:Int64; ABinding:TIdSocketHandle);
procedure WriteString(str:string; ABinding:TIdSocketHandle);
procedure WriteStream(Stream:TMemoryStream; ABinding:TIdSocketHandle);
function ReadInt64(ABinding:TIdSocketHandle):Int64;
function ReadString(ABinding:TIdSocketHandle):string;
procedure ReadStream(var Stream:TMemoryStream; ABinding:TIdSocketHandle);
end;
procedure TUDPClient.ReadStream(var Stream: TMemoryStream);
var
count:Int64;
ack,ack2:TIdAck;
pList:TList<TPacket>;
buffer:TBytes;
packet:TPacket;
I,J,K:Int64;
T:Int64;
Amount:Integer;
Idxs,Temp:array of Int64;
nIdx,TempLen,pn:Integer;
IsFound:Boolean;
begin
count:=RecvAck(); // receive the total count of packets.
pList:=TList<TPacket>.Create();
I:=0;
T:=0;
nIdx:=0;
SetLength(Idxs,MAX_AMOUNT);
SetLength(Temp,MAX_AMOUNT);
while I<count do
begin
Amount:=RecvAck(); // receive the count of packets.
J:=0;
pn:=nIdx;
while nIdx<Amount do
begin
if T+J>=count then break;
Idxs[nIdx]:=T+J;
inc(nIdx);
inc(J);
end;
{Idxs is the array of indexes of packets which will be received soon.}
for J:=1 to Amount do
begin
try
buffer:=ReceiveBuffer();
except
buffer:=nil;
end;
if (buffer=nil) or (Length(buffer)=0) then break;
packet:=BytesToPacket(buffer);
if Length(packet.data)=0 then break;
IsFound:=False;
K:=0;
while K<pList.Count do
begin
if pList[K].Index=packet.Index then
begin
IsFound:=True;
break;
end;
inc(K);
end;
if IsFound then
pList.Delete(K);
pList.Add(packet);
Finalize(buffer);
end;
pList.Sort(TComparer<TPacket>.Construct(function(const Left,Right:TPacket):Integer
begin
Result:=Left.Index-Right.Index;
end));
//Finds the missed packets with Idxs array.
TempLen:=0;
for J:=0 to nIdx-1 do
begin
IsFound:=False;
for K:=I to pList.Count-1 do
if pList[K].Index=Idxs[J] then
begin
IsFound:=True;
break;
end;
if not IsFound then
begin
Temp[TempLen]:=Idxs[J];
inc(TempLen);
end;
end;
// counts the packets which is sent normally.
J:=I;
while J < pList.Count do
begin
if pList[J].Index <> J then
break;
inc(J);
end;
I:=J;
T := T + Amount - pn;
Move(Temp[0],Idxs[0],sizeof(Int64)*TempLen);
nIdx:=TempLen;
// if there is no missed packet, sends OK sign.
// else, sends FAIL and error indexes.
if nIdx=0 then
SendAck(Int64(IA_OK))
else
begin
SendAck(Int64(IA_FAIL));
SendAck(Int64(nIdx));
for J:=0 to nIdx-1 do
SendAck(Idxs[J]);
end;
end;
Finalize(Idxs);
Finalize(Temp);
Stream:=PacketsToStream(pList);
Stream.Position:=0;
for I:=0 to pList.Count-1 do
if Length(pList[I].data)>0 then
begin
buffer:=pList[I].data;
Finalize(buffer);
end;
pList.Free;
end;
procedure TUDPClient.WriteStream(Stream: TMemoryStream);
var
pList:TList<TPacket>;
buffer:TBytes;
ack,ack2:TIdAck;
Amount:Integer;
I,T:Int64;
ldt,dt,ot:TDateTime;
J:Integer;
Idxs:array of Int64;
nIdx,pn:Integer;
ncount:Integer;
Index:Int64;
IsFound:Boolean;
IsExcept:Boolean;
m:Int64;
begin
Stream.Position:=0;
pList:=StreamToPackets(Stream);
SendAck(Int64(pList.Count)); // sends the total count of packets
Amount:=30;
I:=0;
T:=0;
SetLength(Idxs,MAX_AMOUNT);
nIdx:=0;
ncount:=0;
ldt:=-1;
while I<pList.Count do
begin
// Fill Idxs array.
// Idxs array contains the indexes of packets to be sent soon.
J:=0;
while nIdx<Amount do
begin
if T+J>=pList.Count then break;
Idxs[nIdx]:=T+J;
inc(nIdx);
inc(J);
end;
pn:=nIdx;
SendAck(Int64(nIdx)); // sends the count of packets.
ot:=Date()+Time();
for J:=0 to nIdx-1 do
begin
buffer:=PacketToBytes( pList[Idxs[J]] );
SendBuffer(TIdBytes(buffer));
Finalize(buffer);
end;
ack:=TIdAck(RecvAck(10000)); // receives the ack of the receiver.
dt:=Date()+Time();
T:=T+nIdx-ncount;
if ack=IA_FAIL then // if failed, fill the idxs array with error indexs.
begin
nIdx:=RecvAck();
for J:=0 to nIdx-1 do
Idxs[J]:=RecvAck();
ncount:=nIdx;
end
else // if succeeded, clear the idxs array.
begin
ncount:=0;
nIdx:=0;
end;
I:=I+pn-nIdx;
// send-amount controlling //
if ldt<>-1 then
begin
if SecondsBetween(ot,ldt)>SecondsBetween(ot,dt) then
Amount:=Min(Amount+10,MAX_AMOUNT);
if SecondsBetween(ot,ldt)<SecondsBetween(ot,dt) then
Amount:=Max(Amount-10,Max(nIdx,30));
end;
ldt:=dt;
end;
Finalize(Idxs);
for I:=0 to pList.Count-1 do
if Length(pList[I].data)>0 then
begin
buffer:=pList[I].data;
Finalize(buffer);
end;
pList.Free;
end;
procedure TUDPClient.SendAck(Ack: Int64);
var
p:TPacket;
p2:TPacket;
o,t:TDateTime;
buffer:TBytes;
begin
p.Serial:=SNum;
p.Next:=Rand();
SNum:=p.Next;
p.Index:=Ack;
p2.Index:=Int64(IA_FAIL);
p2.Serial:=RNum;
o:=Date()+Time();
while not ((p2.Serial=RNum) and (p2.Index=Int64(IA_OK))) do
begin
if p2.Serial=RNum then
SendBuffer(TIdBytes(PacketToBytes(p)));
try
try
buffer:=ReceiveBuffer();
if Length(buffer)>24 then continue;
p2:=BytesToPacket(buffer);
except
end;
finally
Finalize(buffer);
t:=Date()+Time();
if SecondsBetween(o,t)>=5 then
begin
SNum:=p.Serial;
raise EReadTimeout.Create('Read Timeout');
end;
end;
end;
SendBuffer(TIdBytes(PacketToBytes(p)));
RNum:=p2.Next;
end;
function TUDPClient.RecvAck(Timeout:Int64): Int64;
var
p,p2,ap:TPacket;
buffer:TBytes;
o,t:TDateTime;
begin
if Timeout=-1 then
Timeout:=5000;
p.Serial:=RNum+1;
o := Date() + Time();
while p.Serial<>RNum do
begin
try
try
buffer:=ReceiveBuffer();
if Length(buffer)>24 then continue;
p := BytesToPacket(buffer);
except
end;
finally
T := Date() + Time();
if SecondsBetween(o,T) >= Timeout / 1000 then
raise EReadTimeout.Create('Read Timeout');
end;
end;
p2.Serial:=SNum;
p2.Next:=Rand();
SNum:=p2.Next;
p2.Index:=Int64(IA_OK);
o:=Date()+Time();
t:=o;
ap.Serial:=RNum+1;
while True do
begin
if SecondsBetween(o,t)>=2 then break;
SendBuffer(TIdBytes(PacketToBytes(p2)));
try
try
buffer:=ReceiveBuffer();
ap:=BytesToPacket(buffer);
except
continue;
end;
finally
t:=Date()+Time();
end;
if ap.Serial=RNum then
break;
end;
RNum:=p.Next;
Result:=p.Index;
end;
procedure TUDPServer.ReadStream(var Stream: TMemoryStream; ABinding:TIdSocketHandle);
var
count:Int64;
ack:TIdAck;
pList:TList<TPacket>;
buffer:TBytes;
packet:TPacket;
I,J,K:Int64;
T:Int64;
Amount:Integer;
Idxs,Temp:array of Int64;
nIdx,TempLen,pn:Integer;
IsFound:Boolean;
IPIdx:Integer;
IPNum:TIPNum;
begin
IPIdx:=FindIPNum(ABinding.PeerIP);
if IPIdx=-1 then Exit;
count:=RecvAck(ABinding);
pList:=TList<TPacket>.Create();
I:=0;
T:=0;
nIdx:=0;
SetLength(Idxs,MAX_AMOUNT);
SetLength(Temp,MAX_AMOUNT);
while I<count do
begin
Amount:=RecvAck(ABinding);
J:=0;
pn:=nIdx;
while nIdx<Amount do
begin
if T+J>=count then break;
Idxs[nIdx]:=T+J;
inc(nIdx);
inc(J);
end;
for J:=1 to Amount do
begin
try
buffer:=ReceiveBuffer(ABinding);
except
buffer:=nil;
end;
if (buffer=nil) or (Length(buffer)=0) then break;
packet:=BytesToPacket(buffer);
if Length(packet.data)=0 then break;
IsFound:=False;
K:=0;
while K<pList.Count do
begin
if pList[K].Index=packet.Index then
begin
IsFound:=True;
break;
end;
inc(K);
end;
if IsFound then
pList.Delete(K);
pList.Add(packet);
Finalize(buffer);
end;
pList.Sort(TComparer<TPacket>.Construct(function(const Left,Right:TPacket):Integer
begin
Result:=Left.Index-Right.Index;
end));
TempLen:=0;
for J:=0 to nIdx-1 do
begin
IsFound:=False;
for K:=I to pList.Count-1 do
if pList[K].Index=Idxs[J] then
begin
IsFound:=True;
break;
end;
if not IsFound then
begin
Temp[TempLen]:=Idxs[J];
inc(TempLen);
end;
end;
J:=I;
while J < pList.Count do
begin
if pList[J].Index <> J then
break;
inc(J);
end;
I:=J;
T:=T+Amount-pn;
Move(Temp[0],Idxs[0],sizeof(Int64)*TempLen);
nIdx:=TempLen;
if nIdx=0 then
SendAck(Int64(IA_OK),ABinding)
else
begin
SendAck(Int64(IA_FAIL),ABinding);
SendAck(Int64(nIdx),ABinding);
for J:=0 to nIdx-1 do
SendAck(Int64(Idxs[J]),ABinding);
end;
end;
Finalize(Idxs);
Finalize(Temp);
Stream:=PacketsToStream(pList);
Stream.Position:=0;
for I:=0 to pList.Count-1 do
if Length(pList[I].data)>0 then
begin
buffer:=pList[I].data;
Finalize(buffer);
end;
pList.Free;
end;
procedure TUDPServer.WriteStream(Stream: TMemoryStream; ABinding:TIdSocketHandle);
var
pList:TList<TPacket>;
packet:TPacket;
buffer:TBytes;
ack,ack2:TIdAck;
Amount:Integer;
I,T:Int64;
ldt,dt,ot:TDateTime;
J:Integer;
Idxs:array of Int64;
nIdx,pn:Integer;
ncount:Integer;
Index:Int64;
IsFound:Boolean;
IsExcept:Boolean;
m:Int64;
IPIdx:Integer;
begin
IPIdx:=FindIPNum(ABinding.PeerIP);
if IPIdx=-1 then Exit;
Stream.Position:=0;
pList:=StreamToPackets(Stream,ABinding.PeerIP);
SendAck(Int64(pList.Count),ABinding);
Amount:=Min(pList.Count,30);
I:=0;
T:=0;
SetLength(Idxs,MAX_AMOUNT);
nIdx:=0;
ncount:=0;
ldt:=-1;
while I<pList.Count do
begin
J:=0;
while nIdx<Amount do
begin
if T+J>=pList.Count then break;
Idxs[nIdx]:=T+J;
inc(nIdx);
inc(J);
end;
pn:=nIdx;
SendAck(Int64(nIdx),ABinding);
ot:=Date()+Time();
for J:=0 to nIdx-1 do
begin
buffer:=PacketToBytes( pList[Idxs[J]] );
SendBuffer(ABinding.PeerIP,ABinding.PeerPort,TIdBytes(buffer));
Finalize(buffer);
end;
ack:=TIdAck(RecvAck(ABinding,10000));
dt:=Date()+Time()-ot;
T:=T+nIdx-ncount;
if ack=IA_FAIL then
begin
nIdx:=RecvAck(ABinding);
for J:=0 to nIdx-1 do
Idxs[J]:=RecvAck(ABinding);
ncount:=nIdx;
end
else
begin
ncount:=0;
nIdx:=0;
end;
I:=I+pn-nIdx;
if ldt<>-1 then
begin
if SecondsBetween(ot,ldt)>SecondsBetween(ot,dt) then
Amount:=Min(Amount+10,MAX_AMOUNT);
if SecondsBetween(ot,ldt)<SecondsBetween(ot,dt) then
Amount:=Max(Amount-10,Max(nIdx,30));
end;
ldt:=dt;
end;
Finalize(Idxs);
for I:=0 to pList.Count-1 do
if Length(pList[I].data)>0 then
begin
buffer:=pList[I].data;
Finalize(buffer);
end;
pList.Free;
end;
procedure TUDPServer.SendAck(Ack: Int64; ABinding: TIdSocketHandle);
var
p:TPacket;
p2:TPacket;
IPIdx:Integer;
o,t:TDateTime;
buffer:TBytes;
begin
IPIdx:=FindIPNum(ABinding.PeerIP);
if IPIdx=-1 then Exit;
p.Serial:=IPNumList[IPIdx].SNum;
p.Next:=Rand();
SetSNum(p.Next,IPIdx);
p.Index:=Ack;
p2.Index:=Int64(IA_FAIL);
p2.Serial:=IPNumList[IPIdx].RNum;
o:=Date()+Time();
while not ((p2.Serial=IPNumList[IPIdx].RNum) and (p2.Index=Int64(IA_OK))) do
begin
if p2.Serial=IPNumList[IPIdx].RNum then
SendBuffer(ABinding.PeerIP,ABinding.PeerPort,TIdBytes(PacketToBytes(p)));
try
try
buffer:=ReceiveBuffer(ABinding);
if Length(buffer)>24 then continue;
p2:=BytesToPacket(buffer);
except
end;
finally
Finalize(buffer);
t:=Date()+Time();
if SecondsBetween(o,t)>=5 then
begin
SetSNum(p.Serial,IPIdx);
raise EReadTimeout.Create('Read Timeout');
end;
end;
end;
SendBuffer(ABinding.PeerIP,ABinding.PeerPort,TIdBytes(PacketToBytes(p)));
SetRNum(p2.Next,IPIdx);
end;
function TUDPServer.RecvAck(ABinding: TIdSocketHandle; Timeout:Int64): Int64;
var
p,p2,ap:TPacket;
buffer:TBytes;
IPIdx:Integer;
o,t:TDateTime;
begin
IPIdx:=FindIPNum(ABinding.PeerIP);
if IPIdx=-1 then Exit;
if Timeout=-1 then
Timeout:=5000;
p.Serial:=IPNumList[IPIdx].RNum+1;
o := Date() + Time();
while p.Serial<>IPNumList[IPIdx].RNum do
begin
try
try
buffer:=ReceiveBuffer(ABinding);
if Length(buffer)>24 then continue;
p := BytesToPacket(buffer);
except
end;
finally
T := Date() + Time();
if SecondsBetween(o,T) >= Timeout / 1000 then
raise EReadTimeout.Create('Read Timeout');
end;
end;
p2.Serial:=IPNumList[IPIdx].SNum;
p2.Next:=Rand();
SetSNum(p2.Next,IPIdx);
p2.Index:=Int64(IA_OK);
o:=Date()+Time();
t:=o;
ap.Serial:=IPNumList[IPIdx].RNum+1;
while True do
begin
if SecondsBetween(o,t)>=2 then break;
SendBuffer(ABinding.PeerIP,ABinding.PeerPort,TIdBytes(PacketToBytes(p2)));
try
try
buffer:=ReceiveBuffer(ABinding);
ap:=BytesToPacket(buffer);
except
continue;
end;
finally
t:=Date()+Time();
end;
if ap.Serial=IPNumList[IPIdx].RNum then
break;
end;
SetRNum(p.Next,IPIdx);
Result:=p.Index;
end;
What do you think is the problem?
There is no connection problem. But it sometimes raises EReadTimeout Exception when connected over network while downloading a file.
Environment
OS:Windows 10
Compiler : Delphi 10 tokyo
AP: TP-LINK TL-WR940N PLUS
Tested with My Laptop,PC, Android Phone
My Laptop <-> My Laptop = worked
My Laptop <-> My PC = not worked
My Laptop <-> My Phone (in AP) = not worked
My Laptop <-> My Phone (in laptop's hotspot) = worked
I'm trying send a record over clientsocket and receive on serversocket, everything works well but only on first time, after send one time i need disconnect clientsocket, connect again to send it again.
If somebody can help me.
here is the server side code how i receive the informations:
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
LBuffer: TBytes;
LMessageBuffer: TBytes;
LDataSize: Integer;
LProtocol: TProtocol;
begin
LDataSize := Socket.ReceiveLength;
if LDataSize >= szProtocol then begin
try
Socket.ReceiveBuf(LBuffer, SizeOf(LBuffer));
LProtocol := BytesToProtocol(LBuffer);
// check client command and act accordingly
case LProtocol.Command of
cmdConnect: begin
Memo1.Lines.Add(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end; // cmdConnect: begin
cmdDisconnect: begin
Memo1.Lines.Add(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end; // cmdDisconnect: begin
end;
finally
ClearBuffer(LBuffer);
end;
end;
end;
and here the client side:
var
LBuffer: TBytes;
LProtocol: TProtocol;
x : Integer;
begin
InitProtocol(LProtocol);
LProtocol.Command := cmdConnect;
ClientData.UserName := Edit1.Text;
ClientData.ID := Now;
LProtocol.Sender := ClientData;
LBuffer := ProtocolToBytes(LProtocol);
try
ClientSocket1.Socket.SendBuf(LBuffer, Length(LBuffer));
finally
ClearBuffer(LBuffer);
end;
record declaration:
type
TCommand = (
cmdConnect,
cmdDisconnect,
cmdMessageBroadcast,
cmdMessagePrivate,
cmdScreenShotGet,
cmdScreenShotData);
// client information structure, you can extend this based on your needs
type
TClient = record
UserName: string[50];
ID: TDateTime;
end; // TClient = record
// size of the client information structure
const
szClient = SizeOf(TClient);
Thanks :)
TBytes is a dynamic array, but you are treating it as if it were a static array.
In your client code, you are not sending LBuffer correctly. Being a dynamic array, LBuffer is just a pointer to data that is stored elsewhere in memory. So, you need to dereference LBuffer to pass the correct memory address to SendBuf().
In your server code, you are not even allocating any memory for LBuffer at all before reading bytes into it. And, like in the client, you need to dereference LBuffer when passing it to ReceiveBuf(). You also need to use the correct byte size when telling ReceiveBuf() how many bytes to read (SizeOf(TBytes) is the wrong value to use).
Lastly, you need to pay attention to the return values of SendBuf() and ReceiveBuf(), as they CAN return that fewer bytes than requested were processed! So, you should be calling SendBuf() and ReceiveBuf() in a loop.
Try this:
var
LBuffer: TBytes;
LProtocol: TProtocol;
LBufferPtr: PByte;
LBufferLen: Integer;
LNumSent: Integer;
begin
InitProtocol(LProtocol);
LProtocol.Command := cmdConnect;
ClientData.UserName := Edit1.Text;
ClientData.ID := Now;
LProtocol.Sender := ClientData;
LBuffer := ProtocolToBytes(LProtocol);
LBufferPtr := PByte(LBuffer);
LBufferLen := Length(LBuffer);
repeat
LNumSent := ClientSocket1.Socket.SendBuf(LBufferPtr^, LBufferLen);
if LNumSent = -1 then
begin
// if ClientSocket1.ClientType is set to ctNonBlocking,
// uncomment this check ...
{
if WSAGetLastError() = WSAEWOULDBLOCK then
begin
// optionally call the Winsock select() function to wait
// until the socket can accept more data before calling
// SendBuf() again...
Continue;
end;
}
// ERROR!
ClientSocket1.Close;
Break;
end;
Inc(LBufferPtr, LNumSent);
Dec(LBufferLen, LNumSent);
until LBufferLen = 0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
LBuffer: TBytes;
LDataSize: Integer;
LProtocol: TProtocol;
LBufferPtr: PByte;
LBufferLen: Integer;
LNumRecvd: Integer;
begin
LDataSize := Socket.ReceiveLength;
if LDataSize < szProtocol then Exit;
SetLength(LBuffer, szProtocol);
repeat
// since you are validating ReceiveLength beforehand, ReceiveBuf()
// *should not* return fewer bytes than requested, but it doesn't
// hurt to be careful...
LBufferPtr := PByte(LBuffer);
LBufferLen := szProtocol;
repeat
LNumRecvd := Socket.ReceiveBuf(LBufferPtr^, LBufferLen);
if LNumRecvd <= 0 then Exit;
Inc(LBufferPtr, LNumRecvd);
Dec(LBufferLen, LNumRecvd);
Dec(LDataSize, LNumRecvd);
until LBufferLen = 0;
LProtocol := BytesToProtocol(LBuffer);
// check client command and act accordingly
case LProtocol.Command of
cmdConnect: begin
Memo1.Lines.Add(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end;
cmdDisconnect: begin
Memo1.Lines.Add(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end;
end;
until LDataSize < szProtocol;
end;
That being said, TClientSocket and TServerSocket have been deprecated for a LONG time. They are not even installed by default anymore (but are still available if you need to install them). You should really consider switching to another socket library that handles these kind of details for you, such as Indy's TIdTCPClient and TIdTCPServer (Indy is preinstalled in Delphi), eg:
type
PTIdBytes = ^TIdBytes;
var
LBuffer: TBytes;
LProtocol: TProtocol;
begin
InitProtocol(LProtocol);
LProtocol.Command := cmdConnect;
ClientData.UserName := Edit1.Text;
ClientData.ID := Now;
LProtocol.Sender := ClientData;
LBuffer := ProtocolToBytes(LProtocol);
// TBytes and TIdBytes are technically the same thing under the hood,
// but they are still distinct types and not assignment-compatible,
// so using a dirty hack to pass a TBytes as a TIdBytes without having
// to make a copy of the bytes...
IdTCPClient1.IOHandler.Write(PTIdBytes(#LBuffer)^);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
type
PTBytes = ^TBytes;
var
LBuffer: TIdBytes;
LProtocol: TProtocol;
// note: TIdTCPServer is a multi-threaded component, so you must
// sync with the main thread when accessing the UI...
procedure AddToMemo(const AStr: string);
begin
TThread.Synchronize(nil,
procedure
begin
Memo1.Lines.Add(AStr);
end
);
end;
begin
// ReadBytes() can allocate the buffer for you...
AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol);
// using a similar dirty hack to pass a TIdBytes as a TBytes
// without making a copy of the bytes ...
LProtocol := BytesToProtocol(PTBytes(#LBuffer)^);
// check client command and act accordingly
case LProtocol.Command of
cmdConnect: begin
AddToMemo(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end;
cmdDisconnect: begin
AddToMemo(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
end;
end;
end;
I am trying to find and replace text in a text file. I have been able to do this in the past with methods like:
procedure SmallFileFindAndReplace(FileName, Find, ReplaceWith: string);
begin
with TStringList.Create do
begin
LoadFromFile(FileName);
Text := StringReplace(Text, Find, ReplaceWith, [rfReplaceAll, rfIgnoreCase]);
SaveToFile(FileName);
Free;
end;
end;
The above works fine when a file is relatively small, however; when the the file size is something like 170 Mb the above code will cause the following error:
EOutOfMemory with message 'Out of memory'
I have tried the following with success, however it takes a long time to run:
procedure Tfrm_Main.button_MakeReplacementClick(Sender: TObject);
var
fs : TFileStream;
s : AnsiString;
//s : string;
begin
fs := TFileStream.Create(edit_SQLFile.Text, fmOpenread or fmShareDenyNone);
try
SetLength(S, fs.Size);
fs.ReadBuffer(S[1], fs.Size);
finally
fs.Free;
end;
s := StringReplace(s, edit_Find.Text, edit_Replace.Text, [rfReplaceAll, rfIgnoreCase]);
fs := TFileStream.Create(edit_SQLFile.Text, fmCreate);
try
fs.WriteBuffer(S[1], Length(S));
finally
fs.Free;
end;
end;
I am new to "Streams" and working with buffers.
Is there a better way to do this?
Thank You.
You have two mistakes in first code example and three - in second example:
Do not load whole large file in memory, especially in 32bit application. If file size more than ~1 Gb, you always get "Out of memory"
StringReplace slows with large strings, because of repeated memory reallocation
In second code you don`t use text encoding in file, so (for Windows) your code "think" that file has UCS2 encoding (two bytes per character). But what you get, if file encoding is Ansi (one byte per character) or UTF8 (variable size of char)?
Thus, for correct find&replace you must use file encoding and read/write parts of file, as LU RD said:
interface
uses
System.Classes,
System.SysUtils;
type
TFileSearchReplace = class(TObject)
private
FSourceFile: TFileStream;
FtmpFile: TFileStream;
FEncoding: TEncoding;
public
constructor Create(const AFileName: string);
destructor Destroy; override;
procedure Replace(const AFrom, ATo: string; ReplaceFlags: TReplaceFlags);
end;
implementation
uses
System.IOUtils,
System.StrUtils;
function Max(const A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
{ TFileSearchReplace }
constructor TFileSearchReplace.Create(const AFileName: string);
begin
inherited Create;
FSourceFile := TFileStream.Create(AFileName, fmOpenReadWrite);
FtmpFile := TFileStream.Create(ChangeFileExt(AFileName, '.tmp'), fmCreate);
end;
destructor TFileSearchReplace.Destroy;
var
tmpFileName: string;
begin
if Assigned(FtmpFile) then
tmpFileName := FtmpFile.FileName;
FreeAndNil(FtmpFile);
FreeAndNil(FSourceFile);
TFile.Delete(tmpFileName);
inherited;
end;
procedure TFileSearchReplace.Replace(const AFrom, ATo: string;
ReplaceFlags: TReplaceFlags);
procedure CopyPreamble;
var
PreambleSize: Integer;
PreambleBuf: TBytes;
begin
// Copy Encoding preamble
SetLength(PreambleBuf, 100);
FSourceFile.Read(PreambleBuf, Length(PreambleBuf));
FSourceFile.Seek(0, soBeginning);
PreambleSize := TEncoding.GetBufferEncoding(PreambleBuf, FEncoding);
if PreambleSize <> 0 then
FtmpFile.CopyFrom(FSourceFile, PreambleSize);
end;
function GetLastIndex(const Str, SubStr: string): Integer;
var
i: Integer;
tmpSubStr, tmpStr: string;
begin
if not(rfIgnoreCase in ReplaceFlags) then
begin
i := Pos(SubStr, Str);
Result := i;
while i > 0 do
begin
i := PosEx(SubStr, Str, i + 1);
if i > 0 then
Result := i;
end;
if Result > 0 then
Inc(Result, Length(SubStr) - 1);
end
else
begin
tmpStr := UpperCase(Str);
tmpSubStr := UpperCase(SubStr);
i := Pos(tmpSubStr, tmpStr);
Result := i;
while i > 0 do
begin
i := PosEx(tmpSubStr, tmpStr, i + 1);
if i > 0 then
Result := i;
end;
if Result > 0 then
Inc(Result, Length(tmpSubStr) - 1);
end;
end;
var
SourceSize: int64;
procedure ParseBuffer(Buf: TBytes; var IsReplaced: Boolean);
var
i: Integer;
ReadedBufLen: Integer;
BufStr: string;
DestBytes: TBytes;
LastIndex: Integer;
begin
if IsReplaced and (not(rfReplaceAll in ReplaceFlags)) then
begin
FtmpFile.Write(Buf, Length(Buf));
Exit;
end;
// 1. Get chars from buffer
ReadedBufLen := 0;
for i := Length(Buf) downto 0 do
if FEncoding.GetCharCount(Buf, 0, i) <> 0 then
begin
ReadedBufLen := i;
Break;
end;
if ReadedBufLen = 0 then
raise EEncodingError.Create('Cant convert bytes to str');
FSourceFile.Seek(ReadedBufLen - Length(Buf), soCurrent);
BufStr := FEncoding.GetString(Buf, 0, ReadedBufLen);
if rfIgnoreCase in ReplaceFlags then
IsReplaced := ContainsText(BufStr, AFrom)
else
IsReplaced := ContainsStr(BufStr, AFrom);
if IsReplaced then
begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end
else
LastIndex := Length(BufStr);
SetLength(BufStr, LastIndex);
FSourceFile.Seek(FEncoding.GetByteCount(BufStr) - ReadedBufLen, soCurrent);
BufStr := StringReplace(BufStr, AFrom, ATo, ReplaceFlags);
DestBytes := FEncoding.GetBytes(BufStr);
FtmpFile.Write(DestBytes, Length(DestBytes));
end;
var
Buf: TBytes;
BufLen: Integer;
bReplaced: Boolean;
begin
FSourceFile.Seek(0, soBeginning);
FtmpFile.Size := 0;
CopyPreamble;
SourceSize := FSourceFile.Size;
BufLen := Max(FEncoding.GetByteCount(AFrom) * 5, 2048);
BufLen := Max(FEncoding.GetByteCount(ATo) * 5, BufLen);
SetLength(Buf, BufLen);
bReplaced := False;
while FSourceFile.Position < SourceSize do
begin
BufLen := FSourceFile.Read(Buf, Length(Buf));
SetLength(Buf, BufLen);
ParseBuffer(Buf, bReplaced);
end;
FSourceFile.Size := 0;
FSourceFile.CopyFrom(FtmpFile, 0);
end;
how to use:
procedure TForm2.btn1Click(Sender: TObject);
var
Replacer: TFileSearchReplace;
StartTime: TDateTime;
begin
StartTime:=Now;
Replacer:=TFileSearchReplace.Create('c:\Temp\123.txt');
try
Replacer.Replace('some текст', 'some', [rfReplaceAll, rfIgnoreCase]);
finally
Replacer.Free;
end;
Caption:=FormatDateTime('nn:ss.zzz', Now - StartTime);
end;
Your first try creates several copies of the file in memory:
it loads the whole file into memory (TStringList)
it creates a copy of this memory when accessing the .Text property
it creates yet another copy of this memory when passing that string to StringReplace (The copy is the result which is built in StringReplace.)
You could try to solve the out of memory problem by getting rid of one or more of these copies:
e.g. read the file into a simple string variable rather than a TStringList
or keep the string list but run the StringReplace on each line separately and write the result to the file line by line.
That would increase the maximum file size your code can handle, but you will still run out of memory for huge files. If you want to handle files of any size, your second approach is the way to go.
No - I don't think there's a faster way that the 2nd option (if you want a completely generic search'n'replace function for any file of any size). It may be possible to make a faster version if you code it specifically according to your requirements, but as a general-purpose search'n'replace function, I don't believe you can go faster...
For instance, are you sure you need case-insensitive replacement? I would expect that this would be a large part of the time spent in the replace function. Try (just for kicks) to remove that requirement and see if it doesn't speed up the execution quite a bit on large files (this depends on how the internal coding of the StringReplace function is made - if it has a specific optimization for case-sensitive searches)
I believe refinement of Kami's code is needed to account for the string not being found, but the start of a new instance of the string might occur at the end of the buffer. The else clause is different:
if IsReplaced then begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end else
LastIndex :=Length(BufStr) - Length(AFrom) + 1;
Correct fix is this one:
if IsReplaced then
begin
LastIndex := GetLastIndex(BufStr, AFrom);
LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end
else
if FSourceFile.Position < SourceSize then
LastIndex := Length(BufStr) - Length(AFrom) + 1
else
LastIndex := Length(BufStr);
How to avoid freezing the idHTTP when the internet become slower or no connectivity. My application get freeze and I could not even close the form.
This is how I setup my code
procedure TDownloader.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
lwElapsedMS: LongWord;
iBytesTransferred: Int64;
iBytesPerSec: Int64;
iRemaining: Integer;
begin
if AWorkMode <> wmRead then Exit;
lwElapsedMS := GetTickDiff(FLastTicks, Ticks);
if lwElapsedMS = 0 then lwElapsedMS := 1; // avoid EDivByZero error
if FTotalBytes > 0 then
FPercentDone := Round(AWorkCount / FTotalBytes * 100.0)
else
FPercentDone := 0;
iBytesTransferred := AWorkCount - FLastWorkCount;
iBytesPerSec := Round(iBytesTransferred * 1000 / lwElapsedMS);
if Assigned(OnDownloadProgress) then
begin
if FContinueDownload <> 0 then //previous file downloaded
begin
iRemaining := 100 - FContinueDownload;
iRemaining := Round(FPercentDone * iRemaining / 100);
OnDownloadProgress(Self, FContinueDownload + iRemaining, AWorkCount, FTotalBytes, iBytesPerSec);
end else
OnDownloadProgress(Self, FPercentDone, AWorkCount, FTotalBytes, iBytesPerSec);
end;
FLastWorkCount := AWorkCount;
FLastTicks := Ticks;
if FCancel then
begin
Abort;
TidHttp(ASender).Disconnect;
end;
end;
procedure TDownloader.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
if AWorkMode <> wmRead then Exit;
FPercentDone := 0;
FTotalBytes := AWorkCountMax;
FLastWorkCount := 0;
FLastTicks := Ticks;
end;
procedure TDownloader.IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
if AWorkMode <> wmRead then Exit;
if Assigned(OnDownloadComplete) and (FPercentDone >= 100) then
OnDownloadComplete(Self)
else if Assigned(OnDownloadCancel) then
OnDownloadCancel(Self);
end;
function TDownloader.EXDownload(AURL, ADestFile: String;
AAutoDisconnect: Boolean): Boolean;
var
fsBuffer: TFileStream;
idHttp: TIdHttp;
begin
if FileExists(ADestFile) then
fsBuffer := TFileStream.Create(ADestFile, fmOpenReadWrite)
else
fsBuffer := TFileStream.Create(ADestFile, fmCreate);
fsBuffer.Seek(0, soFromEnd);
try
idHttp := TIdHttp.Create(nil);
idHttp.OnWorkBegin := idHttpWorkBegin;
idHttp.OnWork := idHttpWork;
idHttp.OnWorkEnd := idHttpWorkEnd;
idHttp.Request.CacheControl := 'no-store';
try
...
idHttp.Get(AURL, fsBuffer);
...
finally
idHttp.Free;
end;
finally
fsBuffer.Free;
end;
end;
......
procedure TDownloader.Execute;
begin
Inherited;
while not Terminated do
begin
if FUrl <> '' then
begin
EXDownload(FUrl, FFilename, True);
end;
end;
end;
...
on the main form progress
procedure TfrmDownloadList.DownloadProgress(Sender: TObject; aPercent:Integer;
aProgress, aProgressMax, aBytesPerSec: Int64);
var
yts: PYoutubeSearchInfo;
begin
if Assigned(FCurrentDownload) then
begin
yts := vstList.GetNodeData(FCurrentDownload);
yts.Tag := aPercent;
ProgressBar.Position := aPercent;
vstList.InvalidateNode(FCurrentDownload);
StatusBar.Panels.Items[1].Text := 'Download: ' + FormatByteSize(aProgress) + '/' +
FormatByteSize(aProgressMax);
StatusBar.Panels.Items[2].Text := 'Speed: ' + FormatByteSize(aBytesPerSec) + 'ps';
Application.ProcessMessages;
end;
end;
I don't have problem when the internet is good only when it drops due to poor signal.
this is my app lookslike
If we assume that TDownloader.OnDownloadProgress is assigned to the TfrmDownloadList.DownloadProgress method, then your problem is that you are calling VCL code (your update of the progress bar) from a secondary thread (ie. not from the Main thread). This is not supported.
You'll need to wrap the call with a Synchronize statement from within your thread. Synchronize calls a parameterless method on the main thread. So you need to store the variables that are needed and then call Synchronize on a method in your TDownloader class that then calls on to TfrmDownloadList.DownloadProgress
You cannot call TfrmDownloadList.DownloadProgress directly or indirectly from within code that runs on another thread than the main thread, as it updates VCL objects, and the VCL is not thread-safe.
The same goes for your DownloadComplete event, if it updates any VCL objects...
How about you using TIdAntiFreeze ?
TIdAntiFreeze implements a GUI-integration class that ensures
processor time is allocated for the Application main thread.
Indy works on the blocking sockets model. Calls made to methods in the
Indy components do not return until they are complete. If calls are
made in the main thread, this will cause the Application User
Interface to "freeze" during Indy calls. TIdAntiFreeze counteracts
this effect.
TIdAntiFreeze allows Indy to process Application messages so that
Windows messages continue to be executed while Indy blocking socket
calls are in effect.
Only one TIdAntiFreeze can be active in an application.
I've written a DataSnap server method that returns a TStream object to transfer a file. The client application calls the method and reads the stream fine. My issue is that the method call takes a while to complete before the TStream object is available to read, but on the server side I can see that the method call only takes a second to create the object to return. I was hoping the stream object would be returned immediately so that I can read the stream and display a progress bar for the download progress. Is there another way I can do this?
The server method is very simple :
function TServerMethods.DespatchDocument(sCompanyID, sDocOurRef: string): TStream;
var
sSourceFilePath: string;
strFileStream: TFileStream;
begin
sSourceFilePath := GetDocumentPDFFilePath(sCompanyID, sDocOurRef);
strFileStream := TFileStream.Create(sSourceFilePath, fmOpenRead);
Result := strFileStream;
end;
This is how I did it a while back. I used XE and haven't had a chance to clean it up.
//Server side:
function TServerMethods1.DownloadFile(out Size: Int64): TStream;
begin
Result := TFileStream.Create('upload.fil', fmOpenRead or fmShareDenyNone);
Size := Result.Size;
Result.Position := 0;
end;
//Client side:
procedure TfMain.DownloadFile(Sender: TObject);
var
RetStream: TStream;
Buffer: PByte;
Mem: TMemoryStream;
BytesRead: Integer;
DocumentId: Int64;
Size: Int64;
filename: WideString;
BufSize: Integer;
begin
BufSize := 1024;
try
Mem := TMemoryStream.Create;
GetMem( Buffer, BufSize );
try
RetStream := FDownloadDS.DownloadFile(Size);
RetStream.Position := 0;
if ( Size <> 0 ) then
begin
filename := 'download.fil';
repeat
BytesRead := RetStream.Read( Pointer( Buffer )^, BufSize );
if ( BytesRead > 0 ) then
begin
Mem.WriteBuffer( Pointer( Buffer )^, BytesRead );
end;
lStatus.Caption := IntToStr( Mem.Size ) + '/' + IntToStr( Size );
Application.ProcessMessages;
until ( BytesRead < BufSize );
if ( Size <> Mem.Size ) then
begin
raise Exception.Create( 'Error downloading file...' );
end;
end
else
begin
lStatus.Caption := '';
end;
finally
FreeMem( Buffer, BufSize );
FreeAndNIl(Mem);
end;
except
on E: Exception do
begin
lErrorMessage.Caption := PChar( E.ClassName + ': ' + E.Message );
end;
end;
end;
You can adjust BufSize however you like. I was having trouble getting the size of the stream until I did it this way. I experimented with XE2 and didn't seem to have the same problem but I was uploading. There is probably a better way to retrieve the size of the stream. If I get the answer soon I'll let you know....
On another note - I haven't figured out how to display a progress bar on the server side. I'm still trying to figure this out too.
I hope this helps! Let me know if you have any questions!
Glad you have some luck! This is the other fix I had to do. You can refer to this link https://forums.embarcadero.com/thread.jspa?threadID=66490&tstart=0
After diving in the code I found in "Data.DBXJSONReflect.pas"
procedure TJSONPopulationCustomizer.PrePopulate(Data: TObject; rttiContext: TRttiContext);
...
3473: rttiField.GetValue(Data).AsObject.Free;
3474: rttiField.SetValue(Data, TValue.Empty);
...
I think it should be this way:
3473: rttiField.SetValue(Data, TValue.Empty);
3474: rttiField.GetValue(Data).AsObject.Free;