Дан файл, содержащий текст. Составить в алфавитном порядке список всех слов, встречающихся в этом тексте
Категория: Delphi/Pascal
2011-08-25 22:23:16
code: #pascal
- const m=100; // Максимальное кол-во слов.
- var F:Text;
- a:array[1..m] of string;
- i:integer;
- FileName:string;
- Procedure Load(FileName:String);
- begin
- Assign(F,FileName);
- Reset(F);
- end;
- Procedure Sort1;
- var s:string;
- begin
- i:=1;
- repeat
- ReadLn(F,s);
- repeat
- a[i]:=Copy(s,1,pos(' ',s)-1);
- delete(s,1,pos(' ',s));
- inc(i);
- until pos(' ',s)=0;
- a[i]:=s;
- until EoF(F);
- end;
- Procedure Sort2;
- var n:integer;
- s,s2:string;
- z:boolean;
- begin
- repeat
- z:=false;
- for n:=1 to i-2 do
- begin
- s:=a[n];
- s2:=a[n+1];
- if ord(s[1]) > ord(s2[1]) then
- begin
- a[n]:=s2;
- a[n+1]:=s;
- z:=true;
- end else
- if (ord(s[2]) > ord(s2[2])) and (s[1]=s2[1]) then
- begin
- a[n]:=s2;
- a[n+1]:=s;
- z:=true;
- end else
- if (ord(s[3]) > ord(s2[3])) and (s[1]=s2[1]) and (s[2]=s2[2]) then
- begin
- a[n]:=s2;
- a[n+1]:=s;
- z:=true;
- end;
- end;
- until z = false;
- end;
- Procedure Vivod;
- var n:integer;
- begin
- for n:=1 to i-1 do
- writeln(a[n]);
- end;
- begin
- WriteLn('File:');
- Readln(FileName);
- Load(FileName);
- Sort1;
- Sort2;
- Vivod;
- readln;
- end.
Поделиться: