Программа считывает список фамилий, имен и номеров зачеток с текстового файла и по выбору пользователя(по имени, фамилии или номеру зачетки) сортирует их по алфавиту и сохраняет в новый текстовый файл. Очень надо до сегодняшнего вечера до 23:00. Помогите!!!!

Что уже готово ? Что не получается ?

FAQ : Файлы
FAQ : Записи

+ Поиск ...

Я написал то, что эта прога должна делать. А не получается мне её написать Помоги пожалуйста, а то препод меня завтра четветует.

Я написал то, что эта прога должна делать. А не получается её написать. Помоги пожалуйста, а то препод меня завтра четвертует.

а ты ее пробовал написать?
если да - выкладывай, что получилось.

Помочь и сделать полностью _за_тебя_ это разные вещи, тебе не кажется ? Я могу написать тебе программу, но разбираться в ней ты уже будешь самостоятельно, согласен ?

Конечно согласен. Разобраться я смогу. Ты сегодня её сможешь написать?

Сам пробовал. Но мало что получилось. Попробуй ты. Только сегодня если сможешь.

даже пробовать не буду, пока ты не выложишь то, что написал.

Разбирайся ...

uses crt;

const
  max_len = 100;

type

  TStudent = record
	name: String;
	book: LongInt;
  end;

  TDataBase = array [1..max_len] of TStudent;

  TFile = Text;

function ReadData(fName: String; var db: TDataBase; var dbSize: Integer): Boolean;
var
  temp: String;
  f: TFile;
  value, e: LongInt;
begin


  dbSize := 0;

  assign(f, fName);

  {$i-}
  reset(f);
  {$i+}

  if IOResult <> 0 then ReadData := false else begin

	ReadData := true;

	while not(eof(f)) do begin

	  readln(f, temp);

	  inc(dbSize);

	  with db[dbSize] do begin
		name := Copy(temp, 1, pos(' ', temp) - 1);
		Val(Copy(temp, pos(' ', temp) + 1, 255), value, e);
		if e = 0 then
		 book := value;
	  end;

	end;

	close(f);

  end;
end;

procedure SortBy(var db: TDataBase; dbSize: Integer; byName: Boolean; desc: Boolean);
var
  i, j: Integer;
  temp: TStudent;

begin

  for i := dbSize downto 2 do

   for j := 1 to i - 1 do

	case byName of

	  true: begin

		if ((db[j].name <= db[j + 1].name) = desc) then begin
		  temp := db[j];
		  db[j] := db[j + 1];
		  db[j + 1] := temp;
		end;

	  end;

	  false: begin

		if ((db[j].book <= db[j + 1].book) = desc) then begin
		  temp := db[j];
		  db[j] := db[j + 1];
		  db[j + 1] := temp;
		end;

	  end;
	end;
end;

procedure WriteToFile(fName: String; db: TDataBase; dbSize: Integer);
var
  i: Integer;
  f: TFile;
begin
  assign(f, fName);
  rewrite(f);
  for i := 1 to dbSize do
   writeln(f, db[i].name, ' ', db[i].book);
  close(f);
end;

var
  db: TDataBase;
  dbSize: Integer;
  choice: Char;

begin
  clrscr;

  if not(ReadData('c:\studentsIn.txt', db, dbSize)) then begin
	writeln('Can''t open file');
	halt(1);
  end;

  writeln('Sort By : ');
  writeln('1 - ByName');
  writeln('2 - ByBookNumber');
  write('Your choice ->');

  readln(choice);

  case choice of
   '1': SortBy(db, dbSize, true, false);
   '2': SortBy(db, dbSize, false, false);
  end;

  WriteToFile('c:\studentsOut.txt', db, dbSize);

  writeln('Done'); 

  readln;
end.

Для более точной сортировки по фамилии пользуйся поиском по форуму ...

ps Пример входного файла прикрепляю.

!

klem4, еще одно использование тега PASCОDE закончится для тебя баном на несколько дней. Я просил (в Новостях) больше этот тег НЕ использовать. Ты продолжаешь. Одно из двух, либо ты не читал Новости, либо не принимаешь всерьез мою просьбу...

Извини, не читал исправил на [code]

Прочитал, исправляю на [code = ...]

Виноват, просто не был на форуме почти 2 дня и эта тема у меня не подсвечивалась как непрочитанная почему-то (в 'Обзор нерпочитанных сообщений')...

Ты сам эту прогу проверял? Мне она выдает ошибку вида: Error 202 Stack Overflow Error. Че это ты не в курсе?

Интересно, в каком месте ? При каких входных данных ? У меня отрабатывает без ошибок.

сначала просит переделать переменную e в integer, а когда переделываю, после
var
i: Integer;
f: TFile;
ВОТ ЗДЕСЬ ПИШЕТ ЭТУ ОШИБКУ
begin
assign(f, fName);
rewrite(f);
Кстати, ты не мог прогу попроще написать? Я просто учусь на первом курсе и боюсь, что препод сильно удивится, увидив эту.

klem4, проверять программы надо и на Turbo Pascal-е иногда:

Это - потому, что в TP размер типа Integer в 2 раза меньше размера LongInt, а все-таки там VAR-параметр, то есть как минимум размер типа формального и фактического параметра должен совпадать...

Будет возникать, сомо собой... Ты же в стек запихиваешь полностью весь массив типа TDataBase, а это все-таки 26 Кб (по умолчанию стек ограничен 16384 байтами)...

Saver, я бы немного подправил вышеприведенную программу:

uses crt;

const
  max_len = 100;

type
  TStudent = record
    name: String;
    book: LongInt;
  end;

  TDataBase = array [1..max_len] of TStudent;

  TFile = Text;

function ReadData(fName: String; var db: TDataBase; var dbSize: Integer): Boolean;
var
  temp: String;
  f: TFile;
  p: byte;
  value: LongInt;
  e: integer;
begin
  dbSize := 0;
  assign(f, fName);

  {$i-}
  reset(f);
  {$i+}

  if IOResult <> 0 then ReadData := false
  else begin
    ReadData := true;
    while not(eof(f)) do begin

      readln(f, temp);
      inc(dbSize);

      p := length(temp);
      while temp[p] <> ' ' do dec(p);

      with db[dbSize] do begin

        name := copy(temp, 1, p - 1);
        Val(Copy(temp, p + 1, 255), book, e);

      end;

    end;
    close(f);

  end;
end;

procedure SortBy(var db: TDataBase; dbSize: Integer; sort_by: char);
var
  i, j: Integer;
  temp: TStudent;
  swap_it: boolean;

begin

  for i := dbSize downto 2 do

   for j := 1 to i - 1 do begin

	case sort_by of
          '1': swap_it := (db[j].name > db[j + 1].name);
          '2': swap_it := (db[j].book > db[j + 1].book);
        end;
        if swap_it then begin
	  temp := db[j];
          db[j] := db[j + 1];
          db[j + 1] := temp;
        end;
   end;

end;

{ const добавляем, чтобы избавиться от переполнения стека }
procedure WriteToFile(fName: String; const db: TDataBase; dbSize: Integer);
var
  i: Integer;
  f: TFile;
begin
  assign(f, fName);
  rewrite(f);
  for i := 1 to dbSize do
   writeln(f, db[i].name, ' ', db[i].book);
  close(f);
end;

var
  db: TDataBase;
  dbSize: Integer;
  choice: Char;

begin
  clrscr;

  if not(ReadData('s_In.txt', db, dbSize)) then begin
	writeln('Can''t open file');
	halt(1);
  end;

  writeln('Sort By : ');
  writeln('1 - ByName');
  writeln('2 - ByBookNumber');
  write('Your choice ->');

  readln(choice);
  if choice in ['1' .. '2'] then SortBy(db, dbSize, choice);

  WriteToFile('s_Out.txt', db, dbSize);
  writeln('Done');

  readln;
end.

Обрати внимание на следующие изменения:
1) добавлен Const в списке параметров процедуры WriteToFile: это сделано для того, чтобы в процедуру передавалась не копия всего массива (о чем я писал выше), а только его адрес, причем если параметр объявлен как Const, то это дает хоть какую-то защиту от случайного изменения данных, хранящихся в этом массиве... Преднамеренно его, конечно, можно изменить, но это уже другая тема...

2) я немного переделал саму процедуру сортировки... Ну, не утерпел я, не могу смириться с тем, что одни и те же действия (а именно - обмен элементов массива местами) присутствуют в коде два раза... Да и вызов процедуры сортировки немного упрощен, ты же не должен сортировать И по возрастанию И по убыванию? Тогда один параметр оказывается лишним...

3) имена файлов: когда работаешь в TP (а это еще DOS-компилятор, лучше давать файлам имена, подходящие под схему 8.3: длина имени 8 символов, и 3 - на расширение...)

4) в процедуре чтения я нахожу позицию последнего пробела. Мне кажется, это более точно подходит под условие, ведь в файле может хранится и имя, и фамилия, а они могут разделяться и пробелом тоже... В моем варианте главное, чтобы группа символов после последнего пробела представляла собой номер зачетной книжки...

Будут вопросы по программе - милости просим