filemapping implementation of data transfer in cross-program implementation

Source: Internet
Author: User

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

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.