1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
|
type liste=^chaine;
chaine=record
suivant:liste;
caracter:char
end;
function long(l:liste):integer;
var l1:liste;
conteur:integer;
begin
l1:=l;
conteur:=0;
while l1<>nil do
begin
inc(conteur);
l1:=l1^.suivant
end;
long:=conteur
end;
procedure ajoute(var l:liste;valeur:char);
var l1,vale:liste;
l0:integer;
begin
new(vale);
vale^.caracter:=valeur;
vale^.suivant:=nil;
if l=nil then
l:=vale
else
begin
while l1^.suivant<>nil do
l1:=l1^.suivant;
l1^.suivant:=vale
end
end;
procedure ajouter(var list:liste; valeur:char);
var
p:liste;
begin
new(p);
p^.caracter:=valeur;
p^.suivant := list;
list:= p;
end;
procedure inverse(var l:liste);
var
l1,tete,p:liste;
begin
l1:=l;
tete:=nil;
while l1<>nil do
begin
new(p);
p^.caracter:=l1^.caracter;
l1:=l1^.suivant;
p^.suivant:=tete;
tete:=p
end;
l:=tete
end;
procedure conversion(chain:string;var l:liste);
var
i:integer;
begin
for i:=1 to length(chain)do
ajouter(l,chain[i]);
inverse(l)
end;
procedure imprime(l:liste);
var
l1:liste;
begin
l1:=l;
while l1<>nil do
begin
write(l1^.caracter);
l1:=l1^.suivant
end
end;
function rechercheligne(var t:text;ligne:integer):boolean;
var num:integer;
chemin:string;
trouver:boolean;
begin
write('Veuillez entrer le chemin d''accès au fichier: ');
readln(chemin);
{$i-}
assign(t,chemin);
{$i+}
while ioresult<>0 do
begin
writeln('Erreur chemin d''accès ou fichier inexistant; Veuillez recommencer');
write('Veuillez entrer le chemin d''accès au fichier : ');
readln(chemin);
{$i-}
assign(t,chemin);
{$i+}
end;
reset(t);
trouver:=false;
num:=1;
while not(eof(t)) and (num<>ligne) do
begin
readln(t);
inc(num)
end;
if num=ligne then
trouver:=true;
rechercheligne:=trouver;
end;
procedure lire_ligne(var t:text;ligne:integer;var v:liste);
var valigne:string;
begin
if rechercheligne(t,ligne)=true then
begin
while not(eoln(t))do
read(t,valigne);
conversion(valigne,v);
end
else
writeln('Le fichier ne contient pas cette ligne.')
end;
var valeur:liste;
t:text;
ligne:integer;
ligneliste:liste;
begin
write('Quelle ligne voulez-vous lire : ');
readln(ligne);
lire_ligne(t,ligne,valeur);
imprime(valeur);
writeln(long(valeur))
end. |
Partager