program StringheDaFilePalindrome;
const
LunghezzaMax = 500;
type
TipoIndice = 1..LunghezzaMax;
TipoArrayStringa = packed array [TipoIndice] of char;
TipoStringa = record
caratteri : TipoArrayStringa;
lunghezza : 0..LunghezzaMax
end;
procedure LeggiStringa (var stringa: TipoStringa);
var
ch : char;
continua : boolean;
nome : string;
f : text;
function Maiuscola (c: char): char;
begin
if ('a' <= c) and (c <= 'z') then
Maiuscola := chr(ord(c) - ord('a') + ord('A'))
else
Maiuscola := c
end;
function AlfaNumerico (c: char): boolean;
begin
AlfaNumerico := (('A' <= c) and (c <= 'Z')) or
(('a' <= c) and (c <= 'z')) or
(('0' <= c) and (c <= '9'))
end;
begin
writeln('Nome del file contenente la stringa? ');
readln(nome);
Assign(f, nome);
Reset(f);
continua := TRUE;
with stringa do
begin
lunghezza := 0;
while (not eof(f)) and continua do
begin
read(f, ch);
if AlfaNumerico(ch) then
if lunghezza < LunghezzaMax then
begin
lunghezza := lunghezza + 1;
caratteri[lunghezza] := Maiuscola(ch);
end
else
begin
continua := FALSE;
writeln ('File troppo lungo!')
end
end
end;
Close(f)
end;
function Palindroma (stringa: TipoStringa): boolean;
var
i : TipoIndice;
begin
Palindroma := TRUE;
for i := 1 to trunc(stringa.lunghezza/2) do
if stringa.caratteri[i] <> stringa.caratteri[stringa.lunghezza-i+1] then
Palindroma := FALSE
end;
var
s : TipoStringa;
begin
LeggiStringa(s);
write('La stringa letta contiene ', s.lunghezza,
' caratteri alfanumerici ');
if Palindroma(s) then
writeln('ed e'' palindroma')
else
writeln('e non e'' palindroma');
end.