BTMemoryModule

unit BTMemoryModule;

 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  * Memory DLL loading code                                                 *

  * ------------------------                                                *

  *                                                                         *

  * MemoryModule "Conversion to Delphi"                                     *

  * Copyright (c) 2005 - 2006 by Martin Offenwanger / coder@dsplayer.de     *

  * http://www.dsplayer.de                                                  *

  *                                                                         *

  * Original C++ Code "MemoryModule Version 0.0.1"                          *

  * Copyright (c) 2004- 2006 by Joachim Bauch / mail@joachim-bauch.de       *

  * http://www.joachim-bauch.de                                             *

  *                                                                         *

  * This library is free software; you can redistribute it and/or           *

  * modify it under the terms of the GNU Lesser General Public              *

  * License as published by the Free Software Foundation; either            *

  * version 2.1 of the License, or (at your option) any later version.      *

  *                                                                         *

  * This library is distributed in the hope that it will be useful,         *

  * but WITHOUT ANY WARRANTY; without even the implied warranty of          *

  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       *

  * Lesser General Public License for more details.                         *

  *                                                                         *

  * You should have received a copy of the GNU Lesser General Public        *

  * License along with this library; if not, write to the Free Software     *

  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *

  *                                                                         *

  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{

@author(Martin Offenwanger: coder@dsplayer.de)

@created(Mar 20, 2005)

@lastmod(Sep 27, 2005)

}

interface

uses

  // Borland Run-time Library

  Windows;

   {++++++++++++++++++++++++++++++++++++++

    ***  MemoryModule Type Definition  ***

    --------------------------------------}

type

  PBTMemoryModule = ^TBTMemoryModule;

  _BT_MEMORY_MODULE = packed record

    headers: PImageNtHeaders;

    codeBase: Pointer;

    modules: Pointer;

    numModules: integer;

    initialized: boolean;

  end;

{$EXTERNALSYM _BT_MEMORY_MODULE}

  TBTMemoryModule = _BT_MEMORY_MODULE;

  BT_MEMORY_MODULE = _BT_MEMORY_MODULE;

{$EXTERNALSYM BT_MEMORY_MODULE}

   {++++++++++++++++++++++++++++++++++++++++++++++++++

    ***  Memory DLL loading functions Declaration  ***

    --------------------------------------------------}

// return value is nil if function fails

function BTMemoryLoadLibary(var f_data: Pointer; const f_size: int64): PBTMemoryModule; stdcall;

// return value is nil if function fails

function BTMemoryGetProcAddress(var f_module: PBTMemoryModule; const f_name: PChar): Pointer; stdcall;

// free module

procedure BTMemoryFreeLibrary(var f_module: PBTMemoryModule); stdcall;

// returns last error

function BTMemoryGetLastError: string; stdcall;

implementation

uses

  // Borland Run-time Library

  SysUtils;

   {+++++++++++++++++++++++++++++++++++

    ***  Dll EntryPoint Definition  ***

    -----------------------------------}

type

  TDllEntryProc = function(hinstdll: THandle; fdwReason: DWORD; lpReserved: Pointer): BOOL; stdcall;

   {++++++++++++++++++++++++++++++++++++++++

    ***  Missing Windows API Definitions ***

    ----------------------------------------}

  PImageBaseRelocation = ^TImageBaseRelocation;

  _IMAGE_BASE_RELOCATION = packed record

    VirtualAddress: DWORD;

    SizeOfBlock: DWORD;

  end;

{$EXTERNALSYM _IMAGE_BASE_RELOCATION}

  TImageBaseRelocation = _IMAGE_BASE_RELOCATION;

  IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION;

{$EXTERNALSYM IMAGE_BASE_RELOCATION}

  PImageImportDescriptor = ^TImageImportDescriptor;

  _IMAGE_IMPORT_DESCRIPTOR = packed record

    OriginalFirstThunk: DWORD;

    TimeDateStamp: DWORD;

    ForwarderChain: DWORD;

    Name: DWORD;

    FirstThunk: DWORD;

  end;

{$EXTERNALSYM _IMAGE_IMPORT_DESCRIPTOR}

  TImageImportDescriptor = _IMAGE_IMPORT_DESCRIPTOR;

  IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;

{$EXTERNALSYM IMAGE_IMPORT_DESCRIPTOR}

  PImageImportByName = ^TImageImportByName;

  _IMAGE_IMPORT_BY_NAME = packed record

    Hint: Word;

    Name: array[0..255] of Byte; // original: "Name: array [0..0] of Byte;"

  end;

{$EXTERNALSYM _IMAGE_IMPORT_BY_NAME}

  TImageImportByName = _IMAGE_IMPORT_BY_NAME;

  IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME;

{$EXTERNALSYM IMAGE_IMPORT_BY_NAME}

const

  IMAGE_SIZEOF_BASE_RELOCATION = 8;

{$EXTERNALSYM IMAGE_SIZEOF_BASE_RELOCATION}

  IMAGE_REL_BASED_HIGHLOW = 3;

{$EXTERNALSYM IMAGE_REL_BASED_HIGHLOW}

  IMAGE_ORDINAL_FLAG32 = DWORD($80000000);

{$EXTERNALSYM IMAGE_ORDINAL_FLAG32}

var

  lastErrStr: string;

   {+++++++++++++++++++++++++++++++++++++++++++++++++++++

    ***  Memory DLL loading functions Implementation  ***

    -----------------------------------------------------}

function BTMemoryGetLastError: string; stdcall;

begin

  Result := lastErrStr;

end;

function GetFieldOffset(const Struc; const Field): Cardinal; stdcall;

begin

  Result := Cardinal(@Field) - Cardinal(@Struc);

end;

function GetImageFirstSection(NtHeader: PImageNtHeaders): PImageSectionHeader; stdcall;

begin

  Result := PImageSectionHeader(Cardinal(NtHeader) +

    GetFieldOffset(NtHeader^, NtHeader^.OptionalHeader) +

    NtHeader^.FileHeader.SizeOfOptionalHeader);

end;

function GetHeaderDictionary(f_module: PBTMemoryModule; f_idx: integer): PImageDataDirectory; stdcall;

begin

  Result := PImageDataDirectory(@(f_module.headers.OptionalHeader.DataDirectory[f_idx]));

end;

function GetImageOrdinal(Ordinal: DWORD): Word; stdcall;

begin

  Result := Ordinal and $FFFF;

end;

function GetImageSnapByOrdinal(Ordinal: DWORD): Boolean; stdcall;

begin

  Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0);

end;

procedure CopySections(const f_data: Pointer; const f_old_headers: TImageNtHeaders; f_module: PBTMemoryModule); stdcall;

var

  l_size, i: integer;

  l_codebase: Pointer;

  l_dest: Pointer;

  l_section: PImageSectionHeader;

begin

  l_codebase := f_module.codeBase;

  l_section := GetImageFirstSection(f_module.headers);

  for i := 0 to f_module.headers.FileHeader.NumberOfSections - 1 do begin

    // section doesn't contain data in the dll itself, but may define

    // uninitialized data

    if (l_section.SizeOfRawData = 0) then begin

      l_size := f_old_headers.OptionalHeader.SectionAlignment;

      if l_size > 0 then begin

        l_dest := VirtualAlloc(Pointer(Cardinal(l_codebase) + l_section.VirtualAddress), l_size, MEM_COMMIT, PAGE_READWRITE);

        l_section.Misc.PhysicalAddress := cardinal(l_dest);

        ZeroMemory(l_dest, l_size);

      end;

      inc(longword(l_section), sizeof(TImageSectionHeader));

      // Continue with the nex loop

      Continue;

    end;

    // commit memory block and copy data from dll

    l_dest := VirtualAlloc(Pointer(Cardinal(l_codebase) + l_section.VirtualAddress), l_section.SizeOfRawData, MEM_COMMIT, PAGE_READWRITE);

    CopyMemory(l_dest, Pointer(longword(f_data) + l_section.PointerToRawData), l_section.SizeOfRawData);

    l_section.Misc.PhysicalAddress := cardinal(l_dest);

    // IMAGE_SIZEOF_SECTION_HEADER

    inc(longword(l_section), sizeof(TImageSectionHeader));

  end;

end;

procedure PerformBaseRelocation(f_module: PBTMemoryModule; f_delta: Cardinal); stdcall;

var

  l_i: Cardinal;

  l_codebase: Pointer;

  l_directory: PImageDataDirectory;

  l_relocation: PImageBaseRelocation;

  l_dest: Pointer;

  l_relInfo: ^Word;

  l_patchAddrHL: ^DWord;

  l_type, l_offset: integer;

begin

  l_codebase := f_module.codeBase;

  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_BASERELOC);

  if l_directory.Size > 0 then begin

    l_relocation := PImageBaseRelocation(Cardinal(l_codebase) + l_directory.VirtualAddress);

    while l_relocation.VirtualAddress > 0 do begin

      l_dest := Pointer((Cardinal(l_codebase) + l_relocation.VirtualAddress));

      l_relInfo := Pointer(Cardinal(l_relocation) + IMAGE_SIZEOF_BASE_RELOCATION);

      for l_i := 0 to (trunc(((l_relocation.SizeOfBlock - IMAGE_SIZEOF_BASE_RELOCATION) / 2)) - 1) do begin

        // the upper 4 bits define the type of relocation

        l_type := (l_relInfo^ shr 12);

        // the lower 12 bits define the offset

        l_offset := l_relInfo^ and $FFF;

        //showmessage(inttostr(l_relInfo^));

        if l_type = IMAGE_REL_BASED_HIGHLOW then begin

          // change complete 32 bit address

          l_patchAddrHL := Pointer(Cardinal(l_dest) + Cardinal(l_offset));

          l_patchAddrHL^ := l_patchAddrHL^ + f_delta;

        end;

        inc(l_relInfo);

      end;

      l_relocation := Pointer(cardinal(l_relocation) + l_relocation.SizeOfBlock);

    end;

  end;

end;

function BuildImportTable(f_module: PBTMemoryModule): boolean; stdcall;

var

  l_codeBase: Pointer;

  l_directory: PImageDataDirectory;

  l_importDesc: PImageImportDescriptor;

  l_thunkRef, l_funcRef: ^DWORD;

  l_handle: HMODULE;

  l_temp: integer;

  l_thunkData: TImageImportByName;

begin

  Result := true;

  l_codeBase := f_module.codeBase;

  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_IMPORT);

  if (l_directory.Size > 0) then begin

    l_importDesc := PImageImportDescriptor(Cardinal(l_codeBase) + l_directory.VirtualAddress);

    while (not IsBadReadPtr(l_importDesc, sizeof(TImageImportDescriptor))) and (l_importDesc.Name <> 0) do begin

      l_handle := LoadLibrary(PChar(Cardinal(l_codeBase) + l_importDesc.Name));

      if (l_handle = INVALID_HANDLE_VALUE) then begin

        lastErrStr := 'BuildImportTable: can''t load library: ' + PChar(Cardinal(l_codeBase) + l_importDesc.Name);

        Result := false;

        exit;

      end;

      // ReallocMemory crashes if "f_module.modules = nil"

      if f_module.modules = nil then

        f_module.modules := AllocMem(1);

      f_module.modules := ReallocMemory(f_module.modules, ((f_module.numModules + 1) * (sizeof(HMODULE))));

      if f_module.modules = nil then begin

        lastErrStr := 'BuildImportTable: ReallocMemory failed';

        result := false;

        exit;

      end;

      // module->modules[module->numModules++] = handle;

      l_temp := (sizeof(cardinal) * (f_module.numModules));

      inc(Cardinal(f_module.modules), l_temp);

      cardinal(f_module.modules^) := l_handle;

      dec(Cardinal(f_module.modules), l_temp);

      f_module.numModules := f_module.numModules + 1;

      if l_importDesc.OriginalFirstThunk <> 0 then begin

        l_thunkRef := Pointer(Cardinal(l_codeBase) + l_importDesc.OriginalFirstThunk);

        l_funcRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);

      end else begin

        // no hint table

        l_thunkRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);

        l_funcRef := Pointer(Cardinal(l_codeBase) + l_importDesc.FirstThunk);

      end;

      while l_thunkRef^ <> 0 do begin

        if GetImageSnapByOrdinal(l_thunkRef^) then

          l_funcRef^ := Cardinal(GetProcAddress(l_handle, PChar(GetImageOrdinal(l_thunkRef^))))

        else begin

          CopyMemory(@l_thunkData, Pointer(Cardinal(l_codeBase) + l_thunkRef^), sizeof(TImageImportByName));

          l_funcRef^ := Cardinal(GetProcAddress(l_handle, PChar(@(l_thunkData.Name))));

        end;

        if l_funcRef^ = 0 then begin

          lastErrStr := 'BuildImportTable: GetProcAddress failed';

          result := false;

          break;

        end;

        inc(l_funcRef);

        inc(l_thunkRef);

      end;

      inc(longword(l_importDesc), sizeof(TImageImportDescriptor));

    end;

  end;

end;

function GetSectionProtection(SC: cardinal): cardinal; stdcall;

//SC – ImageSectionHeader.Characteristics

begin

  result := 0;

  if (SC and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then

    result := result or PAGE_NOCACHE;

  // E - Execute, R – Read , W – Write

  if (SC and IMAGE_SCN_MEM_EXECUTE) <> 0 //E ?

    then if (SC and IMAGE_SCN_MEM_READ) <> 0 //ER ?

    then if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //ERW ?

      then result := result or PAGE_EXECUTE_READWRITE

      else result := result or PAGE_EXECUTE_READ

    else if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //EW?

      then result := result or PAGE_EXECUTE_WRITECOPY

    else result := result or PAGE_EXECUTE

  else if (SC and IMAGE_SCN_MEM_READ) <> 0 // R?

    then if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //RW?

    then result := result or PAGE_READWRITE

    else result := result or PAGE_READONLY

  else if (SC and IMAGE_SCN_MEM_WRITE) <> 0 //W?

    then result := result or PAGE_WRITECOPY

  else result := result or PAGE_NOACCESS;

end;

procedure FinalizeSections(f_module: PBTMemoryModule); stdcall;

var

  l_i: integer;

  l_section: PImageSectionHeader;

  l_protect, l_oldProtect, l_size: Cardinal;

begin

  l_section := GetImageFirstSection(f_module.headers);

  for l_i := 0 to f_module.headers.FileHeader.NumberOfSections - 1 do begin

    if (l_section.Characteristics and IMAGE_SCN_MEM_DISCARDABLE) <> 0 then begin

      // section is not needed any more and can safely be freed

      VirtualFree(Pointer(l_section.Misc.PhysicalAddress), l_section.SizeOfRawData, MEM_DECOMMIT);

      inc(longword(l_section), sizeof(TImageSectionHeader));

      continue;

    end;

    l_protect := GetSectionProtection(l_section.Characteristics);

    if (l_section.Characteristics and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then

      l_protect := (l_protect or PAGE_NOCACHE);

    // determine size of region

    l_size := l_section.SizeOfRawData;

    if l_size = 0 then begin

      if (l_section.Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA) <> 0 then begin

        l_size := f_module.headers.OptionalHeader.SizeOfInitializedData;

      end else begin

        if (l_section.Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA) <> 0 then

          l_size := f_module.headers.OptionalHeader.SizeOfUninitializedData;

      end;

      if l_size > 0 then begin

        if not VirtualProtect(Pointer(l_section.Misc.PhysicalAddress), l_section.SizeOfRawData, l_protect, @l_oldProtect) then begin

          lastErrStr := 'FinalizeSections: VirtualProtect failed';

          exit;

        end;

      end;

    end;

    inc(longword(l_section), sizeof(TImageSectionHeader));

  end;

end;

function BTMemoryLoadLibary(var f_data: Pointer; const f_size: int64): PBTMemoryModule; stdcall;

var

  l_result: PBTMemoryModule;

  l_dos_header: TImageDosHeader;

  l_old_header: TImageNtHeaders;

  l_code, l_headers: Pointer;

  l_locationdelta: Cardinal;

  l_DllEntry: TDllEntryProc;

  l_successfull: boolean;

begin

  l_result := nil;

  Result := nil;

  try

    CopyMemory(@l_dos_header, f_data, sizeof(_IMAGE_DOS_HEADER));

    if (l_dos_header.e_magic <> IMAGE_DOS_SIGNATURE) then begin

      lastErrStr := 'BTMemoryLoadLibary: dll dos header is not valid';

      exit;

    end;

    CopyMemory(@l_old_header, pointer(longint(f_data) + l_dos_header._lfanew), sizeof(_IMAGE_NT_HEADERS));

    if l_old_header.Signature <> IMAGE_NT_SIGNATURE then begin

      lastErrStr := 'BTMemoryLoadLibary: IMAGE_NT_SIGNATURE is not valid';

      exit;

    end;

    // reserve memory for image of library

    l_code := VirtualAlloc(Pointer(l_old_header.OptionalHeader.ImageBase), l_old_header.OptionalHeader.SizeOfImage, MEM_RESERVE, PAGE_READWRITE);

    if l_code = nil then

        // try to allocate memory at arbitrary position

      l_code := VirtualAlloc(nil, l_old_header.OptionalHeader.SizeOfImage, MEM_RESERVE, PAGE_READWRITE);

    if l_code = nil then begin

      lastErrStr := 'BTMemoryLoadLibary: VirtualAlloc failed';

      exit;

    end;

    // alloc space for the result record

    l_result := PBTMemoryModule(HeapAlloc(GetProcessHeap(), 0, sizeof(TBTMemoryModule)));

    l_result.codeBase := l_code;

    l_result.numModules := 0;

    l_result.modules := nil;

    l_result.initialized := false;

    // xy: is it correct to commit the complete memory region at once?

    //     calling DllEntry raises an exception if we don't...

    VirtualAlloc(l_code, l_old_header.OptionalHeader.SizeOfImage, MEM_COMMIT, PAGE_READWRITE);

    // commit memory for headers

    l_headers := VirtualAlloc(l_code, l_old_header.OptionalHeader.SizeOfHeaders, MEM_COMMIT, PAGE_READWRITE);

    // copy PE header to code

    CopyMemory(l_headers, f_data, (Cardinal(l_dos_header._lfanew) + l_old_header.OptionalHeader.SizeOfHeaders));

    l_result.headers := PImageNtHeaders(longint(l_headers) + l_dos_header._lfanew);

    // update position

    l_result.headers.OptionalHeader.ImageBase := cardinal(l_code);

    // copy sections from DLL file block to new memory location

    CopySections(f_data, l_old_header, l_result);

    // adjust base address of imported data

    l_locationdelta := Cardinal(Cardinal(l_code) - l_old_header.OptionalHeader.ImageBase);

    if l_locationdelta <> 0 then

      PerformBaseRelocation(l_result, l_locationdelta);

    // load required dlls and adjust function table of imports

    if not BuildImportTable(l_result) then begin

      lastErrStr := lastErrStr + ' BTMemoryLoadLibary: BuildImportTable failed';

      Abort;

    end;

    // mark memory pages depending on section headers and release

    // sections that are marked as "discardable"

    FinalizeSections(l_result);

    // get entry point of loaded library

    if (l_result.headers.OptionalHeader.AddressOfEntryPoint) <> 0 then begin

      @l_DllEntry := Pointer(Cardinal(l_code) + l_result.headers.OptionalHeader.AddressOfEntryPoint);

      if @l_DllEntry = nil then begin

        lastErrStr := 'BTMemoryLoadLibary: Get DLLEntyPoint failed';

        Abort;

      end;

      l_successfull := l_DllEntry(Cardinal(l_code), DLL_PROCESS_ATTACH, nil);

      if not l_successfull then begin

        lastErrStr := 'BTMemoryLoadLibary: Can''t attach library';

        Abort;

      end;

      l_result.initialized := true;

    end;

  except

    BTMemoryFreeLibrary(l_result);

    exit;

  end;

  Result := l_result;

end;

function BTMemoryGetProcAddress(var f_module: PBTMemoryModule; const f_name: PChar): Pointer; stdcall;

var

  l_codeBase: Pointer;

  l_idx: integer;

  l_i: DWORD;

  l_nameRef: ^DWORD;

  l_ordinal: ^WORD;

  l_exports: PImageExportDirectory;

  l_directory: PImageDataDirectory;

  l_temp: ^DWORD;

begin

  Result := nil;

  l_codeBase := f_module.codeBase;

  l_idx := -1;

  l_directory := GetHeaderDictionary(f_module, IMAGE_DIRECTORY_ENTRY_EXPORT);

  if l_directory.Size = 0 then begin

    lastErrStr := 'BTMemoryGetProcAddress: no export table found';

    exit;

  end;

  l_exports := PImageExportDirectory(Cardinal(l_codeBase) + l_directory.VirtualAddress);

  if ((l_exports.NumberOfNames = 0) or (l_exports.NumberOfFunctions = 0)) then begin

    lastErrStr := 'BTMemoryGetProcAddress: DLL doesn''t export anything';

    exit;

  end;

  // search function name in list of exported names

  l_nameRef := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfNames));

  l_ordinal := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfNameOrdinals));

  for l_i := 0 to l_exports.NumberOfNames - 1 do begin

    if StrComp(f_name, PChar(Cardinal(l_codeBase) + l_nameRef^)) = 0 then begin

      l_idx := l_ordinal^;

      break;

    end;

    inc(l_nameRef);

    inc(l_ordinal);

  end;

  if (l_idx = -1) then begin

    lastErrStr := 'BTMemoryGetProcAddress: exported symbol not found';

    exit;

  end;

  if (Cardinal(l_idx) > l_exports.NumberOfFunctions - 1) then begin

    lastErrStr := 'BTMemoryGetProcAddress: name <-> ordinal number don''t match';

    exit;

  end;

  // AddressOfFunctions contains the RVAs to the "real" functions

  l_temp := Pointer(Cardinal(l_codeBase) + Cardinal(l_exports.AddressOfFunctions) + Cardinal((l_idx * 4)));

  Result := Pointer(Cardinal(l_codeBase) + l_temp^);

end;

procedure BTMemoryFreeLibrary(var f_module: PBTMemoryModule); stdcall;

var

  l_module: PBTMemoryModule;

  l_i: integer;

  l_temp: integer;

  l_DllEntry: TDllEntryProc;

begin

  l_module := f_module;

  if l_module <> nil then begin

    if l_module.initialized then begin

      @l_DllEntry := Pointer(Cardinal(l_module.codeBase) + l_module.headers.OptionalHeader.AddressOfEntryPoint);

      l_DllEntry(Cardinal(l_module.codeBase), DLL_PROCESS_DETACH, nil);

      l_module.initialized := false;

      // free previously opened libraries

      for l_i := 0 to l_module.numModules - 1 do begin

        l_temp := (sizeof(cardinal) * (l_i));

        inc(Cardinal(l_module.modules), l_temp);

        if Cardinal(f_module.modules^) <> INVALID_HANDLE_VALUE then

          FreeLibrary(Cardinal(f_module.modules^));

        dec(Cardinal(l_module.modules), l_temp);

      end;

      FreeMemory(l_module.modules);

      if l_module.codeBase <> nil then

        // release memory of library

        VirtualFree(l_module.codeBase, 0, MEM_RELEASE);

      HeapFree(GetProcessHeap(), 0, f_module);

      Pointer(f_module) := nil;

    end;

  end;

end;

end.