Delphi tutorial, A program to massage a pre-existing file. (Level 4).

HOME > > TUTORIALS TABLE OF CONTENTS - - - / - - / - - / - - / - - - Other material for programmers

Delphi tutorial: A program to massage a pre-existing file. (Level 4)

This is still in a draft form.... it is probably mostly right, but I make no promises just yet!!!

This has good information, and there's a search button at the bottom of the page.

Please don't dismiss it because it isn't full of graphics, scripts, cookies, etc!

Click here if you want to know more about the source and format of these pages.

IGNORE ANY PERIODS (.) AT THE START OF ANY LINE

Dt4b: A Little File Massaging program.

This is a level 4 tutorial not because it is very complicated, but because I want to go quickly, skim many details.

The tutorial describes the start of creating a program I wrote for converting Notepad files into crude HTML pages, the pages used in these tutorials!

The program....

Asks the user what file is to be massaged. (Called the source program from here on, and a file named Source.txt is going to be the example.)

Renames it from, e.g., Source.txt to Source.bak
(If there was already a Source.bak, the user can either delete the old Source.bak, or give a different name for Source.txt to be renamed.)

Copies Source.Bak to Source.txt, but changes any lower case 'e's to upper case 'E's. This is a simple thing, useful only as an exercise for the muscles of this program. (In the version I use, the program adds [br] before each isolated CR/LF, and two [br]s before a double cr/lf.)

So..

Broad outline:

Open old file
Rename it
Copy from it, inserting [br]s
Close output file
Close input file

Details of Open/ Rename:

Set TestFlag false
Repeat
If TestFlag=true then explain why file unsatisfactory
Get name of source file
Set TestFlag true
Until file named is more than 8 bytes long

Set NameToGiveIt to [previous].bak
Set TestFlag false
Repeat
If FileExists(NameToGiveIt)=true then
....Ask 'Delete the old file called NameToGiveIt'?
....If Yes then begin
.........delete NameToGiveIt
.........Set TestFlag true
.......else (may not delete)
.........Get new NameToGiveIt from user
...else (did not exist)
.....Set TestFlag true
Until TestFlag true
Rename as NameToGiveIt

So... that's the plan for how we do the filename shuffling.

Now... the code!....

Start a project as explained in Tutorial 1. Call it DD06.

Make the form about 300 high, 400 wide.
Put a label called lMsgs in the bottom part of the form; caption:='Welcome to file massager'; wordwrap:=true;

Add a button captioned 'Select and process file'

From the dialogs tab, put an OpenDialog component on DD06's form. Set option ofFileMustExist=true

In the unit's var declaration add...
dfin,dfout:file of byte;(*DataFiles for INput, OUTput*)
dfinName, dfoutName:string;

Use the object inspector to make DD06f1.Button1Click and fill it as follows...

procedure TDD06f1.Button1Click(Sender: TObject);
var TestFlag,DidNotCancel:boolean;
begin
TestFlag:=true;(*to suppress message on first pass*)
repeat
if TestFlag=false then
showmessage('The file you specified is too short for this program to '+
'process. Name another.');
TestFlag:=false;(*will stay false til good file spec'd*)
opendialog1.filter:= 'Text files (*.TXT)|*.txt|All files (*.*)|*.*|';
DidNotCancel:=opendialog1.execute;
AssignFile(dfin,opendialog1.FileName);
dfinName:=opendialog1.FileName;
reset(dfin);
if Filesize(dfin)>5 then TestFlag:=true;
closefile(dfin);
application.processmessages;
until (not DidNotCancel) or (TestFlag=true);
end;

...and get that much working... it should provide for finding a suitable file, even though it does nothing with it yet.

Next, we need to save and then strip off any extension the filename may have had, e.g. .txt, so to the unit's vars add...
sExtn:string

and to the ButtonClick handler's vars add ...
c1:byte

and after ...
until (not DidNotCancel) or (TestFlag=true);

... add ...
If DidNotCancel then begin
sExtn:='';(*in case no extension*)
c1:=pos('.',dfinName);
if c1>0 then begin
sExtn:=copy(dfinName,c1,1+length(dfinName)-c1);
dfinName:=copy(dfinName,1,c1-1);
lTmp.caption:=dfinName;
(*note that the '.' of, e.g., '.txt' saved in sExtn,
and that dfinName is now extensionless*)
end;
end;(*DidNotCancel*)

Now the selection of a new name for the source can begin. In a simple case, something like Source.txt simply becomes Source.bak, but we are providing for the case where Source.bak already exists.

To ButtonClick's vars add ...
...add sTmp:string t

and just before the...
end;(*DidNotCancel*)

... add ...
TestFlag:=false;
sTmp:=dfinName+'.bak';
repeat
if FileExists(sTmp) then begin
if MessageDlg('File called '+sTmp+' already exists. Delete it?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
if DeleteFile(sTmp) then TestFlag:=true
(*no ; here*)
else (*handle failed deletes*);
end(*No. ; here. This ends do a delete*)
else (*not permitted to delete old .bak, so a new name
will have to be provided, which will then be tested.*)
sTmp:= InputBox('Make Change', 'Give a different extension', '.bak');
if copy(sTmp,1,1)<>'.' then sTmp:='.'+sTmp;
if length(sTmp)>4 then sTmp:='.bak';{already known to be invalid}
sTmp:=dfinName+sTmp;
end(* no ; here. File Existed*)
else TestFlag:=true;(*File didn't exist*)
until TestFlag;
RenameFile(dfinName+sExtn,sTmp);
dfinName:=sTmp;
dfoutName:=dfinName+sExtn;
(*dfin/outNames now hold current name of source file and name
of file output to go to, with their extensions*)

That completes the renaming of the source file, probably as Source.bak.

N.B. The frequent changes of what is in dfinName, which reflect the progress of the processing, give opportunities for confusion.

Now we start on the code for reading through it, writing it out to a new file, making changes along the way.

Just before...
end;(*DidNotCancel*)

... add ...
ReadMassageWriteToNew;
lMsgs.caption:='Done!';

... and just after ...
procedure TDD06f1.Button1Click(Sender: TObject);
var TestFlag,DidNotCancel:boolean;

... add ...

procedure ReadMassageWriteToNew;
(*On entry, dfinName and dfoutName should hold the full path+name+exten
specification of the file to be read from, and the file to be written to.
The first should exist and the second shouldn't*)
var wBytesDone:word;
bTmp:byte;
begin
wBytesDone:=0;
assignfile(dfin,dfinName);
lTmp.caption:=dfoutName;
reset(dfin);
assignfile(dfout,dfoutName);
rewrite(dfout);
repeat
inc(wBytesDone);
if wBytesDone mod 32=0 then application.processmessages;
read(dfin,bTmp);
if bTmp=ord('e') then bTmp:=ord('E');
(*Change lowercase es to Es, as a simple test of prgm*)
write(dfout,bTmp);
until eof(dfin);
closefile(dfout);
closefile(dfin);
end;

Obviously, a program to change es to Es is of limited use, but it illustrates a number of points, and will, I hope, be useful as a starting point for your own needs.

N.B. the application.processmessages which appears within the Repeat..until loop. Without this, your computer can be trapped within the loop if for some reason (typo?) the 'until' condition is never met. Even if it IS met, without the processmessages, this program will take over the computer for its exclusive use until the loop finishes, which is not a good situation to create.

Click here if you're feeling kind! (Promotes my site via "Top100Borland")

Site search Web search

Site Map What's New Search

Ad from page's editor: Yes.. I do enjoy compiling these things for you... hope they are helpful. However.. this doesn't pay my bills!!! If you find this stuff useful, (and you run an MS-DOS or Windows pc) please visit my freeware and shareware page, download something, and circulate it for me? Links on your page to this page would also be appreciated!

Click here to visit editor's freeware, shareware page.

Link to Tutorials main page

Here is how you can contact this page's author, Tom Boyd.

Page WILL BE tested for compliance with INDUSTRY (not MS-only) standards, using the free, publicly accessible validator at validator.w3.org

If this page causes a script to run, why? Because of things like Google panels, and the code for the search button. Why do I mention scripts? Be sure you know all you need to about spyware.

....... P a g e . . . E n d s .....