I'm using TFileStream.Read in a loop to read a text file, but I find that the last part is not being read into the buffer - although the total number of bytes being read is equal to the filesize.
This is my code:
procedure TForm1.DoImport;
var
f: String;
fs: TFileStream;
r, c: Integer;
buf: TBytes;
const
bufsiz = 16384;
begin
SetLength(buf, bufsiz);
f := 'C:\Report\Claims\Claims.csv';
fs := TFileStream.Create(f, fmOpenRead);
try
c := 0;
repeat
r := fs.Read(buf, bufsiz);
Inc(c, r);
until (r <> bufsiz);
showmessage('Done. ' + IntToStr(c)); // <-- c equals to filesize !!
Memo1.Text := StringOf(buf); // <-- but the memo does not show the last chunk of the file
finally
fs.Free;
end;
end;
At the end, the TMemo does not contain the last chunk of the file, but the 2nd to last chunk. Is there something wrong with my code?
Thanks in advance!
The beginning of that buffer contains the last chunk of your file. But after that comes the content of the previous chunk, because you never cleared the buffer. So you think that your memo contains the previous chunk, but it is a mix of both.
You could use the copy function in order to just add a part of the buffer.
Memo1.Text := StringOf(Copy(buf, 0, r)); // r is the number of bytes to copy
A better way for reading a text file is using TStringList or TStringReader. These will take care of the file encoding (Ansi, UTF8, ...) I usually prefer the TStringList because I had too much trouble with some of the bugs in TStringReader.
Related
I need a e method which compares content of two files together, files can be BMP, JPEG, PNG, TIF
I tried this
procedure TForm1.Button1Click(Sender: TObject);
var
f1, f2 : TFileStream;
Bytes1: TBytes;
Bytes2: TBytes;
i: integer;
s: booleAN;
begin
f1 := TFileStream.Create('C:\Output\Layout 1.JPG' , fmOpenRead);
f2 := TFileStream.Create('C:\Data\Layout 1.JPG' , fmOpenRead );
if f1.Size <> f2.Size then
begin
ShowMessage('size');
exit;
end;
SetLength(Bytes1, f1.Size);
f1.Read(Bytes1[0], f1.Size);
SetLength(Bytes2, f2.Size);
f2.Read(Bytes2[0], f2.Size);
s:= true;
for I := 1 to length(Bytes1) do
begin
if Bytes1[i] <> Bytes2[i] then
begin
s := false;
Exit;
end;
end;
if s then
ShowMessage('same');
end;
but this is not working fine for me my files are both the same in content but their size are different in 2 byte.
one of the files is the on that I have to give to user the other one is the files that user is opening the same file and make a copy of it, so why they are 2 byte different i have no idea but they should be away to compare content of these files
The code has one error. Dynamic arrays are zero based so the loop should be:
for I := 0 to high(Bytes1) do
The code is very inefficient. It should not read all the content at once. And you should use CompareMem to compare blocks of memory.
You say that the files have different size, but you expect them to compare equal. Well, that makes no sense. Your code explicitly checks that the sizes match, as it should.
Opening and reading a JPEG file will modify the content because JPEG is a lossy compression algorithm.
Your subject suggests that you wish to compare PowerPoint files but the files are in fact JPEG images.
If you are going to compare JPEGs you probably need to include a range, something like
Const
DELTA = 2 ;
if (Bytes1[i] - Bytes2[i] > DELTA) OR (Bytes1[i] - Bytes2[i] < -DELTA) then
I am having problems with the following code:
var l :string;
var f:Textfile;
begin
assignfile(f,'c:\test\file.txt');
reset(f);
while not eof(f) do
readln(f,l);
closefile(f);
showmessage(l);
My problem is that the showmessage is returning nothing ... it's empty and the text file is not empty.
Why is this happening?
In addition to what has already been said:
Nobody uses lowlevel file routines these days. There are at least two much better approaches. The first involves streams, the second a TStringList:
var sl : TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile('c:\your\file.txt');
ShowMessage(sl.Text);
finally
sl.Free;
end;
end;
Disclaimer: code not tested
You read each new line in the same variable, thereby overwriting the last line with a new line. If the last read returns an empty string (or a string with just spaces or an enter), your message box will seem empty. And even if it were not empty, it would show only the last line, not the whole file.
Use l as a buffer. After each read, append it to another string:
var l: string;
var t: string;
var f: Textfile;
begin
t := '';
assignfile(f, 'c:\test\file.txt');
reset(f);
while not eof(f) do
begin
readln(f, l);
t := t + l;
end;
closefile(f);
showmessage(t);
For large files it is more efficient to use a String Builder instead of concatting everything to the same string, because t will be reallocated on each iteration.
Alternatively, use a TStringList or a TFileStream to read files. Using a TFileStream, you can read the whole file at once into a string. The TStringList has the advantage that it parses the file and makes each line an item in the stringlist.
But with those solutions, you are going to read the whole file into memory. If you can process it line by line, do the processing inside the loop.
The line
Readln(f, l)
puts the current line of f into the string l. Hence it will replace the previous line, so at the end, l will only contain the last line of the file. Maybe the last line is empty?
Most likely the last line of your file is empty.
You may want to try the following to see the difference:
while not eof(f) do
begin
readln(f,l);
showmessage(l);
end;
closefile(f);
I have a binary file (2.5 MB) and I want to find position of this sequence of bytes: CD 09 D9 F5. Then I want to write some data after this position and also overwrite old data (4 KB) with zeros.
Here is how I do it now but it is a bit slow.
ProcessFile(dataToWrite: string);
var
fileContent: string;
f: file of char;
c: char;
n, i, startIndex, endIndex: integer;
begin
AssignFile(f, 'file.bin');
reset(f);
n := FileSize(f);
while n > 0 do
begin
Read(f, c);
fileContent := fileContent + c;
dec(n);
end;
CloseFile(f);
startindex := Pos(Char($CD)+Char($09)+Char($D9)+Char($F5), fileContent) + 4;
endIndex := startIndex + 4088;
Seek(f, startIndex);
for i := 1 to length(dataToWrite) do
Write(f, dataToWrite[i]);
c := #0;
while (i < endIndex) do
begin
Write(f, c); inc(i);
end;
CloseFile(f);
end;
See this answer: Fast read/write from file in delphi
Some options are:
memory mapped files
TFileStream
blockread
To search the file buffer, see Best way to find position in the Stream where given byte sequence starts - one answer mentions the Boyer-Moore algorithm for fast detection of a byte sequence.
Your code to read the entire file into a string is very wasteful. Pascal I/O uses buffering so I don't think it's the byte by byte aspect particularly. Although one big read would be better. The main problem will be the string concatenation and the extreme heap allocation demand required to concatenate the string, one character at a time.
I'd do it like this:
function LoadFileIntoString(const FileName: string): string;
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
SetLength(Result, Stream.Size);//one single heap allocation
Stream.ReadBuffer(Pointer(Result)^, Length(Result));
finally
Stream.Free;
end;
end;
That alone should make a big difference. When it comes to writing the file, a similar use of strings will be much faster. I've not attempted to decipher the writing part of your code. Writing the new data, and the block of zeros again should be batched up to as few separate writes as possible.
If ever you find that you need to read or write very small blocks to a file, then I offer you my buffered file streams: Buffered files (for faster disk access).
The code could be optimised further to read only a portion of the file, and search until you find the target. You may be able to avoid reading the entire file that way. However, I suspect that these changes will make enough of a difference.
I'm want to convert a string value to a global memory handle and vice versa, using the following functions I've just written.
But StrToGlobalHandle() causes my testing program hangs. So GlobalHandleToStr() is untest-able yet and I'm also wondering if my code is logical or not.
function StrToGlobalHandle(const aText: string): HGLOBAL;
var
ptr: PChar;
begin
Result := 0;
if aText <> '' then
begin
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
if Result <> 0 then
begin
ptr := GlobalLock(Result);
if Assigned(ptr) then
begin
StrCopy(ptr, PChar(aText));
GlobalUnlock(Result);
end
end;
end;
end;
function GlobalHandleToStr(const aHandle: HGLOBAL): string;
var
ptrSrc: PChar;
begin
ptrSrc := GlobalLock(aHandle);
if Assigned(ptrSrc) then
begin
SetLength(Result, Length(ptrSrc));
StrCopy(PChar(Result), ptrSrc);
GlobalUnlock(aHandle);
end
end;
Testing code:
procedure TForm3.Button1Click(Sender: TObject);
var
h: HGLOBAL;
s: string;
s2: string;
begin
s := 'this is a test string';
h := StrToGlobalHandle(s);
s2 := GlobalHandleToStr(h);
ShowMessage(s2);
GlobalFree(h);
end;
BTW, I want to use these two functions as helpers to send string values between programs - send a global handle from process A to process B, and process B get the string using GlobalHandleToStr().
BTW 2, I know WM_COPY and other IPC methods, those are not suitable in my case.
The strings in Delphi 2010 are unicode, so you are not allocating the proper buffer size.
replace this line
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
with this
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1)* SizeOf(Char));
If your program hangs when you call GlobalAlloc, then you probably have heap corruption from earlier in your program. That leads to undefined behavior; the function might detect the problem and return an error, it might crash your program, it might silently corrupt yet more of your memory, it might hang, or it might do any number of other things.
That heap corruption might come from a previous call to StrToGlobalHandle because your StrCopy call writes beyond the end of the allocated memory. You're allocating bytes, but the Length function returns the number of characters in the string. That's only valid when characters are one byte wide, which isn't the case as of Delphi 2009. Multiply by SizeOf(Char) to get a byte count:
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(Char) * (Length(aText) + 1));
You can't send data between programs using GlobalAlloc - it worked only in 16-bit Windows. Use Memory Mapped File instead.
I want to terminate file that user selected from my program. I wrote this sample code:
var
aFile: TFileStream;
Const
FileAddr: String = 'H:\Akon.mp3';
Buf: Byte = 0;
begin
if FileExists(FileAddr) then
begin
// Open given file in file stream & rewrite it
aFile:= TFileStream.Create(FileAddr, fmOpenReadWrite);
try
aFile.Seek(0, soFromBeginning);
while aFile.Position <> aFile.Size do
aFile.Write(Buf, 1);
finally
aFile.Free;
ShowMessage('Finish');
end;
end;
end;
As you can see, I overwrite given file with 0 (null) value. This code works correctly, but the speed is very low in large files. I would like do this process in multithreaded code, but I tried some test some code and can't do it. For example, I create 4 threads that do this work to speed up this process.
Is there any way to speed up this process?
I don't know if it could help you, but I think you could do better (than multithreading) writing to file a larger buffer.
For example you could initialize a buffer 16k wide and write directly to FileStream; you have only to check the last part of file, for which you write only a part of the full buffer.
Believe me, it will be really faster...
OK, I'll bite:
const
FileAddr: String = 'H:\Akon.mp3';
var
aFile: TFileStream;
Buf: array[0..1023] of Byte;
Remaining, NumBytes: Integer;
begin
if FileExists(FileAddr) then
begin
// Open given file in file stream & rewrite it
aFile:= TFileStream.Create(FileAddr, fmOpenReadWrite);
try
FillChar(Buf, SizeOf(Buf), 0);
Remaining := aFile.Size;
while Remaining > 0 do begin
NumBytes := SizeOf(Buf);
if NumBytes < Remaining then
NumBytes := Remaining;
aFile.WriteBuffer(Buf, NumBytes);
Dec(Remaining, NumBytes);
end;
finally
aFile.Free;
ShowMessage('Finish');
end;
end;
end;
Multiple threads won't help you here. Your constraint is disk access, primarily because you're writing only 1 byte at a time.
Declare Buf as an array of bytes, and initialise it with FillChar or ZeroMemory. Then change your while loop as follows:
while ((aFile.Position + SizeOf(Buf)) < aFile.Size) do
begin
aFile.Write(Buf, SizeOf(Buf));
end;
if (aFile.Position < aFile.Size) then
begin
aFile.Write(Buf, aFile.Size - aFile.Position);
end;
You should learn from the slowness of the above code that:
Writing one byte at a time is the slowest and worst way to do it, you incur a huge overhead, and reduce your overall performance.
Even writing 1k bytes (1024 bytes) at a time, would be a vast improvement, but writing a larger amount will of course be even faster, until you reach a point of diminishing returns, which I would guess is going to be somewhere between 200k and 500k write buffer size. The only way to find out when it stops mattering for your application is to test, test, and test.
Checking position against size so often is completely superfluous. If you read the size once, and write the correct number of bytes, using a local variable you will save yourself more overhead, and improve performance. ie, Inc(LPosition,BufSize) to increment LPosition:Integer logical variable, by the buffer size amount BufSize.
Not sure if this meets your requirments but it works and it's fast.
var
aFile: TFileStream;
const
FileAddr: String = 'H:\Akon.mp3';
begin
if FileExists(FileAddr) then
begin
aFile:= TFileStream.Create(FileAddr, fmOpenReadWrite);
try
afile.Size := 0;
finally
aFile.Free;
ShowMessage('Finish');
end;
end;
end;
So will something along these lines (declaring b outside the function will improve your performance in the loop, especially when dealing with a large file ). I assume that in the app filename would be a var:
const
b: byte=0;
procedure MyProc;
var
aFile: TFileStream;
Buf: array of byte;
len: integer;
FileAddr: String;
begin
FileAddr := 'C:\testURL.txt';
if FileExists(FileAddr) then
begin
aFile := TFileStream.Create(FileAddr, fmcreate);
try
len := afile.Size;
setlength(buf, len);
fillchar(buf[0], len, b);
aFile.Position := 0;
aFile.Write(buf, len);
finally
aFile.Free;
ShowMessage('Finish');
end;
end;
end;