Синхронизация потоков - Общие вопросы Delphi

Fireblade-fan · 16.12.2012, 16:07

Нужно написать программу, которая запускает 2 процесса, один "читатель", а другой "писатель". В процессе "писатель" должно быть 2 потока писателей, которые добавляют записи в очередь. Процесс "читатель", удаляет записи из очереди, и в нем так же работают 2 потока. Для обмена данными между процессами нужно использовать проецируемые в память файлы. Синхронизировать потоки нужно с помощью событий, создавать с помощью API функций.
Я вроде все сделал, но когда запускаю "potoki_5.exe", запускаются эти 2 процесса, но работает только писатель, причем по несколько раз может добавить одну и ту же запись.
Подскажите плиз, где я мог ошибиться ))

Код potoki_5

PHP код:


			
program Potoki_5;

 

{$APPTYPE CONSOLE}

 

uses

  SysUtils,

  Windows;

 

const n=10;

 

type telem=array [1..n] of integer;

      TQueue=^telem;

 

var queue:TQueue;

    head,tail,count:integer;

    StartInFoW,StartInFoR: TStartupInfo;//ia?aiao?u caionea

    ProcInFoW,ProcInFoR: TProcessInformation;//ia?aiao?u i?ioannia

    hFileMap,hEvent:THandle;

    pView:Pointer;

   // i:integer;

 

Procedure Init;

begin

    head:=1;

    tail:=1;

    count:=0

end;

 

Procedure InQueue(c:integer);

begin

    queue[tail]:=c;

    tail:=tail+1;

    count:=count+1;

    if tail>n then tail:=1

end;

 

Procedure FromQueue(var c:integer);

begin

    c:=queue[head];

    head:=head+1;

    count:=count-1;

    if head>n then tail:=1;

end;

 

Function Empty:boolean;

begin

    Empty:=count=0

end;

 

 

begin

  new(queue);

  init;

  hFileMap:=CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,SizeOf(telem),'FileMap');

  if   hFileMap=0

   then Writeln('Mapping Error')

   else

    begin

      writeln('Mapping Create');

      pView:=MapViewOfFile(hFileMap,FILE_MAP_ALL_ACCESS,0,0,0);

      if pView=nil then

        Writeln('MappingView Error')

       else

        CopyMemory(pView,queue,SizeOf(telem));

      hEvent:=CreateEvent(nil,TRUE,TRUE,'Event');

      //создание процесса писателя

      FillChar(StartInFoW,SizeOf(StartInFoW),0);

      with StartInFoW do

        begin

            cb:=SizeOf(StartInFoW);

            dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;

            wShowWindow:=SW_SHOWNORMAL;

        end;

      if not CreateProcess(nil,PChar('Writer.exe'),nil,nil,

                                     False,CREATE_NEW_CONSOLE,

                                     nil,nil,StartInFoW,ProcInFoW)

      then raise Exception.Create('NOT CREATE PROCESS WRITER');

 

 

      //создание процесса читателя

      FillChar(StartInFoR,SizeOf(StartInFoR),0);//i?enoea

      with StartInFoR do

        begin

           cb:=SizeOf(StartInFoR);

           dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;

           wShowWindow:=SW_SHOWNORMAL;

        end;

 

      if not CreateProcess(nil,PChar('Reader.exe'),nil,nil,

                                False,CREATE_NEW_CONSOLE,nil,nil

                                ,StartInFoR,ProcInFoR)

        then raise Exception.Create('NOT CREATE PROCESS READER');

   end;

   readln;

    CloseHandle(hEvent);

end.

Fireblade-fan · 16.12.2012, 16:08

код reader

PHP код:


			
program Reader;

 

{$APPTYPE CONSOLE}

 

uses

  SysUtils,

  Classes,

  Windows;

 

const n=10;

 

type telem=array [1..n] of integer;

      TQueue=^telem;

 

 var queue:TQueue;

    head,tail,count:integer;

    hFileMap,hEvent:THandle;

    pView:Pointer;

    ThreadID1, ThreadID2:dword;

    chitatel1, chitatel2: THandle;

    s1,s2:string;

 

Procedure Init;

begin

    head:=1;

    tail:=1;

    count:=0

end;

 

Procedure InQueue(c:integer);

begin

    queue[tail]:=c;

    tail:=tail+1;

    count:=count+1;

    if tail>n then tail:=1

end;

 

Procedure FromQueue(var c:integer);

begin

    c:=queue[head];

    head:=head+1;

    count:=count-1;

    if head>n then tail:=1;

end;

 

Function Empty:boolean;

begin

    Empty:=count=0

end;

 

Function Chitatel(s:string):longint; stdcall;

var i:integer; w:dWord; n:integer;

begin

    hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap');

    if   hFileMap=0

     then Writeln('Mapping Error')

     else

     begin

        w:=WaitForSingleObject(hevent, INFINITE);

        if w=WAIT_OBJEcT_0 then

        begin

            //for n:=1 to 3 do

            while True do

            begin

                w:=WaitForSingleObject(hEvent, INFINITE);

                if w=WAIT_OBJEcT_0 then

                begin 

                    ResetEvent(hEvent);

                    Sleep(500);

                    pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0);

                    CopyMemory(queue,pView,SizeOf(telem));

                    if not empty

                    then

                    begin

                      FromQueue(i);

                      Writeln (s,' udalil ',i,' zapis');

                    end;

                    SetEvent(hEvent);

                end;

                CopyMemory(pView,queue,SizeOf(telem));

            end;

        end;

    end;

end; 

 

begin

  new(queue);

  s1:='chitatel 1'; s2:='chitatel 2';

  hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие

  Chitatel1:=CreateThread (nil, 0, @ chitatel, pointer(s1), 0, ThreadID1);

  Chitatel2:=CreateThread (nil, 0, @ chitatel, pointer(s2), 0, ThreadID2);

  readln;

  //CloseHandle(hEvent);

  CloseHandle(chitatel1);

  CloseHandle(chitatel2);

  //UnmapViewOfFile(pView);

  //CloseHandle(hFileMap);

end.

код writer

PHP код:


			
{$APPTYPE CONSOLE}

 

uses

  SysUtils,

  Classes,

  Windows;

 

const n=10;

 

type telem=array [1..n] of integer;

      TQueue=^telem;

 

 var queue:TQueue;

    head,tail,count,i:integer;

    hFileMap,hEvent:THandle;

    pView:Pointer;

    ThreadID1, ThreadID2:dword;

    pisatel1, pisatel2: THandle;

    s1,s2:string;

 

Procedure Init;

begin

    head:=1;

    tail:=1;

    count:=0

end;

 

Procedure InQueue(c:integer);

begin

    queue[tail]:=c;

    tail:=tail+1;

    count:=count+1;

    if tail>n then tail:=1

end;

 

Procedure FromQueue(var c:integer);

begin

    c:=queue[head];

    head:=head+1;

    count:=count-1;

    if head>n then tail:=1;

end;

 

Function Pisatel(s:string):longint; stdcall;

var w:dWord; n:integer;

begin

    hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap');

    if   hFileMap=0

     then Writeln('Mapping Error')

     else

     begin

        //for n:=1 to 3 do

        while True do

        begin

            w:=WaitForSingleObject(hEvent, INFINITE);

            if w=WAIT_OBJEcT_0 then

            begin

                ResetEvent(hEvent);  

                Sleep(500);

                pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0);

                CopyMemory(queue,pView,SizeOf(telem));

                InQueue(i);

                Writeln(s,' dobavil ',i,' zapis');

                i:=i+1;

                CopyMemory(pView,queue,SizeOf(telem));

                SetEvent(hEvent);

            end;

        end;

    end;

end;

 

begin

  i:=1;

  new(queue);

  s1:='pisatel 1'; s2:='pisatel 2';

  hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие

  pisatel1:=CreateThread (nil, 0, @ pisatel, pointer(s1), 0, ThreadID1);

  pisatel2:=CreateThread (nil, 0, @ pisatel, pointer(s2), 0, ThreadID2);

  readln;

  CloseHandle(hEvent);

  CloseHandle(pisatel2);

  CloseHandle(pisatel1);

  //UnmapViewOfFile(pView);

  //CloseHandle(hFileMap);

end.

eoln · 16.12.2012, 18:44

Тут проблема в том, что сразу 4 потока ждут события одновременно и waitforsingleobject могут проскочить несколько потоков, так как при создании события было указано ручное управление сбросом/созданием. В главной программе меняй создание события на автоматический сброс

Код:

hEvent:=CreateEvent(nil,false,TRUE,'Event');

это гарантирует "проскок" только одного потока одновременно
Далее в других процессах удаляй все ручные сбросы ResetEvent, а вместо создания события

Код:

SetEvent(hEvent);

надо вызвать событие для продолжения работы ранее ожидавших потоков

Код:

PulseEvent(hEvent);

В ридере убери один из waitforsingleobject и измени процедуру. Так, например, if not empty - тут всегда ложно будет, ибо count первоначально инициализирован средой в ноль.

И код надо другим тегом оформлять (кнопка с решёткой #)

Fireblade-fan · 17.12.2012, 00:37

eoln, Спасибо! Все переделал, исходник ридера я не тот выложил )) Но все равно не работает, у меня цикл стоит бесконечный, а он только выводит пару записей и все.
Вот исправленый код:

Код:

program Potoki_5;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const n=10;

type telem=array [1..n] of integer;
      TQueue=^telem;

var queue:TQueue;
    head,tail,count:integer;
    StartInFoW,StartInFoR: TStartupInfo;//ia?aiao?u caionea
    ProcInFoW,ProcInFoR: TProcessInformation;//ia?aiao?u i?ioannia
    hFileMap,hEvent:THandle;
    pView:Pointer;
   // i:integer;

Procedure Init;
begin
	head:=1;
	tail:=1;
	count:=0
end;

Procedure InQueue(c:integer);
begin
	queue[tail]:=c;
	tail:=tail+1;
	count:=count+1;
	if tail>n then tail:=1
end;

Procedure FromQueue(var c:integer);
begin
	c:=queue[head];
	head:=head+1;
	count:=count-1;
	if head>n then tail:=1;
end;

Function Empty:boolean;
begin
	Empty:=count=0
end;


begin
  new(queue);
  init;
  hFileMap:=CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,SizeOf(telem),'FileMap');
  if   hFileMap=0
   then Writeln('Mapping Error')
   else
    begin
      writeln('Mapping Create');
      pView:=MapViewOfFile(hFileMap,FILE_MAP_ALL_ACCESS,0,0,0);
      if pView=nil then
        Writeln('MappingView Error')
       else
        CopyMemory(pView,queue,SizeOf(telem));
	  hEvent:=CreateEvent(nil,FALSE,TRUE,'Event');
      //создание процесса писателя
      FillChar(StartInFoW,SizeOf(StartInFoW),0);
      with StartInFoW do
        begin
            cb:=SizeOf(StartInFoW);
            dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
            wShowWindow:=SW_SHOWNORMAL;
        end;
      if not CreateProcess(nil,PChar('Writer.exe'),nil,nil,
                                     False,CREATE_NEW_CONSOLE,
                                     nil,nil,StartInFoW,ProcInFoW)
      then raise Exception.Create('NOT CREATE PROCESS WRITER');


      //создание процесса читателя
      FillChar(StartInFoR,SizeOf(StartInFoR),0);//i?enoea
      with StartInFoR do
        begin
           cb:=SizeOf(StartInFoR);
           dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
           wShowWindow:=SW_SHOWNORMAL;
        end;

      if not CreateProcess(nil,PChar('Reader.exe'),nil,nil,
                                False,CREATE_NEW_CONSOLE,nil,nil
                                ,StartInFoR,ProcInFoR)
        then raise Exception.Create('NOT CREATE PROCESS READER');
   end;
   readln;
    CloseHandle(hEvent);
end.

Код:

program Reader;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  Windows;

const n=10;

type telem=array [1..n] of integer;
      TQueue=^telem;

 var queue:TQueue;
    head,tail,count:integer;
    hFileMap,hEvent:THandle;
    pView:Pointer;
    ThreadID1, ThreadID2:dword;
    chitatel1, chitatel2: THandle;
    s1,s2:string;

Procedure Init;
begin
	head:=1;
	tail:=1;
	count:=0
end;

Procedure InQueue(c:integer);
begin
	queue[tail]:=c;
	tail:=tail+1;
	count:=count+1;
	if tail>n then tail:=1
end;

Procedure FromQueue(var c:integer);
begin
	c:=queue[head];
	head:=head+1;
	count:=count-1;
	if head>n then tail:=1;
end;

Function Empty:boolean;
begin
	Empty:=count=0
end;

Function Chitatel(s:string):longint; stdcall;
var i:integer; w:dWord; n:integer;
begin
  hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap');
  if   hFileMap=0
    then Writeln('Mapping Error')
  else
  begin
      //for n:=1 to 3 do
      while True do
      begin
        w:=WaitForSingleObject(hEvent, INFINITE);
        if w=WAIT_OBJEcT_0 then
        begin;
          //ResetEvent(hEvent);
          pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0);
          CopyMemory(queue,pView,SizeOf(telem));
          FromQueue(i);
          Writeln (s,' udalil ',i,' zapis');
          CopyMemory(pView,queue,SizeOf(telem));
          //SetEvent(hEvent);
          PulseEvent(hEvent);
          Sleep(500);
        end;
      end;
  end;
end; 

begin
  new(queue);
  s1:='chitatel 1'; s2:='chitatel 2';
  hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие
  Chitatel1:=CreateThread (nil, 0, @ chitatel, pointer(s1), 0, ThreadID1);
  Chitatel2:=CreateThread (nil, 0, @ chitatel, pointer(s2), 0, ThreadID2);
  readln;
  //CloseHandle(hEvent);
  CloseHandle(chitatel1);
  CloseHandle(chitatel2);
  //UnmapViewOfFile(pView);
  //CloseHandle(hFileMap);
end.

Fireblade-fan · 17.12.2012, 00:37

Код:

program Writer;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  Windows;

const n=10;

type telem=array [1..n] of integer;
      TQueue=^telem;

 var queue:TQueue;
    head,tail,count,i:integer;
    hFileMap,hEvent:THandle;
    pView:Pointer;
    ThreadID1, ThreadID2:dword;
    pisatel1, pisatel2: THandle;
    s1,s2:string;

Procedure Init;
begin
	head:=1;
	tail:=1;
	count:=0
end;

Procedure InQueue(c:integer);
begin
	queue[tail]:=c;
	tail:=tail+1;
	count:=count+1;
	if tail>n then tail:=1
end;

Procedure FromQueue(var c:integer);
begin
	c:=queue[head];
	head:=head+1;
	count:=count-1;
	if head>n then tail:=1;
end;

Function Pisatel(s:string):longint; stdcall;
var w:dWord; n:integer;
begin
  hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap');
  if   hFileMap=0
  then Writeln('Mapping Error')
  else
  begin
    //for n:=1 to 3 do
    while True do
    begin
      w:=WaitForSingleObject(hEvent, INFINITE);
      if w=WAIT_OBJEcT_0 then
      begin
        //ResetEvent(hEvent);
        pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0);
        CopyMemory(queue,pView,SizeOf(telem));
        InQueue(i);
        Writeln(s,' dobavil ',i,' zapis');
        i:=i+1;
        CopyMemory(pView,queue,SizeOf(telem));
        //SetEvent(hEvent);
        PulseEvent(hEvent);
        Sleep(500);
      end;
    end;
  end;
end;

begin
  i:=1;
  new(queue);
  s1:='pisatel 1'; s2:='pisatel 2';
  hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие
  pisatel1:=CreateThread (nil, 0, @ pisatel, pointer(s1), 0, ThreadID1);
  pisatel2:=CreateThread (nil, 0, @ pisatel, pointer(s2), 0, ThreadID2);
  readln;
  //CloseHandle(hEvent);
  //SuspendThread(pisatel1);
  //SuspendThread(pisatel2);
  CloseHandle(pisatel2);
  CloseHandle(pisatel1);
  //UnmapViewOfFile(pView);
  //CloseHandle(hFileMap);
end.

Fireblade-fan · 17.12.2012, 01:57

Вроде все сделал, все исправил!! ))

16.12.2012, 16:07	#1
Fireblade-fan Пользователь Регистрация: 23.11.2011 Сообщений: 34	Синхронизация потоков Нужно написать программу, которая запускает 2 процесса, один "читатель", а другой "писатель". В процессе "писатель" должно быть 2 потока писателей, которые добавляют записи в очередь. Процесс "читатель", удаляет записи из очереди, и в нем так же работают 2 потока. Для обмена данными между процессами нужно использовать проецируемые в память файлы. Синхронизировать потоки нужно с помощью событий, создавать с помощью API функций. Я вроде все сделал, но когда запускаю "potoki_5.exe", запускаются эти 2 процесса, но работает только писатель, причем по несколько раз может добавить одну и ту же запись. Подскажите плиз, где я мог ошибиться )) Код potoki_5 PHP код: program Potoki_5; {$APPTYPE CONSOLE} uses SysUtils, Windows; const n=10; type telem=array [1..n] of integer; TQueue=^telem; var queue:TQueue; head,tail,count:integer; StartInFoW,StartInFoR: TStartupInfo;//ia?aiao?u caionea ProcInFoW,ProcInFoR: TProcessInformation;//ia?aiao?u i?ioannia hFileMap,hEvent:THandle; pView:Pointer; // i:integer; Procedure Init; begin head:=1; tail:=1; count:=0 end; Procedure InQueue(c:integer); begin queue[tail]:=c; tail:=tail+1; count:=count+1; if tail>n then tail:=1 end; Procedure FromQueue(var c:integer); begin c:=queue[head]; head:=head+1; count:=count-1; if head>n then tail:=1; end; Function Empty:boolean; begin Empty:=count=0 end; begin new(queue); init; hFileMap:=CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,SizeOf(telem),'FileMap'); if hFileMap=0 then Writeln('Mapping Error') else begin writeln('Mapping Create'); pView:=MapViewOfFile(hFileMap,FILE_MAP_ALL_ACCESS,0,0,0); if pView=nil then Writeln('MappingView Error') else CopyMemory(pView,queue,SizeOf(telem)); hEvent:=CreateEvent(nil,TRUE,TRUE,'Event'); //создание процесса писателя FillChar(StartInFoW,SizeOf(StartInFoW),0); with StartInFoW do begin cb:=SizeOf(StartInFoW); dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK; wShowWindow:=SW_SHOWNORMAL; end; if not CreateProcess(nil,PChar('Writer.exe'),nil,nil, False,CREATE_NEW_CONSOLE, nil,nil,StartInFoW,ProcInFoW) then raise Exception.Create('NOT CREATE PROCESS WRITER'); //создание процесса читателя FillChar(StartInFoR,SizeOf(StartInFoR),0);//i?enoea with StartInFoR do begin cb:=SizeOf(StartInFoR); dwFlags:=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK; wShowWindow:=SW_SHOWNORMAL; end; if not CreateProcess(nil,PChar('Reader.exe'),nil,nil, False,CREATE_NEW_CONSOLE,nil,nil ,StartInFoR,ProcInFoR) then raise Exception.Create('NOT CREATE PROCESS READER'); end; readln; CloseHandle(hEvent); end.

16.12.2012, 18:44	#3
eoln Старожил Регистрация: 26.04.2008 Сообщений: 2,645	Тут проблема в том, что сразу 4 потока ждут события одновременно и waitforsingleobject могут проскочить несколько потоков, так как при создании события было указано ручное управление сбросом/созданием. В главной программе меняй создание события на автоматический сброс Код: `hEvent:=CreateEvent(nil,false,TRUE,'Event');` это гарантирует "проскок" только одного потока одновременно Далее в других процессах удаляй все ручные сбросы ResetEvent, а вместо создания события Код: `SetEvent(hEvent);` надо вызвать событие для продолжения работы ранее ожидавших потоков Код: `PulseEvent(hEvent);` В ридере убери один из waitforsingleobject и измени процедуру. Так, например, if not empty - тут всегда ложно будет, ибо count первоначально инициализирован средой в ноль. И код надо другим тегом оформлять (кнопка с решёткой #)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Синхронизация потоков	_Bers	Общие вопросы C/C++	5	23.12.2011 22:57
Синхронизация потоков	kardinal94	Общие вопросы Delphi	5	29.11.2010 21:13
Синхронизация потоков	alenka_ej	Помощь студентам	0	03.06.2010 22:20
синхронизация потоков	m_kostik	Win Api	0	26.03.2010 23:56

16.12.2012, 16:08	#2
Fireblade-fan Пользователь Регистрация: 23.11.2011 Сообщений: 34	код reader PHP код: program Reader; {$APPTYPE CONSOLE} uses SysUtils, Classes, Windows; const n=10; type telem=array [1..n] of integer; TQueue=^telem; var queue:TQueue; head,tail,count:integer; hFileMap,hEvent:THandle; pView:Pointer; ThreadID1, ThreadID2:dword; chitatel1, chitatel2: THandle; s1,s2:string; Procedure Init; begin head:=1; tail:=1; count:=0 end; Procedure InQueue(c:integer); begin queue[tail]:=c; tail:=tail+1; count:=count+1; if tail>n then tail:=1 end; Procedure FromQueue(var c:integer); begin c:=queue[head]; head:=head+1; count:=count-1; if head>n then tail:=1; end; Function Empty:boolean; begin Empty:=count=0 end; Function Chitatel(s:string):longint; stdcall; var i:integer; w:dWord; n:integer; begin hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap'); if hFileMap=0 then Writeln('Mapping Error') else begin w:=WaitForSingleObject(hevent, INFINITE); if w=WAIT_OBJEcT_0 then begin //for n:=1 to 3 do while True do begin w:=WaitForSingleObject(hEvent, INFINITE); if w=WAIT_OBJEcT_0 then begin ResetEvent(hEvent); Sleep(500); pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0); CopyMemory(queue,pView,SizeOf(telem)); if not empty then begin FromQueue(i); Writeln (s,' udalil ',i,' zapis'); end; SetEvent(hEvent); end; CopyMemory(pView,queue,SizeOf(telem)); end; end; end; end; begin new(queue); s1:='chitatel 1'; s2:='chitatel 2'; hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие Chitatel1:=CreateThread (nil, 0, @ chitatel, pointer(s1), 0, ThreadID1); Chitatel2:=CreateThread (nil, 0, @ chitatel, pointer(s2), 0, ThreadID2); readln; //CloseHandle(hEvent); CloseHandle(chitatel1); CloseHandle(chitatel2); //UnmapViewOfFile(pView); //CloseHandle(hFileMap); end. код writer PHP код: {$APPTYPE CONSOLE} uses SysUtils, Classes, Windows; const n=10; type telem=array [1..n] of integer; TQueue=^telem; var queue:TQueue; head,tail,count,i:integer; hFileMap,hEvent:THandle; pView:Pointer; ThreadID1, ThreadID2:dword; pisatel1, pisatel2: THandle; s1,s2:string; Procedure Init; begin head:=1; tail:=1; count:=0 end; Procedure InQueue(c:integer); begin queue[tail]:=c; tail:=tail+1; count:=count+1; if tail>n then tail:=1 end; Procedure FromQueue(var c:integer); begin c:=queue[head]; head:=head+1; count:=count-1; if head>n then tail:=1; end; Function Pisatel(s:string):longint; stdcall; var w:dWord; n:integer; begin hFileMap:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,'FileMap'); if hFileMap=0 then Writeln('Mapping Error') else begin //for n:=1 to 3 do while True do begin w:=WaitForSingleObject(hEvent, INFINITE); if w=WAIT_OBJEcT_0 then begin ResetEvent(hEvent); Sleep(500); pView:=MapViewOfFile(hFileMap,FILE_MAP_WRITE,0,0,0); CopyMemory(queue,pView,SizeOf(telem)); InQueue(i); Writeln(s,' dobavil ',i,' zapis'); i:=i+1; CopyMemory(pView,queue,SizeOf(telem)); SetEvent(hEvent); end; end; end; end; begin i:=1; new(queue); s1:='pisatel 1'; s2:='pisatel 2'; hEvent:=OpenEvent(EVENT_ALL_ACCESS,TRUE,'Event');//Создается событие pisatel1:=CreateThread (nil, 0, @ pisatel, pointer(s1), 0, ThreadID1); pisatel2:=CreateThread (nil, 0, @ pisatel, pointer(s2), 0, ThreadID2); readln; CloseHandle(hEvent); CloseHandle(pisatel2); CloseHandle(pisatel1); //UnmapViewOfFile(pView); //CloseHandle(hFileMap); end.

17.12.2012, 01:57	#6
Fireblade-fan Пользователь Регистрация: 23.11.2011 Сообщений: 34	Вроде все сделал, все исправил!! ))