Developing.ru

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

program sortnames;

 function kolslov(st: string): byte;
const
  razdel = ['.', ','];

type
  ptrNameList = ^nameList;
  nameList = record
    name:String;
    next :p trNameList;
    end;
var firstElement,element,lastElement :p trNameList;
    f,g:text;
    nameString:String;
    k, d: integer;

    slov: longint;

function firstElementGreaterThanSecond(element1,element2 :p trNameList):boolean;
  begin
  firstElementGreaterThanSecond := (element1^.name > element2^.name);
  end;

procedure switchElementsContent(element1,element2 :p trNameList);
var temp:String;
  begin
  temp := element1^.name;
  element1^.name := element2^.name;
  element2^.name := temp;
  end;

procedure printList;
var element :p trNameList;
  begin
  element := firstElement;
  while (element<>nil) do
    begin
    writeln(element^.name);
    element := element^.next;
    end;
  writeln('конец списка');
  end;


begin

firstElement := nil;
Assign (f, 'c:\1.txt');
reset (f);
while not eof(f) do
  begin
  readln(f,nameString);
  if (firstElement = nil) then
    begin
    new(element);
    firstElement := element;
    end
  else
    begin
    new(element^.next);
    element := element^.next;
    end; { end if }
  element^.name := nameString;
  element^.next := nil;
  end; { end while }
close(f);

element := firstElement;

while (element<>nil) do
  element := element^.next;
lastElement := element;

while (firstElement<>lastElement) do
  begin
  element := firstElement;
  while (element^.next<>lastElement) do
    begin
    if firstElementGreaterThanSecond(element,element^.next) then
      switchElementsContent(element,element^.next);
    element := element^.next;
    end;
  lastElement := element;
  end;

begin
  d := 0;
  repeat
    inc(d);
    if nameString[d] in razdel then
    begin
      delete(nameString, d, 1);
      insert(' ', nameString, d);
    end;
  until d > length(nameString);
  st := ' ' + nameString+ ' ';
  while pos('  ', nameString) > 0 do delete(nameString, pos('  ', nameString), 1);
  d := pos(' ', nameString);
  k := -1;
  while d > 0 do
  begin
    delete(nameString, 1, d);
    d := pos(' ', nameString);
    inc(k)
  end;
  kolslov := k
end;

begin
  write('File = '); readln(nameString);
  assign(f, nameString);
  reset(f);
  while not eof(f) do
  begin
    readln(f, nameString);
    inc(slov, kolslov(nameString));

  end;
  close(f);

  writeln('slov = ', slov);

  readln
end;
    Reset(f);
    Assign(g, 'c:\2.txt');
    Rewrite(g);
    While not eof(f) do
    Begin
     Readln(f,nameString);
           Writeln(g,nameString,k);

      end;
      close (f);
      close (G);

      end;
      begin
      end.