Pascal problem

[sirko]

Hi!

Does anybody know how to write a Pascal app that would remove blank lines from a text file.

function RemoveBlankLines(OldFile: string): string;
var fi,fo: Text;
s,NewFile: string;
n: integer;
begin

result:=EmptyStr;
if FileExists(OldFile) then
begin
//rename old file .bak,
n:=Length(OldFile);
while (n>1) and (OldFile[n]<>'.') do Dec(n);
n:=Length(OldFile)-n;
NewFile:=Copy(OldFile,1,Length(OldFile)-n)+'bak';
RenameFile(OldFile,NewFile);
s:=NewFile; NewFile:=OldFile; OldFile:=s;
//massing with file names
AssignFile(fi,OldFile);
AssignFile(fo,NewFile);
Reset(fi);
ReWrite(fo);
while not EOF(fi) do
begin
Readln(fi,s);
if Length(Trim(s))>0 then
WriteLn(fo,s) else
RemoveBlankLines('OldFile.txt');
end;
CloseFile(fo);
CloseFile(fi);

here's my try but it doesn't f*** work.

It's got to be a Pascal Console app.

I'd appreciate if somebody could show me how to solve the darn problem.

[FlamingClaw]

program without_empty_lines;
uses crt;
var f,temp:text;
    s,fname,tempname:string;

(*text file maker procedure*)
procedure create(var x:text; xname:string);
begin
     assign(x,xname);
     rewrite(x);
     close(x);
end;
(*write in some line the main text file*)
procedure write_in(var x:text; xname:string);
var tempstring:string;
    e:char;
begin
    e:='*';
    assign(x,xname);
    append(x);
    tempstring:='';
    writeln('Press ''*'' to quit.');
    while tempstring <> e do begin
          write('The words: ');
          readln(tempstring);
          if tempstring = e then break;
          writeln(x,tempstring);
          writeln('Press ''*'' to quit.');
    end;
    close(x);
end;

(*read and copy not empty lines*)
procedure read_and_copy(var x,y:text; xname,yname:string);
var s1:string;
begin
     assign(x,xname);
     create(y,yname);
     append(y);
     reset(x);
     while not eof(x) do begin
           readln(x,s1);
           if (length(s1)=0) then continue
           else writeln(y,s1);
     end;
     close(x);
     close(y);
end;





begin (*main*)
  clrscr;
  fname:='old.txt';
  tempname:='new.txt';
  create(f,fname);
  write_in(f,fname);
  read_and_copy(f,temp,fname,tempname);
  erase(f); (*delete old file*)
  rename(temp,fname); (*and rename new file to old*)
  readln;
end.
(*created by FlamingClaw.2010.03.14.Hungary*)

[sirko]

program without_empty_lines;
uses crt;
var f,temp:text;
    s,fname,tempname:string;

(*text file maker procedure*)
procedure create(var x:text; xname:string);
begin
     assign(x,xname);
     rewrite(x);
     close(x);
end;
(*write in some line the main text file*)
procedure write_in(var x:text; xname:string);
var tempstring:string;
    e:char;
begin
    e:='*';
    assign(x,xname);
    append(x);
    tempstring:='';
    writeln('Press ''*'' to quit.');
    while tempstring <> e do begin
          write('The words: ');
          readln(tempstring);
          if tempstring = e then break;
          writeln(x,tempstring);
          writeln('Press ''*'' to quit.');
    end;
    close(x);
end;

(*read and copy not empty lines*)
procedure read_and_copy(var x,y:text; xname,yname:string);
var s1:string;
begin
     assign(x,xname);
     create(y,yname);
     append(y);
     reset(x);
     while not eof(x) do begin
           readln(x,s1);
           if (length(s1)=0) then continue
           else writeln(y,s1);
     end;
     close(x);
     close(y);
end;





begin (*main*)
  clrscr;
  fname:='old.txt';
  tempname:='new.txt';
  create(f,fname);
  write_in(f,fname);
  read_and_copy(f,temp,fname,tempname);
  erase(f); (*delete old file*)
  rename(temp,fname); (*and rename new file to old*)
  readln;
end.
(*created by FlamingClaw.2010.03.14.Hungary*)

Wait a second. What am I supposed to do to make this program work? I created text file 'new' and 'old' I wrote something in there but after I ran the program the console window poped up and offers me to write symbols. OK and afer I press * it quits and nothing happens. So... how do I use the program?

[FlamingClaw]

So... how do I use the program?

when the main program begins
we clear the screen,
set fname and tempname
create old file (this is the main)
write_in = you can write some lines to this file
when you press the '*' char then the procedure
closes the old.txt file
and then comes the read_and_copy
open it for reading( the old.txt file)
and if it is contains empty line then do nothing
just continue the reading else ,if the line isn't
empty then write in the temp file named new.txt
when all of not empty lines are copied then
we delete the main file (old.txt)
and rename the new.txt to old.txt

and last if you look at the old.txt file in the
bin directory then you will see that it isn't
contains empty lines...
if you want to read this file contents under pascal then
write a procedure that read a file back

procedure read_in_back(var f:text; name:string);
var li:string;
begin
     assign(f,name);
     reset(f);
     while not eof(f) do begin
           readln(f,li);
           writeln(li);
     end;
     close(f);
     readln;
end;

(*to call this procedure
read_in_back(f,'old.txt');
*)

ok,now let's see the main program again.

program without_empty_lines_2;
uses crt;
var f,temp:text;
    s,fname,tempname:string;

(*text file maker procedure*)
procedure create(var x:text; xname:string);
begin
     assign(x,xname);
     rewrite(x);
     close(x);
end;
(*write in some line the main text file*)
procedure write_in(var x:text; xname:string);
var tempstring:string;
    e:char;
begin
    e:='*';
    assign(x,xname);
    append(x);
    tempstring:='';
    writeln('Press ''*'' to quit.');
    while tempstring <> e do begin
          write('The words: ');
          readln(tempstring);
          if tempstring = e then break;
          writeln(x,tempstring);
          writeln('Press ''*'' to quit.');
    end;
    close(x);
end;

(*read and copy not empty lines*)
procedure read_and_copy(var x,y:text; xname,yname:string);
var s1:string;
begin
     assign(x,xname);
     create(y,yname);
     append(y);
     reset(x);
     while not eof(x) do begin
           readln(x,s1);
           if (length(s1)=0) then continue
           else writeln(y,s1);
     end;
     close(x);
     close(y);
end;


(*reads back all of contents of a text file*)
procedure read_in_back(var f:text; name:string);
var li:string;
begin
     assign(f,name);
     reset(f);
     
     writeln('the contents of the file are: ');
     while not eof(f) do begin
           readln(f,li);
           writeln(li);
     end;
     close(f);
     readln;
end;



begin (*main*)
  clrscr;
  fname:='old.txt';
  tempname:='new.txt';
  create(f,fname);
  write_in(f,fname);
  read_and_copy(f,temp,fname,tempname);
  erase(f); (*delete old file*)
  rename(temp,fname); (*and rename new file to old*)
  read_in_back(f,fname);
  readln;
end.
(*created by FlamingClaw.2010.03.17.Hungary*)