program lab3_7;
{$APPTYPE CONSOLE}
uses
Windows,SysUtils;
var he,hmap,heSinc:THandle;//Дескрипторы события,мэппинга и мьютекса
adres:pchar;//Адрес начала общей памяти
first:boolean;//Первый ли это процесс
hth:array[0..1]of THANDLE;
dw,dr:DWORD;
the_end:boolean;
function GetStringErrorInfo(ErrorCode:Cardinal):String;//Чтобы получать описание ошибки по номеру ошибки
var
i:DWORD;//Номер ощибки
lk : HLOCAL;//Тут будет адрес строки сообщения
begin
i := ErrorCode;
lk := 0;
//Эта функция формирует строку сообщения
if FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
FORMAT_MESSAGE_ALLOCATE_BUFFER,
nil,
i,
0,
PChar(@lk),
0,
nil)>0 then begin
Result := String(PChar(LocalLock(lk)));//Возвращаемое значение функции
LocalFree(lk);//Освободить память
end
else
result:= 'Неизвестный код ошибки';
end;
function ANSIToOEM(const sANSI:String):String;//Преобразовать ANSI строку в OEM(Кодировку Windows в DOS)
begin
SetLength(Result,Length(sANSI));//Задается длина
if not CharToOEM(PChar(sANSI),PChar(Result)) then//Вот тут преобразовываем
Result := 'Wrong ANSI to OEM conversion!'
end;
procedure error;
var x:Dword;
begin
x:=GetLastError;//Получаем код последней ошибки
if x<>0 then writeln(ansitooem(GetStringErrorInfo(x)));//Выводим сообщение об ошибке
end;
//Вводит с клавиатуры
function writethread(dd:dword):dword;stdcall;
var HC:THandle;
ch:char;
s,s1:string;
rr:cardinal;
begin
HC:=GetStdHandle(STD_INPUT_HANDLE);//Получаем дескриптор ввода с консоли
if HC=0 then error;
repeat
s:='';
//Читаем строку
repeat
if not ReadConsole(HC,@ch,1,rr,nil) then error;//Читаем символ
if ch<>#13 then
s:=s+ch;
until (ch=#13);//пока не 'Enter'
if first then//Чтобы знать не свое ли
s1:='1'+s
else
s1:='2'+s;
if not ReadConsole(HC,@ch,1,rr,nil) then error;//Читаем символ(#10)
CopyMemory(adres,PChar(s1),Length(s1)+2);//Копируем строчечку в разделяемую память
if not SetEvent(hesinc) then error;//Сигналим событие
until (s='exit')or(s='a')or the_end;//пока не 'a'
the_end:=true;
result:=0;
end;
function readthread(dd:dword):dword;stdcall;
var HC:THandle;
rr:cardinal;
p:PCHar;
begin
HC:=GetStdHandle(STD_OUTPUT_HANDLE);//Получаем дескриптор вывода в консоль
if HC=0 then error;
repeat
if WaitForSingleObject(hesinc,INFINITE)=WAIT_FAILED then error;//Ждем события
if the_end then exit;
p:=adres;
inc(p);
if ((adres^ ='1') and first)or((adres^ ='2') and not first) then//Если свое
begin
if not SetEvent(hesinc) then error//Сигналим событие
end
else
begin
if not WriteConsole(HC,PChar(ANSITOOEM('Ответ:')),6,rr,nil) then error;//Пишем строку
if not WriteConsole(HC,p,strlen(p),rr,nil) then error;//Пишем строку
if not WriteConsole(HC,PChar(#10#13),2,rr,nil) then error;//Пишем строку
end;
until (string(p)='exit')or(string(p)='a')or the_end;//пока не 'a'
the_end:=true;
result:=0;
end;
Begin//Основная программа
//if not(AllocConsole) then error else try//Чтоб консоль появилась
the_end:=false;
he:=OpenEvent(EVENT_ALL_ACCESS,false,'MyEvent');//Пытаемся открыть событие
first:=he=0;//Первый ли экземпляр приложения мы запускаем?
if first then//Если первый
begin
he:=CreateEvent(nil,true,false,'MyEvent');//Создаём событие
if he=0 then error;
hmap:=CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,1000,'MyMapping');//Создаём мэппинг
if hmap=0 then error;
adres:=MapViewOfFile(hmap,FILE_MAP_ALL_ACCESS,0,0,0);//Отображаем вид на файл в адресное пространство вызывающего процесса
if adres=nil then error;
Hesinc:=CreateEvent(nil,false,false,'MySharedEvent');//Создаём событие
if hEsinc=0 then error;
adres^:=#0;//Записываем в первый байт(начало строки)0
if WaitForSingleObject(he,INFINITE)=WAIT_FAILED then error;//Ждём освобождения события(создания второго процесса)
end
else
begin//Если не первый
if not SetEvent(he)then error;//Сигналим событие
hmap:=OpenFileMapping(PAGE_READWRITE,false,'MyMapping');//Открываем уже существующий мэппинг
if hmap=0 then error;
adres:=MapViewOfFile(hmap,FILE_MAP_ALL_ACCESS,0,0,0);//Отображаем вид на файл в адресное пространство вызывающего процесса
if adres=nil then error;
HEsinc:=OpenEvent(EVENT_ALL_ACCESS,false,'MySharedEvent');//Открываем уже существующее событие
if hESinc=0 then error;
end;
hth[0]:=CreateThread(nil,0,@writethread,nil,0,dw);
hth[1]:=CreateThread(nil,0,@readthread,nil,0,dr);
if WaitForMultipleObjects(2,@hth,true,INFINITE)=WAIT_FAILED then error;
if not UnmapViewOfFile(adres) then error;//Выписывает прописанный вид на файл из адресного пространства вызывающего процесса
//if first then
if not CloseHandle(he) then error;//Убиваем событие
//if first then if
if not CloseHandle(hmap) then error;//Убиваем мэппинг файла
//if first then
if not CloseHandle(hESinc) then error;//Убиваем мьютекс
{finally
if not(FreeConsole)then error;//Закрываем консоль
end;}
End.
Не открывается мэппинг
Код:
Когда запускается второй экземпляр, на строчке adres:=MapViewOfFile(hmap,FILE_MAP_ALL_ACCESS,0,0,0); происходит ошибка "Access is denied."
Скорее всего потому что мэпинг именованый. Попробуй зделать без имени.
hmap:=OpenFileMapping(PAGE_READWRITE,false,'');