Удаление записи из файла по номеру

program baza;
uses crt;
const kolzap=2;{kol-vo zapicey dlu vvoda}
type
FIO=string[30];
 
    Link=^spisok;
    spisok=record
    name:FIO;
    God:1960..2013;
    Dol:string[20];
    Otdel:string[20];
    zarp:word;
    stag:word;
    postupil:word;
    num:word;
    Next:link;
    end;
 
   mas=array[1..100] of link;
   fill=file of spisok;
var
   h:spisok;
   name:string[30] ;
   num:word;
   P,First:Link;
   F:text;
   NamFind:FIO;{pole dly poiska}
   V:0..10;
   EndMenu :boolean;{okonchanie menu}
   x,y,k,s,d,ntek:integer;
 
 
{====chtobi sto raz ne kopirovat}
 procedure zapis;
  var st:link;
 
 begin
 clrscr;
 textcolor(yellow);
 writeln('Ќ®¬Ґа б®ваг¤*ЁЄ*:','':2,p^.num);
 writeln('”.€.Ћ. б®ваг¤*ЁЄ*:','':2,p^.name);
 writeln('ѓ®¤ ஦¤Ґ*Ёп:','':2,p^.God);
 writeln('„®«¦*®бвм:','':2,p^.dol);
 writeln('ЋЄ«*¤:','':2,p^.zarp);
 writeln('O⤥«:','':2,p^.otdel);
 writeln('‘в*¦:','':2,p^.stag);
 writeln('Џ®бвгЇ«Ґ*ЁҐ ** а*Ў®вг:','':2,p^.postupil);
 st:=p^.next
 end;
 
 
{Poisk}
 function FindName(FN:FIO):Link;{Poisk objekta vozrat ukaz fn else nil}
   var Curr:link;
    begin
    Curr:=First;
      while Curr<> nil do
       if Curr^.Name=Fn then
          begin
        FindName:=Curr;
        Exit;
          end
         else
           Curr:=Curr^.Next;
           FindName:=Nil;{v spiske net objektov}
    end;
 
 
{dobav}
 
Procedure dob(A:Link);{dobav obj pervim }
  Begin
    A^.Next:=First;{new obj v spiske}
    First:=A;
  end;
{=============Udalenie pervogo================}
 Procedure DelFirst(var A:Link);
  begin
    A:=First;
    First:=First^.Next;
  end;
 
{Udalenie posle}
 Procedure DelAfter(Old:Link;Var A:link);
   begin
     A:=OLd^.Next;
     Old^.Next:=Old^.Next^.Next;
   end;
 
{Vvesti danny}
 Procedure VVod;
   begin
 
   P:=New(Link);
   write('Ќ®¬Ґа б®ваг¤*ЁЄ*: '    );   readln(P^.Num);       writeLN(f,P^.Num,' ');
   write('‚ўҐ¤ЁвҐ ”.€.Ћ.:'       );   readln(P^.Name);      writeLN(f,P^.Name,' ');
   Write('‚ўҐ¤ЁвҐ ѓ®¤ ஦¤Ґ*Ёп:' );   readln(P^.God);       writeLN(f,P^.God,' ');
   write('‚ўҐ¤ЁвҐ „®«¦*®бвм:'    );   readln(P^.Dol);       writeLN(f,P^.Dol,' ');
   write('‚ўҐ¤ЁвҐ ЋЄ«*¤:'        );   readln(P^.zarp);      writeLN(f,P^.zarp,' ');
   write('Ћв¤Ґ«:'                );   readln(P^.Otdel);     writeLN(f,P^.Otdel,' ');
   write('‘в*¦ а*Ў®вл:'          );   readln(p^.stag);      writeLN(f,p^.stag,' ');
   write('Џ®бвгЇ«Ґ*ЁҐ ** а*Ў®вг:');   readln(P^.postupil);  writeLN(f,P^.postupil,' '); writeln;
 
   writeln(f,' ');
 
     dob(P);
     close(f);
   end;
{============poisk sotrudnika=========}
 procedure poisksotrud;
   var st:link;
     begin
      st:=First;
      writeln;
      writeln;
     textcolor(green);
writeln('‚ўҐ¤ЁвҐ ”.€.Ћ.б®ваг¤*ЁЄ*:');
readln(name);
clreol;
writeln('‚ўҐ¤ЁвҐ *®¬Ґа б®ваг¤*ЁЄ*:');
readln(num);
readln;
 
clreol;
while assigned(st) do
begin
if (name=p^.name) and (num=p^.num) then
    begin
    zapis;
    st:=p^.next;
    end
    else
    st:=p^.next;
    end;
    Textcolor(yellow);
    writeln;
    writeln('Ќ*¦¬ЁвҐ ENTER!!!');
    readln;
end;
 
 
{==========chtenie s file============}
 
procedure chtenie(ntek:integer);
var
    tek_num:word;
    tek_name:fio; i:integer;
    tek_god:word;
    tek_dol:string;
    tek_otdel:string;
    tek_zarp:word;
    tek_postupil:word;
    tek_stag:word;
begin
 
  reset(f);
 
  write('================================================================================');
   write('|Ќ®¬Ґа | ”.€.Ћ.| ѓ®¤ ஦¤Ґ*Ёп |„®«¦*®бвм |‡*аЇ«*в* |Ћв¤Ґ« |‘в*¦   | Џ®бвгЇ«Ґ*ЁҐ|');
   write('================================================================================');
 
   readln;
 
  for i:=1 to 2  do
    begin
     readln(F,P^.num);       tek_num:=p^.num;             write(tek_num:4,' ');
     readln(F,p^.name);      tek_name:=p^.name;           write(tek_name:8,' ');
     readln(F,p^.god);       tek_god:=p^.god;             write(tek_god:8,' ');
     readln(F,P^.dol);       tek_dol:=p^.dol;             write(tek_dol:16,' ');
     readln(F,P^.zarp);      tek_zarp:=p^.zarp;           write(tek_zarp:8,' ');
     readln(F,p^.otdel);     tek_otdel:=P^.otdel;         write(tek_otdel:8,' ');
     readln(F,P^.stag);      tek_stag:=p^.stag;           write(tek_stag:6,' ');
     readln(F,P^.postupil);  tek_postupil:=P^.postupil;   write(tek_postupil:14,' ');
 
    end;
     readln;
     end;
 
{===Udalenie zapisi iz file===}
 
 
 
 
procedure delete(var a:mas);
var n,m:longint;
i:byte;
mas:array[1..20] of spisok;
begin
i:=1;
assign(f,'C:\data.txt');
reset(f);
writeln('Vvedite nomer zapisi dlya udaleniya');
readln(n);
{m:=filesize(f)-n;     |}
seek (f,n);
while not eof(f) do
begin
read (f,mas[i);
i:=i+1
end;
close(f);
reset(f);
seek(f,n-1);
truncate (f);
for i:=1 to m do
write(f,mas[i];
end;
{procedure Udal;
     var st:link;n:integer;
     begin
      Assign(f,'C:\data.txt'); }
      {$I-}
  {   reset(f);
      {$I+}
   {    if IOresult=1 then      }
 
 
 
 
 
 
{Vvesti na ikran}
Procedure MyList;
 var Curr:Link;
   begin
   Curr:=First;
    while Curr<>Nil do
 begin
  clrscr;
    writeln('”.€.Ћ:',Curr^.Name,'':3);
    writeln('ѓ®¤ ஦¤Ґ*ЁҐ:',Curr^.God,'':3);
    writeln('„®«¦*®бвм:',Curr^.Dol,'':3);
    writeln('ЋЄ«*¤:',Curr^.zarp,'':3);
    writeln('Ћв¤Ґ«:',Curr^.Otdel,'':3);
    writeln('Ќ®¬Ґа б®ваг¤*ЁЄ*:',Curr^.Num,'':3);
    writeln('‘в*¦ а*Ў®вл:',Curr^.stag,'':3);
    writeln('Џ®бвгЇ«Ґ*ЁҐ ** а*Ў®вг:',Curr^.Postupil,'':3);
  Curr:=Curr^.Next;
    readln;
  end;
    write('Ќ*¦¬ЁвҐ Enter');
    Readln;
end;
 
{===========================================}
procedure ishem;
var f:text;
    num:word;
    name:fio; i:integer;
    god:word;
    dol:string;
    otdel:string;
    zarp:word;
    postupil:word;
    stag:word;
    s:string;
      begin
      clrscr;
      assign(f,'c:\data.txt');
      reset(f);
      textcolor(yellow);
      write('‚ўҐ¤ЁвҐ ”.€.Ћ. б®ваг¤*ЁЄ*:');
      readln(s);
      write('================================================================================');
           write('|Ќ®¬Ґа | ”.€.Ћ.| ѓ®¤ ஦¤Ґ*Ёп |„®«¦*®бвм |‡*аЇ«*в* |Ћв¤Ґ« |‘в*¦   | Џ®бвгЇ«Ґ*ЁҐ|');
           write('================================================================================');
         while not eof(f) do
        begin
         readln(f,num);
         readln(f,name);
         readln(f,god);
         readln(f,dol);
         readln(f,zarp);
         readln(f,otdel);
         readln(f,stag);
         readln(f,postupil);
             if pos(S,name)>0 then
               begin
 
               write(num:5 ,'');
               write(name:8,'');
               write(god:9,'');
               write(dol:18,'');
               write(zarp:8,'');
               write(otdel:10,'');
               write(stag:6,'');
               write(postupil:10,'');
               writeln;
 
               end
                else
            begin
 
              EndMenu:=false;
 
            end;
        end;
           readln;
           close(f);
 
     end;
 
 
 
{udalenie zapisi}
procedure udal;
var
 Str:array [ 0 .. 100 ] of string;
  f:text;
   i,n,k,c:byte;
   begin
   clrscr;
   assign(f,'C:\data.txt');
   reset(f);
 
   n:=0;
   while not eof(f) do begin
       readln(f,str[n]);
       inc(n);
 
   end;
   close(f);
     for i:=0 to n do begin
     writeln(Str[i]);
     end;
    write('Enter k:');
    readln(k);
         c:=0;
    for i:=0 to n do begin
    if i = k then begin
         c:=1;
    for i:= k to n - 1 do
        Str[i]:=Str[i+1];
      dec(n);
                   end;
                 end;
 
                 writeln;
                 if c = 1 then begin
                 rewrite(f);
 
                 for i:=0 to n do begin
                 writeln(f,Str[i]);
                 end;
                 close(f);
                 end else if c = 0 then
                     writeln('there is no row with such number!');
 
                 readln;
                 end;
 
 
{Osnovnaya programma  }
 
  begin
    clrscr;
    assign(f,'C:\data.txt');
 
    {$I-}
    Append(f);
       if IOResult <>0 then rewrite(f)
      else append(f);
    {$I+}
 
     first:=nil;
 
     New(p);
     EndMenu:=False;
        repeat{ochishati ekran do tex por poka endmenu<>true}
         clrscr;
         textbackground(blue);
         clrscr;
         GotoXY(10,1);
         textcolor(Green);
 
writeln('====================================================='); GotoXY(10,2);
writeln('|“Є*¦ЁвҐ ўЁ¤ а*Ў®вл                                 |'); GotoXY(10,3);
writeln('|0.ЋЄ®*з**ЁҐ а*Ў®вл, ўл室                          |'); GotoXY(10,4);
writeln('|1.‘®§¤**ЁҐ Ў*§л ¤***ле                             |'); GotoXY(10,5);
writeln('|2.“¤*«Ё*ЁҐ ЇҐаў®Ј® н«Ґ¬Ґ*в* Ё§ бЇЁбЄ*              |'); GotoXY(10,6);
writeln('|3.Џа®б¬®ва ўбҐЈ® бЇЁбЄ*                            |'); GotoXY(10,7);
writeln('|4.“¤*«Ґ*ЁҐ н«Ґ¬Ґ*в* Ё§ бЇЁбЄ* §* гЄ*§*⥫Ґ¬        |'); GotoXY(10,8);
writeln('|5.Џ®ЁбЄ б Ї*а*¬Ґва*¬Ё                              |'); GotoXY(10,9);
writeln('|6.—вҐ*ЁҐ Ё§ ”*©«*                                  |'); GotoXY(10,10);
writeln('|7.Џ®ЁбЄ §*ЇЁбЁ б д*©«*                             |'); GotoXY(10,11);
writeln('|8.“¤*«Ґ*ЁҐ §*ЇЁбЁ Ё§ ”*©«*                         |'); GotoXY(10,12);
writeln('|9.„®Ў*ў«Ґ*ЁҐ ¤***ле ў д*©«                         |'); GotoXY(10,13);
textcolor(green);
writeln('=====================================================');
readln(v);
 
   case v of
   1:Vvod;
   2:delFirst(P);
   3:MyList;
   4:begin
     write('‚ўҐ¤ЁвҐ Ё¬п  §* Є®в®а®¬ б«Ґ¤гҐв г¤*«Ёвм Ё§ бЇЁбЄ*:');
     Readln(NamFind);
     DelAfter(FindName(NamFind),P);
     end;
   5:poisksotrud;
   6:chtenie(1);
   7:ishem;
 {  8:udal; }
   9:Vvod;
     else
      endMenu:=True;
     end;
 
  until Endmenu;
  dispose(p);
 
end.

Procedure DelF(n:integer);
var Iof:integer;
    buf:// тип используемый в файле
begin
       Assign(f,'C:\data.txt');
       {$I-}
       reset(f);
       {$I+}
       if IOResult=0 then
       if n<<filesize(f) then
        begin
         seek(f,n+1);
         IOf:=n;
         while not eof(f) do
          begin
           read(f,buf);
           seek(f,iof);
           inc(iof);
           write(f,buf);
          end;
          seek(f,FilePos(f)-1);
         Truncate(f);
        end else writeln('Net takoy zapisi');
    end;
close(f);
end;