Проанализировать содержимое файла

uses Dos;
const
  TwoDigitYear=80; SuffLen=4; SuffPrice='рубл'; SuffQnt='упак';
type
  TDate = packed record
  case Integer of
    0: (d, m: Byte; y: Word);
    1: (AsLong: Longint);
  end;
  TRec = record
    name: String;
    Price, Qnt: Real;
    ExpDate: TDate;
  end;
 
function NextWord(const s: String; var b, e: Integer): Boolean;
begin
  while (b<=Length(s)) and (s[b]<=' ') do Inc(b); e:=b;
  while (e<=Length(s)) and not (s[e]<=' ') do Inc(e);
  NextWord:=b<e;
end;
 
function StrToDate(s: String; var d: TDate): Boolean;
var p, c: Integer;
begin with d do begin
  StrToDate:=False;
  p:=Pos('-',s); if not (p in [2,3]) then Exit;
  Val(Copy(s,1,p-1),d,c); if c<>0 then Exit;
  Delete(s,1,p);
  p:=Pos('-',s); if not (p in [2,3]) then Exit;
  Val(Copy(s,1,p-1),m,c); if c<>0 then Exit;
  Delete(s,1,p);
  Val(s,y,c); if c<>0 then Exit;
  if y<TwoDigitYear then Inc(y,2000) else if y<100 then Inc(y,1900);
  StrToDate:=True;
end; end;
 
function StrToReal(s: String; var r: Real): Boolean;
var p, c: Integer;
begin
  p:=Pos(',',s); if p<>0 then s[p]:='.';
  Val(s,r,c); StrToReal:=c=0;
end;
 
procedure GetToday(var d: TDate);
var dd, mm, dow: Word;
begin with d do begin
  GetDate(y,mm,dd,dow); d:=dd; m:=mm;
end; end;
 
var
  s, t, u: String;
  b, e, bb, ee, n: Integer;
  Today: TDate;
  r: TRec;
begin
  GetToday(Today);
  while not EoF do with r do begin
    ReadLn(s); b:=1; Inc(n); FillChar(r,SizeOf(r),#0);
    while NextWord(s,b,e) do begin
      t:=Copy(s,b,e-b);
      if StrToDate(t,ExpDate) then b:=e
      else begin
        bb:=e;
        if NextWord(s,bb,ee) then begin
          u:=Copy(s,bb,ee-bb); u:=Copy(u,1,SuffLen);
          if (u=SuffPrice) and StrToReal(t,Price) or 
             (u=SuffQnt) and StrToReal(t,Qnt)
          then begin
            b:=ee; Continue;
          end;
        end;
        if name<>'' then name:=name+' '; name:=name+t;
      end;
      b:=e;
    end;
    if Today.AsLong<ExpDate.AsLong then WriteLn(name,' ',price*qnt:0:2);
  end;
  WriteLn('Прочитано: ',n);
end.