datamap.pas

来自「《参透Delphi Kylix》通过131个事例」· PAS 代码 · 共 88 行

unit DataMap;

interface

uses
  Windows, SysUtils, Dialogs;

function GetMappedData(): PChar; stdcall;
procedure SetMappedData(const AData: PChar); stdcall;

procedure Map(const DesiredAccess: DWORD = FILE_MAP_ALL_ACCESS); stdcall;
procedure Unmap(); stdcall;

implementation

const
  SExceptionInfo = 'Error in calling MappedData.dll.';
  SMappedDataName = 'JuMappedData.MappedData';

type
  PMappedData = ^TMappedData;
  TMappedData = packed record
    Size: DWORD;
    Data: array [0..4091] of Char;
  end;

var
  MappedDataHandle: THandle;
  MappedData: PMappedData;
  HasMapped: Boolean;

function GetMappedData: PChar; stdcall;
begin
  Result := MappedData^.Data;
end;

procedure SetMappedData(const AData: PChar); stdcall;
var
  I, Len: Integer;
begin
  try
    FillChar(MappedData^.Data, MappedData^.Size, 0);
    Len := StrLen(AData);
    if Len > 4089 then Len := 4089; // Only first 4090 characters reserved.
    for I := 0 to Len do MappedData^.Data[I] := AData[I];
    MappedData^.Data[Len + 1] := #0;
    MappedData^.Data[Len + 2] := #0;
    MappedData^.Size := Len;
  except
    on Exception do MessageDlg(SExceptionInfo, mtError, [mbOk], 0);
  end;
end;

procedure Map(const DesiredAccess: DWORD); stdcall;
var
  LSize: Integer;
begin
  try
    if HasMapped then exit;
    LSize := SizeOf(TMappedData);
    MappedDataHandle := CreateFileMapping(DWORD($FFFFFFFF), nil, PAGE_READWRITE, 0, LSize, SMappedDataName);
    if MappedDataHandle = 0 then RaiseLastOSError();
    MappedData := MapViewOfFile(MappedDataHandle, DesiredAccess, 0, 0, LSize);
    if not Assigned(MappedData) then
    begin
      CloseHandle(MappedDataHandle);
      RaiseLastOSError();
    end;
    HasMapped := True;
  except
    on Exception do MessageDlg(SExceptionInfo, mtError, [mbOk], 0);
  end;
end;

procedure Unmap(); stdcall;
begin
  try
    if not HasMapped then exit;
    UnmapViewOfFile(MappedData);
    CloseHandle(MappedDataHandle);
    HasMapped := False;
  except
    on Exception do MessageDlg(SExceptionInfo, mtError, [mbOk], 0);
  end;
end;

end.