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.
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
When I examine more than 9000 files with the following Delphi code, I get this error:
Please help me fix this error.
I use Delphi 10.2 Tokyo, and a MacBook with 8 gb RAM and an i5 CPU.
Freeandnill tested
Stream Free;
MemStr Free;
It looks like your post is mostly code; please add some more details I have not more info
Tested
// detect image type
var
Form1: TForm1;
JPG_HEADER: array[0..2] of byte = ($FF, $D8, $FF);
GIF_HEADER: array[0..2] of byte = ($47, $49, $46);
BMP_HEADER: array[0..1] of byte = ($42, $4D);
PNG_HEADER: array[0..3] of byte = ($89, $50, $4E, $47);
TIF_HEADER: array[0..2] of byte = ($49, $49, $2A);
TIF_HEADER2: array[0..2] of byte = (77, 77, 00);
type
TImageType = (ifUnknown, ifJPG, ifGIF, ifBMP, ifPNG, ifTIF);
implementation
{$R *.dfm}
function TypeToStr(ImageType: TImageType): String;
begin
case ImageType of
ifJPG: Result := 'Image/JPEG';
ifGIF: Result := 'Image/GIF';
ifPNG: Result := 'Image/PNG';
ifBMP: Result := 'Image/BMP';
ifTIF: Result := 'Image/TIFF';
else
Result := 'Unknown Type';
end;
end;
function GetImageType(FileName: String): TImageType;
var
Stream: TFileStream;
MemStr: TMemoryStream;
buf: integer;
tmp: string;
begin
Result := ifUnknown;
Stream := TFileStream.Create(FileName, fmOpenRead);
MemStr := TMemoryStream.Create;
try
MemStr.CopyFrom(Stream, 5);
if MemStr.Size > 4 then
begin
// uncomment these lines to detect "unknown types"
// MemStr.Position:=0;
// MemStr.Read(buf,1);
// showmessage(inttostr(ord(buf)));
// MemStr.Read(buf,1);
// showmessage(inttostr(ord(buf)));
// MemStr.Read(buf,1);
// showmessage(inttostr(ord(buf)));
if CompareMem(MemStr.Memory, #JPG_HEADER, SizeOf(JPG_HEADER)) then
Result := ifJPG
else if CompareMem(MemStr.Memory, #GIF_HEADER, SizeOf(GIF_HEADER)) then
Result := ifGIF
else if CompareMem(MemStr.Memory, #PNG_HEADER, SizeOf(PNG_HEADER)) then
Result := ifPNG
else if CompareMem(MemStr.Memory, #BMP_HEADER, SizeOf(BMP_HEADER)) then
Result := ifBMP
else if CompareMem(MemStr.Memory, #TIF_HEADER, SizeOf(TIF_HEADER)) then
Result := ifTIF
else if CompareMem(MemStr.Memory, #TIF_HEADER2, SizeOf(TIF_HEADER2)) then
Result := ifTIF;
end;
finally
Stream.Free;
MemStr.Free;
end;
end;
//Run Cod
procedure TForm1.Button1Click(Sender: TObject);
var
FileName: String;
it: TImageType;
begin
if OpenDialog1.Execute then
begin
FileName := OpenDialog1.FileName;
it := GetImageType(FileName);
Label1.Caption := TypeToStr(it);
end;
end;
You are asking the TStream.CopyFrom() method to read exactly 5 bytes. Internally, it uses the TStream.ReadBuffer() method, which raises a stream error if the exact number of bytes requested is not read. For instance, if you try to read from a file that is less than 5 bytes in size.
In comments, you show that you have a loop that calls GetFileSize() before calling GetImageType(). But that loop is checking the file size for <> 0 when it should be checking for >= 5 instead. Your TForm1.Button1Click() method is not checking GetFileSize() at all before calling GetImageType().
That being said, in GetImageType(), you don't need the TMemoryStream at all. Use a local byte[] array instead, and call the TFileStream.Read() method (not ReadBuffer()!) to populate it. The return value tells you the actual number of bytes read. Use that size when checking your image signatures. You don't need GetFileSize() at all (which BTW, is easier to implement using SysUtils.FindFirst() instead of actually opening the file and querying its size). GetImageType() should simply return ifUnknown if the requested file cannot be accessed (wrap the TFileStream.Create in a try/except) or is too small.
Try this:
type
TImageType = (ifUnknown, ifJPG, ifGIF, ifBMP, ifPNG, ifTIF);
...
function TypeToStr(ImageType: TImageType): String;
begin
case ImageType of
ifJPG: Result := 'Image/JPEG';
ifGIF: Result := 'Image/GIF';
ifPNG: Result := 'Image/PNG';
ifBMP: Result := 'Image/BMP';
ifTIF: Result := 'Image/TIFF';
else
Result := 'Unknown Type';
end;
end;
function GetImageType(FileName: String): TImageType;
const
JPG_HEADER: array[0..2] of byte = ($FF, $D8, $FF);
GIF_HEADER: array[0..2] of byte = ($47, $49, $46);
BMP_HEADER: array[0..1] of byte = ($42, $4D);
PNG_HEADER: array[0..3] of byte = ($89, $50, $4E, $47);
TIF_HEADER: array[0..2] of byte = ($49, $49, $2A);
TIF_HEADER2: array[0..2] of byte = ($4D, $4D, $00);
var
Stream: TFileStream;
buf: array[0..3] of Byte;
bufsize: Integer;
function MatchesSignature(const signature; signatureSize: Integer): Boolean;
begin
Result := (bufsize >= signatureSize) and CompareMem(#buf, #signature, signatureSize);
end;
begin
Result := ifUnknown;
try
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
bufsize := Stream.Read(buf, SizeOf(buf));
if bufsize < 2 then Exit;
finally
Stream.Free;
end;
except
Exit;
end;
// uncomment these lines to detect "unknown types"
// ShowMessage(IntToStr(buf[0]));
// Showmessage(IntToStr(buf[1]));
// Showmessage(IntToStr(buf[2]));
if MatchesSignature(JPG_HEADER, SizeOf(JPG_HEADER)) then
Result := ifJPG
else if MatchesSignature(GIF_HEADER, SizeOf(GIF_HEADER)) then
Result := ifGIF
else if MatchesSignature(PNG_HEADER, SizeOf(PNG_HEADER)) then
Result := ifPNG
else if MatchesSignature(BMP_HEADER, SizeOf(BMP_HEADER)) then
Result := ifBMP
else if MatchesSignature(TIF_HEADER, SizeOf(TIF_HEADER)) then
Result := ifTIF
else if MatchesSignature(TIF_HEADER2, SizeOf(TIF_HEADER2)) then
Result := ifTIF;
end;
You perform MemStr.CopyFrom(Stream, 5); without checking whether stream size is large enough.
So opening of empty or too short file gives that error.
Stream error arises due to reading beyond the end of file.
Try to check Stream.Size before copying
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);
I have a call to GetDIBits that works perfectly in 32-bit, but fails on 64-bit. Despite the different values for the handles the content of the bitmapinfo structure are the same.
Here is the smallest (at least slightly structured) code example I could come up with to reproduce the error. I tested with Delphi 10 Seattle Update 1, but the error seems to occur even with other Delphi versions.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
System.SysUtils,
Vcl.Graphics;
type
TRGBALine = array[Word] of TRGBQuad;
PRGBALine = ^TRGBALine;
type
{ same structure as TBitmapInfo, but adds space for two more entries in bmiColors }
TMyBitmapInfo = record
bmiHeader: TBitmapInfoHeader;
bmiColors: array[0..2] of TRGBQuad;
public
constructor Create(AWidth, AHeight: Integer);
end;
constructor TMyBitmapInfo.Create(AWidth, AHeight: Integer);
begin
FillChar(bmiHeader, Sizeof(bmiHeader), 0);
bmiHeader.biSize := SizeOf(bmiHeader);
bmiHeader.biWidth := AWidth;
bmiHeader.biHeight := -AHeight; //Otherwise the image is upside down.
bmiHeader.biPlanes := 1;
bmiHeader.biBitCount := 32;
bmiHeader.biCompression := BI_BITFIELDS;
bmiHeader.biSizeImage := 4*AWidth*AHeight; // 4 = 32 Bits/Pixel div 8 Bits/Byte
bmiColors[0].rgbRed := 255;
bmiColors[1].rgbGreen := 255;
bmiColors[2].rgbBlue := 255;
end;
procedure Main;
var
bitmap: TBitmap;
res: Cardinal;
Bits: PRGBALine;
buffer: TMyBitmapInfo;
BitmapInfo: TBitmapInfo absolute buffer;
BitsSize: Cardinal;
icon: TIcon;
IconInfo: TIconInfo;
begin
bitmap := TBitmap.Create;
try
icon := TIcon.Create;
try
icon.LoadFromResourceID(0, Integer(IDI_WINLOGO));
if not GetIconInfo(icon.Handle, IconInfo) then begin
Writeln('Error GetIconInfo: ', GetLastError);
Exit;
end;
bitmap.PixelFormat := pf32bit;
bitmap.Handle := IconInfo.hbmColor;
BitsSize := BytesPerScanline(bitmap.Width, 32, 32) * bitmap.Height;
Bits := AllocMem(BitsSize);
try
ZeroMemory(Bits, BitsSize);
buffer := TMyBitmapInfo.Create(bitmap.Width, bitmap.Height);
res := GetDIBits(bitmap.Canvas.Handle, bitmap.Handle, 0, bitmap.Height, Bits, BitmapInfo, DIB_RGB_COLORS);
if res = 0 then begin
Writeln('Error GetDIBits: ', GetLastError);
Exit;
end;
Writeln('Succeed');
finally
FreeMem(Bits);
end;
finally
icon.Free;
end;
finally
bitmap.Free;
end;
end;
begin
try
Main;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
Update A comment to this answer points the way as to why your code is failing. The order of evaluation of bitmap.Handle and bitmap.Canvas.Handle matters. Since parameter evaluation order is undefined, your program has undefined behaviour. And that explains why the x86 and x64 programs differ in behaviour.
So you could resolve the issue by assigning the bitmap handle and device context to local variables in the appropriate order, and then passing these as the arguments to GetDIBits. But I still think that the code is far better to avoid the VCL TBitmap class and use GDI calls directly, as in the code below.
I believe that your mistake is to pass the bitmap handle, and its canvas handle. Instead you should pass, for example, a device context obtained by calling CreateCompatibleDC(0). Or pass IconInfo.hbmColor to GetDIBits. But don't pass the handle of the TBitmap and the handle of its canvas.
I also cannot see any purpose to the TBitmap that you create. All you do with it is obtain the width and height of IconInfo.hbmColor. You don't need to create TBitmap to do that.
So if I were you I would remove the TBitmap, and use CreateCompatibleDC(0) to obtain the device context. This should greatly simplify the code.
You will also need to delete the bitmaps returned by the call to GetIconInfo, but I guess that you know this already and removed that code from the question for simplicity.
Frankly, the VCL objects are just getting in the way here. It's actually much simpler to call the GDI functions directly. Perhaps something like this:
procedure Main;
var
res: Cardinal;
Bits: PRGBALine;
bitmap: Winapi.Windows.TBitmap;
DC: HDC;
buffer: TMyBitmapInfo;
BitmapInfo: TBitmapInfo absolute buffer;
BitsSize: Cardinal;
IconInfo: TIconInfo;
begin
if not GetIconInfo(LoadIcon(0, IDI_WINLOGO), IconInfo) then begin
Writeln('Error GetIconInfo: ', GetLastError);
Exit;
end;
try
if GetObject(IconInfo.hbmColor, SizeOf(bitmap), #bitmap) = 0 then begin
Writeln('Error GetObject');
Exit;
end;
BitsSize := BytesPerScanline(bitmap.bmWidth, 32, 32) * abs(bitmap.bmHeight);
Bits := AllocMem(BitsSize);
try
buffer := TMyBitmapInfo.Create(bitmap.bmWidth, abs(bitmap.bmHeight));
DC := CreateCompatibleDC(0);
res := GetDIBits(DC, IconInfo.hbmColor, 0, abs(bitmap.bmHeight), Bits, BitmapInfo,
DIB_RGB_COLORS);
DeleteDC(DC);
if res = 0 then begin
Writeln('Error GetDIBits: ', GetLastError);
Exit;
end;
Writeln('Succeed');
finally
FreeMem(Bits);
end;
finally
DeleteObject(IconInfo.hbmMask);
DeleteObject(IconInfo.hbmColor);
end;
end;
I am trying to use the system.filesize function to get the size of a file in delphi, it works ok for files < 4GB but fails for files > 4GB.
so i implemented my own that opens the required file as a filestream and gets the streamsize which works perfectly.
Here is a Snippet
function GiveMeSize(PathtoFile : string): int64;
var
stream : TFileStream;
size : int64;
begin
try
stream := TFileStream.Create(PathtoFile, fmOpenReadWrite or fmShareDenyNone);
size := stream.size;
except
showmessage('Unable to get FileSize');
end
finally
stream.free;
end;
but the problem with my above function is that it opens the file which incurs some overhead when processing a large number of files.
is there any function that can get filesize of files > 4GB without opening the file first?
I have tried some functions online but they tend to report wrong file size for files greater than 4GB.
Delphi Version : XE5
Thanks.
System.FileSize is a Pascal I/O function that operates on Pascal File variables. If you want to get the size of a file specified by path, then System.FileSize is simply wrong function to use.
What's more, you quite likely don't want to open the file just to obtain its size. I obtain the file size like this:
function FileSize(const FileName: string): Int64;
var
AttributeData: TWin32FileAttributeData;
begin
if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #AttributeData) then
begin
Int64Rec(Result).Lo := AttributeData.nFileSizeLow;
Int64Rec(Result).Hi := AttributeData.nFileSizeHigh;
end
else
Result := -1;
end;
Googling for the keywords "delphi get file size int64" gives you plenty of examples
I use this:
function GetSizeOfFile(const Filename: string): Int64;
var
sr : TSearchRec;
begin
if FindFirst(fileName, faAnyFile, sr ) <> 0 then
Exit(-1);
try
result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + Int64(sr.FindData.nFileSizeLow);
finally
System.SysUtils.FindClose(sr) ;
end;
end;
You can avoid bit-shifting by assigning into a variant record which I think makes the code below more efficient.
function GetSizeOfFile(const Filename: string): Int64;
type
TSizeType = (stDWORD, stInt64);
var
sizerec: packed record
case TSizeType of
stDWORD: (SizeLow: LongWord; SizeHigh: LongWord);
stInt64: (Size: Int64);
end;
sr : TSearchRec;
begin
if FindFirst(fileName, faAnyFile, sr ) <> 0 then
begin
Result := -1;
Exit;
end;
try
sizerec.SizeLow := sr.FindData.nFileSizeLow;
sizerec.SizeHigh := sr.FindData.nFileSizeHigh;
Result := sizerec.Size;
finally
SysUtils.FindClose(sr) ;
end;
end;
I could've just used "case Boolean of" but like to use the power of Pascal to make the code more descriptive.
I am trying to remotely read a binary (REG_BINARY) registry value, but I get nothing but junk back. Any ideas what is wrong with this code? I'm using Delphi 2010:
function GetBinaryRegistryData(ARootKey: HKEY; AKey, AValue, sMachine: string; var sResult: string): boolean;
var
MyReg: TRegistry;
RegDataType: TRegDataType;
DataSize, Len: integer;
sBinData: string;
bResult: Boolean;
begin
bResult := False;
MyReg := TRegistry.Create(KEY_QUERY_VALUE);
try
MyReg.RootKey := ARootKey;
if MyReg.RegistryConnect('\\' + sMachine) then
begin
if MyReg.KeyExists(AKey) then
begin
if MyReg.OpenKeyReadOnly(AKey) then
begin
try
RegDataType := MyReg.GetDataType(AValue);
if RegDataType = rdBinary then
begin
DataSize := MyReg.GetDataSize(AValue);
if DataSize > 0 then
begin
SetLength(sBinData, DataSize);
Len := MyReg.ReadBinaryData(AValue, PChar(sBinData)^, DataSize);
if Len <> DataSize then
raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
else
begin
sResult := sBinData;
bResult := True;
end;
end;
end;
except
MyReg.CloseKey;
end;
MyReg.CloseKey;
end;
end;
end;
finally
MyReg.Free;
end;
Result := bResult;
end;
And I call it like this:
GetBinaryRegistryData(
HKEY_LOCAL_MACHINE,
'\SOFTWARE\Microsoft\Windows NT\CurrentVersion',
'DigitalProductId', '192.168.100.105',
sProductId
);
WriteLn(sProductId);
The result I receive from the WriteLn on the console is:
ñ ♥ ???????????6Z ????1 ???????☺ ???♦ ??3 ? ??? ?
??
Assuming that you are already connected remotely, try using the GetDataAsString function
to read binary data from the registry.
sResult := MyReg.GetDataAsString(AValue);
You're using Delphi 2010, so all your characters are two bytes wide. When you set the length of your result string, you're allocating twice the amount of space you need. Then you call ReadBinaryData, and it fills half your buffer. There are two bytes of data in each character. Look at each byte separately, and you'll probably find that your data looks less garbage-like.
Don't use strings for storing arbitrary data. Use strings for storing text. To store arbitrary blobs of data, use TBytes, which is an array of bytes.