Question

更新 - 解决并回答，违规行已被注释掉

简要说明

我在将CreateFile与CreateFileMapping链接时出现问题，即使我对CreateFile使用（GENERIC_WRITE或GENERIC_WRITE），而对于CreateFileMapping使用PAGE_READWRITE

详细说明

我正在使用CreateFileMapping在进程之间共享内存。假设我没有映射到物理文件而是使用INVALID_HANDLE_VALUE作为CreateFileMapping的第一个参数，那么它的实际机制工作正常。这很好，但我想要实现的是主进程创建此映射以使用基于磁盘的文件，并定期将其刷新到驱动器，当它关闭时，数据会自动保存。

代码遵循...... （当我运行它时，我得到“错误5：拒绝访问”作为ShowMessage）

const MaximumMapSize = 256 * 1024;
var virtualMemoryPath : string = '';

function getFileHandle(mapname : string; maxSize  : dword) :THandle;
var diskfilename : string;

  lpFileName: PChar;
  dwDesiredAccess: DWORD;
  dwShareMode: DWORD;
  lpSecurityAttributes: PSecurityAttributes;
  dwCreationDisposition : dword;
  dwFlagsAndAttributes: DWORD;
  hTemplateFile : THandle ;

  temp : pointer;
begin
    Result := INVALID_HANDLE_VALUE;
    if (maxSize <= MaximumMapSize) and (Length(virtualMemoryPath) > 0) then
    begin

            diskfilename := virtualMemoryPath+mapname+'.bin';

            if FileExists(diskfilename) then
               Sysutils.DeleteFile(diskfilename);

            lpFileName              := PChar(diskfilename);
            //dwDesiredAccess         := GENERIC_WRITE or GENERIC_WRITE;//<<<wrong
            dwDesiredAccess         := GENERIC_READ or GENERIC_WRITE;
            dwShareMode             := 0;//FILE_SHARE_READ or FILE_SHARE_WRITE;//<<wrong
            lpSecurityAttributes    := nil;
            dwCreationDisposition   := CREATE_ALWAYS;
            dwFlagsAndAttributes    := 0;
            hTemplateFile           := 0 ;


            Result := CreateFile(
                lpFileName,
                dwDesiredAccess,
                dwShareMode,
                lpSecurityAttributes,
                dwCreationDisposition,
                dwFlagsAndAttributes,
                hTemplateFile);

           if (Result <> INVALID_HANDLE_VALUE) then
           begin
             GetMem(temp,maxsize);
             ZeroMemory(temp,maxsize);
             FileWrite(result,temp^,maxSize);
             FreeMem (temp,maxsize);
             FlushFileBuffers(result);
             SetFilePointer(result,0,0,FILE_BEGIN);
           end;
    end;
end;

function createMap (mapname : string ; maxSize: dword; var hFile: THandle) : THandle;
var
    lpFileMappingAttributes: PSecurityAttributes;
    flProtect           : DWORD;
    dwMaximumSizeHigh   : DWORD;
    dwMaximumSizeLow    : DWORD;
    lpName              : PChar;

    LastError : dword;
begin

    Result := INVALID_HANDLE_VALUE;

    if (maxSize > MaximumMapSize) then
        exit;

     // create a disk the file or return INVALID_HANDLE_VALUE if settings have not defined a path to folder
     hFile     :=  getFileHandle(mapname,maxSize);

     lpFileMappingAttributes := nil;
     flProtect          := PAGE_READWRITE;
     dwMaximumSizeHigh  := 0;
     dwMaximumSizeLow   := maxSize;
     lpName := PChar(mapname);

     Result := CreateFileMapping(
        hfile,
        lpFileMappingAttributes,
        flProtect,
        dwMaximumSizeHigh,
        dwMaximumSizeLow,
        lpName);

     if (Result = 0) then
     begin

         if (not (hFile = INVALID_HANDLE_VALUE) ) then
            CloseHandle(hFile);

         hFile := 0;
         LastError := GetLastError();
         ShowMessage( Format('Error %d : %s',[LastError,SysErrorMessage(LastError)]) );

     end
     else
     begin

        ShowMessage(Format('Returing handle %d',[result]));
        if (hFile = INVALID_HANDLE_VALUE) then
            hFile := 0;

     end;

end;

Answer 1

        dwDesiredAccess         := GENERIC_WRITE or GENERIC_WRITE;
        dwShareMode             := FILE_SHARE_READ or FILE_SHARE_WRITE;

这不起作用。您需要读写访问权限。此外，创建视图需要操作系统确保它是唯一可以写入文件的操作系统。除了通过视图之外，没有机制来检测写入文件的另一个进程，并确保这种写入在内存中以及时和同步的方式可见。特别是在多个线程访问视图时无法实现同步更新。

读取共享同样不明智，操作系统无法保证从视图更新文件的时间。唯一的保证是所有视图关闭时都会更新。这也意味着需要有序地关闭Windows，你不能使这种可靠的方式免受诸如断电之类的灾难。同样，需要通过视图而不是文件来完成读取。唯一合适的选择是不分享。

Answer 2

错误在于：

GENERIC_WRITE or GENERIC_WRITE

你的意思是：

GENERIC_READ or GENERIC_WRITE

修复此问题，即可创建文件映射。

我同意汉斯的意见，你不应该共享文件句柄。

使用除INVALID_HANDLE_VALUE之外的hFile，CreateFileMapping失败

2 个答案: