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()}