Hello please i've this packed record :
type
TMyRecord = packed record
BufSize: Word;
TargetUser:array[0..80] of char;
StreamHolder: Byte;
end;
PMyRecord = ^TMyRecord;
// i would like to save the MemoryStream into the StreamHolder
please see my below procedure:
Procedure AddToRec(ATargetUser:String);
var
MyRecord: PMyRecord;
Strm:TMemoryStream;
Size: Integer;
begin
Strm:=TMemoryStream.Create;
try
Strm.LoadFromFile('myFile.dat');
Strm.position:=0;
Size:=Strm.size;
GetMem(MyRecord,Size);
ZeroMemory(MyRecord,Size);
MyRecord.BufSize := Size;
StrCopy(MyRecord.TargetUser,PChar(ATargetUser));
// here how could i copy the Strm into the StreamHolder ?
//SendMyBuffer(MyRecord,Size);
finally
Strm.free;
end;
end;
So please how could i copy the Strm to the StreamHolder ?
many thanks
You appear to want to copy the entire stream onto #MyRecord.StreamHolder. Do that like this:
Strm.ReadBuffer(MyRecord.StreamHolder, Size);
You'll also need to change your GetMem to allocate enough memory.
GetMem(MyRecord, Size + SizeOf(MyRecord^) - SizeOf(MyRecord.StreamHolder));
Or perhaps more elegantly:
GetMem(MyRecord, Size + Integer(#PMyRecord(nil)^.StreamHolder));
As it stands your code does not take account of that part of the record which appears before StreamHolder.
Why not holding
StreamHolder: Byte;
as
StreamHolder: tMemoryStream;
and change the procedure to
var
MyRecord: PMyRecord;
begin
GetMem(MyRecord,SizeOf(pMyRecord));
myRecord.StreamHolder := TMemoryStream.Create;
try
myRecord.StreamHolder.LoadFromFile('myFile.dat');
//Strm.position:=0;
//Size:=Strm.size;
//ZeroMemory(MyRecord,Size);
//MyRecord.BufSize := Size;
StrCopy(MyRecord.TargetUser,PChar(ATargetUser));
finally
// no free in here... free the streamholder whenever you get rid of MyRecord...
end ;
Related
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.
for write something in a file i use for example this code:
procedure MyProc (... );
const
BufSize = 65535;
var
FileSrc, FileDst: TFileStream;
StreamRead: Cardinal;
InBuf, OutBuf: Array [0..bufsize] of byte;
begin
.....
FileSrc := TFileStream.Create (uFileSrc, fmOpenRead Or fmShareDenyWrite);
try
FileDst := TFileStream.Create (uFileTmp, fmCreate);
try
StreamRead := 0;
while ((iCounter < iFileSize) or (StreamRead = Cardinal(BufSize)))
begin
StreamRead := FileSrc.Read (InBuf, BufSize);
Inc (iCounter, StreamRead);
end;
finally
FileDst.Free;
end;
finally
FileSrc.Free;
end;
end;
And for I/O file i use a array of byte, and so is all ok, but when i use a string, for example declaring:
InBuf, OutBuf: string // in delphi xe2 = unicode string
then not work. In sense that file not write nothing. I have understood why, or just think to have understood it.
I think that problem maybe is why string contain just a pointer to memory and not static structure; correct?
In this case, there is some solution for solve it? In sense, is possible to do something for i can to write a file using string and not vector? Or i need necessary use a vector?
If possible, can i can to do ?
Thanks very much.
There are two issues with using strings. First of all you want to use RawByteString so that you ensure the use of byte sized character elements – a Unicode string has elements that are two bytes wide. And secondly you need to dereference the string which is really just a pointer.
But I wonder why you would prefer strings to the stack allocated byte array.
procedure MyProc (... );
const
BufSize = 65536;
var
FileSrc, FileDst: TFileStream;
StreamRead: Cardinal;
InBuf: RawByteString;
begin
.....
FileSrc := TFileStream.Create (uFileSrc, fmOpenRead Or fmShareDenyWrite);
try
FileDst := TFileStream.Create (uFileTmp, fmCreate);
try
SetLength(InBuf, BufSize);
StreamRead := 0;
while ((iCounter < iFileSize) or (StreamRead = Cardinal(BufSize)))
begin
StreamRead := FileSrc.Read (InBuf[1], BufSize);
Inc (iCounter, StreamRead);
end;
finally
FileDst.Free;
end;
finally
FileSrc.Free;
end;
end;
Note: Your previous code declared a buffer of 65536 bytes, but you only ever used 65535 of them. Probably not what you intended.
To use a string as a buffer (which I would not recommend), you'll have to use SetLength to allocate the internal buffer, and you'll have to pass InBuf[1] and OutBuf[1] as the data to read or write.
var
InBuf, OutBuf: AnsiString; // or TBytes
begin
SetLength(InBuf, BufSize);
SetLength(OutBuf, BufSize);
...
StreamRead := FileSrc.Read(InBuf[1], BufSize); // if TBytes, use InBuf[0]
// etc...
You can also use a TBytes, instead of an AnsiString. The usage remains the same.
But I actually see no advantage in dynamically allocating TBytes, AnsiStrings or RawByteStrings here. I'd rather do what you already do: use a stack based buffer. I would perhaps make it a little smaller in a multi-threaded environment.
Yes, you can save / load strings to / from stream, see the following example
var Len: Integer;
buf: string;
FData: TStream;
// save string to stream
// save the length of the string
Len := Length(buf);
FData.Write(Len, SizeOf(Len));
// save string itself
if(Len > 0)then FData.Write(buf[1], Len * sizeof(buf[1]));
// read string from stream
// read the length of the string
FData.Read(Len, SizeOf(Len));
if(Len > 0)then begin
// get memory for the string
SetLength(buf, Len);
// read string content
FData.Read(buf[1], Len * sizeof(buf[1]));
end else buf := '';
On a related note, to copy the contents from one TStream to another TStream, you could just use the TStream.CopyFrom() method instead:
procedure MyProc (... );
var
FileSrc, FileDst: TFileStream;
begin
...
FileSrc := TFileStream.Create (uFileSrc, fmOpenRead Or fmShareDenyWrite);
try
FileDst := TFileStream.Create (uFileTmp, fmCreate);
try
FileDst.CopyFrom(FileSrc, 0); // or FileDst.CopyFrom(FileSrc, iFileSize)
finally
FileDst.Free;
end;
finally
FileSrc.Free;
end;
...
end;
Which can be simplified by calling CopyFile() instead:
procedure MyProc (... );
begin
...
CopyFile(PChar(uFileSrc), PChar(uFileTmp), False);
...
end;
Either way, you don't have to worry about read/writing the file data manually at all!
For some reason my OpenID account no longer exists even when I used it yesterday. But anyway.
I need to save record data into a .dat file. I tried a lot of searching, but it was all related to databases and BLOB things. I wasn't able to construct anything from it.
I have the following record
type
Scores = record
name: string[50];
score: integer;
end;
var rank: array[1..3] of scores;
I just need a simple way of saving and reading the record data from a .dat file. I had the book on how to do it, but that's at school.
You should also take a look at the file of-method.
This is kinda out-dated, but it's a nice way to learn how to work with files.
Since records with dynamic arrays (including ordinary strings) can't be stored to files with this method, unicode strings will not be supported. But string[50] is based on ShortStrings and your record is therefore already non-unicode...
Write to file
var
i: Integer;
myFile: File of TScores;
begin
AssignFile(myFile,'Rank.dat');
Rewrite(myFile);
try
for i := 1 to 3 do
Write(myFile, Rank[i]);
finally
CloseFile(myFile);
end;
end;
Read from file
var
i: Integer;
Scores: TScores;
myFile: File of TScores;
begin
AssignFile(myFile, 'Rank.dat');
Reset(myFile);
try
i := 1;
while not EOF(myFile) do
begin
Read(myFile, Scores);
Rank[i] := Scores; //You will get an error if i is out of the array bounds. I.e. more than 3
Inc(i);
end;
finally
CloseFile(myFile);
end;
end;
Use streams. Here is a simple demo (just demo - in practice there is no need to reopen file stream every time):
type
Scores = record
name: string[50];
score: integer;
end;
var rank: array[1..3] of scores;
procedure WriteScores(var Buf; Count: Integer);
var
Stream: TStream;
begin
Stream:= TFileStream.Create('test.dat', fmCreate);
try
Stream.WriteBuffer(Buf, SizeOf(Scores) * Count);
finally
Stream.Free;
end;
end;
procedure ReadScore(var Buf; Index: Integer);
var
Stream: TStream;
begin
Stream:= TFileStream.Create('test.dat', fmOpenRead or fmShareDenyWrite);
try
Stream.Position:= Index * SizeOf(Scores);
Stream.ReadBuffer(Buf, SizeOf(Scores));
finally
Stream.Free;
end;
end;
// write rank[1..3] to test.dat
procedure TForm1.Button1Click(Sender: TObject);
begin
rank[2].name:= '123';
WriteScores(rank, Length(Rank));
end;
// read rank[2] from test.dat
procedure TForm1.Button2Click(Sender: TObject);
begin
rank[2].name:= '';
ReadScore(rank[2], 2 - Low(rank));
ShowMessage(rank[2].name);
end;
Look in the help under "blockread" and or "blockwrite". There probably will be an example
i use to send a data on two separate process but it fails. it works only under same process... this is concept.
//-----------------------------------------------------------------------------------
MainApps
//-----------------------------------------------------------------------------------
Type
PMyrec = ^TMyrec;
TMyrec = Record
name : string;
add : string;
age : integer;
end;
:OnButtonSend
var aData : PMyrec;
begin
new(aData);
aData.Name := 'MyName';
aData.Add := 'My Address';
aData.Age : 18;
SendMessage(FindWindow('SubApps'),WM_MyMessage,0,Integer(#aData));
end;
//-----------------------------------------------------------------------------------
SubApps
//-----------------------------------------------------------------------------------
Type
PMyrec = ^TMyrec;
TMyrec = Record
name : string;
add : string;
age : integer;
end;
:OnCaptureMessage
var
aData : PMyrec;
begin
aData := PMyrec(Msg.LParam);
showmessage(aData^.Name);
end;
You're right. Addresses only have meaning within a single process. The PMyRec value you create in the first process is just a garbage address in the target process.
To send an arbitrary block of memory to another process via a window message, you should use the wm_CopyData message. You give that message the address of the data and the size, and the OS takes care of copying it into the target process's address space.
Since your data includes a string, which is represented internally as a another pointer, it won't be enough to just copy the 12 bytes of your record. You'll need to allocate additional memory to hold the record and the string data in a single block of memory so wm_CopyData can copy it and the target process can read it.
Here's one way to do it, using a stream to collect the data into a single block of memory.
procedure SendRecord(Source, Target: HWnd; const Rec: TMyRec);
var
Buffer: TMemoryStream;
Len: Integer;
CopyData: TCopyDataStruct;
begin
Buffer := TMemoryStream.Create;
try
Len := Length(Rec.name);
Buffer.Write(Len, SizeOf(Len));
if Len > 0 then
Buffer.Write(Rec.name[1], Len * SizeOf(Char));
Len := Length(Rec.add);
Buffer.Write(Len, SizeOf(Len));
if Len > 0 then
Buffer.Write(Rec.add[1], Len * SizeOf(Char));
Buffer.Write(Rec.age, SizeOf(Rec.age));
CopyData.dwData := 0;
CopyData.cbData := Buffer.Size;
CopyData.lpData := Buffer.Memory;
SendMessage(Target, wm_CopyData, Source, LParam(#CopyData));
finally
Buffer.free;
end;
end;
We write the lengths of the strings in addition to the strings' characters so that the recipient knows how many characters belong to each one. The recipient's code will look like this:
procedure TBasicForm.WMCopyData(var Message: TWMCopyData);
var
Rec: TMyRec;
Len: Integer;
Buffer: TStream;
begin
Buffer := TReadOnlyMemoryStream.Create(
Message.CopyDataStruct.lpData, Message.CopyDataStruct.cbData);
try
if Message.CopyDataStruct.dwData = 0 then begin
Buffer.Read(Len, SizeOf(Len));
SetLength(Rec.name, Len);
if Len > 0 then
Buffer.Read(Rec.name[1], Len * SizeOf(Char));
Buffer.Read(Len, SizeOf(Len));
SetLength(Rec.add, Len);
if Len > 0 then
Buffer.Read(Rec.add[1], Len * SizeOf(Len));
Buffer.Read(Rec.age, SizeOf(Rec.age));
// TODO: Do stuff with Rec here.
Message.Result := 1;
end else
inherited;
finally
Buffer.Free;
end;
end;
I've used the non-standard TReadOnlyMemoryStream since it makes everything easier. Here's a simple implementation for it:
type
TReadOnlyMemoryStream = class(TCustomMemoryStream)
public
constructor Create(Mem: Pointer; Size: LongInt);
function Write(const Buffer; Count: LongInt): LongInt; override;
end;
constructor TReadOnlyMemoryStream.Create;
begin
inherited Create;
SetPointer(Mem, Size);
end;
function TReadOnlyMemoryStream.Write;
begin
Result := 0;
end;
I'm kindly asking you to help me with this problem:
There's a byte array (data: PByte) containing DIB data AND DIBHeader:
TDibHeader = record
size: Cardinal;
width: Integer;
height: Integer;
planes: Word;
bits: Word;
compression: Cardinal;
image_size: Cardinal;
x_res: Integer;
y_res: Integer;
n_colors: Cardinal;
important_colors: Cardinal;
end;
How to convert DIB to TBitmap while keeping the CPU usage low ?
I've tried http://files.codes-sources.com/fichier.aspx?id=43989&f=GdipApi.pas with no success.
I've assigned DIB to an Memory Stream:
DibMemStream.Clear;
DibMemStream.SetSize(header.image_size);
MoveMemory(DibMemStream.Memory,DibBuffer,header.image_size);
I suppose there should be DIB header written somewhere before Bitmap.LoadFromMemoryStream(DibMemStream). Not sure where.
Any ideas please ?
Thank you !
I have used the following scheme to convert in-memory images to TBitmap:
1) Fill TBMPHeader structure
TBMPHeader = packed record
bmfHeader: TBitmapFileHeader;
bmiHeader: TBitmapInfoHeader;
bmiColors: {depends on image format, may be absent};
end;
2) Write BMPHeader + Image Data to MemoryStream
3) Load TBitmap from MemoryStream using TBitmap.LoadFromStream
You seems to have bmiHeader structure filled already. Add bmfHeader and (maybe) bmiColors.
Here is the code I used to convert 256-color grayscale in-memory images to TBitmap (many years ago, sorry, so no details):
procedure TksImage.CopyToBitmap(Bitmap: TBitmap);
var
Stream: TStream;
begin
Stream:= TMemoryStream.Create;
try
SaveToStream(Stream);
Stream.Position:= 0;
Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TksImage.SaveToStream(Stream: TStream);
type
TBMPHeader = packed record
bmfHeader: TBitmapFileHeader;
bmiHeader: TBitmapInfoHeader;
bmiColors: array[0..255] of TRGBQuad;
end;
var
BMPHeader: TBMPHeader;
N: LongWord;
I: Integer;
begin
FillChar(BMPHeader, SizeOf(BMPHeader), 0);
with BMPHeader.bmfHeader do begin
bfType:= $4D42; {'BM'}
bfOffBits:= SizeOf(BMPHeader);
if FChannels = 4 then Dec(bfOffBits, SizeOf(BMPHeader.bmiColors));
bfSize:= bfOffBits + LongWord(FImageSize);
end;
with BMPHeader.bmiHeader do begin
biSize:= SizeOf(BMPHeader.bmiHeader);
biWidth:= FWidth;
biHeight:= FHeight;
biPlanes:= 1;
biBitCount:= 8 * FChannels;
biCompression:= BI_RGB;
biSizeImage:= FImageSize;
{((((biWidth * biBitCount) + 31) and not 31) shr 3) * biHeight;}
end;
N:= 0;
for I:= 0 to 255 do begin
LongWord(bmpHeader.bmiColors[I]):= N;
Inc(N, $010101);
end;
Stream.Write(BMPHeader, BMPHeader.bmfHeader.bfOffBits);
Stream.Write(FImageData^, FImageSize);
end;
It's been a long time since I did any Delphi coding and I've not been able to test this, but if you can provide a handle to the DIB, there's a function - hDIBToTBitmap1() - that should do the trick in this link:
http://www.efg2.com/Lab/Library/Delphi/Graphics/LeadToolsConversions.TXT