unit Main;

interface

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

type
  TfMain = class(TForm)
    GroupBox1: TGroupBox;
    eName: TLabeledEdit;
    dtBirthday: TDateTimePicker;
    Label1: TLabel;
    ePhone: TLabeledEdit;
    eAddress: TLabeledEdit;
    eWeight: TLabeledEdit;
    eHeight: TLabeledEdit;
    btnClearForm: TButton;
    btnWriteSynchFileObj: TButton;
    btnAbout: TButton;
    pn: TPanel;
    btnWriteSynchEventObj: TButton;
    btnWriteWithCallbackFunc: TButton;
    btnWriteSynchIOCP: TButton;
    btnWriteSynchIORes: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnClearFormClick(Sender: TObject);
    procedure btnWriteSynchFileObjClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure btnWriteSynchEventObjClick(Sender: TObject);
    procedure btnWriteWithCallbackFuncClick(Sender: TObject);
    procedure btnWriteSynchIOCPClick(Sender: TObject);
    procedure btnWriteSynchIOResClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

const RecCount   = 1000000;
      LoopLength = 1000000;
      PFName = 'PeopleData.fdata';

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

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

  ovr0, ovr1, ovr2, ovr3, ovr4 : POverlapped;
  hIOCP : THandle;

  WriteFinished, IORes : BOOL;
  WrittenBytes, IOErrCode : DWORD;
  ckTempFile : DWORD = 1;

implementation

{$R *.dfm}

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

procedure TfMain.btnWriteSynchEventObjClick(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;
  pn.Caption := '';

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PI;
  ShowMessage('Починаємо запис...'#13'Закрийте вікно для початку асинхронної '+
    'операції запису з синхронізацією за допомогою об''єкта події');

  ovr2^.Offset := 0;
  ovr2^.OffsetHigh := 0;
  ovr2^.hEvent := CreateEvent(nil, false, false, nil);

  IORes := WriteFile(FFileHandle, PIarr, SizeOf(PIarr), WrittenBytes, ovr2);
  IOErrCode := GetLastError;

  if (not IORes) and (IOErrCode = ERROR_IO_PENDING) then
    ShowMessage('Операцію запису успішно ініційовано!');

  for I := 0 to LoopLength do begin
    if I mod 50 = 0 then pn.Caption := IntToStr(I);
    Application.ProcessMessages;
  end;
  pn.Caption := 'Чекаємо...';
  pn.Update;

  WaitForSingleObject(ovr2^.hEvent, INFINITE);

  if not GetOverlappedResult(FFileHandle, ovr2^, WrittenBytes, false) then begin
    IOErrCode := GetLastError;
    ShowMessage('Помилка!'#13'Код помилки: ' + IntToStr(IOErrCode) +
      #13'Опис помилки: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  pn.Caption := 'Записано!';

  CloseHandle(ovr2^.hEvent);
  FlushFileBuffers(FFileHandle);
end;

procedure TfMain.btnWriteSynchFileObjClick(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;
  pn.Caption := '';

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PI;
  ShowMessage('Починаємо запис...'#13'Закрийте вікно для початку асинхронної '+
    'операції запису з синхронізацією за допомогою файлового об''єкту');

  ovr1^.Offset := 0;
  ovr1^.OffsetHigh := 0;
  ovr1^.hEvent := 0;

  IORes := WriteFile(FFileHandle, PIarr, SizeOf(PIarr), WrittenBytes, ovr1);
  IOErrCode := GetLastError;

  if (not IORes) and (IOErrCode = ERROR_IO_PENDING) then
    ShowMessage('Операцію запису успішно ініційовано!');

  for I := 0 to LoopLength do begin
    if I mod 50 = 0 then pn.Caption := IntToStr(I);
    Application.ProcessMessages;
  end;
  pn.Caption := 'Чекаємо...';
  pn.Update;

  WaitForSingleObject(FFileHandle, INFINITE);

  if not GetOverlappedResult(FFileHandle, ovr1^, WrittenBytes, false) then begin
    IOErrCode := GetLastError;
    ShowMessage('Помилка!'#13'Код помилки: ' + IntToStr(IOErrCode) +
      #13'Опис помилки: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  pn.Caption := 'Записано!';

  FlushFileBuffers(FFileHandle);
end;

// Функція зворотнього виклику
procedure IOResFunc(dwError, dwNumBytes: DWORD; po: POverlapped); stdcall;
begin
  WriteFinished := true;
end;

procedure TfMain.btnWriteWithCallbackFuncClick(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;
  pn.Caption := '';

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PI;
  ShowMessage('Починаємо запис...'#13'Закрийте вікно для початку асинхронної '+
    'операції запису з повідомленням через функцію зворотнього виклику');

  ovr3^.Offset := 0;
  ovr3^.OffsetHigh := 0;
  ovr3^.hEvent := 0;

  WriteFinished := false;
  IORes := WriteFileEx(FFileHandle, @PIarr, SizeOf(PIarr), ovr3^, @IOResFunc);
  IOErrCode := GetLastError;

  if IORes then ShowMessage('Операцію запису успішно ініційовано!');

  for I := 0 to LoopLength do begin
    if I mod 50 = 0 then pn.Caption := IntToStr(I);
    Application.ProcessMessages;
  end;
  pn.Caption := 'Чекаємо...';
  pn.Update;
  SleepEx(10000, true);

  if not GetOverlappedResult(FFileHandle, ovr3^, WrittenBytes, false) then begin
    IOErrCode := GetLastError;
    ShowMessage('Помилка!'#13'Код помилки: ' + IntToStr(IOErrCode) +
      #13'Опис помилки: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  FlushFileBuffers(FFileHandle);
  fMain.pn.Caption := 'Записано!';
end;

procedure TfMain.btnWriteSynchIOCPClick(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;
  pn.Caption := '';

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PI;
  ShowMessage('Починаємо запис...'#13'Закрийте вікно для початку асинхронної '+
    'операції запису з синхронізацією за допомогою порта завершення вводу-виводу');

  ovr4^.Offset := 0;
  ovr4^.OffsetHigh := 0;
  ovr4^.hEvent := 0;

  hIOCP := CreateIOCompletionPort(FFileHandle, 0, ckTempFile, 0);

  IORes := WriteFile(FFileHandle, PIarr, SizeOf(PIarr), WrittenBytes, ovr4);
  IOErrCode := GetLastError;

  if (not IORes) and (IOErrCode = ERROR_IO_PENDING) then
    ShowMessage('Операцію запису успішно ініційовано!');

  for I := 0 to LoopLength do begin
    if I mod 50 = 0 then pn.Caption := IntToStr(I);
    Application.ProcessMessages;
  end;
  pn.Caption := 'Чекаємо...';
  pn.Update;

  GetQueuedCompletionStatus(hIOCP, WrittenBytes, ckTempFile, ovr4, INFINITE);

  if not GetOverlappedResult(FFileHandle, ovr4^, WrittenBytes, false) then begin
    IOErrCode := GetLastError;
    ShowMessage('Помилка!'#13'Код помилки: ' + IntToStr(IOErrCode) +
      #13'Опис помилки: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  pn.Caption := 'Записано!';

  FlushFileBuffers(FFileHandle);
end;

procedure TfMain.btnWriteSynchIOResClick(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;
  pn.Caption := '';

  SetFilePointer(FFileHandle, 0, nil, FILE_BEGIN);
  SetEndOfFile(FFileHandle);
  for I := 1 to RecCount do PIarr[I] := PI;
  ShowMessage('Починаємо запис...'#13'Закрийте вікно для початку асинхронної '+
    'операції запису з синхронізацією за допомогою перевірки результату асинхронної операції');

  ovr0^.Offset := 0;
  ovr0^.OffsetHigh := 0;
  ovr0^.hEvent := 0;

  IORes := WriteFile(FFileHandle, PIarr, SizeOf(PIarr), WrittenBytes, ovr0);
  IOErrCode := GetLastError;

  if (not IORes) and (IOErrCode = ERROR_IO_PENDING) then
    ShowMessage('Операцію запису успішно ініційовано!');

  for I := 0 to LoopLength do begin
    if I mod 50 = 0 then pn.Caption := IntToStr(I);
    Application.ProcessMessages;
  end;
  pn.Caption := 'Чекаємо...';
  pn.Update;

  if not GetOverlappedResult(FFileHandle, ovr0^, WrittenBytes, true) then begin
    IOErrCode := GetLastError;
    ShowMessage('Помилка!'#13'Код помилки: ' + IntToStr(IOErrCode) +
      #13'Опис помилки: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  pn.Caption := 'Записано!';

  FlushFileBuffers(FFileHandle);
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.FormCreate(Sender: TObject);
begin
  MainDir := ExtractFilePath(Application.ExeName);
  FFileHandle := CreateFile(PWideChar(MainDir + PFName), GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ, nil, CREATE_ALWAYS, FILE_FLAG_OVERLAPPED, 0);
  if FFileHandle = INVALID_HANDLE_VALUE then begin
    ShowMessage('Не вдалося відкрити/ створити файл!');
  end;

  New(ovr0);
  New(ovr1);
  New(ovr2);
  New(ovr3);
  New(ovr4);
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
  Dispose(ovr0);
  Dispose(ovr1);
  Dispose(ovr2);
  Dispose(ovr3);
  Dispose(ovr4);

  CloseHandle(FFileHandle);
  CloseHandle(hIOCP);
  DeleteFile(PWideChar(MainDir + PFName));
end;

end.
