Αντιγραφή χωρίς διπλά κενά (Pascal)

{                              Visit:   http://g-lts.no-ip.info/  for more code!              }
program antigrafi;

type fchar = file of char;

// diadikasi pou diabazi to arxio ke to ektiponi.

procedure readfile ( var f:fchar);
begin

    reset(f);

    while not eof(f) do
    begin
        write (f^);
        get(f);
    end;

end;

// telos diadikasias read file
// =======================================================
// Diadikasia copy file

procedure copyfile  (var f:fchar; var g:fchar);

var b:boolean;
begin
    reset(f);
    rewrite(g);
    b := true;

    // gia ta prota spaces osa briski de ta metaferi...
    while ( (not eof(f)) and (f^=' ') ) do
        get(f);

    // ke otan bri kati allo pera apo ta prota spaces genika gia oti periexi..

    while not eof(f) do
    begin
        if (f^=' ') then
        begin
            if b=false then
            begin
                g^:=f^;
                put(g);
                b:=true;
            end;
            get(f);
        end
        else
        begin
            g^:=f^;
            put(g);
            b:=false;
            get(f);
        end;
    end;
end;

// Telos diadikasias copy file
// =======================================================
// Kirio programm..

var f,g:fchar; epilogi:integer;

begin
    assign (f,'fim.txt');
    assign (g,'font.txt');

    readfile(f); // gia na doume to fim ( me ta epipleon kena (spaces)
    writeln(''); // gia logous kalopismou :P
    copyfile(f,g);
    writeln ('Αντιγραφή αρχείων........................[OK].');
    writeln ('Θέλετε να δείτε το αντιγραμμένο αρχείο;');
    writeln ('1 = Ναι.');
    writeln ('2 = Όχι, Έξοδος.');
    read (epilogi);
    if epilogi=1 then
        readfile(g)
    else
        writeln ('Άντε γεια. :)');

end.
{                              Visit:   http://g-lts.no-ip.info/  for more code!              }