xmemory.pas

来自「我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面」· PAS 代码 · 共 119 行

unit xMemory;

interface

uses Windows, SysUtils;

//------------------------------------------------------------------//
function IsMemAddressReadable(P: Pointer; Size: DWORD = 4): Boolean;
function IsMemAddressWritable(P: Pointer; Size: DWORD = 4): Boolean;

//------------------------------------------------------------------//
procedure TryReadMemAddress(P: Pointer; Size: DWORD = 4);
procedure TryWriteMemAddress(P: Pointer; Size: DWORD = 4);

//------------------------------------------------------------------//
function  FileMapOpen(const MapName: string; Size: Integer; var Ptr: Pointer): THandle;
procedure FileMapClose(Handle: THandle; var Ptr: Pointer);
function  IsFileMapExists(const MapName: string): Boolean;


implementation

//------------------------------------------------------------------//
//测试某段内存是否可读，p:指向内存开头,Size:内存大小。
function IsMemAddressReadable(P: Pointer; Size: DWORD = 4): Boolean;
begin
  Result := not IsBadReadPtr(P, Size);
end;

//------------------------------------------------------------------//
//测试某段内存是否可写，p:指向内存开头,Size:内存大小。
function IsMemAddressWritable(P: Pointer; Size: DWORD = 4): Boolean;
begin
  Result := not IsBadWritePtr(P, Size);
end;

//------------------------------------------------------------------//
//测试某段内存是否可读，p:指向内存开头,Size:内存大小。若不能读产生异常。
procedure TryReadMemAddress(P: Pointer; Size: DWORD = 4);
begin
  if not IsMemAddressReadable(P, Size) then
    raise EAccessViolation.CreateFmt('Can''t read address %p',[P]);
end;

//------------------------------------------------------------------//
//测试某段内存是否可写，p:指向内存开头,Size:内存大小。若不能写产生异常。
procedure TryWriteMemAddress(P: Pointer; Size: DWORD = 4);
begin
  if not IsMemAddressWritable(P, Size) then
    raise EAccessViolation.CreateFmt('Can''t write address %p',[P]);
end;

//------------------------------------------------------------------//
//打开文件内存映象
//MapName:映象名称; Size:映象大小; Ptr:指向映象内存的指针。
//用于建立可被所有进程，模块分享的全局数据结构。
//例如：
{
var
	pGlobal: ^TSharedData;
	hMap: THandle;
	
	hMap := FileMapOpen('MyMapFile',Sizeof(TSharedData),Pointer(pGlobal));
	//与其它模块共享pGlobal指向的TSharedData结构，可任意读写此结构的数据。
	FileMapClose(hMap,,Pointer(pGlobal));
}

function FileMapOpen(const MapName: string; Size: Integer; var Ptr: Pointer): THandle;
begin
  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(MapName));
  
  if Result = 0 then
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapName));
      if Result = 0 then Exit;
    end else Exit;
  
  Ptr := MapViewOfFile(Result, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if Ptr = nil then
  begin
    CloseHandle(Result);
    Result := 0;
  end;
end;

{$HINTS OFF}
//------------------------------------------------------------------//
//关闭文件内存映象
procedure FileMapClose(Handle: THandle; var Ptr: Pointer);
begin
  if Assigned(Ptr) then
  begin
    UnmapViewOfFile(Ptr);
    Ptr := nil;
  end;

  if Handle <> 0 then
  begin
    CloseHandle(Handle);
    Handle := 0;
  end;
end;
{$HINTS ON}

//------------------------------------------------------------------//
//文件内存映象是否已存在？
function IsFileMapExists(const MapName: string): Boolean;
var
  hMap: THandle;
begin
  hMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapName));
  Result := hMap <> 0;
  if Result then CloseHandle(hMap);
end;

end.