Informatika gyűjtemény

Egy szinttel feljebb pt_abcode.dpr

2004050607080910

<<  2. óra  >>

<<  Alice és Bob kódja  >>

NézetNyomtat

pt_abcode.dpr (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 1 KB
{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q+,R+,S-,T-,U+,V+,W+,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}
program abcode2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const FName  = 'abcode';
      FNum   = '';
      FBe    = Fname+'.be'+FNum;
      FKi    = Fname+'.ki'+FNum;

var be, ki: textfile;

procedure init;
begin
  assignfile(be,FBe);
  assignFile(ki,Fki);
  reset(be);
  rewrite(ki);
end;

procedure final;
begin
  closefile(be);
  closefile(ki);
end;

function e(a,b:char):boolean;
begin
  e:= (a='1') or ((a='2') and (b in ['0'..'6']))
end;

function calc(st:string):longint;
var i:longint;
    c1,c2,k:longint;
    a,b:char;
begin
  c1:=1;
  c2:=1;
  for i:=1 to length(st)-1 do
    begin
      a:=st[i];
      b:=st[i+1];
      k:=0;
      if e(a,b) then k:=k+c1;
      if b<>'0' then k:=k+c2;
      c1:=c2; c2:=k;
    end;
  result:=k;
end;

procedure main;
var st:string;
    k:longint;
begin
  readln(be,st);
  if st<>'0' then
    repeat
      k:=calc(st);
      writeln(ki,k);
      readln(be,st);
    until st='0';
end;

begin
  init;
  main;
  final;
  writeln('kesz');
  readln;
end. of program
(Vissza)