program Project1;

{$APPTYPE CONSOLE}

uses
 Windows ,  SysUtils;

type
 PUNICODE_STRING = ^UNICODE_STRING;
 UNICODE_STRING = record
   Length: WORD;
   MaximumLength: WORD;
   Buffer: PWideChar;
 end;

 POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;
 {$EXTERNALSYM POBJECT_ATTRIBUTES}
 OBJECT_ATTRIBUTES = record
   Length: ULONG;
   RootDirectory: THandle;
   ObjectName: PUNICODE_STRING;
   Attributes: ULONG;
   SecurityDescriptor: Pointer;
   SecurityQualityOfService: Pointer;
 end;

 NTSTATUS = Longint;

const
 STATUS_OBJECT_NAME_EXISTS  =   $40000000;
 OBJ_CASE_INSENSITIVE       =   $00000040;
 OBJ_OPENIF                 =   $00000080;
 DIRECTORY_TRAVERSE         =       $0002;
 DIRECTORY_CREATE_OBJECT    =       $0004;

function NT_SUCCESS(Status: NTSTATUS): Boolean;
begin
 Result := Status >= 0;
end;

procedure RtlInitUnicodeString(
 var DestinationString : UNICODE_STRING;
 SourceString : PWideChar); stdcall; external 'ntdll.dll';

function  NtCreateSection(
   SectionHandle : PHANDLE;
   DesiredAccess : ACCESS_MASK;
   ObjectAttributes : POBJECT_ATTRIBUTES;
   SectionSize : PLARGEINTEGER;
   Protect : ULONG;
   Attributes : ULONG;
   FileHandle : THandle
 ): NTSTATUS; stdcall; external 'ntdll.dll';

function  NtOpenDirectoryObject(
   DirectoryHandle : PHANDLE;
   DesiredAccess : ACCESS_MASK;
   ObjectAttributes : POBJECT_ATTRIBUTES
 ): NTSTATUS; stdcall; stdcall; external 'ntdll.dll';

procedure InitializeObjectAttributes(
 p: POBJECT_ATTRIBUTES;
 Name: PUNICODE_STRING;
 Attr: ULONG;
 Root: THandle;
 SD: Pointer);
begin
 p^.Length := SizeOf(OBJECT_ATTRIBUTES);
 p^.RootDirectory := Root;
 p^.Attributes := Attr;
 p^.ObjectName := Name;
 p^.SecurityDescriptor := SD;
 p^.SecurityQualityOfService := nil;
end;

procedure RaiseNtError(status: NTSTATUS);
begin
 raise EOSError.CreateFmt(
   'Nt error %.8x , i''m, too lazy to format it properly',
   [status]);
end;

function CreateorOpenSection(): THandle;
var
us, uss: UNICODE_STRING;
oa, oas: OBJECT_ATTRIBUTES;
status: NTSTATUS;
dir: THANDLE;
secsize: LARGE_INTEGER;
begin
RtlInitUnicodeString(us, '\BaseNamedObjects');
InitializeObjectAttributes(@oa, @us, OBJ_CASE_INSENSITIVE, 0, nil);
status := NtOpenDirectoryObject(@dir,
  DIRECTORY_TRAVERSE or DIRECTORY_CREATE_OBJECT, @oa);
if not NT_SUCCESS(status) then
  RaiseNtError(status);
try
  RtlInitUnicodeString(uss, 'AAASuperPuperSection');
  InitializeObjectAttributes(@oas, @uss, OBJ_OPENIF,
    dir, nil);
  secsize.QuadPart := $20000;
  status := NtCreateSection(@Result, SECTION_MAP_WRITE or SECTION_MAP_READ,
    @oas, @secsize, PAGE_READWRITE, SEC_COMMIT, 0);
  if not NT_SUCCESS(status) then
  begin
    RaiseNtError(status);
  end;
  if status = STATUS_OBJECT_NAME_EXISTS then
  begin
    WriteLn('Reopen');
  end;
finally
  CloseHandle(dir);
end;
end;

var H1, H2: THandle;
begin
 try
   H1 := CreateOrOpenSection();
   try
     WriteLn(Format('New section handle %.8x', [H1]));
     H2 := CreateOrOpenSection();
     try
       WriteLn(Format('Reopen section handle %.8x', [H2]));
     finally
       CloseHandle(H2);
     end;
   finally
     CloseHandle(H1);
   end;
 except
   on E: Exception do
     WriteLn('Error ', E.Message);
 end;
 ReadLn
end.

New section handle 00000FBC
Reopen
Reopen section handle 00000FB8