Взаимодействие двух процессов - Delphi - Ответ 7013725

unit FirstUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Con-trols, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    GenBtn: TButton;
    ClearBtn: TButton;
    procedure GenBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
var
  MyMutex: Thandle;
 
procedure TForm1.GenBtnClick(Sender: TObject);
var
  m: cardinal;
  i, j, n: integer;
  ff: TextFile;
begin
  if Edit1.Text = '' then
    begin
      ShowMessage('Не задано количество чисел');
      Exit;
    end;
   n:= StrToInt(Edit1.Text);
 
  randomize;
  for i:= 1 to n do
    begin
// Ждем освобождения мьютекса, если он занят в этом или другом процессе
      if WaitForSingleObject(MyMutex, INFINITE) = WAIT_OBJECT_0 then
        begin    // Выполняется при свободном  мьютексе
          AssignFile(ff,'1.txt');
          Rewrite(ff);
          m:= random (4294967295);   // самое большое 32 разрядное число
          writeln(ff, m);            // пишем его в файл
          Memo1.Lines.Add(IntToStr(m));
//          Flush(ff);                // фиксируем изменения файла на диск
          CloseFile(ff);
 
// Освобождаем мьютекс
          ReleaseMutex(MyMutex);
// Ждем  0.5 секунды, чтобы 2ой процесс зазватил мьютекс
          Sleep(500);
          j:=0;
// Ждем пока не будет файла, т.е. пока вторая программа его удалит
          While FileExists('1.txt') do // Ждем еще до 5 секунд
            begin
              Sleep(500);
              inc(j);
              if j = 10 then
                begin
                  ShowMessage('Не запущена читающая программа' +
                      chr(13) + chr(10) + 'или ожидание слишком велико');
                  Exit;
                end;
            end;
// Конец цикла вывода чисел
        end;
    end;
// После генерации последнего числа захватываем его и сразу осво-бождаем
  if WaitForSingleObject(MyMutex, INFINITE) = WAIT_OBJECT_0 then
    ReleaseMutex(MyMutex);
end;
 
procedure TForm1.ClearBtnClick(Sender: TObject);
begin
  Memo1.Clear;
end;
 
initialization
  MyMutex:= 0;
  MyMutex:= CreateMutex(nil, False, 'Mutex001');
  if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      MessageBox(0,'Вполне возможно читающая программа уже'  + chr(13) + chr(10) +
                              'читала информацию и не освободила мьютекс,' + chr(13) + chr(10) +
                              'перезапустите читающую программу', 'Ошибка',
                              MB_OK or MB_ICONSTOP);
      halt;
    end;
 
finalization
  CloseHandle(MyMutex);
 
end.

unit SecondUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Con-trols, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
var
  MyMutex: THandle;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  m: cardinal;
  i, j, n: integer;
  ff: TextFile;
begin
// Создаем или открываем мьютекс
  n:= 10000; // Предполагаем чтение 10000 чисел
   randomize;
   for i:= 1 to n do
     begin
       MyMutex:= OpenMutex(SYNCHRONIZE, FALSE, 'Mutex001');
       if MyMutex = 0 then
         begin
           ShowMessage('Не запущен процесс, создающий мьютекс');
           Exit;
         end;
// Ждем освобождения мьютекса, если он занят
       if WaitForSingleObject(MyMutex, INFINITE) = WAIT_OBJECT_0 then
// Выполняется при свободном  мьютексе
         begin
           if FileExists('..\1\1.txt') then
             begin
               AssignFile(ff,'..\1\1.txt'); // Файл в каталоге в папке "1" рядом
               Reset(ff);
             end
           else
             begin
               ShowMessage('Нет файла с данными или не' + chr(13) + chr(10) +
                           'запущена создающая файл программа');
               Exit;
             end;
           readln(ff, m);   // читаем число
           Memo1.Lines.Add(IntToStr(m));// пишем его в Memo
           CloseFile(ff);
           DeleteFile('..\1\1.txt');   // Удаляем файл
// Освобождаем мьютекс
           ReleaseMutex(MyMutex);
 
// Ждем  0.5 секунды
           Sleep(500); j:=0;
// Ждем появления файла, т.е. пока первая программа его создаст
           while not FileExists('..\1\1.txt') do  // Ожидаем появления файла
             begin                                // до 3х секунд
               Sleep(500);
               inc(j);
               if j = 6 then
                 begin
                   ShowMessage('Не могу больше ничего прочитать' + chr(13) +
                                chr(10) + 'или передача завершена');
                   Edit1.Text:= IntToStr(i);
                   Exit;
                   ReleaseMutex(MyMutex);
                 end;
             end;
         end;
     end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
  Edit1.Clear;
end;
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  key:= #0;
end;
 
end.