Задача на текстовые файлы и Динамические структуры данных- ПОМОГИТЕ!!!

[MOTOCoder]

Код на паскале.
Пока он не сортирует по алфавиту и не читает из файла, а только извлекает идентификаторы из строки кода. Я просто привел пример чтобы показать, что полноценный лексический анализатор здесь не нужен. Так что код рабочий, просто немного не доделан.

[MOTOCoder]

Вот теперь код выполняет поставленную задачу:
[syntax='Delphi']
program Ident;

uses
crt;

const
ServSymbSet=[',',#39,'[',']','=',':',';','<','>','*','(',')','-','+',' '];
Digits=['0'..'9','.'];

var
FSrc:text;
FKeyList:text;
CurLine:string;
i:integer;
Blocks:array[1..63]of string;
ResWords:array[1..63]of string;
Idents:array[1..63]of string;
ResWdCount:integer;
cnt:integer;
IdentCount:integer;
FName:string;
ALine:string;
x,y:integer;

procedure insert(idx:integer;str:string);
var j:integer;
begin
for j:=IdentCount downto idx do
Idents[j+1]:=Idents[j];
Idents[idx]:=str;
end;

procedure delete(idx:integer);
var j:integer;
begin
for j:=idx to IdentCount do
Idents[j]:=Idents[j+1];
end;

procedure sort;

begin
for i := 1 to (IdentCount) do
for x := 1 to (IdentCount) do
if (Idents[x] < Idents) and (x > i) then
begin
Insert(i, Idents[x]);
Delete(x+ 1);
end;
end;

Procedure AddIdent(Name:string);
var
Exists:boolean;
begin
if Name='' then exit;
Exists:=false;
for i:=1 to IdentCount do
if Idents=Name then
Exists:=true;
If not Exists then
begin
Inc(IdentCount);
Idents[IdentCount]:=Name;
end;
end;

Function EmptyBlock(Block:string):Boolean;
var
B:boolean;
i:integer;
begin
B:=True;
for i:=1 to Length(Block) do
if Block<>' ' then
B:=False;
if Block='' then
B:=true;
EmptyBlock:=B;
end;

Function UpperCase(S:string):string;
var
SS:string;
i:integer;
begin
SS:='';
for i:=1 to Length(S) do
SS:=SS+UpCase(S);
UpperCase:=SS;
end;

Procedure LoadRes;
begin
Assign(FKeyList,'ResWords.txt');
Reset(FKeyList);
while not eof(FKeyList) do
begin
inc(ResWdCount);
Readln(FKeyList,ResWords[ResWdCount]);
end;
close(FKeyList);
end;

Function ParceText(txt:string):integer;
var l,c:integer;
wd:string;
begin
c:=0;
l:=length(txt);
wd:='';
for i:=1 to l+1 do
begin
if ((not (txt in ServSymbSet))and(i<>l+1)) then
wd:=wd+txt
else
begin
inc(c);
Blocks[c]:=wd;
wd:='';
end;
end;
ParceText:=c;
end;

Function RemoveStrValues(Src:string):string;
var
s:string;
i:integer;
SV:boolean;
begin
s:='';
SV:=False;
For i:=1 to Length(Src) do
begin
if Src=#39{'} then
SV:=not SV;
if (not SV)and(Src<>#39) then
s:=s+Src;
end;
RemoveStrValues:=s;
end;

Function DelNumAndRes(Src:string):string;
var
i,j:integer;
cnt:integer;
s:string;
begin
s:='';
cnt:=ParceText(Src);
for i:=1 to cnt do
if (Blocks[1] in Digits)or EmptyBlock(Blocks[i])then
Blocks[i]:='*';

for i:=1 to cnt do
for j:=1 to ResWdCount do
if UpperCase(Blocks[i])=ResWords[j] then
Blocks[i]:='*';

for i:=1 to cnt do
if (Blocks[i]<>'*')and(Blocks[i]<>' ') then
s:=s+Blocks[i]+' ';

DelNumAndRes:=s;
end;

Procedure ProcessLine(Line:string);
var
I:integer;
l:string;
C:integer;
begin
if Line='' then exit;
l:=RemoveStrValues(Line);
L:=DelNumAndRes(l);
C:=ParceText(l);
for i:=1 to C do
AddIdent(Blocks[i]);
end;

begin
writeln('Введите текст программы, по окончанию ввода введите "*"');
Assign(FSrc,'Source.pas');
Rewrite(FSrc);
repeat
Readln(ALine);
if ALine<>'*' then
Writeln(FSrc,ALine);
until ALine='*';
Close(FSrc);
Clrscr;

LoadRes;
Assign(FSrc,'Source.pas');
reset(FSrc);
while not EoF(FSrc) do
begin
Readln(FSrc,ALine);
writeln(ALine);
ProcessLine(ALine);
end;
Close(FSrc);
sort;
writeln;
writeln('Идентификаторы:');
for i:=1 to IdentCount do
writeln(Idents[i]);
readln;
end.

[/syntax]

Могут быть недоработки, но прогнал несколько примеров-все работает.
Файл ResWords.txt примерно такого содержания:

Код: Выделить всё

BEGIN
END
REPEAT
UNTIL
FOR
TO
DO
WHILE
IF
THEN
ELSE
GOTO
CASE
SET
OF
IN
PROCEDURE
FUNCTION
USES
INTERFACE
IMPLEMENTATION
UNIT
PROGRAM
VAR
CONST
TYPE
RECORD
OBJECT

Пустых строк быть не должно.

[paul11j]

MOTOCoder, Огромнийшее спасибо. Выручил. Без тебя бы не справился.
Еще раз спасибо. Удачи!!!

[Styks]

Помогите пожалуйста кто нитьс таким заданием на паскале

1)прочитать текст из файла найти в тесте первое вхождение заданного слдова и вывести его позицию (номер строки-колонки) на экран

[MOTOCoder]

Нужно читать файл посторчно считая строки, пока функция pos, примененная к текущей строке и искомой подстроке не даст результат, отличный от 0. В этом случае результатом функции pos будет номер колонки, а номер строки будет равен значению счетчика.

[Styks]

Все бы ничего, только я не знаю паскаля вообще... У нас в институте программирование только что началось полуфакультативом а уже требуют... Помог бы кто ее написать вообще..)

[MOTOCoder]

Примерно так:
[syntax='Delphi']
var
F:Text;
Col,Row:integer;
FName,S,Search:string;
Found:boolean;

begin
WriteLn('Введите имя файла');
ReadLn(FName);
WriteLn('Введите строку для поиска');
ReadLn(Search);
Assign(F,FName);
Reset(F);
Found:=False;
while (not EOF(F))and(not Found) do
begin
ReadLn(F,S);
Inc(Row);
Col:=Pos(Search,S);
if Col<>0 then
Found:=True;
end;
Close(F);
if Found then
WriteLn('Искомая строка найдена в позиции ',Col,':',Row)
else
WriteLn('Искомая строка не найдена');
ReadLn;
end.
[/syntax]

[Styks]

Огромное спасибО!!!!!!!