DataMuseum.dk

top - download

    Length: 3712 (0xe80)
    Types: TextFile
    Names: »LIX«

└─⟦2a24d2e1b⟧ Bits:30003042 Programmer fra Aarhus kursus
    └─ ⟦this⟧ »LIX« 

TextFile

type streng = string(.80.);
var
  zliste: array (.1..100.) of streng;
  zantal,zl,zp: integer;
  zfil: text;

  procedure fyldop;
  var
    s,fil: streng; ok: boolean;
  begin
    repeat
      ok:=true;
      write('Filnavn (retur for tastatur): '); readln(fil);
      if fil='' then
      begin
        writeln('Skriv højst 100 linier (max. 80 tegn) adskilt af linieskift');
        writeln('Afslut med tom linie:');
        zantal:=0; readln(s);
        while (zantal<100) and (len(s)>0) do
        begin
          zantal:=zantal+1;
          zliste(.zantal.):=s;
          readln(s);
        end;
      end
      else
      begin
        s:=fil+'.pas';
        (*$I-*) assign(zfil,s); reset(zfil); (*$I+*)
        ok:=iores=0;
        if not ok then
        begin
          s:=fil+'.txt';
          (*$I-*) assign(zfil,s); reset(zfil); (*$I+*)
          ok:=iores=0;
        end;
        if not ok then
        begin
          s:=fil;
          (*$I-*) assign(zfil,s); reset(zfil); (*$I+*)
          ok:=iores=0;
        end;
        if not ok then
        begin
          writeln('Filen: ',fil,' findes ikke på disketten');
          zantal:=0;
        end;
        if ok then
        begin
          (* indlæs fil *)
          zantal:=0;
          while (zantal<100) and (not eof(zfil)) do
          begin
            readln(zfil,s);if s='' then s:=' ';
            zantal:=zantal+1;
            zliste(.zantal.):=s;
          end;
        end;
      end;
    until ok;
    zl:=1; zp:=1;
  end;

  function tom: boolean;
  begin
    if zl>zantal then
      tom:=true
    else
      tom:=false;
  end;

  function linieskift: boolean;
  begin
    if (zp=1) and (zl<>1) then
      linieskift:=true
    else
      linieskift:=false;
  end;

  procedure naeste(var blok: streng);
  var
    stop,alfanum: boolean;
    s: streng; ch: char;
  begin
    blok:='';
    if zl>zantal then
      writeln('Naeste kaldt på tom side')
    else
    begin
      s:=zliste(.zl.);
      stop:=false; alfanum:=s(.zp.) in (.'0'..'9','A'..'Å','a'..'å'.);
      while (zp<=len(s)) and not stop do
      begin
        ch:=s(.zp.);
        if alfanum then
        begin
          if ch in (.'0'..'9','A'..'Å','a'..'å'.) then
            blok:=blok+s(.zp.)
          else
            stop:=true;
        end
        else
        begin
          if not (ch in (.'0'..'9','A'..'Å','a'..'å'.)) then
            blok:=blok+s(.zp.)
          else
            stop:=true;
        end;
        if not stop then
          zp:=zp+1;
      end;
      if zp>len(s) then
      begin
        zl:=zl+1; zp:=1;
      end;
    end;
  end; (* naeste *)

  function allecifre(s: streng): boolean;
  var i: integer; ok: boolean;
  begin
    ok:=true;
    i:=1;
    while i<=len(s) do
    begin
      if not (  ('0'<=s(.i.)) and (s(.i.)<='9') ) then
        ok:=false;
      i:=i+1;
    end;
    allecifre:=ok;
  end;

  function alfanum(s: streng): boolean;
  var
    i: integer; ok: boolean;
  begin
    ok:=true;
    i:=1;
    while i<=len(s) do
    begin
      if not (s(.i.) in (.'A'..'Å','a'..'å','0'..'9'.)) then
        ok:=false;
      i:=i+1;
    end;
    alfanum:=ok;
  end;

  function forekommer(skabelon,tekst: streng): boolean;
  var
    i: integer; ok: boolean;
  begin
    ok:=false;
    i:=1;
    while i<=len(skabelon) do
    begin
      if pos(skabelon(.i.),tekst)<>0 then
        ok:=true;
      i:=i+1;
    end;
    forekommer:=ok;
  end;
(*$U+ enable user interrupt *)
«eof»