First, pass the data structure definition and the common Unit code:
Need to introduce unit: winapi.windows;
1. Declaration part
Data sharing between user base and main program
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;
Creating mappings
class function Createmap (ainfo:pauthonlineinfo): Boolean;
Update mappings
class function Updatemap (ainfo:pauthonlineinfo): Boolean;
Close mappings
class procedure Closemap;
Get map data
class function Getauthonlineinfo (ainfo:pauthonlineinfo): Boolean;
End
2. Realization part
{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
Security settings are required to access across user processes
If isnt then
Begin
Securityattr.nlength: = SizeOf (security_attributes);
Securityattr.binherithandle: = True;
Securityattr.lpsecuritydescriptor: = @SecurityDescriptor;
If not InitializeSecurityDescriptor (@SecurityDescriptor, 1) Then
Raise Exception.createfmt (' Initialize security settings failed (%d) ', [GetLastError]);
If not SetSecurityDescriptorDacl (@SecurityDescriptor, TRUE, Nil, FALSE) then
Raise Exception.createfmt (' Security set error (%d) ', [GetLastError]);
If not setkernelobjectsecurity (GetCurrentProcess, Dacl_security_information,
@SecurityDescriptor) Then
Raise Exception.createfmt (' Security setting failed (%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 (' mapped memory space failed (%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
Ii. creating a mapped process code
New (PInfo); PInfo type 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 is the second process name
Third, the process code to read the map file
New (PInfo); PInfo type Pauthonlineinfo
Tauthonlinehelp.getauthonlineinfo (PInfo);
filemapping implementation of data transfer in cross-program implementation