I want to implement a simple http downloader using TIdHttp (Indy10). I found two kind of code examples from the internet. Unfortunately none of them satisfy me 100%. Here is the code and I want some advise.
Variant 1
var
Buffer: TFileStream;
HttpClient: TIdHttp;
begin
Buffer := TFileStream.Create('somefile.exe', fmCreate or fmShareDenyWrite);
try
HttpClient := TIdHttp.Create(nil);
try
HttpClient.Get('http://somewhere.com/somefile.exe', Buffer); // wait until it is done
finally
HttpClient.Free;
end;
finally
Buffer.Free;
end;
end;
The code is compact and very easy to understand. The problem is that it allocates disk space when downloading begins. Another problem is that we cannot show the download progress in GUI directly, unless the code is executed in a background thread (alternatively we can bind HttpClient.OnWork event).
Variant 2:
const
RECV_BUFFER_SIZE = 32768;
var
HttpClient: TIdHttp;
FileSize: Int64;
Buffer: TMemoryStream;
begin
HttpClient := TIdHttp.Create(nil);
try
HttpClient.Head('http://somewhere.com/somefile.exe');
FileSize := HttpClient.Response.ContentLength;
Buffer := TMemoryStream.Create;
try
while Buffer.Size < FileSize do
begin
HttpClient.Request.ContentRangeStart := Buffer.Size;
if Buffer.Size + RECV_BUFFER_SIZE < FileSize then
HttpClient.Request.ContentRangeEnd := Buffer.Size + RECV_BUFFER_SIZE - 1
else
HttpClient.Request.ContentRangeEnd := FileSize;
HttpClient.Get(HttpClient.URL.URI, Buffer); // wait until it is done
Buffer.SaveToFile('somefile.exe');
end;
finally
Buffer.Free;
end;
finally
HttpClient.Free;
end;
end;
First we query the file size from the server and then we download file contents in pieces. Retrieved file contents will be save to disk when they are received completely. The potential problem is we have to send multiple GET requests to the server. I am not sure if some servers (such as megaupload) might limit the number of requests within particular time period.
My expectations
The downloader should send only one GET-request to the server.
The disk space must not be allocated when the download begins.
Any hints are appreciated.
Variant #1 is the simpliest, and is how Indy is meant to be used.
Regarding the disk allocation issue, you can derive a new class from TFileStream and override its SetSize() method to do nothing. TIdHTTP will still attempt to pre-allocate the file when appropriate, but it will not actually allocate any disk space. Writing to TFileStream will grow the file as needed.
Regarding status reporting, TIdHTTP has OnWork... events for that purpose. The AWorkCountMax parameter of the OnWorkBegin will be the actual file size if known (the response is not chunked), or 0 if not known. The AWorkCount parameter of the OnWork event will be the cumulative number of bytes that have been transferred so far. If the file size is known, you can display the total percentage by simply dividing the AWorkCount by the AWorkCountMax and multiplying by 100, otherwise just display the AWorkCount value by itself. If you want to display the speed of the transfer, you can calculate that from the difference of AWorkCount values and the time intervals between multiple OnWork events.
Try this:
type
TNoPresizeFileStream = class(TFileStream)
procedure
procedure SetSize(const NewSize: Int64); override;
end;
procedure TNoPresizeFileStream.SetSize(const NewSize: Int64);
begin
end;
.
type
TSomeClass = class(TSomething)
...
TotalBytes: In64;
LastWorkCount: Int64;
LastTicks: LongWord;
procedure Download;
procedure HttpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
procedure HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
procedure HttpWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
...
end;
procedure TSomeClass.Download;
var
Buffer: TNoPresizeFileStream;
HttpClient: TIdHttp;
begin
Buffer := TNoPresizeFileStream.Create('somefile.exe', fmCreate or fmShareDenyWrite);
try
HttpClient := TIdHttp.Create(nil);
try
HttpClient.OnWorkBegin := HttpWorkBegin;
HttpClient.OnWork := HttpWork;
HttpClient.OnWorkEnd := HttpWorkEnd;
HttpClient.Get('http://somewhere.com/somefile.exe', Buffer); // wait until it is done
finally
HttpClient.Free;
end;
finally
Buffer.Free;
end;
end;
procedure TSomeClass.HttpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
if AWorkMode <> wmRead then Exit;
// initialize the status UI as needed...
//
// If TIdHTTP is running in the main thread, update your UI
// components directly as needed and then call the Form's
// Update() method to perform a repaint, or Application.ProcessMessages()
// to process other UI operations, like button presses (for
// cancelling the download, for instance).
//
// If TIdHTTP is running in a worker thread, use the TIdNotify
// or TIdSync class to update the UI components as needed, and
// let the OS dispatch repaints and other messages normally...
TotalBytes := AWorkCountMax;
LastWorkCount := 0;
LastTicks := Ticks;
end;
procedure TSomeClass.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
PercentDone: Integer;
ElapsedMS: LongWord;
BytesTransferred: Int64;
BytesPerSec: Int64;
begin
if AWorkMode <> wmRead then Exit;
ElapsedMS := GetTickDiff(LastTicks, Ticks);
if ElapsedMS = 0 then ElapsedMS := 1; // avoid EDivByZero error
if TotalBytes > 0 then
PercentDone := (Double(AWorkCount) / TotalBytes) * 100.0;
else
PercentDone := 0.0;
BytesTransferred := AWorkCount - LastWorkCount;
// using just BytesTransferred and ElapsedMS, you can calculate
// all kinds of speed stats - b/kb/mb/gm per sec/min/hr/day ...
BytesPerSec := (Double(BytesTransferred) * 1000) / ElapsedMS;
// update the status UI as needed...
LastWorkCount := AWorkCount;
LastTicks := Ticks;
end;
procedure TSomeClass.HttpWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
if AWorkMode <> wmRead then Exit;
// finalize the status UI as needed...
end;
Here is an example that shows how to use the components OnWork to show a progress bar:
Download a File from internet programatically with an Progress event using Delphi and Indy
You should not worry about the disk allocation. Disk space that is allocated is not actually written to, so it won't damage your disks. Be happy that it is allocated so that it is not possible that another process claims the disk space and let you run out of space!
Do not forget to add this for the Variant 2
: Else HttpClient.Request.ContentRangeEnd := FileSize;
Replace
if Buffer.Size + RECV_BUFFER_SIZE < FileSize then
HttpClient.Request.ContentRangeEnd := Buffer.Size + RECV_BUFFER_SIZE - 1;
By
if Buffer.Size + RECV_BUFFER_SIZE < FileSize then
HttpClient.Request.ContentRangeEnd := Buffer.Size + RECV_BUFFER_SIZE - 1;
Else HttpClient.Request.ContentRangeEnd := FileSize;
Related
I'm trying to download a file of 500 mb more when it's in this size gives out of memory error. I tried switching to 64 bit application and it worked. But I would need it to work in 32 bit application to download file.
var
Stream: TStream;
fileStream: TFileStream;
Buffer: PByte;
BytesRead, BufSize: Integer;
Size: int64;
begin
BufSize := 1024;
fileStream:= TFileStream.Create(GetCurrentDir()+'\DownloadFile.zip',
fmCreate);
GetMem(Buffer, BufSize);
Stream := getDownload(size);
if (Size <> 0) then
begin
repeat
BytesRead := Stream.Read(Pointer(Buffer)^, BufSize);
if (BytesRead > 0) then
begin
fileStream.WriteBuffer(Pointer(Buffer)^, BytesRead);
end;
Application.ProcessMessages
until (BytesRead < BufSize);
if (Size <> fileStream.Size) then
begin
exit;
end;
end;
finally
FreeMem(Buffer, BufSize);
fileStream.Destroy;
end;
end;
function TServiceMethods.getDownload(out Size: Int64): TStream;
begin
Result := TFileStream.Create(GetCurrentDir+'\DownloadFile.zip', fmOpenRead
or fmShareDenyNone);
Size := Result.Size;
Result.Position := 0;
end;
Don't use a memory stream here. That forces the entire file into a contiguous block of memory, which as you discovered exhausts memory in a 32 bit process.
Instead, write the downloaded data directly to file. You can remove the intermediate memory stream and write directly to a file stream.
Of course, all of this assumes that getDownload returns a stream that performs the download as you read it. If getDownload reads the entire file into a memory stream then it suffers from the exact same problem as the code in this question.
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;
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;
I am using a TStringBuilder class ported from .Net to Delphi 7.
And here is my code snippet:
procedure TForm1.btn1Click(Sender: TObject);
const
FILE_NAME = 'PATH TO A TEXT FILE';
var
sBuilder: TStringBuilder;
I: Integer;
fil: TStringList;
sResult: string;
randInt: Integer;
begin
randomize;
sResult := '';
for I := 1 to 100 do
begin
fil := TStringList.Create;
try
fil.LoadFromFile(FILE_NAME);
randInt := Random(1024);
sBuilder := TStringBuilder.Create(randInt);
try
sBuilder.Append(fil.Text);
sResult := sBuilder.AsString;
finally
sBuilder.free;
end;
mmo1.Text := sResult;
finally
FreeAndNil(fil);
end;
end;
showmessage ('DOne');
end;
I am experiencing AV errors. I can alleviate the problem when I create memory with the size multiple by 1024, however sometimes it still occurs.
Am I doing something wrong?
Your code is fine. The TStringBuilder code you're using is faulty. Consider this method:
procedure TStringBuilder.Append(const AString : string);
var iLen : integer;
begin
iLen := length(AString);
if iLen + FIndex > FBuffMax then _ExpandBuffer;
move(AString[1],FBuffer[FIndex],iLen);
inc(FIndex,iLen);
end;
If the future length is too long for the current buffer size, the buffer is expanded. _ExpandBuffer doubles the size of the buffer, but once that's done, it never checks whether the new buffer size is sufficient. If the original buffer size is 1024, and the file you're loading is 3 KB, then doubling the buffer size to 2048 will still leave the buffer too small in Append, and you'll end up overwriting 1024 bytes beyond the end of the buffer.
Change the if to a while in Append.