Тема: Файлы
Показать сообщение отдельно
Старый 27.05.2012, 17:53   #8 (permalink)
Oksana777
Member
 
Регистрация: 08.05.2012
Сообщений: 16
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

uses
SysUtils,
windows; const N=2;
type
TExam =
record
name_ex : string[18];
ball : integer;
end;
TArray = array[1..10,1..N] of TExam;
TRecord =
record
fio : string[40];
num_k : integer;
num_g : integer;
forma : integer;
uspeh : TArray;

end;
TFile = file of TRecord;
var com:integer; Student:Tfile; Res:TextFile; exit:boolean; im:string;
//функция формирования записи
function FormRecord:TRecord;//создание записи
var i,j:integer;
begin
with Result do begin readln;
write('фио '); readln(fio);
write('курс '); readln(num_k);
write('группа '); readln(num_g);
write('форма обучения(0-целевая,1-договор)'); readln(forma);
for i:=1 to (num_k)*2 do begin
Writeln('сессия',i);
for j:=1 to N do begin
write('экзамен: ');{readln;} readln(uspeh[i,j].name_ex);
write('оценка: '); readln(uspeh[i,j].ball);
end;
end;
end;
end;
//формирование файла
Procedure FormFile( var St:Tfile);
var x:TRecord; flag:integer; s:string;
begin
Write('Введите имя создаваемого файла');readln; read(s);
AssignFile(St,s); rewrite(St); flag:=1;

while flag=1 do begin
x:=FormRecord; {readln;} //обращение к процедуре создания записи
write(St,x);
Writeln('Хотите ввести еще запись(1-да, 2 нет)');read(flag)
end;
CloseFile(St);
end;
//здесь должна быть процедура условия задачки!
// печать файла на экран
procedure PrintFile(var f:Tfile;var name:string);
var x:Trecord;i,j:integer;
begin
readln;
Writeln('введите имя файла'); readln(name);
while not FileExists(name) do begin
Writeln(' такого файла нет в данной папке введите новое имя файла');
readln(name);
end;
AssignFile(f,name);
reset(f);
while not eof(f) do begin
read(f,x);
with x do begin
Writeln('фио: ',fio);
Writeln('курс: ',num_k);
Writeln('группа: ',num_g);
Writeln('форма обучения(0-целевая,1-договор): ',forma);
for i:=1 to (num_k)*2 do begin
Writeln('сессия',i);
for j:=1 to N do begin
writeln('экзамен: ',uspeh[i,j].name_ex);
writeln('оценка: ',uspeh[i,j].ball);
end;
end; writeln;
end;
end; writeln; CloseFile(f);
end;
//конвертирование текстового файла в типизированный
Procedure ConvertTXTtoRec(var t:TextFile;var f:Tfile);
var x:TRecord; i,j:integer; name:string;
begin
readln;
Writeln('Имя исходного файла(типизированного) '); read(name);
while not FileExists(name) do begin
Writeln(' Такого файла нет в данной папке введите новое имя файла');
readln(name);
end;
AssignFile(t,name+'.txt'); reset(t); readln;
Writeln('Введи имя конечного файла '); readln(name);
AssignFile(f,name); rewrite(f);
while not eof(t) do begin
with x do begin
readln(t,fio);
readln(t,num_k);
readln(t,num_g);
readln(t,forma);
for i:=1 to (num_k)*2 do
for j:=1 to N do begin
readln(t,name);
uspeh[i,j].name_ex:=name;
readln(t,name);
uspeh[i,j].ball:=StrToInt(name);
end;
end; readln(t);
write(f,x)
end;
CloseFile(t); CloseFile(f);
Writeln('Файл создан')
end;
//Процедура конвертирования типизированного файла в текстовый
Procedure ConverttoTxt(var t:TextFile; var f:Tfile);
var x:Trecord; name,s:string;i,j:integer;
begin
readln;
writeln('Имя исходного файла(типизированного) '); readln(name);
AssignFile(f,name); reset(f);
writeln('Имя результурующего файла(текст)'); readln(name);

AssignFile(t, name+'.txt');rewrite(t);
while not eof(f) do begin
read(f,x);
with x do begin
s:=fio;
writeln(t,s);
s:=InttoStr(num_k);
writeln(t,s);
s:=InttoStr(num_g);
writeln(t,s);
s:=InttoStr(forma);
writeln(t,s);
for i:=1 to (num_k)*2 do
for j:=1 to N do begin
s:=uspeh[i,j].name_ex;
writeln(t,s);
s:=InttoStr(uspeh[i,j].ball);
writeln(t,s);end;

end;
writeln(t,'********');
end; Writeln('Конвертирование завершено'); CloseFile(t); CloseFile(f); end;
// Удаление файла
Procedure Delete(var t:Tfile);
var name:string;
begin
readln;
Writeln('Какой файл удалить? Введите имя '); read(name);
while not FileExists(name) do begin
Writeln(' Такого файла нет в данной папке введите новое имя файла');
readln(name);
end;
AssignFile(t,name); erase(t);
Writeln('Файл ',name,' успешно удален');
end;
//Вставка записи в файл
Procedure Paste(var t:Tfile; name:string);
var x:Trecord; flag:integer;
begin
Assignfile(t,name);
reset(t); flag:=1;
while not eof(t) do read(t,x);
while flag=1 do begin
x:=FormRecord; readln; //обращение к процедуре создания записи
write(t,x);
Writeln('Хотите ввести еще запись(1-да, 2 нет)');read(flag)
end;
CloseFile(t);
Writeln('Записи добавлены ')
end;
//Процедура удаления записи
procedure Delzap (var f : TFile; name : string);
var r : TRecord; i, n: integer; fnew : TFile;
begin
assign(f, name); assign(fnew, name+'2');
reset(f); rewrite(fnew);
write('Какую по счету запись удалить?'); readln(n);
i:=1;
while (i<=n-1) and not eof(f) do begin
read(f, r);
write(fnew, r);
inc(i);
end;
If eof(f) then begin
writeln('Файл слишком короткий');
close(f); close(fnew); erase(fnew);
end
else begin
read(f, r);
while not eof(f) do begin
read(f, r);
write(fnew, r);
end;
close(f); erase(f); close(fnew);
writeln('Запись успешно удалена из файла', name);
Rename(fnew, name);
end;
end;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251); exit:=false;
while exit=false do begin

Writeln('Введите команду или 0 для вывода меню'); read(com);
while (com<0)or(com>6)do begin
Writeln('Ошибка. Введите другую команду '); read(com);
end;
if com=0 then begin
writeln('1-создать файл');
writeln('2-открыть файл');

writeln('3-конвертировать файл');
writeln('4-Удалить файл');
writeln('5-применить условие к файлу');
writeln('6-выход');
read(com);
while (com<0)or(com>6)do begin
Writeln('Ощибка. Введите другую команду '); read(com);
end; end;
case com of
1: FormFile(Student); // 1-создать файл
2: begin
PrintFile(Student,im); // 2-открыть файл
readln;
Writeln('1-добавить запись в конец файла ');
Writeln('2-удалить указанную запись ');
Writeln('0-не выполнять никаких действий и перейти в вводу основных команд ');
read(com);
if com=1 then Paste(Student,im);
if com=2 then DelZap(Student,im);
end;
3: begin //3-конвертировать файл
Writeln('1-из Txt,2-в Txt'); read(com);
while (com<>1) and (com<>2) do begin
Writeln('Ошибка. Введите другую команду '); read(com);
end;
if com=1 then ConvertTXTtoRec(Res,Student);
if com=2 then ConverttoTxt(Res,Student);
end;
4: Delete(Student);// удалить файл
5: Uslovie; // применить условие к файлу
6: exit:=true; //выход из программы
end;

end;
end.
Oksana777 вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070