跨程序实现数据传递之FileMapping实现
一、传递数据结构定义及公共单元代码:
需要引入单元:winapi.windows;
1、声明部分
//用户库及主程序间数据共享相关
TAuthOnlineInfo = record
IsDLL: Boolean;
IsOnline: Boolean;
IsAuth: Boolean;
IsToDB: Boolean;
CurDBID: Integer;
UserName: string[255];
end;
PAuthOnlineInfo = ^TAuthOnlineInfo;
TAuthOnlineHelp = class
private
const KeyName = '{89B70110-BC0A-426F-B097-3FC0271744AE}';
class var FMapFile: THandle;
class var FBuf: Pointer;
class var FExist: Boolean;
class function IsNT: Boolean;
public
class function Exist: Boolean;
//创建映射
class function CreateMap(AInfo: PAuthOnlineInfo): Boolean;
//更新映射
class function UpdateMap(AInfo: PAuthOnlineInfo): Boolean;
//关闭映射
class procedure CloseMap;
//获取映射数据
class function GetAuthOnlineInfo(AInfo: PAuthOnlineInfo): Boolean;
end;
2、实现部分
{ TAuthOnlineHelp }
class procedure TAuthOnlineHelp.CloseMap;
begin
if FBuf <> nil then
UnMapViewOfFile(FBuf);
if FMapFile <> 0 then
CloseHandle(FMapFile);
FBuf := nil;
FMapFile := 0;
end;
class function TAuthOnlineHelp.CreateMap(AInfo: PAuthOnlineInfo): Boolean;
var
SecurityDescriptor: TSecurityDescriptor;
SecurityAttr: TSecurityAttributes;
begin
//需要加安全设置,才能跨用户进程访问
if IsNT then
begin
SecurityAttr.nLength := SizeOf(SECURITY_ATTRIBUTES);
SecurityAttr.bInheritHandle := True;
SecurityAttr.lpSecurityDescriptor := @SecurityDescriptor;
if not InitializeSecurityDescriptor(@SecurityDescriptor, 1) then
raise Exception.CreateFmt('初始化安全设置失败(%d)', [GetLastError]);
if not SetSecurityDescriptorDacl(@SecurityDescriptor, TRUE, nil, FALSE) then
raise Exception.CreateFmt('安全设置错误(%d)', [GetLastError]);
if not SetKernelObjectSecurity(GetCurrentProcess, DACL_SECURITY_INFORMATION,
@SecurityDescriptor) then
raise Exception.CreateFmt('安全设置失败(%d)', [GetLastError]);
FMapFile := CreateFileMapping($FFFFFFFF, @SecurityAttr, PAGE_READWRITE,
0, SizeOf(TAuthOnlineInfo), PChar(KeyName));
end
else
FMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
0, SizeOf(TAuthOnlineInfo), PChar(KeyName));
if (FMapFile = 0) or (GetLastError() = ERROR_ALREADY_EXISTS) then
begin
Result := False;
Exit;
end
else
Result := True;
FBuf := MapViewOfFile(FMapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);
if (FBuf = nil) then
begin
raise Exception.CreateFmt('映射内存空间失败 (%d).', [GetLastError]);
CloseHandle(FMapFile);
Result := False;
Exit;
end
else if AInfo <> nil then
CopyMemory(FBuf, AInfo, SizeOf(TAuthOnlineInfo));
FExist := True;
end;
class function TAuthOnlineHelp.Exist: Boolean;
begin
Result := FExist;
end;
class function TAuthOnlineHelp.GetAuthOnlineInfo(AInfo: PAuthOnlineInfo): Boolean;
var
hMapFile: THandle;
pBuf: Pointer;
begin
Result := False;
if (AInfo= nil) then Exit;
hMapFile := OpenFileMapping(FILE_MAP_READ, FALSE, PChar(KeyName));
if hMapFile = 0 then
begin
Result := False;
Exit;
end;
pBuf := MapViewOfFile(hMapFile, FILE_MAP_READ, 0, 0, SizeOf(TAuthOnlineInfo));
if (pBuf = nil) then
begin
CloseHandle(hMapFile);
Result := False;
Exit;
end;
CopyMemory(AInfo, pBuf, SizeOf(TAuthOnlineInfo));
UnmapViewOfFile(pBuf);
CloseHandle(hMapFile);
Result := True;
end;
class function TAuthOnlineHelp.IsNT: Boolean;
var
OS: TOSVERSIONINFO;
begin
OS.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
GetVersionEx(OS);
Result := (OS.dwMajorVersion >= 5) or (OS.dwPlatformId = VER_PLATFORM_WIN32_NT);
end;
class function TAuthOnlineHelp.UpdateMap(AInfo: PAuthOnlineInfo): Boolean;
begin
Result := False;
if (AInfo= nil) then Exit;
if FMapFile = 0 then
Exit
else
begin
CopyMemory(FBuf, AInfo, SizeOf(TAuthOnlineInfo));
Result := True;
end;
end;
二、创建映射的进程代码
New(pInfo); //pInfo 类型PAuthOnlineInfo
pInfo.IsDLL := False;
pInfo.CurDBID := ASheet.App.BaseData.CurUserDBID;
if TAuthOnlineHelp.Exist then
TAuthOnlineHelp.UpdateMap(pInfo)
else
TAuthOnlineHelp.CreateMap(pInfo);
Dispose(pInfo);
ShellExecute(0, 'Open', PWideChar(sFileName), nil, nil, SW_SHOWMAXIMIZED); //sFileName是第二个进程名称
三、读取映射文件的进程代码
New(pInfo); //pInfo 类型PAuthOnlineInfo
TAuthOnlineHelp.GetAuthOnlineInfo(pInfo);