Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit StartUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, EditUnit, Vcl.Themes, Vcl.Styles,
- Vcl.Samples.Spin, ShowUnit;
- type
- TStartForm = class(TForm)
- ShowModeButton: TButton;
- EditModeButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- DeveloperMenu: TMenuItem;
- CostSpinEdit: TSpinEdit;
- ModeLabel: TLabel;
- ColorLabel: TLabel;
- LightRButton: TRadioButton;
- DarkRButton: TRadioButton;
- CostLabel: TLabel;
- procedure DeveloperMenuClick(Sender: TObject);
- procedure EditModeButtonClick(Sender: TObject);
- procedure ShowModeButtonClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure LightRButtonClick(Sender: TObject);
- procedure DarkRButtonClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure InstructionMenuClick(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- StartForm: TStartForm;
- ServiceCost: integer;
- implementation
- {$R *.dfm}
- uses
- WriteUnit;
- const
- LIGHT_SKIN = 'Smokey Quartz Kamri';
- DARK_SKIN = 'Charcoal Dark Slate';
- procedure TStartForm.DeveloperMenuClick(Sender: TObject);
- begin
- MessageDlg('Student: Ravodin Alexander Dmitrievich.' + #13#10 + 'Group: 151002.'
- + #13#10 + #13#10 + 'Contacts:' + #13#10 + 'VKontakte: ' +
- 'https://vk.com/ushouldbelieveme' + #13#10 +'E-mail: ' +
- 'telephonedatabasedev@gmail.com', MtInformation, [mbOk], 0);
- end;
- procedure TStartForm.InstructionMenuClick(Sender: TObject);
- begin
- MessageDlg('This is the start window. It includes next functions:' + #13#10 +
- '1. Сhoosing a work mod;' + #13#10 + '2. Choosing a color mod;' +
- #13#10 + '3. Provider cost setting.' + #13#10 + #13#10 + 'First' +
- ' option includes two modes:' + #13#10 + '- Show mode: allows' +
- 'you just to see subscribers using searching and sorting tools.'
- + #13#10 + '- Edit mode: includes 3 more functions:' + #13#10 +
- 'a) Adding subscribers;' + #13#10 + 'b) Editing current ' +
- 'subscriber''s data;' + #13#10 + 'c) Deleting subscribers;' +
- #13#10 + #13#10 + 'Color mode allow you to switch between ligth' +
- ' and dark themes.' + #13#10 + #13#10 + 'Setting a provider cost' +
- ' will determine the way of payment calсulation:' + #13#10 +
- 'You enter 30-days provider cost in dollars and new payments' +
- ' will be counted according to in.' + #13#10 + 'Press "ctrl + i"'
- + ' to open instruction;' + #13#10 + 'Press "esc" to exit program.',
- MtInformation, [mbOk], 0);
- end;
- procedure TStartForm.EditModeButtonClick(Sender: TObject);
- begin
- EditForm.show();
- StartForm.Enabled := false;
- ServiceCost := CostSpinEdit.value;
- end;
- procedure TStartForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- removeDeleters;
- end;
- procedure TStartForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := false;
- if MessageDlg('Are you sure if you want to exit?', mtConfirmation, mbYESNO, 0) = mrYES then
- begin
- CanClose := true;
- end;
- end;
- procedure TStartForm.FormCreate(Sender: TObject);
- begin
- TStyleManager.TrySetStyle(LIGHT_SKIN);
- LightRButton.Checked := true;
- end;
- procedure TStartForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- StartForm.Close()
- end;
- procedure TStartForm.LightRButtonClick(Sender: TObject);
- begin
- TStyleManager.TrySetStyle(LIGHT_SKIN);
- end;
- procedure TStartForm.DarkRButtonClick(Sender: TObject);
- begin
- TStyleManager.TrySetStyle(DARK_SKIN);
- end;
- procedure TStartForm.ShowModeButtonClick(Sender: TObject);
- begin;
- ServiceCost := CostSpinEdit.value;
- StartForm.Enabled := false;
- ShowForm.show();
- end;
- end.
- unit EditUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.Menus, Vcl.StdCtrls, ListUnit,
- System.Actions, Vcl.ActnList, System.UITypes;
- type
- TEditForm = class(TForm)
- SubscribersStringGrid: TStringGrid;
- TelephoneEdit: TEdit;
- MainMenu: TMainMenu;
- AddButton: TButton;
- EditButton: TButton;
- DeleteButton: TButton;
- InstructionMenu: TMenuItem;
- TelephoneRButton: TRadioButton;
- SortLabel: TLabel;
- NameRButton: TRadioButton;
- SurnameRButton: TRadioButton;
- PatronymicRButton: TRadioButton;
- CityRButton: TRadioButton;
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- ShowButton: TButton;
- PatronymicLabel: TLabel;
- CityLabel: TLabel;
- TelephoneLabel: TLabel;
- TaskLabel: TLabel;
- ClearButton: TButton;
- DateRButton: TRadioButton;
- procedure FormShow(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure AddButtonClick(Sender: TObject);
- procedure fillStringGrid(SubscribersStringGrid: TStringGrid; TelephoneEdit, SurnameEdit, NameEdit,
- PatronymicEdit, CityEdit: TEdit);
- procedure ShowButtonClick(Sender: TObject);
- procedure clearStringGrid();
- procedure DeleteButtonClick(Sender: TObject);
- procedure RadioButtonCLick(Sender: TObject);
- procedure ClearButtonClick(Sender: TObject);
- function isCorrectTextData(CurrentEdit: TEdit): boolean;
- function isCorrectNumberData(CurrentEdit: TEdit): boolean;
- procedure DataEditKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- function areEditsCorrect(): boolean;
- procedure EditButtonClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure InstructionMenuClick(Sender: TObject);
- procedure buildStringGrid(SubscribersStringGrid: TStringGrid);
- procedure setEditButtonsCondition();
- procedure sortList();
- procedure getRequiredSubscriber(var RequiredSubscriber: TRequiredSubscriber;
- RequiredTelephoneNumber: string; RequiredSurname: string; RequiredName: string;
- RequiredPatronymic: string; RequiredCity: string);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- EditForm: TEditForm;
- SubscriberList: TSubscriberList;
- SubscriberIndex: TNumber;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, AddUnit, CorrectUnit, StartUnit;
- const
- TEXT_TOP_OFFSET = 3;
- BIG_LETTERS = ['A'..'Z'];
- SMALL_LETTERS = ['a'..'z'];
- DIGITS = ['0'..'9'];
- var
- CurrentRadioButton: integer = 0;
- NumberArray: array of TNumber;
- procedure TEditForm.AddButtonClick(Sender: TObject);
- begin
- AddForm.Show;
- EditForm.Enabled := false;
- end;
- procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
- var
- P: TSubscriberPointer;
- begin
- SubscriberList.deleteList;
- SubscriberList.Free;
- clearStringGrid;
- StartForm.enabled := true;
- StartForm.show;
- end;
- procedure TEditForm.setEditButtonsCondition();
- begin
- if SubscribersStringGrid.RowCount > 1 then
- begin
- DeleteButton.Enabled := true;
- EditButton.Enabled := true;
- end
- else
- begin
- DeleteButton.Enabled := false;
- EditButton.Enabled := false;
- end;
- end;
- procedure TEditForm.buildStringGrid(SubscribersStringGrid: TStringGrid);
- const
- NUMBER_PART = 14;
- TELEPHONE_PART = 7.5;
- SURNAME_PART = 5.1;
- NAME_PART = 6.6;
- PATRONYMIC_PART = SURNAME_PART;
- CITY_PART = 6.5;
- DAYS_PART = 13;
- var
- StringGridSize: integer;
- begin
- SubscribersStringGrid.Cells[0, 0] := ' №';
- SubscribersStringGrid.Cells[1, 0] := ' Telephone';
- SubscribersStringGrid.Cells[2, 0] := ' Surname';
- SubscribersStringGrid.Cells[3, 0] := ' Name';
- SubscribersStringGrid.Cells[4, 0] := ' Patronymic';
- SubscribersStringGrid.Cells[5, 0] := ' City';
- SubscribersStringGrid.Cells[6, 0] := 'Days left';
- StringGridSize := SubscribersStringGrid.width;
- SubscribersStringGrid.ColWidths[0] := Round(StringGridSize / NUMBER_PART);
- SubscribersStringGrid.ColWidths[1] := Round(StringGridSize / TELEPHONE_PART);
- SubscribersStringGrid.ColWidths[2] := Round(StringGridSize / SURNAME_PART);
- SubscribersStringGrid.ColWidths[3] := Round(StringGridSize / NAME_PART);
- SubscribersStringGrid.ColWidths[4] := Round(StringGridSize / PATRONYMIC_PART);
- SubscribersStringGrid.ColWidths[5] := Round(StringGridSize / CITY_PART);
- SubscribersStringGrid.ColWidths[6] := Round(StringGridSize / DAYS_PART);
- end;
- procedure TEditForm.FormCreate(Sender: TObject);
- begin
- buildStringGrid(SubscribersStringGrid);
- end;
- procedure TEditForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- EditForm.Close()
- else
- if Key = #13 then
- ShowButtonClick(Sender);
- end;
- procedure TEditForm.FormShow(Sender: TObject);
- begin
- SubscriberList := TSubscriberList.NewSubscriberList();
- EditButton.Enabled := false;
- DeleteButton.Enabled := false;
- clearStringGrid;
- end;
- procedure TEditForm.InstructionMenuClick(Sender: TObject);
- begin
- MessageDlg('This is the edit window. It includes next functions:' + #13#10 + '1. Searching by certain data;' + #13#10
- + '2. Sorting by all categories;' + #13#10 +
- '3. Adding new subscriber;' + #13#10 + '4. Edtining selected one;' + #13#10 +
- '5. Deleting selected one.' + #13#10 + #13#10 +
- 'Right input:' + #13#10 +
- 'a) Telephone number field: first char - "+" or digit and next are digits; length = 13;'
- + #13#10 + 'b) Text fields: first char - big letter and next are small letters. Length:'
- + #13#10 + 'City -11, Surname - 14, Name - 11, Patronymic - 14.' + #13#10
- + #13#10 + 'Use "clear" to clear all fields and turn sort off;'
- + #13#10 + #13#10 + 'Press "ctrl + i" to open instruction;'
- + #13#10 + 'Press "enter" to show subscribers;'
- + #13#10 + 'Press "esc" to go back to start widnow.', MtInformation, [mbOk], 0);
- end;
- procedure TEditForm.ShowButtonClick(Sender: TObject);
- begin
- if areEditsCorrect() then
- begin
- clearStringGrid();
- if not isFileEmpty() then
- begin
- fillStringGrid(SubscribersStringGrid, TelephoneEdit, SurnameEdit, NameEdit,
- PatronymicEdit, CityEdit);
- setEditButtonsCondition();
- end
- else
- MessageDlg('Subscriber file is empty.', mtError, [mbOk], 0, mbOk);
- end
- else
- begin
- MessageDlg('Wrong data.', mtError, [mbCancel], 0);
- clearButtonClick(Sender);
- end;
- end;
- function TEditForm.areEditsCorrect(): boolean;
- begin
- Result := (IsCorrectNumberData(TelephoneEdit) and IsCorrectTextData(SurnameEdit) and
- IsCorrectTextData(NameEdit) and IsCorrectTextData(PatronymicEdit) and
- IsCorrectTextData(CityEdit));
- end;
- procedure TEditForm.DataEditKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if not (Key in BIG_LETTERS) then
- Key := #0
- end
- else
- if not(Key in SMALL_LETTERS) then
- Key := #0;
- end;
- end;
- procedure TEditForm.TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if ((not(Key in DIGITS)) and (Key <> '+')) then
- Key := #0
- end
- else
- if not(Key in DIGITS) then
- Key := #0;
- end;
- end;
- procedure TEditForm.RadioButtonCLick(Sender: TObject);
- begin
- CurrentRadioButton := (Sender as TRadioButton).tag;
- end;
- procedure TEditForm.ClearButtonClick(Sender: TObject);
- begin
- TelephoneEdit.text := '';
- NameEdit.text := '';
- SurnameEdit.text := '';
- PatronymicEdit.text := '';
- CityEdit.text := '';
- TelephoneRButton.Checked := false;
- SurnameRButton.Checked := false;
- NameRButton.Checked := false;
- PatronymicRButton.Checked := false;
- CityRButton.Checked := false;
- DateRButton.Checked := false;
- CurrentRadioButton := 0;
- SubscribersStringGrid.RowCount := 1;
- EditButton.Enabled := false;
- DeleteButton.Enabled := false;
- end;
- procedure TEditForm.sortList();
- begin
- if not SubscriberList.IsEmpty then
- case CurrentRadioButton of
- 0: ;
- 1: SubscriberList.sort(TSubscriberList.compareByTelephoneNumber);
- 2: SubscriberList.sort(TSubscriberList.CompareBySurname);
- 3: SubscriberList.sort(TSubscriberList.CompareByName);
- 4: SubscriberList.sort(TSubscriberList.CompareByPatronymic);
- 5: SubscriberList.sort(TSubscriberList.CompareByCity);
- 6: SubscriberList.sort(TSubscriberList.CompareByDate);
- end;
- end;
- procedure TEditForm.fillStringGrid(SubscribersStringGrid: TStringGrid;
- TelephoneEdit, SurnameEdit, NameEdit,
- PatronymicEdit, CityEdit: TEdit);
- var
- i, j, ListLength: Integer;
- PCurrentSubscriber: TSubscriberPointer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- i := 1;
- j := 0;
- SubscriberList.deleteList();
- getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- readSubscribers(RequiredSubscriber);
- sortList();
- ListLength := SubscriberList.length();
- setlength(NumberArray, ListLength);
- PCurrentSubscriber := SubscriberList.getHeader()^.next;
- while (PCurrentSubscriber <> nil) do
- begin
- SubscribersStringGrid.RowCount := SubscribersStringGrid.RowCount + 1;
- SubscribersStringGrid.Cells[0, i] := intToStr(i);
- SubscribersStringGrid.Cells[1, i] := PCurrentSubscriber^.telephoneNumber;
- SubscribersStringGrid.Cells[2, i] := PCurrentSubscriber^.surname;
- SubscribersStringGrid.Cells[3, i] := PCurrentSubscriber^.name;
- SubscribersStringGrid.Cells[4, i] := PCurrentSubscriber^.patronymic;
- SubscribersStringGrid.Cells[5, i] := PCurrentSubscriber^.city;
- SubscribersStringGrid.Cells[6, i] := intToStr(PCurrentSubscriber^.numberOfDays);
- NumberArray[j] := PCurrentSubscriber^.number;
- Inc(i);
- inc(j);
- PCurrentSubscriber := PCurrentSubscriber^.next;
- end;
- end;
- procedure TEditForm.getRequiredSubscriber(var RequiredSubscriber: TRequiredSubscriber; RequiredTelephoneNumber: string; RequiredSurname: string;
- RequiredName: string; RequiredPatronymic: string;
- RequiredCity: string);
- begin
- RequiredSubscriber.telephoneNumber := RequiredTelephoneNumber;
- RequiredSubscriber.surname := RequiredSurname;
- RequiredSubscriber.name := RequiredName;
- RequiredSubscriber.patronymic := RequiredPatronymic;
- RequiredSubscriber.city := RequiredCity;
- end;
- procedure TEditForm.clearStringGrid();
- begin
- SubscribersStringGrid.RowCount := 1;
- SubscribersStringGrid.ColCount := 7;
- end;
- procedure TEditForm.DeleteButtonClick(Sender: TObject);
- var
- SubscriberNumber: integer;
- begin
- if (SubscribersStringGrid.Row <> 0) then
- begin
- SubscriberNumber := NumberArray[SubscribersStringGrid.Row - 1];
- deleteSubscriber(SubscriberNumber);
- ShowButtonClick(Sender);
- end;
- end;
- procedure TEditForm.EditButtonClick(Sender: TObject);
- begin
- if (SubscribersStringGrid.Row <> 0) then
- begin
- SubscriberIndex := NumberArray[SubscribersStringGrid.Row - 1];
- EditForm.Enabled := false;
- CorrectForm.Show;
- end;
- end;
- function TEditForm.IsCorrectTextData(CurrentEdit: TEdit): boolean;
- var
- IsCorrectInput: boolean;
- TextLength, i: integer;
- begin
- isCorrectInput := false;
- TextLength := length(CurrentEdit.text);
- i := 2;
- if TextLength <= CurrentEdit.MaxLength then
- begin
- if TextLength = 0 then
- IsCorrectInput := true
- else
- begin
- if (TextLength = 1) and (CurrentEdit.text[1] in BIG_LETTERS) then
- IsCorrectInput := True
- else
- begin
- IsCorrectInput := CurrentEdit.text[1] in BIG_LETTERS;
- while IsCorrectInput and (i <= TextLength) do
- begin
- if not(CurrentEdit.text[i] in SMALL_LETTERS) then
- IsCorrectInput := false;
- inc(i);
- end;
- end;
- end;
- end;
- Result := IsCorrectInput;
- end;
- function TEditForm.isCorrectNumberData(CurrentEdit: TEdit): boolean;
- var
- IsCorrectInput: boolean;
- TextLength, i: integer;
- begin
- isCorrectInput := false;
- TextLength := length(CurrentEdit.text);
- i := 2;
- if TextLength <= CurrentEdit.MaxLength then
- begin
- if TextLength = 0 then
- IsCorrectInput := true
- else
- begin
- if (TextLength = 1) and ((CurrentEdit.text[1] in DIGITS) or (CurrentEdit.text[1] = '+')) then
- isCorrectInput := true
- else
- begin
- IsCorrectInput := (CurrentEdit.text[1] in DIGITS) or (CurrentEdit.text[1] = '+');
- while isCorrectInput and (i <= TextLength) do
- begin
- if not (CurrentEdit.text[i] in DIGITS) then
- IsCorrectInput := false;
- inc(i);
- end;
- end;
- end;
- end;
- Result := IsCorrectInput;
- end;
- end.
- unit ShowUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.Menus, Vcl.StdCtrls, ListUnit,
- System.Actions, Vcl.ActnList, System.UITypes, EditUnit;
- type
- TShowForm = class(TForm)
- SubscribersStringGrid: TStringGrid;
- TelephoneEdit: TEdit;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- TelephoneRButton: TRadioButton;
- SortLabel: TLabel;
- NameRButton: TRadioButton;
- SurnameRButton: TRadioButton;
- PatronymicRButton: TRadioButton;
- CityRButton: TRadioButton;
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- ShowButton: TButton;
- PatronymicLabel: TLabel;
- CityLabel: TLabel;
- TelephoneLabel: TLabel;
- TaskLabel: TLabel;
- ClearButton: TButton;
- DateRButton: TRadioButton;
- procedure FormShow(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure AddButtonClick(Sender: TObject);
- procedure fillStringGrid();
- procedure ShowButtonClick(Sender: TObject);
- procedure clearStringGrid();
- procedure RadioButtonCLick(Sender: TObject);
- procedure ClearButtonClick(Sender: TObject);
- procedure TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- function areEditsCorrect(): boolean;
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure InstructionMenuClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- ShowForm: TShowForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, AddUnit, CorrectUnit, StartUnit;
- const
- TEXT_TOP_OFFSET = 3;
- BIG_LETTERS = ['A'..'Z'];
- SMALL_LETTERS = ['a'..'z'];
- DIGITS = ['0'..'9'];
- var
- CurrentRadioButton: integer = 0;
- procedure TShowForm.AddButtonClick(Sender: TObject);
- begin
- AddForm.Show;
- ShowForm.Enabled := false;
- end;
- procedure TShowForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- SubscriberList.deleteList;
- SubscriberList.Free;
- clearStringGrid;
- StartForm.enabled := true;
- StartForm.show;
- end;
- procedure TShowForm.FormCreate(Sender: TObject);
- begin
- EditForm.buildStringGrid(SubscribersStringGrid);
- end;
- procedure TShowForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- ShowForm.Close()
- else
- if Key = #13 then
- ShowButtonClick(Sender);
- end;
- procedure TShowForm.FormShow(Sender: TObject);
- begin
- SubscriberList := TSubscriberList.NewSubscriberList();
- clearStringGrid();
- end;
- procedure TShowForm.ShowButtonClick(Sender: TObject);
- begin
- if areEditsCorrect() then
- begin
- clearStringGrid();
- if not isFileEmpty() then
- fillStringGrid()
- else
- MessageDlg('Subscriber file is empty.', mtError, [mbOk], 0, mbOk);
- end
- else
- begin
- MessageDlg('Wrong data.', mtError, [mbCancel], 0);
- clearButtonClick(Sender);
- end;
- end;
- function TShowForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit));
- end;
- procedure TShowForm.TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- begin
- EditForm.TelephoneEditKeyPress(Sender, Key);
- end;
- procedure TShowForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- EditForm.DataEditKeyPress(Sender, Key);
- end;
- procedure TShowForm.RadioButtonCLick(Sender: TObject);
- begin
- EditForm.RadioButtonCLick(Sender);
- end;
- procedure TShowForm.ClearButtonClick(Sender: TObject);
- begin
- TelephoneEdit.text := '';
- NameEdit.text := '';
- SurnameEdit.text := '';
- PatronymicEdit.text := '';
- CityEdit.text := '';
- TelephoneRButton.Checked := false;
- SurnameRButton.Checked := false;
- NameRButton.Checked := false;
- PatronymicRButton.Checked := false;
- CityRButton.Checked := false;
- DateRButton.Checked := false;
- CurrentRadioButton := 0;
- SubscribersStringGrid.RowCount := 1;
- end;
- procedure sortList();
- begin
- EditForm.sortList;
- end;
- procedure TShowForm.fillStringGrid();
- begin
- EditForm.fillStringGrid(SubscribersStringGrid, TelephoneEdit, SurnameEdit, NameEdit,
- PatronymicEdit, CityEdit);
- end;
- procedure TShowForm.clearStringGrid();
- begin
- SubscribersStringGrid.RowCount := 1;
- SubscribersStringGrid.ColCount := 7;
- end;
- end.
- unit AddUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.Samples.Spin, EditUnit;
- type
- TAddForm = class(TForm)
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- PatronymicLabel: TLabel;
- CityLabel: TLabel;
- DateLabel: TLabel;
- TelephoneLabel: TLabel;
- TelephoneEdit: TEdit;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- TaskLabel: TLabel;
- AddButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- SubscriberAddedLabel: TLabel;
- PaymentEdit: TSpinEdit;
- WrongDataLabel: TLabel;
- SubscriberExistsLabel: TLabel;
- procedure AddButtonClick(Sender: TObject);
- procedure SomeEditChange(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure turnLabelsOff();
- procedure InstructionMenuClick(Sender: TObject);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- procedure TelephoneKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure FormShow(Sender: TObject);
- function areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- function areEditsCorrect(): boolean;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- AddForm: TAddForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, ListUnit, StartUnit;
- const
- BIG_LETTERS = ['A'..'Z'];
- SMALL_LETTERS = ['a'..'z'];
- DIGITS = ['0'..'9'];
- procedure TAddForm.AddButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateOfPay: TDateOfPay;
- SameSubscriberIndex: integer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- TelephoneNumber := toTelephoneNumber(TelephoneEdit.text);
- Surname := toSurname(SurnameEdit.Text);
- Name := toName(NameEdit.Text);
- Patronymic := toPatronymic(PatronymicEdit.Text);
- City := toCity(CityEdit.Text);
- DateOfPay := toDateOfPay(Now, PaymentEdit.value);
- TurnLabelsOff();
- EditForm.getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- if isExist(RequiredSubscriber, SameSubscriberIndex) then
- SubscriberExistsLabel.Visible := true
- else
- begin
- if not areEditsCorrect() then
- WrongDataLabel.Visible := true
- else
- begin
- write(TelephoneNumber, Surname, Name, Patronymic, City, DateofPay);
- SubscriberAddedLabel.Visible := true;
- end;
- end;
- end;
- function TAddForm.areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- begin
- Result := ((TelephoneEdit.text <> '') and (SurnameEdit.text <> '') and (FathernameEdit.text <> '')
- and (NameEdit.text <> '') and (CityEdit.text <> ''));
- end;
- function TAddForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit) and
- areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, PatronymicEdit, CityEdit));
- end;
- procedure TAddForm.FormClose(Sender: TObject; var Action: TCloseAction);
- var
- Edit: TEdit;
- begin
- EditForm.enabled := true;
- TurnLabelsOff();
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- PaymentEdit.value := 0;
- end;
- procedure TAddForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- AddForm.Close()
- else
- if Key = #13 then
- AddButtonClick(Sender);
- end;
- procedure TAddForm.FormShow(Sender: TObject);
- var
- Edit: TEdit;
- begin
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- end;
- procedure TAddForm.SomeEditChange(Sender: TObject);
- begin
- turnLabelsOff();
- end;
- procedure TAddForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if not (Key in BIG_LETTERS) then
- Key := #0
- end
- else if not(Key in SMALL_LETTERS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TelephoneKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if ((not(Key in DIGITS)) and (Key <> '+')) then
- Key := #0
- end
- else if not(Key in DIGITS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TurnLabelsOff();
- begin
- SubscriberAddedLabel.Visible := false;
- SubscriberExistsLabel.Visible := false;
- WrongDataLabel.Visible := false;
- end;
- end.
- unit CorrectUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.Samples.Spin, DateUtils, AddUnit, EditUnit;
- type
- TCorrectForm = class(TForm)
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- PatronumicLabel: TLabel;
- CityLabel: TLabel;
- TelephoneLabel: TLabel;
- TelephoneEdit: TEdit;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- TaskLabel: TLabel;
- SaveButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- PayLabel: TLabel;
- ResetButton: TButton;
- DateLabel: TLabel;
- DateOfPayLabel: TLabel;
- PaySpinEdit: TSpinEdit;
- SuccessLabel: TLabel;
- WrongDataLabel: TLabel;
- UpdateMenu: TMenuItem;
- SubscriberExistsLabel: TLabel;
- procedure ResetButtonClick(Sender: TObject);
- procedure TurnLabelsOff();
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure FormShow(Sender: TObject);
- procedure SaveButtonClick(Sender: TObject);
- procedure showSavedInfo();
- procedure UpdateMenuClick(Sender: TObject);
- procedure deleteSpaces();
- procedure InstructionMenuClick(Sender: TObject);
- procedure TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- function areEditsCorrect(): boolean;
- procedure SomeEditChange(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- CorrectForm: TCorrectForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, ListUnit;
- procedure TCorrectForm.ResetButtonClick(Sender: TObject);
- begin
- DateOfPayLabel.caption := dateToStr(Now);
- PaySpinEdit.Value := 0;
- turnLabelsOff();
- end;
- function TCorrectForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit) and
- AddForm.areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, PatronymicEdit, CityEdit));
- end;
- procedure TCorrectForm.SaveButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateofPay: TDateOfPay;
- SameSubscriberIndex: integer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- SameSubscriberIndex := -1;
- TelephoneNumber := toTelephoneNumber(TelephoneEdit.text);
- Surname := toSurname(SurnameEdit.Text);
- Name := toName(NameEdit.Text);
- Patronymic := toPatronymic(PatronymicEdit.Text);
- City := toCity(CityEdit.Text);
- DateOfPay := toDateOfPay(strToDate(DateOfPayLabel.Caption), PaySpinEdit.Value);
- PaySpinEdit.Value := 0;
- EditForm.getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- if isExist(RequiredSubscriber, SameSubscriberIndex)
- and (not(SubscriberIndex = SameSubscriberIndex)) then
- SubscriberExistsLabel.Visible := true
- else
- begin
- if (not areEditsCorrect()) then
- WrongDataLabel.Visible := true
- else
- begin
- write(SubscriberIndex, TelephoneNumber, Surname, Name, Patronymic, City,
- DateofPay);
- showSavedInfo();
- SuccessLabel.Visible := true;
- end;
- end;
- end;
- procedure TCorrectForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- EditForm.enabled := true;
- PaySpinEdit.value := 0;
- end;
- procedure TCorrectForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- AddForm.Close()
- else
- if Key = #13 then
- SaveButtonClick(Sender);
- end;
- procedure TCorrectForm.FormShow(Sender: TObject);
- begin
- showSavedInfo();
- end;
- procedure TCorrectForm.deleteSpaces();
- var
- Edit: TEdit;
- i: integer;
- BufferString: string;
- begin
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- begin
- BufferString := Edit.text;
- Edit.text := '';
- for i := 1 to length(BufferString) do
- if BufferString[i] <> ' ' then
- Edit.text := Edit.text + BufferString[i];
- end;
- end;
- procedure TCorrectForm.showSavedInfo();
- var
- CurrentSubscriber: TSubscriber;
- DateString: string;
- begin
- CurrentSubscriber := getSubscriber(SubscriberIndex, DateString);
- TelephoneEdit.text := CurrentSubscriber.telephoneNumber;
- SurnameEdit.text := CurrentSubscriber.surname;
- NameEdit.text := CurrentSubscriber.name;
- PatronymicEdit.text := CurrentSubscriber.patronymic;
- CityEdit.text := CurrentSubscriber.city;
- deleteSpaces;
- DateOfPayLabel.caption := DateString;
- PaySpinEdit.Value := 0;
- turnLabelsOff();
- end;
- procedure TCorrectForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- AddForm.TextEditKeyPress(Sender, Key);
- end;
- procedure TCorrectForm.SomeEditChange(Sender: TObject);
- begin
- turnLabelsOff();
- end;
- procedure TCorrectForm.TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- begin
- AddForm.TelephoneKeyPress(Sender, Key);
- end;
- procedure TCorrectForm.TurnLabelsOff();
- begin
- SuccessLabel.visible := false;
- WrongDataLabel.visible := false;
- SubscriberExistsLabel.visible := false;
- end;
- procedure TCorrectForm.UpdateMenuClick(Sender: TObject);
- begin
- showSavedInfo();
- end;
- end.
- unit ReadUnit;
- interface
- uses
- System.SysUtils, ListUnit, EditUnit, DateUtils;
- const
- PathToFile = 'C:\t\SubscribersFile.bin';
- FILE_NAME = 'SubscribersFile.bin';
- DELETER: ansichar = '/';
- START_SUBSCRIBER_OFFSET: LongWord = 0;
- type
- TBinaryFile = file of byte;
- procedure readSubscribers(var RequiredSubscriber: TRequiredSubscriber);
- function getSubscriber(Index: longWord; var DateString: string): TSubscriber;
- function isEqual(var RequiredString: string; var CurrentArray: array of AnsiChar): boolean;
- function isExist(var RequiredSubscriber: TRequiredSubscriber; var SameSubscriberIndex: integer): Boolean;
- function isFileEmpty(): Boolean;
- function dateArrayToString(var DateOfPayArray: TDateOfPay): string;
- function dateToNumber(var DateOfPayArray: TDateOfPay): TNumberOfdays;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var TelephoneNumberArray: TTelephoneNumber): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var SurnameArray: TSurname): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var NameArray: TName): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var FathernameArray: TPatronymic): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var CityArray: TCity): boolean; overload;
- function isRequiredSubscriber(var SourceFile: TBinaryFile; var TelephoneNumberArray: TTelephoneNumber;
- var SurnameArray: TSurname; var NameArray: TName;
- var PatromynicArray: TPatronymic; var CityArray: TCity;
- var RequiredSubscriber: TRequiredSubscriber): boolean;
- implementation
- function dateArrayToString(var DateOfPayArray: TDateOfPay): string;
- begin
- Result := copy(DateOfPayArray, 1, 2) + '.' + copy(DateOfPayArray, 3, 2) + '.' + copy(DateOfPayArray, 5, 4);
- end;
- function dateToNumber(var DateOfPayArray: TDateOfPay): TNumberOfdays;
- var
- NumberOfDaysLeft: integer;
- WritenTime, NowTime: TDateTime;
- StringTime: string;
- Difference: TNumberOfDays;
- DayDifferece: TNumberOfDays;
- ComparisonResult: integer;
- begin
- StringTime := dateArrayToString(DateOfPayArray);
- WritenTime := strToDate(StringTime);
- NowTime := Now();
- ComparisonResult := compareDate(WritenTime, NowTime);
- DayDifferece := daysBetween(WritenTime, NowTime);
- Difference := DayDifferece * ComparisonResult;
- Result := Difference;
- end;
- procedure readSubscribers(var RequiredSubscriber: TRequiredSubscriber);
- var
- SourceFile: TBinaryFile;
- TelephoneNumberArray: TTelephoneNumber;
- SurnameArray: TSurname;
- NameArray: TName;
- PatromynicArray: TPatronymic;
- CityArray: TCity;
- DateofPayArray: TDateOfPay;
- Number: TNumber;
- Offset: integer;
- OneByte: ansichar;
- NumberOfDays: longWord;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET;
- Seek(SourceFile, Offset);
- while not EOF(SourceFile) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if OneByte <> DELETER then
- begin
- Seek(SourceFile, Offset);
- blockRead(SourceFile, Number, NUMBER_LENGTH);
- if isRequiredSubscriber(SourceFile, TelephoneNumberArray,
- SurnameArray, NameArray, PatromynicArray, CityArray,
- RequiredSubscriber) then
- begin
- blockRead(SourceFile, DateOfPayArray, DATE_OF_PAY_LENGTH);
- NumberOfDays := dateToNumber(DateOfPayArray);
- SubscriberList.add(TelephoneNumberArray, SurnameArray,
- NameArray, PatromynicArray, CityArray, NumberOfDays, Number);
- end;
- end;
- Offset := Offset + RECORD_SIZE;
- Seek(SourceFile, Offset);
- end;
- close(SourceFile);
- end;
- function getSubscriber(Index: longWord; var DateString: string): TSubscriber;
- var
- SourceFile: TBinaryFile;
- Offset: integer;
- CurrentSubscriber: TSubscriber;
- DateOfPayArray: TDateOfPay;
- NumberOfDays: longWord;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET + RECORD_SIZE * Index + NUMBER_LENGTH;
- Seek(SourceFile, Offset);
- blockRead(SourceFile, CurrentSubscriber.telephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.surname, SURNAME_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.name, NAME_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.patronymic, PATRONYMIC_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.city, CITY_LENGTH);
- blockRead(SourceFile, DateOfPayArray, DATE_OF_PAY_LENGTH);
- DateString := dateArrayToString(DateOfPayArray);
- close(SourceFile);
- Result := CurrentSubscriber;
- end;
- function isExist(var RequiredSubscriber: TRequiredSubscriber; var SameSubscriberIndex: integer): boolean;
- var
- IsExist: boolean;
- SourceFile: TBinaryFile;
- TelephoneNumberArray: TTelephoneNumber;
- SurnameArray: TSurname;
- NameArray: TName;
- PatromynicArray: TPatronymic;
- CityArray: TCity;
- DateofPayArray: TDateOfPay;
- Number: TNumber;
- Offset: integer;
- OneByte: ansichar;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET;
- Seek(SourceFile, Offset);
- IsExist := false;
- while (not EOF(SourceFile)) and (not IsExist) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if OneByte <> DELETER then
- begin
- Seek(SourceFile, Offset);
- blockRead(SourceFile, Number, NUMBER_LENGTH);
- if isRequiredSubscriber(SourceFile, TelephoneNumberArray,
- SurnameArray, NameArray, PatromynicArray, CityArray, RequiredSubscriber) then
- begin
- IsExist := true;
- SameSubscriberIndex := Number;
- end;
- end;
- Offset := Offset + RECORD_SIZE;
- Seek(SourceFile, Offset);
- end;
- close(SourceFile);
- Result := IsExist;
- end;
- function isRequiredSubscriber(var SourceFile: TBinaryFile; var TelephoneNumberArray: TTelephoneNumber;
- var SurnameArray: TSurname; var NameArray: TName;
- var PatromynicArray: TPatronymic; var CityArray: TCity;
- var RequiredSubscriber: TRequiredSubscriber): boolean;
- begin
- Result := isRequiredData(SourceFile, RequiredSubscriber.telephoneNumber, TelephoneNumberArray)
- and isRequiredData(SourceFile, RequiredSubscriber.surname, SurnameArray)
- and isRequiredData(SourceFile, RequiredSubscriber.name, NameArray)
- and isRequiredData(SourceFile, RequiredSubscriber.patronymic, PatromynicArray)
- and isRequiredData(SourceFile, RequiredSubscriber.city, CityArray);
- end;
- function isFileEmpty(): Boolean;
- var
- SourceFile: TBinaryFile;
- SizeOfFile: integer;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- Reset(SourceFile);
- SizeOfFile := FileSize(SourceFile);
- close(SourceFile);
- Result := (SizeOfFile = 0);
- end;
- function isEqual(var RequiredString: string; var CurrentArray: array of AnsiChar): Boolean;
- var
- IsSame: boolean;
- i: integer;
- begin
- IsSame := true;
- i := 1;
- while IsSame and (i <= length(RequiredString)) do
- if (RequiredString[i] <> char(CurrentArray[i - 1])) then
- IsSame := false
- else
- inc(i);
- Result := IsSame;
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var TelephoneNumberArray: TTelephoneNumber): boolean;
- begin
- blockRead(SourceFile, TelephoneNumberArray, TELEPHONE_NUMBER_LENGTH);
- Result := isEqual(RequiredString, TelephoneNumberArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var SurnameArray: TSurname): boolean;
- begin
- blockRead(SourceFile, SurnameArray, SURNAME_LENGTH);
- Result := isEqual(RequiredString, SurnameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var NameArray: TName): boolean;
- begin
- blockRead(SourceFile, NameArray, NAME_LENGTH);
- Result := isEqual(RequiredString, NameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var FathernameArray: TPatronymic): boolean;
- begin
- blockRead(SourceFile, FathernameArray, PATRONYMIC_LENGTH);
- Result := isEqual(RequiredString, FathernameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var CityArray: TCity): boolean;
- begin
- blockRead(SourceFile, CityArray, CITY_LENGTH);
- Result := isEqual(RequiredString, CityArray);
- end;
- end.
- unit ListUnit;
- interface
- uses
- System.SysUtils, Vcl.ExtCtrls;
- const
- TELEPHONE_NUMBER_LENGTH = 13;
- SURNAME_LENGTH = 14;
- NAME_LENGTH = 11;
- PATRONYMIC_LENGTH = 14;
- CITY_LENGTH = 11;
- DATE_OF_PAY_LENGTH = 8;
- NUMBER_LENGTH = 4;
- RECORD_SIZE = TELEPHONE_NUMBER_LENGTH + SURNAME_LENGTH + NAME_LENGTH +
- PATRONYMIC_LENGTH + CITY_LENGTH + DATE_OF_PAY_LENGTH + NUMBER_LENGTH;
- ONLY_DATA_SIZE = TELEPHONE_NUMBER_LENGTH + SURNAME_LENGTH + NAME_LENGTH +
- PATRONYMIC_LENGTH + CITY_LENGTH + DATE_OF_PAY_LENGTH;
- type
- TTelephoneNumber = array[1..TELEPHONE_NUMBER_LENGTH] of AnsiChar;
- TSurname = array[1..SURNAME_LENGTH] of AnsiChar;
- TName = array[1..NAME_LENGTH] of AnsiChar;
- TPatronymic = array[1..PATRONYMIC_LENGTH] of AnsiChar;
- TCity = array[1..CITY_LENGTH] of AnsiChar;
- TDateOfPay = array[1..DATE_OF_PAY_LENGTH] of AnsiChar;
- TNumberOfDays = integer;
- TNumber = longWord;
- TSubscriberPointer = ^TSubscriber;
- TCompareMethod = function(Previous, Next: TSubscriberPointer): boolean of object;
- TSubscriber = record
- next: TSubscriberPointer;
- telephoneNumber: TTelephoneNumber;
- surname: TSurname;
- name: TName;
- patronymic: TPatronymic;
- city: TCity;
- numberOfDays: TNumberOfDays;
- number: TNumber;
- end;
- TRequiredSubscriber = record
- telephoneNumber, surname, name, patronymic, city: string;
- numberOfDays: TNumberOfDays;
- number: TNumber;
- end;
- TSubscriberList = class
- private
- Header: TSubscriberPointer;
- procedure QuckSort(var headRef: TSubscriberPointer; CompareMethod: TCompareMethod);
- function getTail(Node: TSubscriberPointer): TSubscriberPointer;
- function quickSortRecur(head: TSubscriberPointer;
- fin: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- function partition(head: TSubscriberPointer; Fin: TSubscriberPointer;
- var NewHead: TSubscriberPointer;
- var NewTail: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- public
- function getHeader(): TSubscriberPointer;
- constructor NewSubscriberList();
- destructor Destroy(); override;
- procedure add(CurrentTelephoneNumber: TTelephoneNumber;
- CurrentSurname: TSurname; CurrentName: TName;
- CurrentFatherName: TPatronymic; CurrentCity: TCity;
- CurrentNumberOfDays: TNumberOfDays; CurrentNumber: TNumber);
- procedure deleteList();
- function length(): integer;
- function IsEmpty(): boolean;
- function getLastPosition(): TSubscriberPointer;
- procedure sort(CompareMethod: TCompareMethod);
- class function compareByTelephoneNumber(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareBySurname(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByName(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByPatronymic(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByCity(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByDate(Previous,
- Next: TSubscriberPointer): boolean;
- end;
- implementation
- uses
- EditUnit, ReadUnit;
- constructor TSubscriberList.NewSubscriberList();
- begin
- new(Header);
- Header^.next := nil;
- end;
- Destructor TSubscriberList.Destroy;
- Begin
- Dispose(Self.Header);
- Inherited;
- End;
- function TSubscriberList.IsEmpty(): Boolean;
- begin
- Result := (Header^.next = nil);
- end;
- function TSubscriberList.getHeader(): TSubscriberPointer;
- begin
- Result := Self.Header;
- end;
- function TSubscriberList.length(): integer;
- var
- ListLength: integer;
- PTemp: TSubscriberPointer;
- begin
- PTemp := getHeader();
- ListLength := 0;
- while (PTemp^.next <> nil) do
- begin
- PTemp := PTemp^.next;
- inc(ListLength);
- end;
- Result := ListLength;
- end;
- function TSubscriberList.getLastPosition(): TSubscriberPointer;
- var
- PTemp: TSubscriberPointer;
- begin
- PTemp := getHeader();
- while (PTemp^.next <> nil) do
- PTemp := PTemp^.next;
- Result := PTemp;
- end;
- procedure TSubscriberList.add(CurrentTelephoneNumber: TTelephoneNumber; CurrentSurname: TSurname;
- CurrentName: TName; CurrentFatherName: TPatronymic; CurrentCity: TCity;
- CurrentNumberOfDays: TNumberOfDays; CurrentNumber: TNumber);
- var
- PLastSubscriber: TSubscriberPointer;
- begin
- PLastSubscriber := getLastPosition();
- new(PLastSubscriber^.next);
- PLastSubscriber := PLastSubscriber^.next;
- PLastSubscriber^.number := CurrentNumber;
- PLastSubscriber^.telephoneNumber := CurrentTelephoneNumber;
- PLastSubscriber^.surname := CurrentSurname;
- PLastSubscriber^.name := CurrentName;
- PLastSubscriber^.patronymic := CurrentFatherName;
- PLastSubscriber^.city := CurrentCity;
- PLastSubscriber^.numberOfDays := CurrentNumberOfDays;
- PLastSubscriber^.next := nil;
- end;
- procedure TSubscriberList.deleteList();
- var
- PDeleter: TSubscriberPointer;
- PTemp: TSubscriberPointer;
- begin
- PTemp := Header^.next;;
- while PTemp <> nil do
- begin
- PDeleter := PTemp;
- PTemp := PTemp^.next;
- dispose(PDeleter);
- end;
- Header^.next := nil;
- end;
- class function TSubscriberList.compareByTelephoneNumber(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.telephoneNumber > Next^.telephoneNumber);
- end;
- class function TSubscriberList.compareBySurname(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.surname > Next^.surname);
- end;
- class function TSubscriberList.compareByName(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.name > Next^.name);
- end;
- class function TSubscriberList.compareByPatronymic(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.patronymic > Next^.patronymic);
- end;
- class function TSubscriberList.compareByCity(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.city > Next^.city);
- end;
- class function TSubscriberList.compareByDate(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.numberOfDays > Next^.numberOfDays);
- end;
- function TSubscriberList.getTail(Node: TSubscriberPointer): TSubscriberPointer;
- begin
- while (Node <> nil) and (Node^.next <> nil) do
- Node := Node^.next;
- Result := Node;
- end;
- function TSubscriberList.partition(Head: TSubscriberPointer; Fin: TSubscriberPointer;
- var NewHead: TSubscriberPointer;
- var NewTail: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- var
- Pivot: TSubscriberPointer;
- Previous: TSubscriberPointer;
- Current: TSubscriberPointer;
- Tail: TSubscriberPointer;
- Temp: TSubscriberPointer;
- begin
- Pivot := Fin;
- Previous := nil;
- Current := Head;
- Tail := Pivot;
- while (Current <> Pivot) do
- begin
- if CompareMethod(Pivot, Current) then
- begin
- if (NewHead = nil) then
- NewHead := Current;
- Previous := Current;
- Current := Current^.next;
- end
- else
- begin
- if (Previous <> nil) then
- Previous^.next := Current^.next;
- Temp := Current^.next;
- Current^.next := nil;
- Tail^.next := Current;
- Tail := Current;
- Current := Temp;
- end;
- end;
- if (NewHead = nil) then
- NewHead := Pivot;
- NewTail := Tail;
- Result := Pivot;
- end;
- function TSubscriberList.quickSortRecur(Head: TSubscriberPointer;
- Fin: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- var
- NewHead: TSubscriberPointer;
- NewEnd: TSubscriberPointer;
- Temp: TSubscriberPointer;
- Pivot: TSubscriberPointer;
- begin
- if ((not (Head <> nil)) or (Head = Fin)) then
- Result := Head
- else
- begin
- NewHead := nil;
- NewEnd := nil;
- Pivot := partition(Head, Fin, NewHead, NewEnd, CompareMethod);
- if (NewHead <> Pivot) then
- begin
- Temp := NewHead;
- while (Temp^.next <> Pivot) do
- Temp := Temp^.next;
- Temp^.next := nil;
- NewHead := quickSortRecur(NewHead, Temp,CompareMethod);
- Temp := getTail(NewHead);
- Temp^.next := Pivot;
- end;
- Pivot^.next := quickSortRecur(Pivot^.next, NewEnd, CompareMethod);
- Result := NewHead;
- end;
- end;
- procedure TSubscriberList.Sort(CompareMethod: TCompareMethod);
- begin
- QuckSort(Self.getHeader^.next, CompareMethod);
- end;
- procedure TSubscriberList.QuckSort(var headRef: TSubscriberPointer; CompareMethod: TCompareMethod);
- var
- Tail: TSubscriberPointer;
- begin
- Tail := getTail(headRef);
- headRef := quickSortRecur(headRef, Tail, CompareMethod);
- end;
- end.
- unit WriteUnit;
- interface
- uses
- System.SysUtils, ListUnit, ReadUnit, StartUnit;
- procedure clearFile();
- procedure write(TelephoneNumber: TTelephoneNumber; Surname: TSurname;
- Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay); overload;
- procedure write(SubscriberIndex: TNumber; TelephoneNumber: TTelephoneNumber;
- Surname: TSurname; Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay); overload;
- function toTelephoneNumber(Data: string): TTelephoneNumber;
- function toSurname(Data: string): TSurname;
- function toName(Data: string): TName;
- function toPatronymic(Data: string): TPatronymic;
- function toCity(Data: string): TCity;
- function toDateOfPay(StartDate: TDate; Data: integer): TDateOfPay;
- procedure deleteSubscriber(NumberOfSubscriber: TNumber);
- procedure removeDeleters();
- implementation
- uses
- DateUtils, Math;
- procedure clearFile();
- var
- SourceFile: TBinaryFile;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- rewrite(SourceFile);
- closeFile(SourceFile);
- end;
- procedure removeDeleters();
- const
- TEMP_FILE_NAME = 'TempFile.bin';
- var
- SourceFile, TempFile: TBinaryFile;
- OneByte: ansichar;
- BufferArray: Array[1..ONLY_DATA_SIZE] of ansichar;
- offset: integer;
- Number: longWord;
- begin
- assign(SourceFile, GetCurrentDir + '\' + FILE_NAME);
- assign(TempFile, GetCurrentDir + '\' + TEMP_FILE_NAME);
- Number := 0;
- rewrite(TempFile);
- reset(SourceFile);
- offset := START_SUBSCRIBER_OFFSET;
- while not EOF(SourceFile) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if (OneByte <> DELETER) then
- begin
- Seek(SourceFile, Offset + NUMBER_LENGTH);
- blockRead(SourceFile, BufferArray, ONLY_DATA_SIZE);
- blockWrite(TempFile, Number, NUMBER_LENGTH);
- blockWrite(TempFile, BufferArray, ONLY_DATA_SIZE);
- inc(Number);
- end;
- Offset := Offset + RECORD_SIZE;
- seek(SourceFile, Offset);
- end;
- closeFile(SourceFile);
- closeFile(TempFile);
- deleteFile(GetCurrentDir + '\' + FILE_NAME);
- RenameFile(GetCurrentDir + '\' + TEMP_FILE_NAME, GetCurrentDir + '\' + FILE_NAME);
- end;
- procedure write(TelephoneNumber: TTelephoneNumber; Surname: TSurname;
- Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay);
- const
- MAX_SUBSCRIBER_NUMBER = 999999;
- var
- SourceFile: TBinaryFile;
- SizeOfFile: integer;
- NumberOfRecord: LongWord;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- SizeOfFile := fileSize(SourceFile) - START_SUBSCRIBER_OFFSET;
- NumberOfRecord := SizeOfFile div RECORD_SIZE;
- if NumberOfRecord < MAX_SUBSCRIBER_NUMBER then
- begin
- Seek(SourceFile, SizeOfFile);
- blockWrite(SourceFile, NumberOfRecord, NUMBER_LENGTH);
- blockWrite(SourceFile, TelephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockWrite(SourceFile, Surname, SURNAME_LENGTH);
- blockWrite(SourceFile, Name, NAME_LENGTH);
- blockWrite(SourceFile, FatherName, PATRONYMIC_LENGTH);
- blockWrite(SourceFile, City, CITY_LENGTH);
- blockWrite(SourceFile, DateOfPay, DATE_OF_PAY_LENGTH);
- end;
- closeFile(SourceFile);
- end;
- procedure write(SubscriberIndex: TNumber; TelephoneNumber: TTelephoneNumber;
- Surname: TSurname; Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay);
- var
- SourceFile: TBinaryFile;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- seek(SourceFile, START_SUBSCRIBER_OFFSET + SubscriberIndex * RECORD_SIZE);
- blockWrite(SourceFile, SubscriberIndex, NUMBER_LENGTH);
- blockWrite(SourceFile, TelephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockWrite(SourceFile, Surname, SURNAME_LENGTH);
- blockWrite(SourceFile, Name, NAME_LENGTH);
- blockWrite(SourceFile, Fathername, PATRONYMIC_LENGTH);
- blockWrite(SourceFile, City, CITY_LENGTH);
- blockWrite(SourceFile, DateofPay, DATE_OF_PAY_LENGTH);
- closeFile(SourceFile);
- end;
- procedure deleteSubscriber(NumberOfSubscriber: TNumber);
- const
- DELETER: ansichar = '/';
- var
- SourceFile: TBinaryFile;
- Offset: integer;
- NumberOfRecord: LongWord;
- DeleterArray: array[1..RECORD_SIZE] of ansichar;
- begin
- fillchar(DeleterArray, RECORD_SIZE, DELETER);
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := NumberOfSubscriber * RECORD_SIZE;
- seek(SourceFile, Offset);
- blockWrite(SourceFile, DeleterArray, RECORD_SIZE);
- closeFile(SourceFile);
- end;
- function toTelephoneNumber(Data: string): TTelephoneNumber;
- var
- ResultArray: TTelephoneNumber;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := ansichar(Data[i]);
- inc(i);
- end;
- while i <= TELEPHONE_NUMBER_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toSurname(Data: string): TSurname;
- var
- ResultArray: TSurname;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := ansichar(Data[i]);
- inc(i);
- end;
- while i <= SURNAME_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toName(Data: string): TName;
- var
- ResultArray: TName;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= NAME_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toPatronymic(Data: string): TPatronymic;
- var
- ResultArray: TPatronymic;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= PATRONYMIC_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toCity(Data: string): TCity;
- var
- ResultArray: TCity;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= CITY_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toDateOfPay(StartDate: TDate; Data: integer): TDateOfPay;
- const
- FIRST_DOT = 3;
- SECOND_DOT = 6;
- MAX_DATE_STR = '23.11.9999';
- var
- ResultArray: TDateOfPay;
- i, j: integer;
- NewDate: TDate;
- NewDateString: string;
- MaxDate: TDate;
- begin
- MaxDate := strToDate(MAX_DATE_STR);
- NewDate := incDay(StartDate, Round(Data/(ServiceCost / 30)));
- NewDateString := dateToStr(NewDate);
- j := 1;
- if (CompareDate(NewDate, MaxDate) = 1) then
- NewDateString := dateToStr(StartDate);
- for i := 1 to (DATE_OF_PAY_LENGTH + 2) do
- begin
- if (i <> FIRST_DOT) and (i <> SECOND_DOT) then
- begin
- ResultArray[j] := ansichar(NewDateString[i]);
- inc(j)
- end
- end;
- Result := ResultArray;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement