Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Не открывается мэппинг

247
22 марта 2008 года
wanja
1.2K / / 03.02.2003
Есть у меня такая вот програмка:
Код:
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."
9.3K
22 марта 2008 года
iridum
175 / / 26.08.2007
Скорее всего потому что мэпинг именованый. Попробуй зделать без имени.
247
24 марта 2008 года
wanja
1.2K / / 03.02.2003
Попробовал. Теперь ошибка в строке
hmap:=OpenFileMapping(PAGE_READWRITE,false,'');
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог