|
File
Remove all files and subdirectories
Write / Read array of records into a file
Read data from a file
Set a file's date and time
Import a large comma delimited file
Set compiled time in the aboutbox
CopyFile Function / Procedure
Reading Binary File
TOutline component read from file
Fixed field data input
Opening file for read only
File of type TList
Reading long strings from a file
GetFileSize
File Sharing question
Ascii code for eof
Iterating thru subdirectories
TMemoryStream
Saving a TTreeView's contents
A file of mulptiple records
Append Two Binary Files
Coping of the files
End Of File
File splitting and rejoining
How to match file date / time stamps
Copying files
Recursively removing files and subdirectories
Reading and writing data to/from files
Getting files date/time stamp
Storing TColor
Slow disk to diskette copy and back
How can I rename a directory
Save 500 chars from array into a file
Remove all files and subdirectories
Question
Has anyone run across a function that will recursively remove files and
directories given a starting subdirectory path. Failing that I would
settle for a simple RemoveDirectory function that will just remove a
given directory.
Answer
A:
This doesn't check for attributes being set, which might preclude deletion
of a file. Put a {$I-} {$I+} pair around the functions that cause the problem.
procedure removeTree (DirName: string);
var
FileSearch: SearchRec;
begin
{ first, go through and delete all the directories }
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') AND
( (FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '\' then
removeTree (DirName+FileSearch.Name)
else
removeTree (DirName+'\'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;
{ then, go through and delete all the files }
FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') then
Remove (workdir);
end;
FindNext (FileSearch)
end;
rmDir (DirName)
end;
Write / Read array of records into a file
Question
I need to save a array of record variable. Which is the best way to do it?
It's possible read the file with data-aware component?
Answer
A:
It's not very Delphi-like (but then, neither are Pascal records really),
but you can read and write records to and from a file using the standard
Pascal file manipulation procedures like so:
type
TMyRec = record ;
Field1 : integer ;
Field2 : string ;
end ;
TMyRecArray = array [0..9] of TMyRec ;
var
MyArray : TMyRecArray ;
MyRec : TMyRec ;
RecFile : file of TMyRec ;
begin
{...some code that intializes MyArray goes here...}
AssignFile( RecFile, 'MYREC.FIL' ) ;
ReWrite( RecFile ) ;
for i := 0 to 9 do
begin
Write( RecFile, MyRec[i] ) ;
end ;
CloseFile( RecFile ) ;
You can also use Read() to get a record from such a file, and Seek() to
move to a particular record in the file (starting with 0). For more
details on these have a look at "I/O Routines" in the Delphi on-line
help.
If you want to do this with the Data Aware components, you'll have to
construct a database where the database "records" reflect the structure
of your Pascal records, then provide translation routines to get the
data from one to the other. I'm not aware of any way to do this
directly, but it could certainly be encapsulated in a component.
Read data from a file
Question
How can I read data from a file being created by another program?
We have a program that collects data and constantly appends to a
daily file (ASCII text file). Even though the file has data in it, the file's
size is 0 until the program that is writing to it closes it. I need to read
records from this file as they are appended. I try reading from the file with
a Delphi program (see code below), it refuses to read any data from the file
until the other process closes it and the file size is updated.
procedure TestRead(FileName: String);
var
AMAFile: File;
BlockBuffer: Pointer;
Result: Integer;
begin
BlockBuffer :=3D AllocMem(BlockSize);
AssignFile(AMAFile, FileName);
FileMode :=3D 0;
try
Reset(AMAFile, BlockSize);
except
MessageDlg('Unable to access ' + FileName, mtError, [mbOK], 0);
end;
BlockRead(AMAFile, BlockBuffer^, 1, Result);
if(Result < 1) then
MessageDlg('Unable to read first record from ' + FileName, mtError,
[mbOK], 0)
else
MessageDlg('Successfully read first record from ' + FileName,
mtInformation, [mbOK], 0);
CloseFile(AMAFile);
FreeMem(BlockBuffer, BlockSize);
end;
Answer
A:
There is a procedure Flush that works with open text files.
flush(f);
The manual is not clear on whether Flush commits the file to disk. If it
doesn't there would be data in other temporary buffers. As an extra measure
of safety I normally follow it with a call to dos. This call may not be needed
but, just in case.
A possible example follows:
Uses
Sysutils;
var
F : text; { this is your text file }
Procedure TextFlush(F : Text);
var
fhandle : word;
begin
Flush(F);
fhandle := ttextrec(F).Handle; { get the msdos handle }
asm
mov ax, $6800
mov bx, handle
call DOS3CALL
end;
end;
If the file is a block file skip the flush step and use tfilerec instead of
ttextrec.
A:
The Filemode variable determins how the file is opened (By default in
exclusive mode).
Unfortunately it doesn't work on text files so you'ld have to use blockreads
and writes into a buffer and then convert the sections of the buffer to
strings if you want to handle it as a text file.
A:
Assign or AssignFile as it is now known cannot be used on a file that
is already open (I checked and this is documented). Now for one of my
famed shots in the dark - Why not use the API call to OpenFile
that's probably what you are using in C anyway.
A:
If it's a text file you first flush the text buffer with flush
flush(f)
The rest applies to all files:
Commit the file using the dos commit function, available
since DOS 5.
asm
mov ax, $6800 { commit file }
mov bx, ttextrec(f).handle { get the handle of the file }
call dos3call { this is the preferred way, INT
$21 would work as well }
end;
According to Microsoft documentation, this call also flushes the SMARTDRIVE
buffers.
The applicable MS language is as follows (MSDN10):
To flush the data held by the SMARTDRV.EXE version 4.0 buffer, you can
do one of the following:
- Use the MS-DOS Commit File function (which writes changed data from
the buffer). This is Interrupt 21h, function 68h.
- Use the MS-DOS Disk Reset function (which writes changed data and
invalidates/empties the cache). This is Interrupt 21h, function
0Dh.
Set a file's date and time
Question
I have tried to set the date and time of a file I have created. I am
actually using the sample unit FMXUtils which is supplied with the
Delphi disks for the File Manager sample (in the documentation samples).
I found that the code in the unit was actually commented out and that
it did not actually work when I removed the comments. I've tried using
SetFTime, DOS calls (in inline assembly code) and other methods without
luck. No error is returned and the file's date and time are unaltered.
I don't want to have to call a shelled executable routine either.
Answer
A:
You've been in the correct direction for trying to use SetFTime. Below is
a few line of source that alter the date & time of a file:
var
f: file;
begin
Assign(f, DirInfo.Name);
Reset(f);
SetFTime(f, Time);
Close(f);
end;
Import a large comma delimited file
Question
I have a large comma delimited file (average 500K) with variable length
fields (although the field types are standard) that I want to import into a
Paradox Table for quicker access.
The strings are in quotes, the numbers are not. However two problems I can
see, #1: If the field is blank there is nothing between the commas, #2:
Three of the character fields are a length of 500 characters.
Answer
A:
Here's two functions that I use will nearly all of my projects.
To use the routine is easy, eg:
var s: String; f: TextFile;
AssignFile(f, 'D:\INPUT.TXT);
Reset(f);
while not EOF(f) do
begin
ReadLn(s, f);
ShowMessage(GetField(s, 1)); {The first field}
ShowMessage(GetField(s, 6)); {The sixth field}
ShowMessage(GetField(s, 25)); {will return '' if no 25 column...}
end;
CloseFile(f);
{ ==== This function will return a field from a delimited string. ==== }
function GetField(InpString: String; fieldpos: Integer): String;
var
c: Char;
curpos, i: Integer;
begin
curpos := 1;
for i := 1 to fieldpos do
begin
result := ''; if curpos > Length(InpString) then Break;
repeat
c := InpString[curpos]; Inc(curpos, 1);
if (c = '"') or (c = #13) or (c = #10) then c := ' ';
if c <> ',' then result := result + c;
until (c = ',') or (curpos > Length(InpString))
end;
if (curpos > Length(InpString)) and (i < fieldpos) then result := '';
result := Trim(result);
end;
{ ==== This function will trim a string removing spaces etc. ==== }
function Trim(inp_str: String): String;
var
i: Integer;
begin
for i := 1 to Length(inp_str) do if inp_str[i] <> ' ' then Break;
if i > 1 then Delete(inp_str, 1, i - 1);
for i := Length(inp_str) downto 1 do if inp_str[i] <> ' ' then Break;
if i < Length(inp_str) then Delete(inp_str, i + 1, Length(inp_str));
result := inp_str;
if result = ' ' then result := '';
end;
Set compiled time in the aboutbox
Question
How do you set the compiled time in the aboutbox, so when you select
About, you know when was that app compiled.
Answer
A:
I am assuming that the problem is getting the complied time ?
Var
F : Integer;
S : String;
Begin
F:=FileOpen(ExpandFileName(Application.ExeName), 0);
S:=TimeToStr(FileDateToDateTime(FileGetDate(F)));
FileClose(F);
End;
Look up DateTime... in the OnLine Help. There's probably a better way
without using FileOpen.
You might also consider using the File Time as a version number, so a
time of 6:02 is version 6.02, and set the time yourself, using something
like Touch.
CopyFile Function / Procedure
Question
SetFTime and GetFTime use the DOS interrupt $21 though. I'd prefer to use
some Windows API stuff myself, but I couldn't find reference to any similar
functions in the API.
Answer
A:
The unit which contains this code must have "LZExpand" in its "uses" clause
(without the quotes, of course).
"var" declarations:
SourceHandle, DestHandle: Integer;
SName,DName: String;
SName and DName are fully qualified source and destination file names.
In the body of the procedure:
{set file handles}
SourceHandle := FileOpen(SName,0);
DestHandle := FileCreate(DName);
{set buffer, perform copy, clear buffer}
LZStart;
CopyLZFile(SourceHandle,DestHandle);
LZDone;
{close files}
FileClose(SourceHandle);
FileClose(DestHandle);
Reading Binary File
Question
I am trying to read a binary file, 1 character at a time to match a
certain one. Does anyone have any ideas on how to do this.
Answer
A:
var
f: File;
c: Char;
begin
AssignFile(f, 'this.bin');
Reset(f, 1);
BlockRead(f, c, sizeof(c));
CloseFile(f);
end;
A:
function FindInFile( cFileName : string; cCh : char ) : boolean;
var fFile : file;
aBuf : array[1..1024] of char;
lFound : boolean;
x,
nRead : integer;
begin
Assign( fFile, cFileName );
Reset( fFile, 1 );
lFound := False;
repeat
BlockRead( fFile, aBuf, SizeOf( aBuf ), nRead );
x := 1;
while not lFound and ( x <= nRead ) do
begin
lFound := ( aBuf[ x ] = cCh )
Inc( x )
end;
until ( nRead < SizeOf( aBuf ) ) or lFound;
FindInFile := lFound
end;
A:
Have a look at the following code:
var
f: file;
c: Char;
begin
AssignFile(f, 'c:\autoexec.bat);
Reset(f, 1); <- Note: Record size = 1 byte normally!
while not Eof(f) do
begin
BlockRead(f, c, SizeOf(c));
{Now process c}
end;
CloseFile(f);
end;
To speed this procedure up, don't read 1 character at a time. Perhaps
it would be better to declare a PChar, say of size 200, and read in
a block of 200 bytes at a time. {eg BlockRead(f, p, 200);}
This though will take slightly more code than shown here...
(Still use a recordsize of 1, if you are not certain of blocksize)
TOutline component read from file
Question
I am having a bad time trying to use the outline component. I am trying to
write the data to a file and then read it back in.
If anybody has had some experience with this component I would appreciate
some tips.
Answer
A:
If you want to save a TOutline, then you might want to have a look to the
SaveToFile
and ReadFromFile methods. If you want to create your own file (to store the
associated
data along with your TOutline), then you should consider using a TStream
(or descendant -> TFileStream).
I had also problems to store a TOutline in a custom file. A simple way to
achiev the goal is to create
a record like
TSaveNode=record
Text: String
Index: Longint;
Parent: Longint;
Data: Pointer
end;
This is all the information you need to save a TOutline. You can save it by
iterating all the TOutlineNodes and write them to the Stream. To load the
file read record by record and use the TOutline.AddChild method. The
trecord contains all the necessary information.
Fixed field data input
Question
I am trying to read in a text data file in fixed-field format, where variable
V1 is colums 1-3, V2 is colums 4-5, etc. What is the best method to import
this data in Delphi?
Answer
A:
Here's the easiest way to do it, it might not be the best:
var F : TextFile;
S : String;
AssignFile(F, 'FILENAME.TXT');
Reset(F);
while Not EOF(F)
do begin
Readln(F, S);
V1:= Copy(S,1,3);
V2:= Copy(S,4,6);
...
end;
CloseFile(F);
This is what I would normally do, but if the file is very large I
would read it using blockread and scan the block afterwards. If you're
thinking of using ODBC, I don't think it's worth it.
Opening file for read only
Question
I am working on an App that must allow multiple stations to open a
file a the same time. Is there anyway to open a file for read
only, and then should an update be needed, lock the file so no
one else can do an update until the current operation is complete?
These files are created and read with the BlockRead and Blockwrite
commands if it's any help.
Answer
A:
Set the FileMode variable before opening or creating the file. You can use
the 'File Open Mode constants' to set this. Look at the help for 'Sysutils
unit'. About half way down the page you'll see 'File Open Mode constants'.
These work great with the FileMode variable. You should OR one of the
fmOpen... constants with one of the fmShare... constants to set the mode.
A:
Look-up the FileMode variable in help. If you set it to zero before opening
the file, the opening will be read-only. The default is read/write for
untyped files.
A:
You might like to try setting the filemode after you assign the
file. ie:
AssignFile(F, FileName);
FileMode := 0; ( Set file access to read only }
Reset(F);
.
.
.
CloseFile(F);
File of type TList
Question
I have a TList object which itself contains a TList object. I want to be able
to save the entire contents to a disk file.
Answer
A:
Ok, this is not as simple as it looks. However, some time ago with much
help from people on this list, I did this. Some source code for Toverheadmap
follows..
Note the ReadData and WriteData methods on the objects being written to
disk, and the SaveToFile and LoadFromFile methods on the TList itself. This
really should be a bit more generic, but I haven't had the time/inclination
to make it so as of yet. (Ie, the TList should be able to save/restore any
object with a readdata/writedata method.)
------------------------------------
unit Charactr;
interface
uses
Graphics, StdCtrls, Classes, Sysutils, Winprocs, Ohmap, ohmstuff;
type
TMapCharacterList = class(TList)
private
FMap:TOverHeadMap;
public
procedure RenderVisibleCharacters; virtual;
procedure Savetofile(const filename:String);
procedure Loadfromfile(const filename:String);
procedure Clear;
destructor Destroy; override;
property MapDisp:TOverHeadMap read FMap write FMap;
end;
TFrameStore = class(TList)
procedure WriteData(Writer:Twriter); virtual;
procedure ReadData(Reader:TReader); virtual;
procedure Clear;
end;
TMapCharacter = class(TPersistent)
private
FName:string;
FMap:TOverHeadMap;
FFrame:Integer;
FFramebm,FFrameMask,FWorkBuf:TBitmap;
FFrameStore,FMaskStore:TFrameStore;
FXpos,FYpos,FZpos:Integer;
FTransColor:TColor;
FVisible,FFastMode,FIsClone,FRedrawBackground:Boolean;
procedure SetFrame(num:Integer);
function GetOnScreen:Boolean;
procedure SetVisible(vis:Boolean);
procedure MakeFrameMask(trColor: TColor);
procedure MakeFrameMasks; {For switching to fast mode...}
procedure ReplaceTransColor(trColor: TColor);
procedure SetXPos(x:Integer);
procedure SetYPos(y:Integer);
procedure SetZPos(z:Integer);
procedure SetFastMode(fast:Boolean);
public
constructor Create(ParentMap:TOverheadmap); virtual;
destructor Destroy; override;
property Name:string read FName write FName;
property Fastmode:Boolean read FFastMode write SetFastMode;
property FrameStore:TFrameStore read FFrameStore write FFramestore;
property MaskStore:TFrameStore read FMaskStore write FMaskStore;
property Frame:integer read FFrame write SetFrame;
property Framebm:TBitmap read FFramebm;
property FrameMask:TBitmap read FFrameMask;
property TransColor:TColor read FTransColor write FTransColor;
property Xpos:Integer read FXpos write SetXpos;
property YPos:Integer read FYpos write SetYpos;
property ZPos:Integer read FZpos write SetZpos;
property Map:TOverHeadMap read FMap write FMap;
property OnScreen:Boolean read GetOnScreen;
property Visible:Boolean read FVisible write SetVisible;
property IsClone:Boolean read FIsClone write FIsClone;
property RedrawBackground:Boolean read FRedrawBackground write
FRedrawBackground;
procedure Render; virtual;
procedure RenderCharacter(mapcoords:Boolean;cxpos,cypos:Integer;mask,bm,
wb:TBitmap); virtual;
procedure Clone(Source:TMapCharacter); virtual;
procedure SetCharacterCoords(x,y,z:Integer); virtual;
procedure WriteData(Writer:Twriter); virtual;
procedure ReadData(Reader:TReader); virtual;
end;
implementation
constructor TMapCharacter.Create(ParentMap:TOverheadmap);
begin
inherited Create;
FIsClone:=False;
FFramebm:=TBitMap.create;
FFrameMask:=TBitmap.Create;
FWorkbuf:=TBitMap.Create;
if Not(FIsClone) then
FFrameStore:=TFrameStore.Create;
FTransColor:=clBlack;
FFastMode:=False;
FMap:=ParentMap; end;
destructor TMapCharacter.Destroy;
var
a,b:Integer;
begin
FFramemask.free;
FFramebm.free;
FWorkBuf.Free;
if Not(FIsClone) then begin
FFrameStore.Clear;
FFrameStore.free;
end;
if (MaskStore<>nil) and Not(FIsClone) then begin
MaskStore.Clear;
MaskStore.Free;
end;
inherited Destroy; end;
{
This procedure copies the relevant information from a character into itself
...
Clones start out invisible, with zeroed map coordinates.
}
procedure TMapCharacter.Clone(Source:TMapCharacter);
begin
FName:=Source.Name;
FFastMode:=Source.FastMode;
FFrameStore:=Source.FrameStore;
FMaskStore:=Source.MaskStore;
FTransColor:=Source.TransColor;
FMap:=Source.Map;
FVisible:=False;
Frame:=Source.Frame; {Trigger frame retrieval.}
FIsClone:=True; end;
procedure TMapCharacter.SetXPos(x:Integer);
begin
Map.Redraw(xpos,ypos,zpos,-1);
FXpos:=x;
Render;
end;
procedure TMapCharacter.SetYPos(y:Integer);
begin
Map.Redraw(xpos,ypos,zpos,-1);
FYPos:=y;
Render;
end;
procedure TMapCharacter.SetZPos(z:Integer);
begin
Map.Redraw(xpos,ypos,zpos,-1);
FZpos:=z;
Render;
end;
procedure TMapCharacter.SetCharacterCoords(x,y,z:Integer);
begin
Map.Redraw(xpos,ypos,zpos,-1);
Fxpos:=x; Fypos:=y; Fzpos:=z;
Render;
end;
procedure TMapCharacter.SetFrame(num:Integer);
begin
if (num<=FFrameStore.count-1) and (num>-1) then begin
FFrame:=num;
FFramebm.Assign(TBitmap(FFrameStore.items[num]));
if Ffastmode=false then begin
FFrameMask.Width:=FFramebm.width;
FFrameMask.Height:=FFramebm.height;
FWorkBuf.Height:=FFramebm.height;
FWorkBuf.Width:=FFramebm.width;
makeframemask(TransColor);
replacetranscolor(TransColor);
end
else begin
FWorkBuf.Height:=FFramebm.height;
FWorkBuf.Width:=FFramebm.width;
FFrameMask.Assign(TBitmap(FMaskStore.items[num]));
end;
end;
end;
procedure TMapCharacter.MakeFrameMask(trColor: TColor);
var
testbm1,testbm2: TBitmap;
trColorInv: TColor;
begin
testbm1 := TBitmap.Create;
testbm1.width := 1;
testbm1.height:=1;
testbm2 := TBitmap.Create;
testbm2.width := 1;
testbm2.height:=1;
testbm1.Canvas.Pixels[0,0]:=trColor;
testbm2.Canvas.CopyMode:=cmSrcInvert;
testbm2.Canvas.Draw(0,0,testbm1);
trColorInv:=testbm2.Canvas.Pixels[0,0];
testbm1.free;
testbm2.free;
with FFrameMask.Canvas do
begin
Brush.Color:= trColorInv;
BrushCopy( Rect(0,0,FFrameMask.Width,FFrameMask.Height),FFramebm,
Rect(0,0,FFramebm.Width,FFramebm.Height),trColor);
CopyMode:=cmSrcInvert;
Draw(0,0,FFramebm);
end;
end;
procedure TMapCharacter.ReplaceTransColor(trColor: TColor);
begin
with FFramebm.Canvas do
begin
CopyMode:=cmSrcCopy;
Brush.Color:= clBlack;
BrushCopy( Rect(0,0,FFramebm.Width,FFramebm.Height),FFramebm,
Rect(0,0,FFramebm.Width,FFramebm.Height),trColor);
end;
end;
function TMapCharacter.GetOnScreen:Boolean;
var
dispx,dispy:Integer;
begin
dispx:=Map.width div map.tilexdim;
dispy:=Map.height div map.tileydim;
if (xpos>=Map.xpos) and (xpos<=map.xpos+dispx) and (ypos>=map.ypos) and
(ypos>=map.ypos+dispy) then
result:=true; end;
procedure TMapCharacter.SetVisible(vis:Boolean);
begin
if vis and OnScreen then Render;
FVisible:=vis;
end;
procedure TMapCharacter.SetFastMode(fast:Boolean);
begin
if fast<>FFastMode then begin
if fast=true then begin
FMaskStore:=TFrameStore.Create;
MakeFrameMasks;
FFastMode:=True;
frame:=0;
end
else begin
FMaskStore.Free;
FFastMode:=False;
end;
end;
end;
procedure TMapCharacter.MakeFrameMasks;
var
a:Integer;
bm:TBitMap;
begin
if FFrameStore.count>0 then begin
for a:=0 to FFrameStore.Count-1 do begin
Frame:=a;
bm:=TBitMap.create;
bm.Assign(FFrameMask);
FMaskStore.add(bm);
end;
end;
end;
procedure TMapCharacter.Render;
var
x,y:Integer;
begin
if visible and onscreen then
RenderCharacter(true,xpos,ypos,FFramemask,FFramebm,FWorkbuf);
end;
procedure TMapCharacter.RenderCharacter(mapcoords:Boolean;cxpos,cypos:
Integer;mask,bm,wb:TBitmap);
var
x,y:Integer;
begin
if map.ready then begin
{
If the user specifies it in mapcoords, we handle redrawing the tile
(s) first.
if not, he does.
}
if mapcoords then begin
if FRedrawBackground then
Map.redraw(cxpos,cypos,FMap.zpos,-1);
wb.Canvas.Draw(0,0,TMapIcon(FMap.Iconset[map.zoomlevel].items
[FMap.Map.Iconat(cxpos,cypos,Map.zpos)]).image);
x:=(cxpos-Map.xpos)*FMap.tilexdim;
y:=(cypos-Map.ypos)*FMap.tileydim;
end
else
wb.Canvas.Copyrect(rect(0,0,FMap.tilexdim,FMap.tileydim),FMap.
Screenbuffer.canvas,rect(x,y,x+FMap.tilexdim,
y+FMap.tileydim));
with wb do begin
Map.Canvas.CopyMode := cmSrcAnd;
Map.Canvas.Draw(0,0,Mask);
Map.Canvas.CopyMode := cmSrcPaint;
Map.Canvas.Draw(0,0,bm);
Map.Canvas.Copymode:=cmSrcCopy;
end;
Map.Canvas.CopyRect(Rect(x,y,x+FMap.tilexdim,y+FMap.tileydim),wb.
canvas,
Rect(0,0,FMap.tilexdim,FMap.tileydim));
end;
end;
procedure TMapCharacter.WriteData(Writer:TWriter);
begin
with Writer do begin
WriteListBegin;
WriteString(FName);
WriteBoolean(FFastMode);
WriteInteger(TransColor);
FFrameStore.WriteData(Writer);
if FFastMode then
FMaskStore.WriteData(Writer);
WriteListEnd;
end;
end;
procedure TMapCharacter.ReadData(Reader:TReader);
begin
with Reader do begin
ReadListBegin;
Fname:=ReadString;
FFastMode:=ReadBoolean;
TransColor:=ReadInteger;
FFrameStore.ReadData(Reader);
if FFastMode then begin
FMaskStore:=TFrameStore.Create;
FMaskStore.ReadData(Reader);
end;
ReadListEnd;
end;
end;
procedure TMapCharacterList.RenderVisibleCharacters;
var
a:Integer;
begin
for a:=0 to count-1 do
TMapCharacter(items[a]).render;
end;
procedure TMapCharacterList.clear;
var
obj:TObject;
begin
{This routine deallocates all resources inside this here list}
if self.count>0 then
begin
repeat
obj:=self.items[0];
obj.free;
self.remove(self.items[0]);
until self.count=0;
end;
end;
destructor TMapCharacterList.Destroy;
var
a:Integer;
begin
if count>0 then
for a:=0 to count-1 do
TObject(items[a]).free;
inherited destroy; end;
procedure TMapCharacterList.loadfromfile(const filename:string);
var
i:Integer;
Reader:Treader;
Stream:TFileStream;
obj:TMapCharacter; begin
stream:=TFileStream.create(filename,fmOpenRead);
try
reader:=TReader.create(stream,$ff);
try
with reader do begin
try
ReadSignature;
if ReadInteger<>$6667 then
Raise EReadError.Create('Not a character list.');
except
Raise EReadError.Create('Not a valid file.');
end;
ReadListBegin;
while not EndofList do begin
obj:=TMapCharacter.create(FMap);
try
obj.ReadData(reader);
except
obj.free;
raise EReadError.Create('Error in character list
file.');
end;
self.add(obj);
end;
ReadListEnd;
end;
finally
reader.free;
end;
finally
stream.free;
end;
end;
procedure TMapCharacterList.savetofile(const filename:String);
var
Stream:TFileStream;
Writer:TWriter;
i:Integer;
obj:TMapCharacter; begin
stream:=TFileStream.create(filename,fmCreate or fmOpenWrite);
try
writer:=TWriter.create(stream,$ff);
try
with writer do begin
WriteSignature;
WriteInteger($6667);
WriteListBegin;
for i:=0 to self.count-1 do
TMapCharacter(self.items[i]).writedata(writer);
WriteListEnd;
end;
finally
writer.free;
end;
finally
stream.free;
end;
end;
procedure TFrameStore.WriteData(Writer:TWriter);
var
mstream:TMemoryStream;
a,size:Longint;
begin
mstream:=TMemoryStream.Create;
try
with writer do begin
WriteListBegin;
WriteInteger(count);
for a:=0 to count-1 do begin
TBitmap(items[a]).savetostream(mstream);
size:=mstream.size;
WriteInteger(size);
Write(mstream.memory^,size);
mstream.position:=0;
end;
WriteListEnd;
end;
finally
Mstream.free;
end;
end;
procedure TFrameStore.ReadData(Reader:TReader);
var
mstream:TMemoryStream;
a,listcount,size:Longint;
newframe:TBitMap;
begin
mstream:=TMemoryStream.create;
try
with reader do begin
ReadListBegin;
Listcount:=ReadInteger;
for a:=1 to listcount do begin
size:=ReadInteger;
mstream.setsize(size);
read(mstream.Memory^,size);
newframe:=TBitmap.create;
newframe.loadfromstream(mstream);
add(newframe);
end;
ReadListEnd;
end;
finally
Mstream.free;
end;
end;
procedure TFrameStore.clear;
var
Obj:TObject;
begin
{This routine deallocates all resources inside this here list}
if self.count>0 then
begin
repeat
obj:=self.items[0];
obj.free;
self.remove(self.items[0]);
until self.count=0;
end;
end;
end.
Reading long strings from a file
Question
What's the easiest way to read in a long ASCII record directly into a PChar
or character array? Can I use ReadLn for this? All the examples in the
Delphi help use strings, but could I do something like this instead?
Answer
A:
You might want to consider using a stream (TFileStream,
TMemoryStream) to help you do the job. You'll have to find the CR/LF
pair yourself, but it would probably work fairly well -- something like this
(too lazy tonight for real code)
Start := Stream.Position;
End := Start;
Repeat
Stream.Read(Buffer^, 1024);
CRPos := FindCR(Buffer^); { Where FindCR returns 0..1023 for CR,
1024 if not found}
Inc(End, CRPos);
Until CRPos < 1024;
GetMem(MyPChar, End - Start); { May be +-1 here -- again, lazy me! }
Stream.Seek(Start);
Stream.Read(MyPChar^, End - Start)
Then set the CR at the end of MyPChar to 0, and Seek to End + 1 or so
(to skip the LF).
GetFileSize
Question
Like everyone else (I suppose) I had patched around the lack
of a GetFileSize function and botched one together using
AssignFile, Reset, FileSize & CloseFile.
This merry morning I find that it doesn't work for files which
have the "Read only" attribute set.
I guess I could further botch it to work using FileGetAttr and
FileSetAttr, but I can't believe that there's nothing in the
Windows API.
Failing that, has anybody else written a nice clean GetFileSize
function that works properly for any file. I'd prefer it to
work on an unopened file, or failing that on a File Handle, but
not from a "File Variable".
I don't want much, just the size in bytes.
Answer
A:
Here's a bit of code I use to determine info about a group of files:
var
Fhnd2 : File ;
sPath : String;
tpath : string;
SearchRec: TSearchRec;
tempsearch : string;
tempfiles : Integer;
tempbytes : LongInt;
wBytes : Word;
sTemp : String ;
iLen : Integer ;
szString: Array[0..128] Of Char;
ec : integer;
BEGIN
{* Fetch System Directory *}
MailManLogS('MailMan Begin');
sTemp := ParamStr(0) ;
iLen := Length(sTemp) ;
WHILE sTemp[iLen] <> '\' DO
DEC (iLen) ;
StrPCopy(szString, sTemp) ;
szString[iLen] := #0 ;
SysDir := StrPas(szString) ;
tempbytes := 0;
tempfiles := 0;
Files2bProc := 0;
Bytes2bProc := 0;
MailManLogS('Calculate Files To Be Processed');
{* Find out how many files and bytes are to be processed *}
tempsearch := SysDir + 'spool\witchcrf\d\*.*' ;
ec := FindFirst(tempsearch, faSysFile, SearchRec);
While ec = 0 do
begin
if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
begin
tempfiles := tempfiles + 1;
----> tempbytes := tempbytes + SearchRec.Size; <------
TotalInBytes.Text := IntToStr(tempbytes);
TotalInFiles.Text := IntToStr(tempfiles);
MailManLogS('File-' + SearchRec.Name + ' Size-' + IntToStr(SearchRec.Size));
end;
ec := FindNext(SearchRec);
end;
MailManLogS('Total Files = ' + IntToStr(tempfiles) + ' Bytes = ' + IntToStr(tempbytes));
end;
All the syntax may not be right, I just cut and paste a section of
one of my programs to demonstrate how the FindFirst Function
works. It returns info about file in SearchRec which should
contain any info you want about a file. I think it's exactly what
your looking for as the file doesn't have to be open.
A:
I have cobbled together something using FindFirst.
It returns a record of type TSearchRec. This record contains a
variable Size which is the file size in bytes. It may not be pretty
but it works.
function GetFileSize(FileName: string): Longint;
var
SearchRec: TSearchRec;
begin
if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
Result:=SearchRec.Size
else
Result:=-1; {return an error, this can be anything less
than zero}
end;
A:
If you like, you can pick one of these two for a start. The first is
a hack that changes the file attributes temporarily to allow the
read. The second uses the Windows API, but doesn't do any error
checking.
Function FileGetSize1(Filename : String) : LongInt;
var
F : File;
OldFileAttr : Integer;
begin
if FileExists(Filename)
then
begin
OldFileAttr := FileGetAttr(Filename);
FileSetAttr(Filename,OldFileAttr and (faReadOnly xor $FFFF));
try
AssignFile(F, Filename);
Reset(F,1);
Result := FileSize(F);
CloseFile(F);
finally
FileSetAttr(Filename, OldFileAttr);
end;
end
else
Result := 0;
end;
Function FileGetSize2(Filename : String) : LongInt;
var
FileHandle : Integer;
begin
if FileExists(Filename)
then
begin
FileName := FileName + chr(0);
FileHandle := _lopen(@FileName[1], 0);
Result := _llseek(FileHandle, 0, 2);
_lclose(FileHandle);
end
else
Result := 0;
end;
[Eric Nielsen, htrsoft@midwest.net]
A:
I didn't bother with AssignFile.
Function FileSizeInBytes(YourFile : String) : LongInt;
Var
F : Integer;
Begin
F:=FileOpen(YourFile,0); { ReadOnly Mode }
FilesizeInBytes := FileSeek(F,0,2);
FileClose(F)
End;
Note: No error checking !!!
File Sharing question
Question
I have a robot-type application which runs unattended, and I am having
some filesharing problems:
The robot opens a text file for append, then adds a line to it, then
closes it. If the file is in use by someone else, even for read, Windows
puts up a message saying Sharing Violation, retry/cancel, and the robot
is then hung. This happens in win31 with vshare.386 and in win95.
I have tried flagging the files as Shareable (they are on a Novell
server), this doesnt help. I have looked at the filemodes available, and
none seem to help. How can I trap this error in my program, and handle it
myself?
Answer
A:
Have you tried a try ... except block yet?
I had a similar, but not the same, problem.
Code like this worked fine...
try
{open file code goes here}
...
except
{exception handling code goes here}
{something like MessageDlg('Cannot open file', mtError, [mbOk], 0)
would do nicely :) }
...
end;
A:
The Shareable netware attribute is used for EXE & COM files, and let
multiple users run one file. This will not work for text files.
One method would be to check to see if the DOS "READ-ONLY" attribute is set.
Most DOS & Windows programs will set the flag after it opens a file to keep
everyone else out. You can alternativly check for the NETWARE "READ-ONLY
file attribute. This could be done with one of the NETWARE API components
that are floating around. When your program finds one of these conditions
to be true, just have it wait a certain amount of time then check again.
Ascii code for eof
Question
What is the ascii code for the marker for a text file
the same thing as the ascii code for is #13.
Answer
The standard DOS EOF marker is control-Z, or ASCII character 26
Iterating thru subdirectories
Question
I know how to iterate through the files in a particular directory. But, how
do you iterate through the subdirectories of that directory?
Answer
A:
procedure TFormList.RecurseDir(PathInicial: string);
var
SearchRec: TSearchRec;
Result: integer;
tmpName: string;
begin
DirectoryListBox1.Directory:=PathInicial;
Result:=FindFirst(PathInicial+'\*.*', faAnyFile, SearchRec);
While Result = 0 do begin
if ExtOk(SearchRec.Name) then
{ if directory... }
if SearchRec.Attr and faDirectory > 0 then
{ recurse in... }
RecurseDir(PathInicial+'\'+SearchRec.Name)
else begin
tmpName:=PathInicial+'\'+SearchRec.Name;
tmpName:=Copy(tmpName,
Pos(PathOrigen,tmpName)+Length(PathOrigen),
Length(tmpName)-Length(PathOrigen));
ListBox1.Items.Add(LowerCase(tmpName));
end;
Application.ProcessMessages;
Result:=FindNext(SearchRec);
end;
DirectoryListBox1.Directory:=PathInicial;
end;
TMemoryStream
Question
Could anyone give any pointers to let me use
TMemoryStream to save data - mainly lines of strings.
Answer
A:
Think of memory stream as a file that is located in memory. So the writes
are very similar to the write command for files. (Actually it is closer to
the blockwrite command.)
To put a string the slow way you could do the following:
for i := 1 to Length(s) do memstream.Write(s[i], 1);
That would write the string one character at a time. Simple and easy to
understand, but a bit slow. A faster way would be to do the following:
memstream.Write(s[1], Length(s));
The two lines do the same thing, they append characters to the stream. If
you have never done a seek on the stream, they just append to the end.
Now to handle the line feeds you have to add them yourself:
memstream.Write(#13, 1);
memstream.Write(#10, 1);
Or you could do some sneaky things like this:
procedure StreamWriteStr(var ms: TMemoryStream; s: string);
begin
ms.Write(s[1], Length(s));
end;
procedure StreamWriteLnStr(var ms: TMemoryStream; s: string);
begin
StreamWriteStr(ms, s + #13#10);
end;
Or you could create you own descendant class of TMemoryStream with a method
to write strings.
Saving a TTreeView's contents
Question
Is it possible to save the contents of a TTreeView and keep the
structure of the items an data in a file? I mean, is there a way to
save the items and data like (supose) SaveComponentData(MyTTreeView)
and then to load the items and data from the file (again supose)
LoadComponentData(MyTTreeView)?
Answer
It is possible:
MyTreeView.SaveToFile('Filename');
and later:
MyTreeView.LoadFromFile('Filename');
The problem: This method saves only the names of the items and the
structure (the file is a textfile which reflects the structure). It
doesn't save the ImageIndex property and so on. After "LoadFromFile"
you must restore the Images.
A file of mulptiple records
Question
I am writing an adventure game and need to store information
in a save game. The game requires data from 3 different records
and one variable -
record1 = hotspot scene information(50 recs),
record2 = conversation information (60 recs),
record3 = hypertext information(50 recs)
variable = integer - # of scene currently on.
My problem is that I need to seek for a particular record of particular type
in the file ( I do not want to have to keep huge arrays of records in memory
). I know how to do this with a file containing records of only one record
type but have no clue how to combine all three records and one integer into
a single random access file.
Answer
I generally use a file with a header then just keep the header in memory and
use it to seek to the records I need.
Type
TSaveHeader = Record
scene : Integer;
hotspots : LongInt;
talk : LongInt;
hype : LongInt;
End;
Var
SaveHeader : TSaveHeader;
Procedure OpenSaveFile(fname : String);
Var
f : File;
i : Integer;
Begin
AssignFile(f, fname);
Reset(f, 1);
BlockRead(f, SaveHeader, Sizeof(TSaveHeader));
{ get one set of records }
Seek(f, SaveHeader.hotspots);
For i := 1 To 50 Do
BlockRead(f, somevar, sizeof_hotspotrec);
{ and so on }
CloseFile(f);
End;
{ assuming the file is open }
Procedure GetHotspotRec(index : LongInt; Var hotspotrec : THotspot);
Var
offset : LongInt;
Begin
offset := SaveHeader.hotspots + index * Sizeof(THotSpot);
Seek(f, offset);
BlockRead(f, hotspotrec, Sizeof(THotspot));
End;
Append Two Binary Files
Question
I need to Append two Binary Files together how could I do that ?
Answer
The easiest way would be to open the first one, move to the end and copy the
second one.
Var
f1, f2 : File;
xfer : Word;
buf : PChar;
Begin
AssignFile(f1, name1);
Reset(f1);
Seek(f1, Filesize(f1));
AssignFile(f2, name2);
Reset(f2);
GetMem(buf, 65000);
Repeat
BlockRead(f1, buf^, 65000, xfer);
BlockWrite(f2, buf^, xfer);
Until xfer < 65000;
CloseFile(f1);
CloseFile(f2);
End;
Coping of the files
Question
I have diffculties with coping the files. Delphi don't want to compile
LZCopy command.
this way it work very slow
pbBuf := PChar( LocalAlloc(LMEM_FIXED, 1) );
FileSeek(source,0,0);
FileSeek(dest,0,0);
repeat
cbRead := Fileread(source, pbBuf, 1);
FileWrite(dest, pbBuf, cbRead);
until (cbRead = 0);
Answer
A:
{ You must add LZExpand to your uses clause ea. USES LZExpand; }
function CopyFile(SrcF,DestF : string) : boolean;
var
SFile,
DFile : integer;
Res : longint;
Msg : string;
begin
SFile := FileOpen(SrcF,0); { Open ReadOnly = 0, Write=1, Readwrite=2}
DFile := FileCreate(DestF);
Res := LZCopy(SFile,DFile);
FileClose(SFile);
FileClose(DFile);
if Res < 0 then
begin
Msg := 'Unknown error';
case Res of
LZERROR_BADINHANDLE : Msg := 'Invalid Source file handle';
LZERROR_BADOUTHANDLE : Msg := 'Invalid Destination file handle';
LZERROR_BADVALUE : Msg := 'Input parameter is out of range';
LZERROR_GLOBALLOC : Msg := 'Insufficient memory for the required buffers';
LZERROR_GLOBLOCK : Msg := 'Internal data structure handle invalid';
LZERROR_READ : Msg := 'Source file format is not valid';
LZERROR_UNKNOWNALG : Msg := 'The Source file was compressed with an unrecognized compression algorithm';
LZERROR_WRITE : Msg := 'There is insufficient space for the output file';
end;
MessageDlg(Msg,mtERROR,[mbOK],0);
result := FALSE
end else
result := TRUE;
end;
A:
I'll bet it's slow! It's reading the file one character at a time... Try
allocating 8192 bytes and reading 8192 bytes at a time. That should speed
it up a bit...
A:
The simplest way to copy files is this:
VAR
sI,dI:Longint;
sD,sS:TFilename;
USES LZExpand;
............
sI := FileOpen(sS,fmShareDenyWrite);
dI := FileCreate(sD);
{ Copy file }
CopyLZFile(sI,dI);
{close files}
FileClose(sI);
FileClose(dI);
End Of File
Question
I have a typed file. When using Eof() I do not get to the end of
file. Now the only reason I know this is that I have another application
(not my own) that reads passed this point?
Answer
A:
I'm not sure that you are using eof() in the right context. eof()
simply CHECK's if you are at the end of "f" file. It does not send you
anywhere. Heres a sample of getting to the end of file.
procedure gotoeof (f : file);
{ jumps to eof }
begin
seek (f, 0); { goto start }
seek (f, filesize(f)); { move ahead "x" number of bytes, in this
case the
size of the file! }
end; {gotoeof}
A:
Eof() will only test for the end of file condition. You need to use
Seek() or SeekEof() to set the file pointer to the end of file.
File splitting and rejoining
Question
Just wondering if anybody knows how to split a file (it will be compressed
via lha) across floppies and then successfully recombine the it later.
Answer
Not too hard, here's something that should do it:
inf: file;
outf: file;
size: longint;
outsize: longint;
amt: word;
amtRead: word;
assignfile (inf, 'input file');
reset (inf, 1);
size := fileSize (inf);
repeat
showMessage (enter floppy in "A") { or "B" or allow them to specify }
assignFile (outf, 'A:output file');
rewrite (outf, 1);
outsize := diskFree (1); { or 2 if it's the "B" drive }
while (outsize > 0) and (size > 0) do begin
amt := sizeof(buf);
if amt > outsize then amt := outsize;
blockRead (inf, buf, amt, amtRead);
blockWrite (outf, buf, amtRead);
dec (outSize, amtRead);
dec (size, amtRead);
end;
closeFile (outf);
until size <= 0;
closeFile (inf);
This is OTTOMH, syntax hasn't been checked, etc. You may want to add other
code to let the user specify the "A" or "B" drive, and/or a naming scheme so
that if disks get out of order it's trapped.
Re-assembling the files is similar: open outf on the hard disk, ask the user
for the first floppy, blockRead/blockWrite from the floppy to the hard disk,
then ask the user for the next floppy, etc. until all floppies are read.
How to match file date / time stamps
Question
How can I write a function that sets the date of one file equal to the date of another file?
Answer
{
A: No problem. Just use the following function, which takes two strings
representing full DOS path/file names. The file who's date you
wish to set is the second parameter, and the date you wish to set it to
is given by the file in the first parameter.
}
procedure CopyFileDate(const Source, Dest: String);
var
SourceHand, DestHand: word;
begin
SourceHand := FileOpen(Source, fmOutput); { open source file }
DestHand := FileOpen(Dest, fmInput); { open dest file }
FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }
FileClose(SourceHand); { close source file }
FileClose(DestHand); { close dest file }
end;
Copying files
Question
How to copy files?
Answer
{
Example #1 - uses a File stream
}
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
End;
{
Example #2 - uses memory blocks for read/write
}
procedure FileCopy(const FromFile, ToFile: string);
var
FromF, ToF: file;
NumRead, NumWritten: Word;
Buf: array[1..2048] of Char;
begin
AssignFile(FromF, FromFile);
Reset(FromF, 1); { Record size = 1 }
AssignFile(ToF, ToFile); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
{
Example #3 - uses LZCopy, which USES LZExpand
}
procedure CopyFile(FromFileName, ToFileName: string);
var
FromFile, ToFile: File;
begin
AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }
AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }
Reset(FromFile); { Open file for input }
try
Rewrite(ToFile); { Create file for output }
try
{ copy the file an if a negative value is returned }
{ raise an exception }
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0
then
raise EInOutError.Create('Error using LZCopy')
finally
CloseFile(ToFile); { Close ToFile }
end;
finally
CloseFile(FromFile); { Close FromFile }
end;
end;
Recursively removing files and subdirectories
Question
Has anyone run across a function that will recursively remove files and
directories given a starting subdirectory path.
Answer
{
This is adapted from some code I wrote for Borland Pascal 5.5 under DOS (the
original code didn't do rmDir, so you might want to experiment with where
the directory pointer goes after the rmDir at the end of the function). I
suspect that the Delphi version is either identical or has a few changes in
function name(s) (check the Delphi help for file management functions).
This doesn't check for attributes being set, which might preclude deletion
of a file. (In Pascal 5.5, you'd put a {$I-} {$I+} pair around the
functions that cause the problem; don't know if you do that in Delphi.)
}
procedure removeTree (DirName: string);
var
FileSearch: SearchRec;
begin
{ first, go through and delete all the directories }
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') AND
( (FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '\' then
removeTree (DirName+FileSearch.Name)
else
removeTree (DirName+'\'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;
{ then, go through and delete all the files }
FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') then
Remove (workdir);
end;
FindNext (FileSearch)
end;
rmDir (DirName)
end;
Reading and writing data to/from files
Question
How to read and write data from / to files?
Answer
{
The following example shows how to write and read data to
and from a file. It is intended merely as a starting
point for those that are struggling to get started with
file related IO. Please read the documentation on each
object for more information. Some very minimal exception
handling is thrown in and by no means constitutes a
robust solution
In order to setup the program, place a TMemo component on
a form with a Write captioned and a Read captioned button.
Run the program, place some lines in the "memo", then
press on Write. Clear the "memo", and press on Read.
}
procedure TForm1.BtnWriteClick(Sender: TObject);
{ by: Michael Vincze
}
var
FileStream: TFileStream;
Writer : TWriter;
I : Integer;
begin
FileStream := TFileStream.Create ('c:\delphi\projects\delta40\fileio\stream.txt',
fmCreate or fmOpenWrite or fmShareDenyNone);
Writer := TWriter.Create (FileStream, $ff);
Writer.WriteListBegin;
for I := 0 to Memo1.Lines.Count - 1 do Writer.WriteString (Memo1.Lines[I]);
Writer.WriteListEnd;
Writer.Destroy;
FileStream.Destroy;
end;
procedure TForm1.BtnReadClick(Sender: TObject);
{ by: Michael Vincze
}
var
FileStream: TFileStream;
Reader : TReader;
begin
{ try opening a non existent file
}
try
FileStream := TFileStream.Create ('c:\delphi\projects\delta40\fileio\bogus.txt',
fmOpenRead);
except
; { no need to Destroy since the Create failed }
end;
FileStream := TFileStream.Create ('c:\delphi\projects\delta40\fileio\stream.txt',
fmOpenRead);
Reader := TReader.Create (FileStream, $ff);
Reader.ReadListBegin;
Memo1.Lines.Clear;
while not Reader.EndOfList do Memo1.Lines.Add (Reader.ReadString);
Reader.ReadListEnd;
Reader.Destroy;
FileStream.Destroy;
end;
Getting files date/time stamp
Question
How do I get a file's date and time stamp?
Answer
function GetFileDate(TheFileName: string): string;
var
FHandle: integer;
begin
FHandle := FileOpen(TheFileName, 0);
try
Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
finally
FileClose(FHandle);
end;
end;
DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.
Storing TColor
Question
Simple question, but I can't find an example of storing a TColor in
either a database or an inifile, and I'm not sure how to deal with Hex.
Answer
Should be able to store it as IntToStr(thecolor);
No need to know hex.
Slow disk to diskette copy and back
Question
I wrote an "install.exe" in Delphi 2 that copies three files (total size,
1.09MB) from the installation diskette to the hard disk. The amazing problem
I have is that it takes fully ten minutes to copy the four files! I open
each file as a "file of byte" type, and read each byte then write each byte
to hard disk.
I can't figure out why its so slow.
Answer
A:
Instead of reading byte per byte, you should open the file with a record size of
64K or so, and read blocks. This will be much faster.
If you'd like to be real easy, there are components out there to copy files ....
Example of a copyfile routine :
Function CopyFile(FromPath,ToPath : String) : integer;
Var
F1 : file;
F2 : file;
NumRead : word;
NumWritten : word;
Buf : pointer;
BufSize : longint;
Totalbytes : longint;
TotalRead : longint;
Begin
Result := 0;
Assignfile(f1,FromPath);
Assignfile(F2,ToPath);
reset(F1,1);
TotalBytes := Filesize(F1);
Rewrite(F2,1);
BufSize := 16384;
GetMem(buf,BufSize);
TotalRead :=0;
repeat
BlockRead(F1, Buf^, BufSize, NumRead);
inc(TotalRead,NumRead);
BlockWrite(F2, Buf^, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
if (NumWritten <> NumRead) then
begin
{error }
result := -1;
end
closefile(f1);
Closefile(f2);
End;
A:
If you have a file of byte, or just File, you should be using Blockread which
will allow a buffer size of 64Kb (ish). However, here is a quicker way. Use
Compress which I think comes with Delphi, otherwise is probably available on
Microsoft site, to create files like filename.ex_. This means that less info
needs transferring.
Below is some code to copy the files over. Even better, this will work on
your current files, since if the files are not compressed they simply get
copied !
function TInstallForm.UnCompress(src, dest: String; Var Error : LongInt):
Boolean;
var
s, d: TOFStruct;
fs, fd: Integer;
fnSrc, fnDest: PChar;
begin
src:=src + #0;
dest:=dest + #0;
fnSrc:=@src[1]; { Trick the Strings into being ASCIIZ }
fnDest:=@dest[1];
fs := LZOpenFile(fnSrc, s, OF_READ); { Get file handles }
fd := LZOpenFile(fnDest, d, OF_CREATE);
Error:=LZCopy(fs, fd); { Here's the magic API call }
Result:=(Error > -1);
LZClose( fs ); { Make sure to close 'em! }
LZClose( fd );
end;
Procedure UnCompressError(Error : LongInt);
Begin
Case Error Of
LZERROR_BADINHANDLE : S:='The handle identifying the source file was not
valid';
LZERROR_BADOUTHANDLE: S:='The handle identifying the destination file was
not valid';
LZERROR_BADVALUE : S:='The input parameter was out of the allowable
range';
LZERROR_GLOBALLOC : S:='There is insufficient memory for the required
buffers';
LZERROR_GLOBLOCK : S:='The handle identifying the internal data
structures is invalid';
LZERROR_READ : S:='The source file format was not valid';
LZERROR_UNKNOWNALG : S:='The source file was compressed with an
unrecognised compression algorithm';
LZERROR_WRITE : S:='There is insufficient space for the output file'
Else
S:='Unknown problem with Uncompress'
End;
MessageDlg(S, mtConfirmation,[mbOK],0);
Close
End;
A:
function CopyFile( SrcName,DestName : string ): boolean;
{ generic file copy routine; requires
full path & name for source & destination }
var
Buf: array[1..1024*4] of byte; { this size can be adjusted.. by
declaring a pointer you can use GetMem to create a large buffer on the heap }
TotalRead: longint;
NumRead,
NumWritten: word;
TotalWritten: longint;
FromFileSize: longint;
FrF,ToF : file;
FileTime : longint;
begin
FGetTime(SrcName,FileTime);
Assign(FrF,SrcName);
Reset(FrF,1);
FromFileSize := FileSize(FrF);
Assign(ToF,DestName);
Rewrite(ToF,1);
TotalRead := 0;
TotalWritten := 0;
REPEAT
BlockRead (FrF, Buf, SizeOf(Buf), NumRead);
TotalRead := TotalRead + NumRead;
BlockWrite(ToF, Buf, NumRead, NumWritten);
TotalWritten := TotalWritten + NumWritten;
UNTIL (NumRead = 0) OR (NumWritten <> NumRead);
Close(FrF);
Close(ToF);
{ returns true if these are equal, false if not equal }
CopyFile := (TotalWritten = FromFileSize);
end;
How can I rename a directory
Question
Does anybody know how to rename a directory ?
Answer
The RenameFile function (SysUtils unit) works for directories as well as files.
Save 500 chars from array into a file
Question
I load an array of 500 chars at run time and I would like to save it to a file.
Answer
A:
The following code should get you started.
Type
TCharArray = Array[500] of Char;
Procedure WriteToFile(Var aArray : TCharArray; sFileName : String); {Note:
Declaring the array as a Var parameter causes a pointer to the array to be
passed, rather than the copying of the entire array onto the stack - you
may prefer to take the slight overhead for the safety provided by not
passing it as a Var parameter.}
Var
nArrayIndex : Word;
fFileHandle : TextFile;
Begin
AssignFile(fFileHandle, sFileName);
Rewrite(fFileHandle);
For nArrayIndex := 1 to 500 Do
Begin
Write(fFileHandle, aArray[nArrayIndex]); End;
CloseFile(fFileHandle);
End; {end Procedure, WriteToFile()}
|