unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

const RecCount = 1000000;
      LoopSize = 1000000;
      WM_ThreadDone = WM_USER;

type
  TfMain = class(TForm)
    GroupBox1: TGroupBox;
    eName: TLabeledEdit;
    dtBirthday: TDateTimePicker;
    Label1: TLabel;
    ePhone: TLabeledEdit;
    eAddress: TLabeledEdit;
    eWeight: TLabeledEdit;
    eHeight: TLabeledEdit;
    btnClearForm: TButton;
    btnWrite: TButton;
    btnGoToBegin: TButton;
    btnAbout: TButton;
    pn: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnClearFormClick(Sender: TObject);
    procedure btnWriteClick(Sender: TObject);
    procedure btnGoToBeginClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ThreadDone(var AMessage : TMessage); message WM_ThreadDone;
  end;

  PPeopleInfo = ^TPeopleInfo;
  TPeopleInfo = record
    Name : string[100];
    Weight : real;
    Height : real;
    Birthday : TDate;
    Phone : string[50];
    Address : string[200];
  end;

var
  fMain: TfMain;
  PF : file of TPeopleInfo;
  MainDir : string;
  PI : TPeopleInfo;
  PIarr : array [1..RecCount] of TPeopleInfo;

  FFileHandle : THandle;       // Ідентифікатор відкритого файлу

  hWritingThread : THandle;
  WritingThreadID  : DWORD;

const PFName = 'PeopleData.fdata';
      EndMessage = 'Операцію запису закінчено!';

implementation

{$R *.dfm}

procedure TfMain.ThreadDone(var AMessage : TMessage);
begin
  CloseHandle(hWritingThread);
  ShowMessage(EndMessage);
  btnWrite.Enabled := true;
end;

procedure TfMain.btnAboutClick(Sender: TObject);
begin
  MessageDlg('Демонстрація синхронного файлового вводу/ виводу', mtInformation, [mbOK], 0);
end;

function WritingThreadFunc(Ptr: Pointer): LongInt;
var WrittenBytes, I: DWORD;
    PIPtr : PPeopleInfo;
begin
  PIPtr := PPeopleInfo(Ptr);

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PIPtr^;

  WriteFile(FFileHandle, PIarr, SizeOf(PIarr), WrittenBytes, nil);

  FlushFileBuffers(FFileHandle);

  PostMessage(fMain.Handle, WM_ThreadDone, 0, 0);
end;

procedure TfMain.btnWriteClick(Sender: TObject);
var I : DWORD;
begin
  with PI do begin
    Name := eName.Text;
    Birthday := dtBirthday.Date;
    Phone := ePhone.Text;
    Address := eAddress.Text;
    Weight := StrToFloat(eWeight.Text);
    Height := StrToFloat(eHeight.Text);
  end;
  btnWrite.Enabled := false;

  hWritingThread := BeginThread(nil, 0, @WritingThreadFunc, @PI, 0, WritingThreadID);

  for I := 1 to LoopSize do
    if I mod 50 = 0 then begin
      pn.Caption := IntToStr(I);
      Application.ProcessMessages;
    end;
end;

procedure TfMain.btnClearFormClick(Sender: TObject);
begin
  eName.Text := '';
  dtBirthday.Date := EncodeDate(2000, 1, 1);
  ePhone.Text := '';
  eAddress.Text := '';
  eWeight.Text := '';
  eHeight.Text := '';
end;

procedure TfMain.btnGoToBeginClick(Sender: TObject);
begin
  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
  MainDir := ExtractFilePath(Application.ExeName);
  FFileHandle := CreateFile(PWideChar(MainDir + PFName), GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if FFileHandle = INVALID_HANDLE_VALUE then begin
    ShowMessage('Не вдалося відкрити/ створити файл!');
  end;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
  CloseHandle(FFileHandle);
  DeleteFile(PWideChar(MainDir + PFName));
end;

end.
