Програмирование на языке высокого уровня

  Cards: TCards;

  t_fuel, t_client, kursor, n: integer;

  chislo:string;

  v,s:boolean;

Begin

FAddCards:=False;

  {Проверка на  существование файла}

  if NOT FileExists(AFilename) then begin

    assign(t,AFilename);

    Rewrite(t);

    Close (t);

    ReadKey;

  end;

  {Запрос данных  для записи}

  Assign(t,AFilename);

  Reset(t);

  While not Eof(t) do Read(t, Cards);

    seek(t,0);

    ClrScr;

    WriteLn ('Внимание  все поля обязательны к заполнению!');

    WriteLn ('Выдать карту: ');

    WriteLn;

    kursor:=0;

    n:=1;

  {Запрашиваем  и проверяем формат ввода новой  карты}

  Repeat

    Write('Введите  номер карты (6 цифр):  ');

    Readln(chislo);

    v:= FIntTrue (chislo,6);

    If v=True then begin

    while NOT EOF(t) do begin

      seek(t,kursor);

      Read(t,Cards);

      If chislo=Cards.CardNo then begin

        n:=n+1;

      end;

      inc(kursor);

    end;

    If n<>1 then begin

      Writeln('Данная карта уже имеет владельца!!! Введите другую карту');

      ReadKey;

    end

    else begin

      n:=0;

      Cards.CardNo:=chislo;

    end;

   end;

  until n=0;

  {Запрашиваем  и проверяем формат владельца  карты}

  repeat

    begin

      Write ('Введите Ф.И.О Клиента: ');

      Readln(Cards.Client);

      s:=True;

      if length(Cards.Client)=0 then s:=False;

      if pos(' ',Cards.Client)=1 then s:=False;

    end;

  until s=True;

  {Запрашиваем тип топлива}

  repeat

    Write ('Выберите тип топлива: 1-"АИ-80", 2-"АИ-92", 3-"АИ-95", 4-"ДТ" :  ');

    readln (t_fuel);

    case t_fuel of

      1: Cards.GoodType:='"АИ-80"';

      2: Cards.GoodType:='"АИ-92"';

      3: Cards.GoodType:='"АИ-95"';

      4: Cards.GoodType:='"ДТ"';

    end;

  until (t_fuel=1) Or (t_fuel=2) Or (t_fuel=3) Or (t_fuel=4);

  {Запрашиваем тип владельца карты}

  repeat

    Write ('Выберите  тип клиента: 1 - "Физ.лицо", 2 - "Юр.лицо :   ');

    ReadLn (t_client);

    case t_client of

      1: Cards.ClientType:='"Физ.лицо"';

      2: Cards.ClientType:='"Юр.лицо"';

    end;

  until (t_client=1) Or (t_client=2);

  {Запрашиваем и проверяем формат пароля карты}

  Repeat

    Write('Введите  пароль (4 цифры):  ');

    Readln(Chislo);

    v:= FIntTrue (chislo,4);

  until v=True;

  Cards.Passwd:=chislo;

  Write (t, Cards);

  Close(t);

  FAddCards:=True;

  writeln('!!! Запись  успешно добавлена в БД !!!');

  writeln;

  writeln('Нажмите  любую клавишу...');

  ReadKey;

end;

{Функция редактирования  данных с номером карты}

Function FEditClient (AFileName:string;AFTmpFile:string; PoleId:integer):boolean;

var

  FTmp, t, temp: File of TCards;

  Cards:TCards;

  b,kursor,t_fuel,t_client:integer;

  iskomoe, NewName, chislo:string;

  s,v:boolean;

begin

  FEditClient:=False;

  Assign(t,AFileName);

  Reset(t);

  Assign(FTmp,AFTmpFile);

  Reset(FTmp);

  Assign(temp,'temp.dat');

  Rewrite(temp);

  seek(FTmp,0);

  Read(FTmp,Cards);

  {Запрашиваем и проверяем формат владельца карты}

  If PoleId=0 then begin

    repeat

      begin

        Write('Введите нового клиента: ');

        ReadLn(Cards.Client);

        s:=True;

        if length(Cards.Client)=0 then s:=False;

        if pos(' ',Cards.Client)=1 then s:=False;

      end;

    until s=True;

  end;

  {Запрашиваем тип топлива}

  If PoleId=1 then begin

    repeat

      Write ('Выберите тип топлива: 1-"АИ-80", 2-"АИ-92", 3-"АИ-95", 4-"ДТ" :  ');

      readln (t_fuel);

      case t_fuel of

        1: Cards.GoodType:='"АИ-80"';

        2: Cards.GoodType:='"АИ-92"';

        3: Cards.GoodType:='"АИ-95"';

        4: Cards.GoodType:='"ДТ"';

      end;

    until (t_fuel=1) Or (t_fuel=2) Or (t_fuel=3) Or (t_fuel=4);

  end;

  {Запрашиваем  новый тип владельца карты}

  If PoleId=2 then begin

    repeat

      Write ('Выберите тип клиента: 1 - "Физ.лицо", 2 - "Юр.лицо :   ');

      ReadLn (t_client);

      case t_client of

       1: Cards.ClientType:='"Физ.лицо"';

        2: Cards.ClientType:='"Юр.лицо"';

      end;

    until (t_client=1) Or (t_client=2);

  end;

  {Запрашиваем  и проверяем формат пароля  карты}

  If PoleId=3 then begin

    Repeat

      Write('Введите пароль (4 цифры):  ');

      Readln(Chislo);

      v:= FIntTrue (chislo,4);

    until v=True;

    Cards.Passwd:=chislo;

  end;

  Write(temp,cards);

  Rewrite (FTmp);

  Write(FTmp,cards);

  {Переписываем  оставшиеся записи}

  seek(FTmp,0);

  Read(FTmp,Cards);

  iskomoe:=Cards.CardNo;

  kursor:=0;

  While NOT EOF(t) do begin

    seek(t,kursor);

    Read(t,Cards);

    If iskomoe<>Cards.CardNo then begin

      write(temp,Cards);

    end;

    inc(kursor);

  end;

  Close(t);

  Close(temp);

  Close(FTmp);

  Erase(t);

  Rename(temp,AFileName);

  FEditClient:=True;

end; 

{Функция меню редактирования}

Function FEdit (AFileName:string;AFTmpFile:string):boolean;

var

  b:integer;

  a:char;

Begin

FEdit:=False;

  {По номеру  карты находим запись для редактирования}

  SelectCardsNO(AFileName, AFTmpFile);

  {Выводим на  Экран Окно редактирования}

  Repeat

    begin

      ClrScr;

      FShowFile(AFTmpFile);

      WriteLn('<1>-Изменить владельца карты.');

      WriteLn('<2>-Изменить тип топлива.');

      WriteLn('<3>-Изменить тип владельца  карты.');

      WriteLn('<4>-Изменить пароль.');

      WriteLn('<Esc>-Выйти...');

      a:=ReadKey;

      b:=ord(a);

      Case b of

        49: FEditClient(AFileName, AFTmpFile,0);

        50: FEditClient(AFileName, AFTmpFile,1);

        51: FEditClient(AFileName, AFTmpFile,2);

        52: FEditClient(AFileName, AFTmpFile,3);

        27: Exit;

      end;

    end;

  until b=27;

end; 

{Процедура - Сортировки по имени}

Procedure FSortByClient (AFileName:string);

var

  t: File of TCards;

  Cards1,Cards2: TCards;

  kursor1,kursor2, f_size: Longint;

begin

  if NOT FileExists(AFileName) then Exit;

  Assign(t,AfileName);

  Reset(t);

  kursor1:=0;

  f_size:=FileSize(t)-1;

  while kursor1 < f_size do begin

    seek(t,kursor1);

    Read(t,Cards1);

    kursor2:=kursor1+1;

    while kursor2 <= f_size  do begin

      seek(t,kursor2);

      Read(t,Cards2);

      if Cards1.Client>Cards2.Client then begin

        seek(t,kursor1);

        write(t,Cards2);

        seek(t,kursor2);

        write(t,Cards1);

        Cards1:=Cards2;

      end;

      inc(kursor2);

    end;

    inc(kursor1);

  end;

  Close(t);

end; 

{Процедура - Сортировки  по номеру карты}

Procedure FSortByCardNo (AFileName:string);

var

  t: File of TCards;

  Cards1,Cards2: TCards;

  kursor1,kursor2, f_size: Longint;

begin

  if NOT FileExists(AFileName) then Exit;

  Assign(t,AfileName);

  Reset(t);

  kursor1:=0;

  f_size:=FileSize(t)-1;

  while kursor1 < f_size do begin

    seek(t,kursor1);

    Read(t,Cards1);

    kursor2:=kursor1+1;

    while kursor2 <= f_size  do begin

      seek(t,kursor2);

      Read(t,Cards2);

      if Cards1.CardNo>Cards2.CardNo then begin

        seek(t,kursor1);

        write(t,Cards2);

        seek(t,kursor2);

        write(t,Cards1);

        Cards1:=Cards2;

      end;

      inc(kursor2);

    end;

    inc(kursor1);

  end;

  Close(t);

end; 

{Процедура - Сортировки  по Типу топлива}

Procedure FSortByGoodType (AFileName:string);

var

  t: File of TCards;

  Cards1,Cards2: TCards;

  kursor1,kursor2, f_size: Longint;

begin

  if NOT FileExists(AFileName) then Exit;

  Assign(t,AfileName);

  Reset(t);

  kursor1:=0;

  f_size:=FileSize(t)-1;

  while kursor1 < f_size do begin

    seek(t,kursor1);

    Read(t,Cards1);

    kursor2:=kursor1+1;

    while kursor2 <= f_size  do begin

      seek(t,kursor2);

      Read(t,Cards2);

      if Cards1.GoodType>Cards2.GoodType then begin

        seek(t,kursor1);

        write(t,Cards2);

        seek(t,kursor2);

        write(t,Cards1);

        Cards1:=Cards2;