обработка текстовых файлов

Yreng · #1 13.12.2010, 16:19

Здраствуйте. Нужна помощь
Вот условие задачи:
"Из двух типизированных файлов с компонентами записей
type
Stud = record
Year: Integer;
Name: String[20];
end;

получить текстовый файл, в котором объединены эти два файла, но повторяющихся записей быть не должно. в каждом из файлов по отдельности повторяющихся записей нет. а если вместе то могут быть.
отсортировать результирующий файл по убыванию года.
вывести на экран исходные файлы, результирующий файл."
пример:
1 файл
Alexander 1989
Masha 1983

2 файл
Misha 1932
Gera 1902
Masha 1983

результирующий файл:
Alexander 1989
Masha 1983
Misha 1932
Gera 1902

Бьюсь над этой прогой уже довольно долго, получаю всевозможные ошибки.
Через минут 5 выложу свой код, но он не правильно работает(поясню почему).
Пожалуйста если есть возможность напишите эту программу, по примеру я всё пойму.
(через 5 минут своё выложу)

BoRoV · #2 13.12.2010, 17:51

Код:

var
  f: file of Stud;
  i, j, n, k: integer;
  a1, a2: array of Stud;
  t: Stud;

begin
  AssignFile(f, 'C:\file1.dat');
  Reset(f);
  i := 0;
  while not eof(f) do
  begin
    SetLength(a1, i + 1);
    Read(f, a1[i]);
    inc(i);
  end;
  CloseFile(f);

  AssignFile(f, 'C:\file2.dat');
  Reset(f);
  n := 0;
  while not eof(f) do
  begin
    SetLength(a2, n + 1);
    Read(f, a2[n]);
    inc(n);
  end;
  CloseFile(f);

  j := i;
  dec(n);
  while n >= 0 do
  begin
    k := i - 1;
    while k >= 0 do
    begin
      if (a1[k].Name = a2[n].Name) and (a1[k].Year = a2[n].Year) then
        break;
      dec(k);
    end;
    if k = -1 then
    begin
      SetLength(a1, j + 1);
      a1[j].Year := a2[n].Year;
      a1[j].Name := a2[n].Name;
      inc(j);
    end;
    dec(n);
  end;

  // Sorting
  for i := 0 to j - 2 do
  begin
    for n := i + 1 to j - 1 do
      if (a1[i].Year > a1[n].Year) then
      begin
        t.Year := a1[i].Year;
        t.Name := a1[i].Name;

        a1[i].Year := a1[n].Year;
        a1[i].Name := a1[n].Name;

        a1[n].Year := t.Year;
        a1[n].Name := t.Name;
      end;
  end;

  AssignFile(f, 'C:\file.dat');
  Rewrite(f);
  for i := 0 to j - 1 do
  begin
    Write(f, a1[i]);
    Writeln(a1[i].Year, ' ', a1[i].Name);
  end;
  CloseFile(f);
  Writeln('Ready');
  Readln;
end.

Yreng · #3 13.12.2010, 20:32

файл 1
alexander1992
masha1992
или
alexander 1992
masha 1992
пробовал итак и так
файл 2
alexander1992
petr1982
bora1711
и с пробелами пробовал.
результат на экране :
1919902218 lexander1992
petr19
Ready
результат в файле
(*)lexander1992
petr19
bor
(заместо * там стоит странный значёк)
Явно видно, что программа работает не верно.
обрезаются имена, выводятся странные цифры и значки.

BoRoV · #4 13.12.2010, 20:38

Цитата:

Из двух типизированных файлов с компонентами записей
type
Stud = record
Year: Integer;
Name: String[20];
end;

Ну дык ты же щас приводишь просто список имен и годов, это не типизированный.

Yreng · #5 13.12.2010, 20:43

типизированный, это когда все переменные байтовые ?
что-то я не очень понял как он задаётся. в самом компиляторе создаётся?
(у нас этой темы не было на лекциях, поэтому я так фейлю, пытаюсь гуглить, но там только про байты говорят, а примера нет)

BoRoV · #6 13.12.2010, 20:47

Цитата:

Сообщение от Yreng

типизированный, это когда все переменные байтовые ?
что-то я не очень понял как он задаётся. в самом компиляторе создаётся?
(у нас этой темы не было на лекциях, поэтому я так фейлю, пытаюсь гуглить, но там только про байты говорят, а примера нет)

Код:

var
  f: file of Stud;

Yreng · #7 13.12.2010, 20:53

я не могу понять, я ошибаюсь, когда данные задаю в dat файлах или где-то в коде надо что-то поменять?
я лично думаю, что в дат файле ошибаюсь...

BoRoV · #8 13.12.2010, 21:03

Ты обещал свой код показать. На нём и будем править ошибки.

Вот так записываем первый и второй файл.

Код:

var
  f: file of Stud;
  res: char;
  t: Stud;

begin
  AssignFile(f, 'C:\file1.dat');
  Reset(f);
  Seek(f, filesize(f));
  repeat
    Write('Year : ');
    Readln(t.Year);
    Write('Name : ');
    Readln(t.Name);
    Write(f, t);
    Write('Next (y/n): ');
    readln(res);
  until (res = 'n');
  CloseFile(f);
  Writeln('Ready');
  Readln;
end.

Yreng · #9 13.12.2010, 21:30

извините за задержу, вот мой код(нерабочий)
основные проблемы:
1. при считывании из файла, последняя строка обрезается до1 буквы, а после идут крякозабры и иероглифы.
2. два файла не считывает, а считывает лишь один.
сижу над прогой несколько дней, и теперь она помоему ещё хуже стала работать.(в начале считывался из двух только 1 файл в конце с крякозабрами, а теперь вобще ничего не считывает)

Код:

program example;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  Stud = record
    Name: String[20];
    Year: Integer;
  end;
  StFile = file of Stud;

procedure OutputFile(var FileToWrite: StFile);
var
  TempRecord: Stud;

begin
  Reset(FileToWrite);
  while not EOF(FileToWrite) do
  begin
    Read(FileToWrite, TempRecord);
    with TempRecord do
      Write(Name);
    Writeln;
  end;
end;



procedure SortFile(var FileToSort: StFile);
var
  I, J: Integer;
  MaximumYear: Integer;
  TempRecord: stud;
  IndexOfMaxRecord: Integer;
  RecordNumberI: stud;
  MinRecord: stud;

begin
  for I := 0 to FileSize(FileToSort) - 2 do
  begin
    Seek(FileToSort, I);
    Read(FileToSort, RecordNumberI);
    MaximumYear := RecordNumberI.Year;
    IndexOfMaxRecord := I;

    for J := I + 1 to FileSize(FileToSort) - 1 do
    begin
      Read(FileToSort, TempRecord);
      if TempRecord.Year > MaximumYear then
      begin
        MaximumYear := TempRecord.Year;
        IndexOfMaxRecord := J;
      end;
    end;
    Seek(FileToSort, IndexOfMaxRecord);
    Read(FileToSort, MinRecord);
    Seek(FileToSort, IndexOfMaxRecord);
    Write(FileToSort, RecordNumberI);
    Seek(FileToSort, I);
    Write(FileToSort, MinRecord);
  end;
end;


procedure Input(var F, G: Stfile; out J: TextFile);
var
  Temp: Stud;
begin
  Reset(F);
  Rewrite(J);
  Reset(J);
  while not Eof(F) do
  begin
    Read(F, Temp);
    Write(J, Temp.Name);
  end;
  Reset(G);
  while not Eof(G) do
  begin
    Read(G, Temp);
    Write(J, Temp.Name);
  end;
end;

var
  F: StFile;
  A: StFile;
  J: Textfile;

begin
  Assign(F, 'C:\file1.dat');
  Reset(F);
  Assign(A, 'C:\file1.dat');
  Reset(A);

  Writeln('Исходный файл:');
  OutputFile(F);


  Writeln;
  Writeln('Исходный файл №2:');
  OutputFile(A);
  Writeln;

  Assign(J, 'result.txt');
  Rewrite(J);

   Input(F, A, J);
  SortFile(F);
  Writeln;
  Writeln('Отсортированный исходный файл:');
  OutputFile(F);

  CloseFile(F);
  CloseFile(A);
  Readln;
end.

BoRoV · #10 13.12.2010, 22:05

Ну код наверное не твой

а где-то взят на просторах интернета. Я привёл уже и код как записывать в файлы, бери и пользуйся. И у меня кажется проще чем в том "твоём" коде.

Yreng · #11 13.12.2010, 22:42

Кроме сортировки всё полностью моё, а сортировка на половину моя(переделана из сортировки массива с помощью процедуры, я ей не занимался особо, т.к. до этого баги были).
а если файлы были бы не типизированными, а текстовыми, то что это изменило было? файлы бы задавались через текстовый редактор, а не программно? тогда как раз бы и были такие глюки, как я описал(урезанная строка с иероглифами к примеру).
большое спасибо за помощь!

lmikle · #12 14.12.2010, 00:07

какую-то фигню ты написал.
у меня получилось что-то вот такое (это если по простому):

Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  TStud = record
    Name : String[20];
    Year : Integer;
  end;

var
  A : Array Of TStud;
  A1, A2 : Array Of TStud;

procedure ReadFile1(AFileName : String);
var
  F : File Of TStud;
begin
  SetLength(A1,0);
  If FileExists(AFileName) Then
    Begin
      AssignFile(F,AFileName);
      Reset(F);
      While Not EOF(F) Do
        Begin
          SetLength(A1,Length(A1)+1);
          Read(F,a1[High(A1)]);
        End;
      CloseFile(F);
    End;
end;

procedure ReadFile2(AFileName : String);
var
  F : File Of TStud;
begin
  SetLength(A2,0);
  If FileExists(AFileName) Then
    Begin
      AssignFile(F,AFileName);
      Reset(F);
      While Not EOF(F) Do
        Begin
          SetLength(A2,Length(A2)+1);
          Read(F,A2[High(A1)]);
        End;
      CloseFile(F);
    End;
end;

procedure TypeArray(AA : Array Of TStud);
var
  I : Integer;
begin
  For I := Low(AA) To High(AA) Do
    WriteLn(AA[i].Year,' ',AA[i].Name);
end;

procedure Swap(AA : Array Of TStud; I, J : Integer);
var
  T : TStud;
begin
  T := AA[i];
  AA[i] := AA[J];
  AA[J] := T;
end;

procedure SortArray(AA : Array Of TStud);
var
  I, J : Integer;
begin
  For I := Low(AA) To High(AA)-1 Do
    For J := I+1 To High(AA) Do
      If AA[i].Year = AA[J].Year
        Then
          Begin
            If AA[i].Name > AA[J].Name Then Swap(AA,I,J);
          End
        Else
          If AA[i].Year > AA[J].Year Then Swap(AA,I,J);
end;

function IsExists(T : TStud; AA : Array Of TStud) : Boolean;
var
  I : Integer;
begin
  Result := False;
  For I := Low(AA) To High(AA) Do
    If (AA[i].Year = T.Year) And (AA[i].Name = T.Name) Then
      Begin
        Result := True;
        Break;
      End;
end;

procedure ComposeIntoResult(AA : Array Of TStud);
var
  I : Integer;
begin
  For I := Low(AA) To High(AA) Do
    If Not IsExists(AA[i],A) Then
      Begin
        SetLength(A,Length(A)+1);
        A[High(A)] := AA[i];
      End;
end;

procedure WriteFile(AFileName : String; AA : Array Of TStud);
var
  I : Integer;
  F : File Of TStud;
begin
  AssignFile(F,AFileName);
  Rewrite(F);
  For I := Low(AA) To High(AA) Do
    Write(F,AA[i]);
  CloseFile(F)
end;

begin
  ReadFile1('In1.dat');
  ReadFile2('In2.dat');

  WriteLn('--- File 1 ---');
  TypeArray(A1);
  WriteLn;

  WriteLn('--- File 2 ---');
  TypeArray(A2);
  WriteLn;

  SetLength(A,0);
  ComposeIntoResult(A1);
  ComposeIntoResult(A2);
  SortArray(A);

  WriteLn('--- Result ---');
  TypeArray(A);
  WriteLn;

  Write('Press Enter to close...');
  ReadLn;
end.

BoRoV · #13 14.12.2010, 10:58

Ну это тоже не совсем красиво

Код:

procedure ReadFile1(AFileName : String);
var
  F : File Of TStud;
begin
  SetLength(A1,0);
  If FileExists(AFileName) Then
    Begin
      AssignFile(F,AFileName);
      Reset(F);
      While Not EOF(F) Do
        Begin
          SetLength(A1,Length(A1)+1);
          Read(F,a1[High(A1)]);
        End;
      CloseFile(F);
    End;
end;

procedure ReadFile2(AFileName : String);
var
  F : File Of TStud;
begin
  SetLength(A2,0);
  If FileExists(AFileName) Then
    Begin
      AssignFile(F,AFileName);
      Reset(F);
      While Not EOF(F) Do
        Begin
          SetLength(A2,Length(A2)+1);
          Read(F,A2[High(A1)]);
        End;
      CloseFile(F);
    End;
end;

Лучше это всё через одну ф-ию реализовать

Код:

procedure _ReadFile(AFileName : String; var A: Array of TStud);
var
  F : File Of TStud;
begin
  SetLength(A,0);
  If FileExists(AFileName) Then
    Begin
      AssignFile(F,AFileName);
      Reset(F);
      While Not EOF(F) Do
        Begin
          SetLength(A,Length(A)+1);
          Read(F,A[High(A)]);
        End;
      CloseFile(F);
    End;
end;

Страдалецъ · #14 14.12.2010, 13:19

Вообще-то условием задачи не запрещено использовать класс TStringList

Остается взять только читалку типизированной структуры и загнать в класс. Все стальное там уже реализовано.

Yreng · #15 14.12.2010, 15:01

теперь я понял свою ошибку(я файл в ворд паде создавал, а надо было через программу). потренировался, всё ок.
только одна проблема. я взял вашу программу и дополнил её вводом этих файлов (file1.dat и file2.dat), на экране всё работает правильно, а когда открываю file.dat , то там неразбериха, странные символы и т.д. Это как-то можно испрвить или это из-за того, что файл не txt, поэтому в него так записывается?

Код:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  Stud = record
    Year: Integer;
    Name: String[20];
  end;  
var
  f: file of Stud;
  i, j, n, k: integer;
  a1, a2: array of Stud;
  t: Stud;
  res: char;

begin
  AssignFile(f, 'C:\file1.dat');
  Reset(F);
  repeat
    Write('Name: ');
    ReadLn(t.Name);
    Write('Year: ');
    ReadLn(t.Year);
    Write('res: ');
    Write(F, T);
    ReadLn(Res);
  until (res = 'n');
  Closefile(F);

   AssignFile(f, 'C:\file2.dat');
  Reset(F);
  repeat
    Write('Name: ');
    ReadLn(t.Name);
    Write('Year: ');
    ReadLn(t.Year);
    Write('res: ');
    Write(F, T);
    ReadLn(Res);
  until (res = 'n');
  CloseFile(F);

  AssignFile(f, 'C:\file1.dat');
  Reset(f);
  i := 0;
  while not eof(f) do
  begin
    SetLength(a1, i + 1);
    Read(f, a1[i]);
    inc(i);
  end;
  CloseFile(f);

  AssignFile(f, 'C:\file2.dat');
  Reset(f);
  n := 0;
  while not eof(f) do
  begin
    SetLength(a2, n + 1);
    Read(f, a2[n]);
    inc(n);
  end;
  CloseFile(f);

  j := i;
  dec(n);
  while n >= 0 do
  begin
    k := i - 1;
    while k >= 0 do
    begin
      if (a1[k].Name = a2[n].Name) and (a1[k].Year = a2[n].Year) then
        break;
      dec(k);
    end;
    if k = -1 then
    begin
      SetLength(a1, j + 1);
      a1[j].Year := a2[n].Year;
      a1[j].Name := a2[n].Name;
      inc(j);
    end;
    dec(n);
  end;

  // Sorting
  for i := 0 to j - 2 do
  begin
    for n := i + 1 to j - 1 do
      if (a1[i].Year > a1[n].Year) then
      begin
        t.Year := a1[i].Year;
        t.Name := a1[i].Name;

        a1[i].Year := a1[n].Year;
        a1[i].Name := a1[n].Name;

        a1[n].Year := t.Year;
        a1[n].Name := t.Name;
      end;
  end;

  AssignFile(f, 'C:\file.dat');
  Rewrite(f);
  for i := 0 to j - 1 do
  begin
    Write(f, a1[i]);
    Writeln(a1[i].Year, ' ', a1[i].Name);
  end;
  CloseFile(f);
  Writeln('Ready');
  Readln;
end.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты