• Я родился с этим знанием
  
• Ко мне во сне Билл Гейтс приходил и все-все рассказал
  
• Читал документацию, книжки, форумы разные... Думал, пробовал и опять думал
  

unit Unit1;

interface

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

type
  TTaskRec = record
    FileName: string;
  end;
  PTaskRec = ^TTaskRec;

  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create();
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CPort: TCompletionPort;
  ProcessorsCount: integer;
const
  ThreadPerProcessor = 4;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  n: integer;
begin
  for n:= 0 to Pred(ProcessorsCount * ThreadPerProcessor) do
    TMyThread.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  n: integer;
begin
  for n:= 0 to Pred(ProcessorsCount * ThreadPerProcessor) do
    CPort.SetCompletion(0, 0, TOverlappedEx(nil^));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SR: TSearchRec;
  F: TextFile;
  s: string;
  PTask: PTaskRec;
  POvp: POverlappedEx absolute PTask;
begin
  if FindFirst('D:\Temp\Test\*.txt', faAnyFile, SR) = 0 then
  repeat
    AssignFile(F, 'D:\Temp\Test\'+SR.Name);
    Reset(F);
    Read(f, s);
    CloseFile(F);

    if s = 'new' then
    begin
      New(PTask);
      PTask.FileName:= SR.Name;
      CPort.SetCompletion(0, 1, POvp^);
    end;

  until FindNext(SR) <>0;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s: string;
  n: integer;
begin
  s:= 'new'#13#10 + StringOfChar('x', 1024) + #13#10;
  for n:= 0 to 511 do
  begin
    with TFileStream.Create('D:\Temp\Test\' + IntToStr(n) + '.txt', fmCreate) do
    try
      Size:= 0;
      WriteBuffer(s[1], Length(s));
    finally
      free;
    end;
  end;
end;

{ TMyThread }

constructor TMyThread.Create;
begin
  FreeOnTerminate:= true;
  inherited Create(false);
end;

procedure TMyThread.Execute;
var
  Bytes, Key: Cardinal;
  pOvp: POverlappedEx;
  pTask: PTaskRec absolute pOvp;
  s: string;
  F: TextFile;
begin
  while CPort.WaitCompletion(Bytes, Key, pOvp) do
  begin
    if Key = 0 then Break;
    if pTask <> nil then
    begin
      s:= pTask.FileName;
      Dispose(pTask);
    end else
      Continue;

    AssignFile(F, 'D:\Temp\Test\' + s);
    Append(F);
    WriteLn(F, 'done');
    CloseFile(F);
  end;
end;

procedure Init;
var
  SysInfo: TSystemInfo;
begin
  CPort:= TCompletionPort.Create();
  GetSystemInfo(SysInfo);
  ProcessorsCount:= integer(SysInfo.dwNumberOfProcessors);
end;

initialization
  Init;
finalization
  CPort.Free;
end.

unit Unit1;

interface

uses
  Classes;

type
  MyThread = class(TThread)
  private
    fn:string;
    { Private declarations }
  protected
    procedure Execute; override;
  public
    constructor Create(const AFN:string);
  end;

implementation

uses MainUnit;
constructor MyThread.Create(const AFN:string);
begin
  inherited Create(true);
  FN:=AFN;
  Resume; 
end;

procedure MyThread.Execute;
var
F: TextFile;
begin
AssignFile(F, 'C:\testThread\docs\'+FN);
Append(F);
WriteLn(F, 'done');
CloseFile(F);
end;
end.

procedure TForm1.Button1Click(Sender: TObject);
var
SR: TSearchRec;
F: TextFile;
s: string;
begin
if FindFirst('C:\testThread\docs\*.txt', faAnyFile, SR) = 0 then begin
  AssignFile(F, 'C:\testThread\docs\'+SR.Name);
  Reset(F);
  Read(f, s);
  CloseFile(F);

  repeat
  if s = 'new' then begin
    MyThread.Create(SR.Name);
  end;

  until FindNext(SR) <>0;
end;
end;

end.

type
  MyThread = class(TThread)
  private
    { Private declarations }
    FFileName: string;
  protected
    procedure Execute; override;
  public
    constructor Create(const FileName: string);
  end;

constructor MyThread.Create;
begin
  FFileName:= FileName;
  FreeOnTerminate:= true;
  inherited Create(false);
end;

procedure MyThread.Execute;
var
F: TextFile;
begin
AssignFile(F, 'C:\testThread\docs\'+FFileName);
Append(F);
WriteLn(F, 'done');
CloseFile(F);
end;

unit MainUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  STR: String;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
SR: TSearchRec;
F: TextFile;
s: string;
begin
if FindFirst('C:\testThread\docs\*.txt', faAnyFile, SR) = 0 then
begin
  repeat
  AssignFile(F, 'C:\testThread\docs\'+SR.Name);
  Reset(F);
  Read(f, s);
  CloseFile(F);

  if s = 'new' then
  begin
    STR := SR.Name;
    MyThread.Create(False);
  end;

  until FindNext(SR) <>0;
end;
end;

end.

unit Unit1;

interface

uses
  Classes;

type
  MyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

uses MainUnit;

procedure MyThread.Execute;
var
F: TextFile;
begin
AssignFile(F, 'C:\testThread\docs\'+STR);
Append(F);
WriteLn(F, 'done');
CloseFile(F);
end;
end.