Advertisement
KrestininVladislav

Untitled

Nov 18th, 2017
67
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.74 KB | None | 0 0
  1. program FinalLaba3zad3;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8.    SysUtils;
  9.  
  10. const
  11.    CMaxNameSize = 30;
  12.    CMaxNumPart = 15;
  13.    CMinNumPart = 2;
  14.    CMinScore = 0;
  15.    CMaxScore = 1000;
  16. type
  17.    TGrade = Integer;
  18.    TRec = record
  19.       ParticipantName : string[CMaxNameSize];
  20.       Score : TGrade;
  21.    end;
  22.    TArrOfRec = array of TRec;
  23.  
  24. function GetUserAcception: Boolean;
  25. type
  26.    TCharSet =  Set of Char;
  27. var
  28.    UserChoice: Char;
  29.    UserCommandForAcception: TCharSet;
  30.    UserCommandForRejection: TCharSet;
  31. begin
  32.    repeat
  33.       Write('Enter ''Y'' / 1 for acception or ''N'' / 0 for rejection: ');
  34.       UserCommandForAcception := ['Y','y','1'];
  35.       UserCommandForRejection := ['N','n','0'];
  36.  
  37.  
  38.  
  39.       ReadLn(UserChoice);
  40.    until UserChoice in (UserCommandForAcception + UserCommandForRejection);
  41.    GetUserAcception := UserChoice in UserCommandForAcception;
  42. end;
  43.  
  44. function GetRightInputPath(): string;
  45. var
  46.    PathToFile: string;
  47.    FileIsAvailable: Boolean;
  48.    TextFile: Text;
  49. begin
  50.    Write('Enter path to input file: ');
  51.    repeat
  52.       FileIsAvailable := True;
  53.       ReadLn(PathToFile);//C:\ucheba\Лабы\Win32\Debug\laba3zad3In.txt
  54.       if not FileExists(PathToFile) then
  55.          Write('File doesnt exists or specified path is wrong.Try again: ')
  56.       else
  57.          try
  58.             Assign(TextFile, PathToFile);
  59.             Reset(TextFile);
  60.             Close(TextFile);
  61.          except
  62.             FileIsAvailable := False;
  63.             Write('File is unavailable.Unclock it for reading or choose',
  64.                'another file: ');
  65.          end;
  66.    until FileExists(PathToFile) and FileIsAvailable;
  67.    GetRightInputPath := PathToFile;
  68. end;
  69.  
  70. function GetValidNumPart(): Integer;
  71. var
  72.    NumPart: Integer;
  73.    NumPartIsCorr: Boolean;
  74. begin
  75.    NumPart := 0;
  76.    Write('Enter number of participants: ');
  77.    repeat
  78.       try
  79.          NumPartIsCorr := True;
  80.          ReadLn(NumPart);
  81.          if (NumPart > CMaxNumPart) or (NumPart < CMinNumPart) then
  82.          begin
  83.             NumPartIsCorr := False;
  84.             Write('Number of participants can be from ', CMinNumPart,' to ',
  85.                CMaxNumPart,'.Try again: ');
  86.          end;
  87.       except
  88.          NumPartIsCorr := False;
  89.          Write ('Enter integer number from ', CMinNumPart,' to ',
  90.                CMaxNumPart,'.Try again: ');
  91.       end;
  92.    until NumPartIsCorr;
  93.    GetValidNumPart := NumPart;
  94. end;
  95.  
  96. function InPutFromFile(PathToFile: string;
  97.    var DataOfFileIsCorr: Boolean): TArrOfRec;
  98. var
  99.    TextFile: Text;
  100.    List: TArrOfRec;
  101.    i, NumPart: Integer;
  102.    TempCh: Char;
  103.    DistChSet: set of Char;
  104. begin
  105.    DistChSet := [':','|'];
  106.    NumPart := GetValidNumPart();
  107.    SetLength(List, NumPart);
  108.    repeat
  109.       try
  110.          DataOfFileIsCorr := True;
  111.          Assign(TextFile, PathToFile);
  112.          Reset(TextFile);
  113.          for i := 0 to Length(List) - 1 do
  114.          begin
  115.             with List[i] do
  116.             begin
  117.                TempCh := #0;
  118.                repeat
  119.                   ParticipantName := ParticipantName + TempCh;
  120.                   Read(TextFile, TempCh);
  121.                until EOLn(TextFile) or (TempCh in DistChSet);
  122.                while Length(ParticipantName) < CMaxNameSize do
  123.                   ParticipantName := ParticipantName + ' ';
  124.                ReadLn(TextFile, Score);
  125.                if (Score < CMinScore) or (Score > CMaxScore) then
  126.                   DataOfFileIsCorr := False;
  127.             end;
  128.          end;
  129.       except
  130.          WriteLn('File data is not valid!');
  131.          DataOfFileIsCorr := False;
  132.       end;
  133.    until DataOfFileIsCorr;
  134.    Close(TextFile);
  135.    InPutFromFile := List;
  136. end;
  137.  
  138. function InPutConsole(): TArrOfRec;
  139. var
  140.    NumOfPart: Integer;
  141.    RecIsCorrect: Boolean;
  142.    List: TArrOfRec;
  143.    i: Integer;
  144. begin
  145.    i := 0;
  146.    NumOfPart := GetValidNumPart();
  147.    SetLength(List, NumOfPart);
  148.    while i < Length(List)  do
  149.       with List[i] do
  150.       begin
  151.          repeat
  152.             RecIsCorrect := True;
  153.             try
  154.                Write('Enter name of ', i + 1,' participant: ');
  155.                ReadLn(ParticipantName);
  156.                while Length(ParticipantName) < CMaxNameSize do
  157.                   ParticipantName := ParticipantName + ' ';
  158.                Write('Enter score of ', i + 1,' participant: ');
  159.                ReadLn(Score);
  160.                if (Score < CMinScore) or (Score > CMaxScore) then
  161.                begin
  162.                   RecIsCorrect := False;
  163.                   Write('Score is an integer number!Try Again.')
  164.                end
  165.                else
  166.                   Inc(i);
  167.             except
  168.                RecIsCorrect := False;
  169.                WriteLn('You have entered not valid data. Try again!');
  170.             end;
  171.          until RecIsCorrect;
  172.       end;
  173.    InPutConsole := List;
  174. end;
  175.  
  176. function GetAvailableOutputPath(): string;
  177. var
  178.    OutPutPath: string;
  179.    OutPutFile: Text;
  180.    OutPutFileIsAvailable: Boolean;
  181. begin
  182.    WriteLn('Warning!!!Choosed file will be rewriten.You may lose yor''s data.');
  183.    repeat
  184.       OutPutFileIsAvailable := True;
  185.       Write('Enter output path: ');
  186.       try
  187.          ReadLn(OutPutPath);
  188.          Assign(OutPutFile, OutputPath);
  189.          ReWrite(OutPutFile);
  190.          Close(OutPutFile);
  191.       except
  192.          OutPutFileIsAvailable := False;
  193.          Write('File is unavailable!try again.');
  194.       end;
  195.    until OutPutFileIsAvailable;
  196.    GetAvailableOutputPath := OutputPath
  197. end;
  198.  
  199. procedure OutPutFile(List: TArrOfRec; PathToOutputFile: String);
  200. var
  201.    OutPutFile: Text;
  202.    i: Integer;
  203. begin
  204.    Assign(OutPutFile, PathToOutputFile);
  205.    Rewrite(OutPutFile);
  206.    WriteLn(OutPutFile, 'Result List: ');
  207.    for i := 0 to Length(List) - 1 do
  208.       begin
  209.          with List[i] do
  210.          begin
  211.             Write(OutPutFile, ParticipantName, '  |  ');
  212.             WriteLn(OutPutFile, Score);
  213.          end;
  214.       end;
  215.    WriteLn('Result has been successfully saved!');
  216.    Close(OutPutFile);
  217. end;
  218.  
  219. procedure OutPutArrOfRec(List: TArrOfRec);
  220. var
  221.    i: Integer;
  222. begin
  223.    for i := 0 to Length(List) - 1 do
  224.       begin
  225.          with List[i] do
  226.          begin
  227.             Write(ParticipantName, '  |  ');
  228.             WriteLn(Score);
  229.          end;
  230.       end;
  231. end;
  232.  
  233. function Sort(List: TArrOfRec): TArrOfRec;
  234. const
  235.    CFirstSymbolPos = 1;
  236. var
  237.    i, j: Integer;
  238.    TempRec: TRec;
  239. begin
  240.    for i := Length(List) - 1 downto 0 do
  241.       for j:= i downto 0 do
  242.       begin
  243.          if List[j].Score < List[i].Score then
  244.          begin
  245.             TempRec := List[i];
  246.             List[i] := List[j];
  247.             List[j] := TempRec;
  248.          end;
  249.          if (List[j].Score = List[i].Score) and
  250.             (Ord(List[i].ParticipantName[CFirstSymbolPos]) <
  251.             Ord(List[j].ParticipantName[CFirstSymbolPos]))  then
  252.             begin
  253.                TempRec := List[i];
  254.                List[i] := List[j];
  255.                List[j] := TempRec;
  256.             end;
  257.       end;
  258.    Sort := List;
  259. end;
  260.  
  261. procedure main;
  262. var
  263.    List: TArrOfRec;
  264.    PathToInputFile, PathToOutputFile: string;
  265.    DataOfFileIsCorr: Boolean;
  266. begin
  267.    repeat
  268.       Write('Do you want to get list of participans from file?');
  269.       if GetUserAcception then
  270.       repeat
  271.          PathToInputFile := GetRightInputPath;
  272.          DataOfFileIsCorr := True;
  273.          List := InPutFromFile(PathToInputFile, DataOfFileIsCorr)
  274.       until DataOfFileIsCorr
  275.       else
  276.          List := InPutConsole();
  277.       List := Sort(List);
  278.       OutPutArrOfRec(List);
  279.       Write('Save results to file?');
  280.       if GetUserAcception then
  281.       begin
  282.          PathToOutputFile := GetAvailableOutputPath();
  283.          OutPutFile(List, PathToOutputFile);
  284.       end;
  285.       Write('Restart program?');
  286.    until  not GetUserAcception;
  287. end;
  288.  
  289. begin
  290.    Main;
  291. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement