DOKAN ADA BINDINGS
version 1.0
by Dmitry A. Kazakov

(mailbox@dmitry-kazakov.de)
[Home]

This library is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 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 General Public License for more details. You should have received a copy of the GNU 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.

As a special exception, if other files instantiate generics from this unit, or you link this unit with other files to produce an executable, this unit does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Public License.


Dokan is a user-space file system for Windows 32- and 64-bit. It consists of a driver and a library. The driver routes the I/O requests to the file system device to the library callback.

The software provided here is Ada bindings to the Dokan library. The bindings consist of thin and thick parts. The thin bindings closely follow the Dokan library entry points. As such they are very uncomfortable. The thick binding provide a higher-level access to the Dokan library. It is kept conform to the Ada 95, Ada 2005, Ada 2012 language standards.

Source distribution   dokan_1_0.tgz (tar + gzip)   [Download]

See also changes log.


[TOC][Next]

1. Thick bindings

The thick bindings are provided by the package Dokan.File_System. The package defines the following types. The binding callback use file names encoded in UTF-16 when it get the name from the Dokan library. Other calls use more convenient UTF-8. The names are not converted from UTF-16 to UTF-8 to avoid unnecessary overhead. The implementation may choose the encoding it suits best. The utility operations To_UTF8_String and From_UTF8_String are provided for conversions between these encodings.

[Back][TOC][Next]

1.1. File system

The type Abstract_File_System represents a mounted instance of the file system, e.g. a volume:

type Abstract_File_System is
   abstract new
Ada.Finalization.Limited_Controlled with private;
type
Abstract_File_System_Ptr is access Abstract_File_System'Class;

The following operations are defined on it:

procedure Create_Directory
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Error      : out int
          )  is abstract;

This procedure is called to create a directory. When the directory already exists ERROR_ALREADY_EXISTS is returned (positive, which is not a fault). Name is the directory path (UTF-16). Process_ID identifies the process creating the directory. Error is result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information.

procedure Create_File
          (  System      : in out Abstract_File_System;
             Name        : LPCWSTR;
             Process_ID  : ULONG;
             IO_Mode     : File_Access_Mode;
             Sharing     : File_Sharing_Mode;
             Disposition : File_Open_Mode;
             Options     : File_Options;
             File        : out Abstract_Node_Ptr;
             Error       : out int
          )  is abstract;

This procedure is called to create a new file or open and an existing one. Name is the file path (UTF-16). Process_ID identifies the process creating the file. IO_Mode is the file access mode defined as follows:

type File_Access_Mode is mod 2**2;
No_Access    : constant File_Access_Mode := 0;
Read_Access  : constant File_Access_Mode := 1;
Write_Access : constant File_Access_Mode := 2;
Full_Access  : constant File_Access_Mode := 3;

The function Image:

function Image (Mode : File_Access_Mode) return String;

returns textual representation of Mode. The parameter Sharing of Create_File specifies the file sharing mode. It can be an or-combination of sharing modes. It has the type:

type File_Sharing_Mode is mod 2**3;
Shared_Read   : constant File_Sharing_Mode := 2**0;
Shared_Write  : constant File_Sharing_Mode := 2**1;
Shared_Delete : constant File_Sharing_Mode := 2**2;

The function Image:

function Image (Mode : File_Sharing_Mode) return String;

returns textual representation of Mode. The parameter Disposition the file disposition. It is an enumeration type:

type File_Open_Mode is
     (  Overwrite,
        Create_New,
        Open_Or_Create,
        Open_Existing,
        Truncate
     );

The function Image:

function Image (Mode : File_Open_Mode) return String;

The following table specifies the behavior of Create_File depending on whether the file exists:

Mode File exists File does not exist
Disposition Error code Disposition Error code
Overwrite Truncate ERROR_ALREADY_EXISTS Create ERROR_SUCCESS
Create_New Fail ERROR_ALREADY_EXISTS Create ERROR_SUCCESS
Open_Or_Create Open ERROR_ALREADY_EXISTS Create ERROR_SUCCESS
Open_Existing Open ERROR_SUCCESS Fail ERROR_FILE_NOT_FOUND
Truncate Open ERROR_SUCCESS Fail ERROR_FILE_NOT_FOUND

The parameter Options specifies file opening options. File is a pointer the newly created file object. When the operation fails it should be null. Otherwise it will be freed. The returned object is owned by the bindings. It will be freed when the file is closed. Error is the result Windows error code. The error code is negative when the operation has failed. It is zero on success and positive on warnings or additional information. When the path specifies a directory the implementation should fail with, e.g. with ERROR_INVALID_ACCESS.

procedure Delete_Directory
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Error      : out int
          )  is abstract;

This procedure is called to delete a directory. When the directory is not empty the operation fails with ERROR_DIR_NOT_EMPTY. Name is the directory path (UTF-16). Process_ID identifies the process deleting the directory. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information.

procedure Delete_File
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Error      : out int
          )  is abstract;

This procedure is called to delete a file. Name is the file path (UTF-16). Process_ID identifies the process deleting the file. Error is result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information.

procedure Do_Unmount
          (  System : in out Abstract_File_System
          )  is abstract;

This procedure is called when file system is being unmounted.

procedure Enable_Tracing
          (  System : in out Abstract_File_System;
             On     : Boolean
          );

This is used to enable or disable tracing in the bindings. Note that the Dokan library has tracing of its own. Dokan tracing is enabled when the volume is mounted.

procedure Finalize (System : in out Abstract_File_System);

This procedure is called upon object finalization. It unmounts the file system instance. Note that any derived type shall call this procedure from its implementation of Finalize when it overrides Finalize.

function Get_File_System_Flags
         (  System : Abstract_File_System
         )  return DWORD is abstract;

This function returns the file system flags. See GetVolumeInformation for further information.

function Get_File_System_Name
         (  System : Abstract_File_System
         )  return String is abstract;

This function returns the file system name in UTF-8 encoding.

procedure Get_File_Time
          (  System   : Abstract_File_System;
             Name     : LPCWSTR;
             Created  : out FILETIME;
             Accessed : out FILETIME;
             Written  : out FILETIME;
             Error    : out int
          );

This procedure is called to obtain file creation, last access and last writing times. Error the is result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information.

function Get_Maximal_File_Length
         (  System : Abstract_File_System
         )  return Natural is abstract;

The function returns the maximal number of characters supported for a file name. Note that the value is in characters, not in bytes.

procedure Get_Security
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Security   : SECURITY_INFORMATION;
             Descriptor : out SECURITY_DESCRIPTOR;
             Error      : out int
          );

This procedure is called to obtain file or directory security. Process_ID identifies the process requesting information. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information. The default implementation fails with ERROR_INVALID_FUNCTION.

function Get_Tracing (System : Abstract_File_System) return Boolean;

This function returns true if tracing is enabled.

function Get_Volume_Name
         (  System : Abstract_File_System
         )  return String is abstract;

This function returns the file system volume name in UTF-8 encoding.

function Get_Volume_Serial_Number
         (  System : Abstract_File_System
         )  return String is abstract;

This function returns the volume serial number.

procedure Get_Volume_Space
          (  System     : in out Abstract_File_System;
             Process_ID : ULONG;
             Total      : out Byte_Count;
             Free       : out Byte_Count;
             Available  : out Byte_Count
          );

This procedure is called to get file system statistics. Process_ID identifies the process requesting the file system space. The result may depend on the process if quotas are active, e.g. Available which is the number of bytes available for the user.

procedure Open_Directory
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Directory  : out Abstract_Directory_Ptr;
             Error      : out int
          );

This procedure is called to open a directory. Process_ID identifies the process opening the directory. Directory points to the newly created object of the type Abstract_Directory. The directories are opened in order to list files in. Error is the result Windows error code. The error code is negative when the operation failed and the returned object is freed. It is zero on success and positive on warnings or additional information. The default implementation returns ERROR_ACCESS_DENIED.

procedure Move
          (  System     : in out Abstract_File_System;
             Process_ID : ULONG;
             Old_Name   : LPCWSTR;
             New_Name   : LPCWSTR;
             Replace    : Boolean;
             Error      : out int
          );

This procedure is called to rename a file or directory. Process_ID identifies the process renaming the file or directory. Old_Name is the path of the file or directory to rename (UTF-16). New_Name is the new path (UTF-16). Replace is true if the operation replaces any existing files or directories. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information. The default implementation fails with ERROR_INVALID_NAME.

procedure Mount
          (  System       : in out Abstract_File_System;
             Mount_Point  : String;
             Options      : Option_Type := 0;
             Thread_Count : Natural     := 1
          );

The file system is initially not mounted. In order to mount it this procedure must be called. Mount_Point is the mounting point of the file system, e.g. a device letter like L:. Options is a combination of the Dokan library options defined in the package Dokan:

When Thread_Count is not 1, the file system operations are called concurrently from several system threads. In that case the implementation must protect the internal data from corruption. Each instance of the file system runs a task that dispatches requests to the system. The task is completed when the object is finalized. Use_Error is propagated when the file system is already mounted. Status_Error is propagated when there is no response from the dispatcher task.

procedure Set_Attributes
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Attributes : DWORD;
             Error      : out int
          );

This procedure is called to change file or directory attributes. Name is the file or directory path (UTF-16). Process_ID identifies the process setting attributes. Attributes is the file attributes to set. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information. The default implementation fails with ERROR_INVALID_DATA.

procedure Set_File_Time
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Created    : FILETIME;
             Accessed   : FILETIME;
             Written    : FILETIME;
             Error      : out int
          );

This procedure sets file or directory times. Name is the file or directory path (UTF-16). Process_ID identifies the process setting attributes. Attributes is the file attributes to set. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information. The default implementation fails with ERROR_ACCESS_DENIED.

procedure Set_Security
          (  System     : in out Abstract_File_System;
             Name       : LPCWSTR;
             Process_ID : ULONG;
             Security   : SECURITY_INFORMATION;
             Descriptor : SECURITY_DESCRIPTOR;
             Error      : out int
          );

This procedure sets file or directory security. Name is the file or directory path (UTF-16). Process_ID identifies the process setting attributes. Error is the result Windows error code. The error code is negative when the operation failed. It is zero on success and positive on warnings or additional information. The default implementation fails with ERROR_INVALID_FUNCTION.

procedure Trace
          (  System : in out Abstract_File_System;
             Text   : String
          );
procedure
Trace
          (  System : in out Abstract_File_System;
             Text   : String;
             Error  : Exception_Occurrence
          );
procedure
Trace
          (  System : in out Abstract_File_System;
             Text   : String;
             Name   : LPCWSTR;
             Error  : Exception_Occurrence
          );

This procedures are used to trace actions and errors. The default implementations do nothing.

procedure Unmount (System : in out Abstract_File_System);

This procedure is called to explicitly unmount the file system. Ultimately it calls to the abstract procedure Do_Unmount which actually does the work.

[Back][TOC][Next]

1.2. Abstract node

Abstract node represents an open file or directory of the file system. It is the abstract parent type for both files and directories:

type Abstract_Node is abstract
   new
Ada.Finalization.Limited_Controlled with private;
type
Abstract_Node_Ptr is access Abstract_Node'Class;

The following operations are defined on the type:

procedure Cleanup
          (  File       : in out Abstract_Node;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Delete     : Boolean;
             Error      : out int
          );

This procedure is called when a system handle to the open file or directory is closed. Name is the file or directory path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process. Delete is true if the file or directory is must be deleted when its finally closed. Error is the result Windows error code. This is not a very useful operation, because handles to the files are created silently. The default implementation does nothing.

procedure Close
          (  File       : in out Abstract_Node;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Delete     : Boolean;
             Error      : out int
          );

This procedure is called when to the open file or directory is closed. Name is the file or directory path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process. Delete is true if the file or directory is must be deleted when its finally closed. Error is the result Windows error code. This is not a very useful operation, because handles to the files are created silently. The default implementation does nothing.

procedure Finalize (File : in out Abstract_Node);

This procedure is called upon finalization of the object. If overridden the new implementation must call to the parent's one.

procedure Get_Information
          (  File       : in out Abstract_Node;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Attributes : out DWORD;
             Created    : out FILETIME;
             Accessed   : out FILETIME;
             Written    : out FILETIME;
             Size       : out Byte_Count;
             Links      : out DWORD;
             Index      : out File_Index;
             Error      : out int
          )  is abstract;

This procedure is called to obtain information about the file or directory. Name is the file or directory path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process requesting information. Error is the result Windows error code. This is not a very useful operation, because handles to the files are created silently.

[Back][TOC][Next]

1.3. Abstract directory

Abstract directory represents an open directory on the file system:

type Abstract_Directory is abstract
   new
Abstract_Node with private;
type
Abstract_Directory_Ptr is access Abstract_Directory'Class;

The following operations are defined on the type:

procedure Finalize (Directory : in out Abstract_Directory);

This procedure is called upon finalization of the object. If overridden the new implementation must call to the parent's one.

procedure Find
          (  Directory  : in out Abstract_Directory;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Fill       : FillFileData_Ptr;
             Info       : File_Info_Ptr;
             Error      : out int
          );

This procedure is called to enumerate files in the directory. Name is the directory path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process searching the directory. Fill is procedure to call for each directory file. Info is the value to pass to Fill. Error is the result Windows error code. Fill is declare as follows:

type FillFileData_Ptr is access function
     (  Data : WIN32_FIND_DATAW;
        Info : File_Info_Ptr
     )  return int;
pragma Convention (Stdcall, FillFileData_Ptr);

Here Data is the Windows data structure to filled with the file data. Info is the corresponding parameter passed to Find. The result is non-zero if the enumeration of files must be stopped.

[Back][TOC][Next]

1.4. Abstract file

Abstract file represents an open file on the file system:

type Abstract_File is abstract
   new
Abstract_Node with private;
type
Abstract_File_Ptr is access Abstract_File'Class;

The following operations are defined on the type:

procedure Finalize (File : in out Abstract_File);

This procedure is called upon finalization of the object. If overridden the new implementation must call to the parent's one.

procedure Flush
          (  File       : in out Abstract_Directory;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Error      : out int
          );

This procedure is called to flush all file buffers. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process flushing the file. Error is the result Windows error code. The default implementation fails with ERROR_WRITE_FAULT.

procedure Lock
          (  File        : in out Abstract_Directory;
             Name        : LPCWSTR;
             System      : in out Abstract_File_System'Class;
             Process_ID  : ULONG;
             Byte_Offset : Byte_Count;
             Length      : Byte_Count;
             Error       : out int
          );

This procedure is called to lock a portion of the file. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process locking the file. Byte_Offset is the first byte to lock (zero-based). Length is the number of bytes to lock. Error is the result Windows error code. The default implementation fails with ERROR_LOCK_FAILED.

procedure Read
          (  File        : in out Abstract_Directory;
             Name        : LPCWSTR;
             System      : in out Abstract_File_System'Class;
             Process_ID  : ULONG;
             Buffer      : out Storage_Array;
             Last        : out Storage_Offset;
             Offset      : Byte_Count;
             Error       : out int
          );

This procedure is called to read a portion of the file. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process reading the file. Buffer is the read buffer. Last is set to the last read storage element. Offset is the first byte to read (zero-based). Error is the result Windows error code. The default implementation fails with ERROR_READ_FAULT.

procedure Write
          (  File        : in out Abstract_Directory;
             Name        : LPCWSTR;
             System      : in out Abstract_File_System'Class;
             Process_ID  : ULONG;
             Buffer      : Storage_Array;
           [ Offset      : Byte_Count; ]
             Error       : out int
          );

This procedure is called to write a portion of the file. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process writing the file. Buffer is the write buffer. Offset is the first byte to write (zero-based). When omitted, the file is written starting at its end. Error is the result Windows error code. The default implementation fails with ERROR_WRITE_FAULT.

procedure Set_End_Of
          (  File       : in out Abstract_Directory;
             Name       : LPCWSTR;
             System     : in out Abstract_File_System'Class;
             Process_ID : ULONG;
             Length     : Byte_Count;
             Error      : out int
          );

This procedure is called to set the file end. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process setting the file end. Length is the new file length in bytes. Error is the result Windows error code. The default implementation fails with ERROR_WRITE_FAULT.

procedure Unlock
          (  File        : in out Abstract_Directory;
             Name        : LPCWSTR;
             System      : in out Abstract_File_System'Class;
             Process_ID  : ULONG;
             Byte_Offset : Byte_Count;
             Length      : Byte_Count;
             Error       : out int
          );

This procedure is called to unlock a portion of the file. Name is the file path (UTF-16). System is the file system the file or directory is located on. Process_ID identifies the process unlocking the file. Byte_Offset is the first byte to unlock (zero-based). Length is the number of bytes to unlock. Error is the result Windows error code. The default implementation fails with ERROR_LOCK_FAILED.

[Back][TOC][Next]

1.5. Utility operations

The package Dokan.File_System provides the following utility operations:

function From_Time (Stamp : Time) return FILETIME;

This function converts Ada calendar's time to Windows' FILETIME. Time_Error is propagated on conversion errors.

function From_UTF8_String (Text : String) return Wide_String;

This function converts an UTF-8 encoded string to UTF-16 equivalent.

function Get_Error_Text (Code : DWORD) return String;

This function gets Windows' error message text corresponding to Code.

function To_Time (Stamp : FILETIME) return Time;

This function converts Windows' FILETIME to Ada calendar's time. Time_Error is propagated on conversion errors.

function To_UTF8_String (Text : LPCWSTR) return String;

This function converts an UTF-16 encoded string to UTF-8 equivalent. It also normalizes Text by replacing '/' with '\'.


[Back][TOC][Next]

2. Samples

[Back][TOC][Next]

2.1. Memory-resident file system

The package Memory_FS provides a simplified sample implementation of memory-resident file system. The implementation uses Simple Components for Ada, which is required for building the sample.

The package Memory_FS is located in the subdirectory example/memory-fs:

File memory_fs.ads:
with Ada.Exceptions;           use Ada.Exceptions;
with Win32;                    use Win32;
with Win32.WinNT;              use Win32.WinNT;
with Dokan.File_System;        use Dokan.File_System;
with Dokan.Thin;               use Dokan.Thin;
with Synchronization.Mutexes;  use Synchronization.Mutexes;
with System.Storage_Elements;  use System.Storage_Elements;

with Ada.Text_IO;
with Generic_Unbounded_Array;
with Object.Handle;
with Tables.UTF8_Names;
with Win32.WinBase;

package Memory_FS is
   --
   -- Memory_File_System -- A memory-resident file system
   --

   type Memory_File_System is new Abstract_File_System with private;

The Memory_File_System type is derived from Abstract_File_System.

File memory_fs.ads (continuation):
   --
   -- Set_Trace_File -- Designate the trace output file
   --
   --    System        - File system
   --    [ File_Name ] - The trace file name, if missing standard output used
   --

   procedure Set_Trace_File
             (  System    : in out Memory_File_System;
                File_Name : String
             );
   procedure Set_Trace_File (System : in out Memory_File_System);

Here a two utility operations are defined for debugging purpose. The procedure Set_Trace_File redirects trace output to a specific file when the parameter File_Name is present or to the standard output, if omitted.

File memory_fs.ads (continuation):
private
   type
Node is abstract new Object.Entity with record
      Created    : Win32.Winbase.FILETIME;
      Accessed   : Win32.Winbase.FILETIME;
      Written    : Win32.Winbase.FILETIME;
      Attributes : DWORD;
   end record;
   type Node_Ptr is access Node'Class;
   function Get_Size (File : Node) return Byte_Count is abstract;
   procedure Initialize (File : in out Node);

In the private part of the package the abstract base type of the file system nodes is defined. A node is either a file or a directory. The type Node is abstract and derived from Object.Enity in order to provide reference counting collection. The fields of Node are file or directory access times and the attributes. Abstract operation Get_Size is defined to return the file system space allocated for the node.

File memory_fs.ads (continuation):
   package Node_Handles is new Object.Handle (Node, Node_Ptr);

Here the generic package Object.Handle is instantiated to provide handles to the node objects. When the last handle to a node disappears the node is deleted.

File memory_fs.ads (continuation):
   package Raw_Tables is new Tables (Node_Handles.Handle);

   procedure Check_Spelling (Name : String);
   function Check_Matched (Source : String; Pointer : Integer)
      return Boolean;

   package Directory is new Raw_Tables.UTF8_Names;
   use Directory;

 Here case-insensitive tables of handles to the files system nodes is defined through instantiation of the generic package Tables.UTF8_Names. The package requires two subroutines:

The implementation of Check_Spelling checks if its string parameter is a valid Windows file name. Check_Matched verifies if name is not followed by a letter, digit or any other legal file name character.

File memory_fs.ads (continuation):
   type Folder_Node is new Node with record
      Data : Directory.Dictionary;
   end record;
   function Get_Size (File : Folder_Node) return Byte_Count;
   procedure Initialize (File : in out Folder_Node);

The type Folder_Node represents a file system directory. It is derived from Node and contains a table of files from the directory. The table type is defined by the instance of Tables.UTF8_Names.

File memory_fs.ads (continuation):
   package Storage_Arrays is
      new
Generic_Unbounded_Array
          (  Index_Type        => Storage_Offset,
             Object_Type       => Storage_Element,
             Object_Array_Type => Storage_Array,
             Null_Element      => 0,
             Minimal_Size      => 1024,
             Increment         => 1024
          );
   use Storage_Arrays;

An instance of Generic_Unbounded_Array serves a container of file contents. The array is indexed by Storage_Offset and contains Storage_Elements. A more sophisticated implementation may use non-contiguous storage allocation schema.

File memory_fs.ads (continuation):
   type File_Node is new Node with record
      Length : Storage_Count := 0;
      Data   : Unbounded_Array;
   end record;
   function Get_Size (File : File_Node) return Byte_Count;
   procedure Initialize (File : in out File_Node);

Here a file system plain file node is defined. The node has current file length (Length component) and file contents (Data of Unbounded_Array).

File memory_fs.ads (continuation):
   type Memory_File_System is new Abstract_File_System with record
      Root       : Node_Handles.Handle;
      Into_File  : Boolean := False;
      Trace_File : Ada.Text_IO.File_Type;
      Lock       : aliased Mutex;
   end record;

Now the file system itself is defined. It has the components:

File memory_fs.ads (continuation):
   procedure Create_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             );
   procedure Create_File
             (  System      : in out Memory_File_System;
                Name        : LPCWSTR;
                Process_ID  : ULONG;
                IO_Mode     : File_Access_Mode;
                Sharing     : File_Sharing_Mode;
                Disposition : File_Open_Mode;
                Options     : File_Options;
                File        : out Abstract_Node_Ptr;
                Error       : out int
             );
   procedure Delete_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             );
   procedure Delete_File
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             );
   procedure Do_Unmount (System : in out Memory_File_System);
   procedure Finalize (System : in out Memory_File_System);
   procedure Get_File_Time
             (  System   : in out Memory_File_System;
                Name     : LPCWSTR;
                Created  : out Win32.Winbase.FILETIME;
                Accessed : out Win32.Winbase.FILETIME;
                Written  : out Win32.Winbase.FILETIME;
                Error    : out int
             );

Here some of the abstract operations of the base type are overridden.

File memory_fs.ads (continuation):
   function Find
            (  System : access Memory_File_System;
               Name   : LPCWSTR;
               Parent : access Node_Handles.Handle;
               Check  : Boolean := True
            )  return String;

This utility function is used internally to decompose a file path into a handle to the parent's directory and simple file name. Name is the file path UTF-16 encoded. Parent is the output handle for the directory part. Check is true when the file simple name must be checked. The function returns the simple name. Constraint_Error is propagated when the name is illegal. End_Error is propagated when a parent directory does not exist. Name_Error is propagated when a parent is not a directory.

File memory_fs.ads (continuation):
   procedure Find
             (  System : in out Memory_File_System;
                Name   : LPCWSTR;
                File   : out Node_Handles.Handle;
                Error  : out int
             );

This is a simplified version of Find used when an existing file should be searched for. Name is the file path UTF-16 encoded. File is a handle to the file specified. Error is the Windows error code set according to the search outcome.

File memory_fs.ads (continuation):
   function Get_File_System_Flags
            (  System : Memory_File_System
            )  return DWORD;
   function Get_File_System_Name
            (  System : Memory_File_System
            )  return String;
   function Get_Maximal_File_Length
            (  System : Memory_File_System
            )  return Natural;
   function Get_Volume_Name
            (  System : Memory_File_System
            )  return String;
   function Get_Volume_Serial_Number
            (  System : Memory_File_System
            )  return DWORD;
   procedure Get_Volume_Space
             (  System     : in out Memory_File_System;
                Process_ID : ULONG;
                Total      : out Byte_Count;
                Free       : out Byte_Count;
                Available  : out Byte_Count
             );
   procedure Initialize (System : in out Memory_File_System);
   procedure Move
             (  System     : in out Memory_File_System;
                Process_ID : ULONG;
                Old_Name   : LPCWSTR;
                New_Name   : LPCWSTR;
                Replace    : Boolean;
                Error      : out int
             );
   procedure Open_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Directory  : out Abstract_Directory_Ptr;
                Error      : out int
             );
   procedure Set_Attributes
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Attributes : DWORD;
                Error      : out int
             );
   procedure Set_File_Time
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Created    : Win32.Winbase.FILETIME;
                Accessed   : Win32.Winbase.FILETIME;
                Written    : Win32.Winbase.FILETIME;
                Error      : out int
             );
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String
             );
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String;
                Error  : Exception_Occurrence
             );
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String;
                Name   : LPCWSTR;
                Error  : Exception_Occurrence
             );

Here is another portion of primitive operations gets overridden.

File memory_fs.ads (continuation):
   type Memory_File (File : access File_Node'Class) is
      new
Abstract_File with
   record

      Reference : Node_Handles.Handle;
      Mode      : File_Access_Mode := No_Access;
   end record;

Memory_File is an implementation of Abstract_File which serves as a proxy to an open file system file. An object has the components:

File memory_fs.ads (continuation):
   procedure Close
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Delete     : Boolean;
                Error      : out int
             );
   procedure Flush
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Error      : out int
             );
   procedure Get_Information
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Attributes : out DWORD;
                Created    : out Win32.Winbase.FILETIME;
                Accessed   : out Win32.Winbase.FILETIME;
                Written    : out Win32.Winbase.FILETIME;
                Size       : out Byte_Count;
                Links      : out DWORD;
                Index      : out File_Index;
                Error      : out int
             );
   procedure Read
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : out Storage_Array;
                Last       : out Storage_Offset;
                Offset     : Byte_Count;
                Error      : out int
             );
   procedure Write
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : Storage_Array;
                Error      : out int
             );
   procedure Write
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : Storage_Array;
                Offset     : Byte_Count;
                Error      : out int
             );
   procedure Set_End_Of
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Length     : Byte_Count;
                Error      : out int
             );

The primitive operations of Abstract_File are overridden here.

File memory_fs.ads (continuation):
   type Memory_Folder (Folder : access Folder_Node'Class) is
      new
Abstract_Directory with
   record

      Reference : Node_Handles.Handle;
   end record;

Memory_Folder is an implementation of Abstract_Directory which serves as a proxy to an open file system directory. An object keeps a handle to the file system directory object.

File memory_fs.ads (continuation):
   procedure Close
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Delete     : Boolean;
                Error      : out int
             );
   procedure Find
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Fill       : FillFileData_Ptr;
                Info       : File_Info_Ptr;
                Error      : out int
             );
   procedure Get_Information
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Attributes : out DWORD;
                Created    : out Win32.Winbase.FILETIME;
                Accessed   : out Win32.Winbase.FILETIME;
                Written    : out Win32.Winbase.FILETIME;
                Size       : out Byte_Count;
                Links      : out DWORD;
                Index      : out File_Index;
                Error      : out int
             );
end Memory_FS;

This overrides operations of Abstract_Directory.

File memory_fs.adb:
with Ada.Calendar;               use Ada.Calendar;
with Ada.IO_Exceptions;          use Ada.IO_Exceptions;
with Strings_Edit.Quoted;        use Strings_Edit.Quoted;
with Strings_Edit.UTF8;          use Strings_Edit.UTF8;
with Strings_Edit.UTF8.Mapping;  use Strings_Edit.UTF8.Mapping;
with Strings_Edit.UTF8.Maps;     use Strings_Edit.UTF8.Maps;
with System.Storage_Pools;       use System.Storage_Pools;
with Win32.WinError;             use Win32.WinError;

with Strings_Edit.UTF8.Maps.Constants;
with Win32.CRT.StdLib;

package body Memory_FS is
   use
Node_Handles;
   use type DWORD;
   use type LONG;
   use type int;

   NUL : constant Wide_Character := Wide_Character'Val (0);

The implementation of the package Memory_FS follows.

File memory_fs.adb (continuation):
   procedure Check_Spelling (Name : String) is
      Pointer : Integer := Name'First;
      Symbol  : Code_Point;
   begin
      while
Pointer <= Name'Last loop
         Get (Name, Pointer, Symbol);
         case Symbol is
            when
0..31 =>
               Raise_Exception
               (  Constraint_Error'Identity,
                  "File name contains control characters"
               );
            when Character'Pos ('<') | Character'Pos ('>') |
                 Character'Pos (':') | Character'Pos ('"') |
                 Character'Pos ('/') | Character'Pos ('\') |
                 Character'Pos ('|') | Character'Pos ('?') |
                 Character'Pos ('*') =>
               Raise_Exception
               (  Constraint_Error'Identity,
                  "File name contains one of <,>,:,"",/,\,|,*"
               );
            when others =>
               null;
         end case;
      end loop;
   exception
      when
Constraint_Error =>
         raise;
      when others =>
         Raise_Exception
         (  Constraint_Error'Identity,
            "Wrong encoded file name"
         );
   end Check_Spelling;

The implementation of Check_Spelling raises Contraint_Error if the name contains a control character or else one of <, >, :, ", /, \, |, ?, *.

File memory_fs.adb (continuation):
   function Check_Matched (Source : String; Pointer : Integer)
      return Boolean is
   begin
      case
Source (Pointer) is
         when
Character'Val (0)..Character'Val (31) =>
            return True;
         when '<' | '>' | ':' | '"' | '/' | '\' | '|' | '*' =>
            return True;
         when others =>
            return False;
      end case;
   end Check_Matched;

The implementation checks if any of the forbidden characters follows the name, this is Source (Pointer). In this case the name can ends at Pointer and the returned value is true. Otherwise, the result is false.

File memory_fs.adb (continuation):
   procedure Close
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Delete     : Boolean;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      This   : File_Node'Class renames File.File.all;
      Lock   : Holder (Volume.Lock'Access);
   begin
      if
Delete then
         This.Attributes := This.Attributes or FILE_ATTRIBUTE_TEMPORARY;
         Delete_File (System, Name, Process_ID, Error);
      else
         This.Accessed := From_Time (Clock);
         if 0 /= (File.Mode and Write_Access) then
            This.Written := This.Accessed;
         end if;
         Error := 0;
      end if;
   end Close;

The implementation of closing file deletes the file when Delete is true. Otherwise, it sets the Accessed and Written fields of the file node to the current time. The utility function From_Time is used to convert Ada.Calendar.Time to Windows' FILETIME. Note that the implementation uses the file system mutex to block concurrent access.

File memory_fs.adb (continuation):
   procedure Close
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Delete     : Boolean;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      This   : Folder_Node'Class renames Directory.Folder.all;
      Lock   : Holder (Volume.Lock'Access);
   begin
      if
Delete then
         This.Attributes := This.Attributes or FILE_ATTRIBUTE_TEMPORARY;
         Delete_Directory (System, Name, Process_ID, Error);
      else
         This.Accessed := From_Time (Clock);
         Error := 0;
      end if;
   end Close;

The implementation of closing directory is same as for a file.

File memory_fs.adb (continuation):
   procedure Create_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             )  is
      Lock   : Holder (System.Lock'Access);
      Parent : aliased Node_Handles.Handle;
   begin
      declare

         Folder : String := Find (System'Access, Name, Parent'Access);
      begin
         Check_Spelling (Folder);

The implementation of directory creation starts with searching for the directory parent using the function Find and getting the directory name. After that the directory name is checked using Check_Spelling.

File memory_fs.adb (continuation):
         declare
            This   : Folder_Node'Class renames
                     Folder_Node'Class (Ptr (Parent).all);
            Offset : Natural := Locate (This.Data, Folder);

Here we get the parent node object and locate the specified name in the table of its children (the component Data). The result is zero if there is no child with this name.

File memory_fs.adb (continuation):
         begin
            if
Offset = 0 then
               Add (This.Data, Folder, Ref (new Folder_Node));
               This.Accessed := From_Time (Clock);
               This.Written  := This.Accessed;
               This.Created  := This.Accessed;
               Error := 0;

Since there is no such child, we create a new directory node, add a handle to it to the children. The creation, access, write times are set to the current time.

File memory_fs.adb (continuation):
            else
               if
(  Ptr (GetTag (This.Data, Offset)).all
                  in Folder_Node'Class
                  )
               then
                  Error := ERROR_ALREADY_EXISTS;
               else
                  Error := -ERROR_ALREADY_EXISTS;
               end if;
            end if;

There is a child with this name. We check if the child is a directory and if so return ERROR_ALREADY_EXISTS as an informational code. Otherwise, ERROR_ALREADY_EXISTS  is returned as an error.

File memory_fs.adb (continuation):
      end;
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Create_Directory;

Finally we catch exceptions propagating on invalid name, non-existing parent, wrong parent name and return corresponding error codes.

File memory_fs.adb (continuation):
   procedure Create_File
             (  System      : in out Memory_File_System;
                Name        : LPCWSTR;
                Process_ID  : ULONG;
                IO_Mode     : File_Access_Mode;
                Sharing     : File_Sharing_Mode;
                Disposition : File_Open_Mode;
                Options     : File_Options;
                File        : out Abstract_Node_Ptr;
                Error       : out int
             )  is
      Lock   : Holder (System.Lock'Access);
      Parent : aliased Node_Handles.Handle;
   begin
      declare

         Directory : Boolean := False;
         Pattern   : Boolean := False;
         File_Name : String :=
                     Find (System'Access, Name, Parent'Access, False);

The implementation of file creation must be able both to create a new file or to open an existing file. It starts with finding the file parent directory and getting the file name.

File memory_fs.adb (continuation):
      begin
         for
Index in File_Name'Range loop
            case
File_Name (Index) is
               when
'*' | '?' =>
                  Pattern := True;
                  exit;
               when others =>
                  null;
            end case;
         end loop;

Sometimes Windows uses file names containing wild-cards * and ?. Here we check if the name contains any of them and set the variable Pattern to true.

File memory_fs.adb (continuation):
         declare
            This   : Folder_Node'Class renames
                     Folder_Node'Class (Ptr (Parent).all);
            Offset : Natural;
            Item   : Node_Handles.Handle;

 Here we get the parent directory node. Then the behavior depends on whether the name contains wild-cards or not.

File memory_fs.adb (continuation):
         begin
            if
Pattern then
               Offset := 0;
               declare
                  Pattern_Name : Wide_String :=
                                 From_UTF8_String (File_Name) & NUL;
               begin
                  for
Index in 1..GetSize (This.Data) loop
                     declare

                        Name : Wide_String :=
                               (  From_UTF8_String
                                  (  GetName (This.Data, Index)
                                  )
                               &  NUL
                               );
                     begin
                        if
0 /= IsNameInExpression
                                (  Addr (Pattern_Name),
                                   Addr (Name),
                                   1
                                )
                        then
                           Offset := Index;
                           exit;
                        end if;
                     end;
                  end loop;
               end;

When the name contains wild-cards we go through all children and look for the first child which name is matched by the pattern. For matching the function IsNameInExpression from the thin Dokan bindings is used. Dokan uses UTF-16 encoding. Note how the name is converted to UTF-16 using From_UTF8_String. Note also that NUL must be added to the name to make it working. When a child is found Offset is the child's position in the children table of the parent directory node. When no child is found Offset is zero.

File memory_fs.adb (continuation):
            else
               Offset := Locate (This.Data, File_Name);
            end if;

When the name contains no wild-cards we search the children table for the name. Again Offset is the child position in the table or zero.

File memory_fs.adb (continuation):
            if Offset = 0 then -- No file exists
               case Disposition is
                  when
Overwrite | Create_New | Open_Or_Create =>
                     Error := 0;
                  when Open_Existing | Truncate =>
                     Error := -ERROR_FILE_NOT_FOUND;
                     return;
               end case;
               Item := Ref (new File_Node);
               Add (This.Data, File_Name, Item);
               This.Accessed := From_Time (Clock);
               This.Written  := This.Accessed;
               This.Created  := This.Accessed;

When there is no child with the name the implementation looks at the Disposition parameter. When Disposition is Open_Existing or Truncate, the implementation faults with code ERROR_FILE_NOT_FOUND. When it is Overwrite or Create_New or Open_Or_Create, a file is created and the error code is set to zero. The file node is allocated and a handle to it (Item) is added to the children list. The file creation, access, write times are set to the current time. The variable Directory remains false.

File memory_fs.adb (continuation):
            else -- File exists
               Item := GetTag (This.Data, Offset);
               Directory := Ptr (Item).all in Folder_Node'Class;
               case Disposition is

When there is a child with the name Item set to point to the child's node. The node is checked for being a directory and Directory is set. Then the Disposition parameter is checked:

File memory_fs.adb (continuation):
                  when Open_Or_Create =>
                     if Directory and then IO_Mode /= No_Access then
                        Error := -ERROR_INVALID_ACCESS;
                        return;
                     end if;
                     Error := ERROR_ALREADY_EXISTS;

When Disposition is Open_Or_Create and the child is a directory and the I/O mode requires reading, writing or deleting the implementation fails with ERROR_INVALID_ACCESS. Otherwise the result is set to ERROR_INVALID_ACCESS.

File memory_fs.adb (continuation):
                  when Open_Existing =>
                     if Directory and then IO_Mode /= No_Access then
                        Error := -ERROR_INVALID_ACCESS;
                        return;
                     end if;
                     Error := 0;

When Disposition is Open_Existing and the child a directory and the I/O mode requires reading, writing or deleting the implementation fails with ERROR_INVALID_ACCESS. Otherwise the result is set to zero.

File memory_fs.adb (continuation):
                  when Truncate | Overwrite =>
                     if Directory then
                        Error := -ERROR_INVALID_ACCESS;
                        return;
                     end if;
                     Error := ERROR_ALREADY_EXISTS;
                     File_Node'Class (Ptr (Item).all).Length := 0;

When Disposition is Open_Truncate or Overwrite and the child a directory the implementation fails with ERROR_INVALID_ACCESS. Otherwise the result is set to ERROR_INVALID_ACCESS. Then the file node length is set to zero, which is equivalent to truncation and overwriting.

File memory_fs.adb (continuation):
                  when Create_New =>
                     Error := -ERROR_ALREADY_EXISTS;
                     return;
               end case;
            end if;

When Disposition is Create_New the implementation fails with ERROR_INVALID_ACCESS.

File memory_fs.adb (continuation):
            if Directory then
               File := new Memory_Folder
                           (  Folder_Node'Class
                              (  Ptr (Item).all
                              ) 'Unchecked_Access
                           );
               Memory_Folder (File.all).Reference := Item;

When a directory is opened an new instance of Memory_Folder is allocated. Its component Reference is set to the file system node from the variable Item.

File memory_fs.adb (continuation):
            else
               File := new Memory_File
                           (  File_Node'Class
                              (  Ptr (Item).all
                              ) 'Unchecked_Access
                           );
               declare
                  This : Memory_File renames Memory_File (File.all);
               begin
                  This.Reference := Item;
                  This.Mode := IO_Mode;
               end;
            end if;

When a file is opened or create an new instance of Memory_File is allocated. Its component Reference is set to the file system node from the variable Item. The component Mode is set to the required I/O mode.

File memory_fs.adb (continuation):
         end;
      end;
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Create_File;

Here we catch exceptions propagating on invalid name, non-existing parent, wrong parent name and return corresponding error codes.

File memory_fs.adb (continuation):
   procedure Delete_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             )  is
      Lock   : Holder (System.Lock'Access);
      Parent : aliased Node_Handles.Handle;
   begin
      declare

         Simple : String := Find (System'Access, Name, Parent'Access);
         Offset : Natural;
         This   : Folder_Node'Class renames
                  Folder_Node'Class (Ptr (Parent).all);

The implementation directory deletion starts with finding the parent directory and getting the directory name.

File memory_fs.adb (continuation):
      begin
         Offset := Locate (This.Data, Simple);

Here the parent directory is searched for the specified directory name. Offset is zero when nothing found. Otherwise it is the position of the directory in the table of children.

File memory_fs.adb (continuation):
         if Offset = 0 then
            Error := -ERROR_FILE_NOT_FOUND;

When no file exists the implementation fails with the code ERROR_FILE_NOT_FOUND.

File memory_fs.adb (continuation):
         else
            declare

               File : Node'Class renames
                      Ptr (GetTag (This.Data, Offset)).all;

When there is a file its node is accessed as File.

File memory_fs.adb (continuation):
            begin
               if
File in File_Node'Class then
                  Directory.Delete (This.Data, Offset);
                  This.Accessed := From_Time (Clock);
                  This.Written  := This.Accessed;
                  Error := 0;

When the node is a plain file it is deleted from the table of the parent's children. The access and write times of the parent are updated.

File memory_fs.adb (continuation):
               elsif (  (  0
                        /= (  File.Attributes
                           and
                              FILE_ATTRIBUTE_TEMPORARY
                        )  )
                     or else
                        GetSize (Folder_Node'Class (File).Data) = 0
                     )  then
                  Directory.Delete (This.Data, Offset);
                  This.Accessed := From_Time (Clock);
                  This.Written  := This.Accessed;
                  Error := 0;

When the node is a directory it is tested for either being temporary or else empty. Then it is deleted the same way a plain file would be.

File memory_fs.adb (continuation):
               else
                  Error := -ERROR_DIR_NOT_EMPTY;
               end if;

Otherwise, the implementation fails with ERROR_DIR_NOT_EMPTY.

ile memory_fs.adb (continuation):
            end;
         end if;
      end;
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Delete_Directory;

Here we catch exceptions propagating on invalid name, non-existing parent, wrong parent name and return corresponding error codes.

File memory_fs.adb (continuation):
   procedure Delete_File
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Error      : out int
             )  is
      Lock   : Holder (System.Lock'Access);
      Parent : aliased Node_Handles.Handle;
   begin
      declare

         Simple : String := Find (System'Access, Name, Parent'Access);
         Offset : Natural;
         This   : Folder_Node'Class renames
                  Folder_Node'Class (Ptr (Parent).all);

The implementation file deletion is similar to directory deletion. It starts with finding the parent directory and getting the directory name.

File memory_fs.adb (continuation):
      begin
         Offset := Locate (This.Data, Simple);

Here the parent directory is searched for the specified file name. Offset is zero when nothing found. Otherwise it is the position of the file in the table of children.

File memory_fs.adb (continuation):
         if Offset = 0 then
            Error := -ERROR_FILE_NOT_FOUND;

When no file exists the implementation fails with the code ERROR_FILE_NOT_FOUND.

File memory_fs.adb (continuation):
         else
            declare

               File : Node'Class renames
                      Ptr (GetTag (This.Data, Offset)).all;

When there is a file its node is accessed as File.

File memory_fs.adb (continuation):
            begin
               if
File in File_Node'Class then
                  Directory.Delete (This.Data, Offset);
                  This.Accessed := From_Time (Clock);
                  This.Written  := This.Accessed;
                  Error         := 0;

When the node is a plain file it is deleted by removing it from the parent's children table. The access and write times of the parent are updated.

File memory_fs.adb (continuation):
               else
                  Error := -ERROR_ACCESS_DENIED;
               end if;

Otherwise, when the node is a directory, the implementation fails with ERROR_ACCESS_DENIED.

File memory_fs.adb (continuation):
            end;
         end if;
      end;
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Delete_File;

Here we catch exceptions propagating on invalid name, non-existing parent, wrong parent name and return corresponding error codes.

File memory_fs.adb (continuation):
   procedure Do_Unmount
             (  System : in out Memory_File_System
             )  is
   begin
      if
Get_Tracing (System) then
         Trace (System, "Unmounting");
      end if;
   end Do_Unmount;

 The implementation of Do_Unmount does not requires any specific actions. The only thing it does is tracing.

File memory_fs.adb (continuation):
   procedure Finalize (System : in out Memory_File_System) is
   begin
      if
Get_Tracing (System) then
         Trace (System, "Finalizing memory file system");
      end if;
      if System.Into_File then
         Ada.Text_IO.Close (System.Trace_File);
      end if;
      Finalize (Abstract_File_System (System));
   end Finalize;

Finalization does tracing and then calls to the parent's type implementation.

File memory_fs.adb (continuation):
   function Find
            (  System : access Memory_File_System;
               Name   : LPCWSTR;
               Parent : access Node_Handles.Handle;
               Check  : Boolean := True
            )  return String is
      Path    : String  := To_UTF8_String (Name);
      Pointer : Integer := Path'First;
      Start   : Integer := Pointer;
      Current : Node_Handles.Handle renames Parent.all;

The utility function Find starts with conversion UTF-16 encoded Name to UTF-8. Current is renamed handle to the parent (parameter Parent).

File memory_fs.adb (continuation):
   begin
      if
Get_Tracing (System.all) then
         if
Check then
            Trace
            (  System.all,
               " Looking for " & Quote (Path) & " [checked]"
            );
         else
            Trace
            (  System.all,
               " Looking for " & Quote (Path) & " [unchecked]"
            );
         end if;
      end if;
      Current := System.Root;

After some tracing Parent is set to the file system root.

File memory_fs.adb (continuation):
      if Path'Length = 0 then -- Root directory
         return "";

When the path is empty the parent remains root directory and file name is returned empty.

File memory_fs.adb (continuation):
      elsif Path (Pointer) = '\' then -- We are in the root directory
         Pointer := Pointer + 1;
         Start   := Pointer;
      end if
;

When the path starts with a slash, the slash is skipped. Start points to the beginning of a directory name. Pointer does to the current character to process. UTF-8 issues can be safely ignored because ASCII-7 characters are encoded in UTF-8 as is.

File memory_fs.adb (continuation):
      while Pointer <= Path'Last loop
         if
Path (Pointer) = '\' then

Here we are looking for the next slash indicating end of the parent directory name.

File memory_fs.adb (continuation):
            if Ptr (Current).all not in Folder_Node'Class then
               if
Get_Tracing (System.all) then
                  Trace
                  (  System.all,
                     (  " Not a directory "
                     &  Quote (Path (Path'First..Start))
                  )  );
               end if;
               Raise_Exception
               (  Name_Error'Identity,
                  (  "Not a directory: "
                  &  Path (Path'First..Start)
               )  );
            end if;

When the handle to the current node is not a directory the directory name just found cannot be its child. The implementation does tracing and raises Name_Error to indicate wrong path.

File memory_fs.adb (continuation):
            declare
              
Folder : Folder_Node'Class renames
                        Folder_Node'Class (Ptr (Current).all);
               Offset : Natural :=
                        Locate
                        (  Folder.Data,
                           Path (Start..Pointer - 1)
                        );

When the node is a directory, the directory name Path (Start..Pointer - 1) is searched for amount its children. Offset is zero when no child is found.

File memory_fs.adb (continuation):
            begin
               if
Offset = 0 then
                  if
Get_Tracing (System.all) then
                     Trace
                     (  System.all,
                        (  " Not exists "
                        &  Quote (Path (Start..Pointer - 1))
                     )  );
                  end if;
                  Raise_Exception
                  (  End_Error'Identity,
                     "Not exist " & Path (Start..Pointer - 1)
                  );
               end if;

When no child exists, the path is wrong.

File memory_fs.adb (continuation):
               Pointer := Pointer + 1;
               Start   := Pointer;
               Current := GetTag (Folder.Data, Offset);
            end;

Otherwise, the child becomes current node. Pointer and Start are advanced behind the slash.

File memory_fs.adb (continuation):
         else
            Pointer := Pointer + 1;
         end if;
      end loop;

Characters different from slash are skipped. When the loop is existed Path (Start..Path'Last) is the file name.

File memory_fs.adb (continuation):
      if Check then
         if Get_Tracing (System.all) then
            Trace
            (  System.all,
               (  "Checking "
               &  Quote (Path (Start..Path'Last))
            )  );
         end if;
         Check_Spelling (Path (Start..Path'Last));
         return Path (Start..Path'Last);

If Check is true, the file name is checked.

File memory_fs.adb (continuation):
      elsif Start > Path'Last then -- Special case
         return "*";

Empty file name corresponds to the paths ending with slash. The file name is considered wild-card *.

File memory_fs.adb (continuation):
      else
         return
Path (Start..Path'Last);
      end if;
   end Find;

Otherwise, Path (Start..Path'Last) is the file name.

File memory_fs.adb (continuation):
   procedure Find
             (  System : in out Memory_File_System;
                Name   : LPCWSTR;
                File   : out Node_Handles.Handle;
                Error  : out int
             )  is
      Parent : aliased Node_Handles.Handle;
   begin
      declare

         Simple : String := Find (System'Access, Name, Parent'Access);
         Offset : Natural;
         This   : Folder_Node'Class renames
                  Folder_Node'Class (Ptr (Parent).all);

This variant of Find searches for the specified name as a whole. It calls to Find splitting the path Name into a handle to the parent directory node and simple file name.

File memory_fs.adb (continuation):
      begin
         if
Simple = "" then -- Root directory
            File  := System.Root;
            Error := 0;

When file name is empty the result is the root directory.

File memory_fs.adb (continuation):
         else
            Offset := Locate (This.Data, Simple);
            if Offset = 0 then
               Error := -ERROR_FILE_NOT_FOUND;
            else
               File  := GetTag (This.Data, Offset);
               Error := 0;
            end if;
         end if;
      end;

When file name is not empty the parent's children table is searched for it. When the search was unsuccessful is fault with ERROR_FILE_NOT_FOUND. Otherwise, File is set to the child found.

File memory_fs.adb (continuation):
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Find;

Here we catch exceptions propagating on invalid name, non-existing parent, wrong parent name and return corresponding error codes.

File memory_fs.adb (continuation):
   procedure Find
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Fill       : FillFileData_Ptr;
                Info       : File_Info_Ptr;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);

 The implementation of Find gets the file system object (Volume) and locks the file system.

File memory_fs.adb (continuation):
      function Add
               (  Item : Node'Class;
                  Name : Wide_String
               )  return Boolean is
         Data    : Win32.Winbase.WIN32_FIND_DATAW;
         Pointer : Natural := 0;
         Size    : Byte_Count := Get_Size (Item);
         Result  : DWORD;
      begin
         Data.dwFileAttributes := Item.Attributes;
         Data.ftCreationTime   := Item.Created;
         Data.ftLastAccessTime := Item.Accessed;
         Data.ftLastWriteTime  := Item.Written;
         Data.nFileSizeHigh    := DWORD (Size / 2**32);
         Data.nFileSizeLow     := DWORD (Size mod 2**32);
         Data.dwReserved0      := 0;
         Data.dwReserved1      := 0;
         for Source in Name'First..Name'Last loop
            exit when
Pointer >= Data.cFileName'Last;
            Data.cFileName (Pointer) :=
               WCHAR'Val (Wide_Character'Pos (Name (Source)));
            Pointer := Pointer + 1;
         end loop;
         Result :=
            Win32.Winbase.GetShortPathNameW
            (  Addr (Name),
               Data.cAlternateFileName (0)'Unchecked_Access,
               Data.cAlternateFileName'Length
            );
         return 0 /= Fill (Data, Info);
      end Add;

The internal subprogram Add is used to add each found child. The parameter Item is the file system node of the child. Name is the child's name in UTF-16, null-terminated. The structure WIN32_FIND_DATAW is filled with the file attributed, file times, file size. The file name (UTF-16) is also stored into it. The function GetShortPathNameW is used for the cAlternateFileName. Finally, user-defined callback Fill is called. The result is true if the callback returns non-zero.

File memory_fs.adb (continuation):
      Data : Memory_FS.Directory.Dictionary renames
             Directory.Folder.Data;
   begin
      for
Index in 1..GetSize (Data) loop
         if
Get_Tracing (System) then
            Trace (System, "Found " & Quote (GetName (Data, Index)));
         end if;
         exit when Add
                   (  Ptr (GetTag (Data, Index)).all,
                      From_UTF8_String (GetName (Data, Index)) & NUL
                   );
      end loop;
      Error := 0;

Here we go through the directory's children and call Add for each of them. When Add returns false, the loop is exited prematurely, because the client cannot accept more data.

File memory_fs.adb (continuation):
   exception
      when
Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Find;

Exceptions propagating on invalid name, non-existing parent, wrong parent name are converted into the corresponding error codes.

File memory_fs.adb (continuation):
   procedure Flush
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Error      : out int
             )  is
   begin

      Error := 0;
   end Flush;

Flush is always successful.

File memory_fs.adb (continuation):
   function Get_File_System_Flags
            (  System : Memory_File_System
            )  return DWORD is
   begin
      return
FILE_CASE_PRESERVED_NAMES or FILE_UNICODE_ON_DISK;
   end Get_File_System_Flags;

The implementation of Get_File_System_Flags returns flags indicating support of preserved case of file names and Unicode.

File memory_fs.adb (continuation):
   function Get_File_System_Name
            (  System : Memory_File_System
            )  return String is
   begin
      return
"Memory file system";
   end Get_File_System_Name;

 The file system name is returned as Memory file system.

File memory_fs.adb (continuation):
   procedure Get_File_Time
             (  System   : in out Memory_File_System;
                Name     : LPCWSTR;
                Created  : out Win32.Winbase.FILETIME;
                Accessed : out Win32.Winbase.FILETIME;
                Written  : out Win32.Winbase.FILETIME;
                Error    : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      File   : Node_Handles.Handle;
   begin
      Find (System, Name, File, Error);
      if Error = 0 then
         declare
            Item : Node'Class renames Ptr (File).all;
         begin
            Created  := Item.Created;
            Accessed := Item.Accessed;
            Written  := Item.Written;
         end;
      end if;
   end Get_File_Time;

 The implementation of Get_File_Time find the file system node and gets times from there.

File memory_fs.adb (continuation):
   procedure Get_Information
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Attributes : out DWORD;
                Created    : out Win32.Winbase.FILETIME;
                Accessed   : out Win32.Winbase.FILETIME;
                Written    : out Win32.Winbase.FILETIME;
                Size       : out Byte_Count;
                Links      : out DWORD;
                Index      : out File_Index;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Item   : File_Node'Class renames File.File.all;
   begin
      Attributes := Item.Attributes;
      Created    := Item.Created;
      Accessed   := Item.Accessed;
      Written    := Item.Written;
      Size       := Get_Size (Item);
      Links      := 0;
      Index      := File_Index (To_Integer (Item'Address));
      Error      := 0;
   end Get_Information;

 The implementation of Get_Information takes file times from the file system node. The file size is returned by the primitive operation Get_Size.

File memory_fs.adb (continuation):
   procedure Get_Information
             (  Directory  : in out Memory_Folder;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Attributes : out DWORD;
                Created    : out Win32.Winbase.FILETIME;
                Accessed   : out Win32.Winbase.FILETIME;
                Written    : out Win32.Winbase.FILETIME;
                Size       : out Byte_Count;
                Links      : out DWORD;
                Index      : out File_Index;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Item   : Folder_Node'Class renames Directory.Folder.all;
   begin
      Attributes := Item.Attributes;
      Created    := Item.Created;
      Accessed   := Item.Accessed;
      Written    := Item.Written;
      Size       := 0;
      Links      := 0;
      Index      := File_Index (To_Integer (Item'Address));
      Error      := 0;
   end Get_Information;

The implementation for a directory is similar. The size is zero.

File memory_fs.adb (continuation):
   function Get_Maximal_File_Length
            (  System : Memory_File_System
            )  return Natural is
   begin
      return
Win32.CRT.StdLib.MAX_PATH;
   end Get_Maximal_File_Length;

The maximal file name length is set to the system maximum.

File memory_fs.adb (continuation):
   function Get_Size (File : File_Node) return Byte_Count is
   begin
      return
Byte_Count (File.Length);
   end Get_Size;

The implementation of Get_Size of File_Node returns the actual size of the file.

File memory_fs.adb (continuation):
   function Get_Size (File : Folder_Node) return Byte_Count is
      Size : Byte_Count := 0;
   begin
      for
Index in 1..GetSize (File.Data) loop
         Size := Size + Get_Size (Ptr (GetTag (File.Data, Index)).all);
      end loop;
      return Size;
   end Get_Size;

The implementation of Get_Size of File_Folder returns recursively calculated size of all files in the directory.

File memory_fs.adb (continuation):
   function Get_Volume_Name
            (  System : Memory_File_System
            )  return String is
   begin
      return
"RAM DISK";
   end Get_Volume_Name;

The implementation of Get_Volume_Name returns RAM DISK.

File memory_fs.adb (continuation):
   function Get_Volume_Serial_Number
            (  System : Memory_File_System
            )  return DWORD is
   begin
      return
1;
   end Get_Volume_Serial_Number;

 The file system serial number is 1.

File memory_fs.adb (continuation):
   procedure Get_Volume_Space
             (  System     : in out Memory_File_System;
                Process_ID : ULONG;
                Total      : out Byte_Count;
                Free       : out Byte_Count;
                Available  : out Byte_Count
             )  is
      Lock : Holder (System.Lock'Access);
   begin
      Total     := Get_Size (Ptr (System.Root).all);
      Free      := 0;
      Available := 0;
   end Get_Volume_Space;

The implementation of Get_Volume_Space calculates used space and returns it as total volume space. Free and available space are returned zero.

File memory_fs.adb (continuation):
   procedure Initialize (System : in out Memory_File_System) is
   begin

      Set (System.Root, new Folder_Node);
      Initialize (Abstract_File_System (System));
   end Initialize;

Initialization of the file system creates the root directory node and then calls to the parent type initialization.

File memory_fs.adb (continuation):
   procedure Initialize (File : in out Node) is
      use
Object;
      Stamp : Win32.Winbase.FILETIME := From_Time (Clock);
   begin
      Initialize (Entity (File));
      File.Created  := Stamp;
      File.Accessed := Stamp;
      File.Written  := Stamp;
   end Initialize;

Initialization of a file system node calls to the parent type initialization and sets file or directory times to the current time.

File memory_fs.adb (continuation):
   procedure Initialize (File : in out Folder_Node) is
   begin

      File.Attributes := FILE_ATTRIBUTE_DIRECTORY;
      Initialize (Node (File));
   end Initialize;

Initialization of a file system directory sets the directory attribute and calls to the parent's Initialize.

File memory_fs.adb (continuation):
   procedure Initialize (File : in out File_Node) is
   begin

      File.Attributes := 0;
      Initialize (Node (File));
   end Initialize;

Initialization of a file system file sets the directory attribute to zero and calls to the parent's Initialize.

File memory_fs.adb (continuation):
   procedure Move
             (  System     : in out Memory_File_System;
                Process_ID : ULONG;
                Old_Name   : LPCWSTR;
                New_Name   : LPCWSTR;
                Replace    : Boolean;
                Error      : out int
             )  is
      Lock : Holder (System.Lock'Access);
      use Strings_Edit.UTF8.Maps.Constants;
   begin
      declare

         Old_Path : String := To_UTF8_String (Old_Name);
         New_Path : String := To_UTF8_String (New_Name);
      begin

The implementation of Move renames a file. It starts with converting the old and the new file paths to UTF-8.

File memory_fs.adb (continuation):
         declare
            Old_Parent : aliased Node_Handles.Handle;
            New_Parent : aliased Node_Handles.Handle;
            Old_Simple : String :=
                         Find (System'Access, Old_Name, Old_Parent'Access);
            New_Simple : String :=
                         Find (System'Access, New_Name, New_Parent'Access);
            Old_Offset : Natural;
            New_Offset : Natural;
            File       : Node_Handles.Handle;
            Old_Folder : Folder_Node'Class renames
                         Folder_Node'Class (Ptr (Old_Parent).all);
            New_Folder : Folder_Node'Class renames
                         Folder_Node'Class (Ptr (New_Parent).all);

Both paths are split into parent and simple file name. The parents are then accessed as Old_Folder and New_Folder.

File memory_fs.adb (continuation):
         begin
            Old_Offset := Locate (Old_Folder.Data, Old_Simple);
            if Old_Offset = 0 then
               Error := -ERROR_FILE_NOT_FOUND;
               return;

The old file is searched in its parent directory. When not found (Old_Offset is zero) the implementation fails with ERROR_FILE_NOT_FOUND.

File memory_fs.adb (continuation):
            elsif Is_Prefix (Old_Path, New_Path, Lower_Case_Map) then
               if New_Path'Length = Old_Path'Length then
                  Error := 0;
                  return;

When the old path is contained by the new path (ignoring the case) and both have same length, the implementation succeeds, null renaming.

File memory_fs.adb (continuation):
               elsif New_Path (Old_Path'Length) = '\' then
                  Error := -ERROR_IS_SUBST_PATH;
                  return;
               end if;
            end if;

When the old path in the new path is followed by slash, the renaming fails with ERROR_IS_SUBST_PATH as an attempt to rename directory into its own descendant.

File memory_fs.adb (continuation):
            New_Offset := Locate (New_Folder.Data, New_Simple);
            if New_Offset = 0 then
               File := GetTag (Old_Folder.Data, Old_Offset);
               Directory.Delete (Old_Folder.Data, Old_Offset);
               Add (New_Folder.Data, New_Simple, File);
               Error := 0;

The new file is located in its parent directory. When no such file exists (New_Offset is zero), a handle to the file system node is stored. Then it is removed from its parent directory and put into the new parent's directory under new name.

File memory_fs.adb (continuation):
            elsif Replace then
               File := GetTag (Old_Folder.Data, Old_Offset);
               Directory.Delete (Old_Folder.Data, Old_Offset);
               Directory.Replace (New_Folder.Data, New_Offset, File);
               Error := 0;

When there is a file with the same name and Replace is true, the handle to the renamed file replaces the handle to the existing file in the new parent directory. This has the effect of removing the existing file or directory.

File memory_fs.adb (continuation):
            else
               Error := -ERROR_FILE_EXISTS;
            end if;
         end;
      end;

When Replace is false, the implementation fails with ERROR_FILE_EXISTS.

File memory_fs.adb (continuation):
   exception
      when Constraint_Error =>
         Error := -ERROR_INVALID_NAME;
      when End_Error =>
         Error := -ERROR_PATH_NOT_FOUND;
      when Name_Error =>
         Error := -ERROR_BAD_PATHNAME;
   end Move;

Exceptions propagating on invalid name, non-existing parent, wrong parent name are converted into the corresponding error codes.

File memory_fs.adb (continuation):
   procedure Open_Directory
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Directory  : out Abstract_Directory_Ptr;
                Error      : out int
             )  is
      Lock : Holder (System.Lock'Access);
      File : Node_Handles.Handle;
   begin
      Find (System, Name, File, Error);

The implementation of Open_Directory searches for the file specified.

File memory_fs.adb (continuation):
      if Error = 0 then
         declare

            Item : Node'Class renames Ptr (File).all;
         begin
 

When search was successful the corresponding file system node is accessed and checked for being a directory node.

File memory_fs.adb (continuation):
            if Item in Folder_Node'Class then
               Directory :=
                  new Memory_Folder
                      (  Folder_Node'Class (Item)'Unchecked_Access
                      );
               Memory_Folder (Directory.all).Reference := File;

When the node is a directory an instance of Memory_Folder is created and a reference to the directory is stored in it.

File memory_fs.adb (continuation):
            else
               Error := -ERROR_DIRECTORY;
            end if;
         end;
      end if;
   end Open_Directory;

When the node is a plain file, the implementation fails with the code ERROR_DIRECTORY.

File memory_fs.adb (continuation):
   procedure Read
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : out Storage_Array;
                Last       : out Storage_Offset;
                Offset     : Byte_Count;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Self   : File_Node'Class renames File.File.all;
   begin
      if
0 = (File.Mode and Read_Access) then
         Error := -ERROR_ACCESS_DENIED;

The implementation of Read checks if the access mode allows Read_Access. If not the implementation fails with ERROR_ACCESS_DENIED.

File memory_fs.adb (continuation):
      elsif Offset > Byte_Count (Self.Length) then
         Error := -ERROR_HANDLE_EOF;

If the Offset points beyond the file end the implementation fails with ERROR_HANDLE_EOF.

File memory_fs.adb (continuation):
      else
         declare

            Available : Storage_Count :=
                        Self.Length - Storage_Offset (Offset);
         begin
            if
Available >= Buffer'Length then
               Last := Buffer'Last;
               Buffer :=
                  Self.Data.Vector
                  (  Storage_Offset (Offset) + 1
                  .. Storage_Offset (Offset) + Buffer'Length
                  );

When the offset is within the file Available is set to the number of storage element to the file end. If Available is greater than or equal to the buffer size all buffer is filled and Last is set to the last buffer element.

File memory_fs.adb (continuation):
            else
               Last := Buffer'First + Available - 1;
               Buffer (Buffer'First..Last) :=
                  Self.Data.Vector
                  (  Storage_Offset (Offset) + 1
                  .. Self.Length
                  );
            end if;
         end;
         Error := 0;
      end if;
   end Read;

When Available is less than the buffer only a part of the buffer is used.

File memory_fs.adb (continuation):
   Supported_Attributes : constant DWORD :=
                                   (  FILE_ATTRIBUTE_READONLY
                                   or FILE_ATTRIBUTE_TEMPORARY
                                   or FILE_ATTRIBUTE_DIRECTORY
                                   );

Supported_Attributtes is the list of file attributes which can be set.

File memory_fs.adb (continuation):
   procedure Set_Attributes
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Attributes : DWORD;
                Error      : out int
             )  is
      Lock : Holder (System.Lock'Access);
      File : Node_Handles.Handle;
   begin
      Find (System, Name, File, Error);

The implementation of Set_Attributes starts with searching for the file.

File memory_fs.adb (continuation):
      if Error = 0 then
         declare

            Item : Node'Class renames Ptr (File).all;
         begin
            if Attributes = FILE_ATTRIBUTE_NORMAL then
               if Item in Folder_Node'Class then
                  Error := -ERROR_INVALID_DATA;
               else
                  Item.Attributes := 0;
               end if;

When the search was successful the file system node is accessed. When Attributes is FILE_ATTRIBUTE_NORMAL the node is checked for being a directory. For a directory the implementation fails with ERROR_INVALID_DATA. Otherwise, file attributes are zeroed and the implementation successed.

File memory_fs.adb (continuation):
            elsif 0 = (Attributes and not Supported_Attributes) then
               if
Item in Folder_Node'Class then
                  if
0 = (Attributes and FILE_ATTRIBUTE_DIRECTORY) then
                     Error := -ERROR_INVALID_DATA;
                  else
                     Item.Attributes := Attributes;
                  end if;

When no unsupported attributes appear in Attributes and the node is a directory Attributes is checked for having FILE_ATTRIBUTE_DIRECTORY set. When not set the implementation fails with ERROR_INVALID_DATA. Otherwise, attributes are set and the implementation successeds.

File memory_fs.adb (continuation):
               else
                  if
0 = (Attributes and FILE_ATTRIBUTE_DIRECTORY) then
                     Item.Attributes := Attributes;
                  else
                     Error := -ERROR_INVALID_DATA;
                  end if;
               end if;

When the node is a file the behavior is reverse. When FILE_ATTRIBUTE_DIRECTORY  is used the implementation fails.

File memory_fs.adb (continuation):
            else
               Error := -ERROR_INVALID_DATA;
            end if;
         end;
      end if;
   end Set_Attributes;

When unsupported attributes are used, the implementation fails with ERROR_INVALID_DATA.

File memory_fs.adb (continuation):
   procedure Set_End_Of
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Length     : Byte_Count;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Self   : File_Node'Class renames File.File.all;

The implementation of Set_End_Of accesses the file node.

File memory_fs.adb (continuation):
      if Length > Byte_Count (Self.Length) then
         Error := -ERROR_HANDLE_EOF;
      else
         Self.Length := Storage_Count (Length);
         Error := 0;
      end if;
   end Set_End_Of;

When the requested file end is beyond the file size the implementation fails with ERROR_HANDLE_EOF. Otherwise, the file is truncated and the implementation succeeds.

File memory_fs.adb (continuation):
   procedure Set_File_Time
             (  System     : in out Memory_File_System;
                Name       : LPCWSTR;
                Process_ID : ULONG;
                Created    : Win32.Winbase.FILETIME;
                Accessed   : Win32.Winbase.FILETIME;
                Written    : Win32.Winbase.FILETIME;
                Error      : out int
             )  is
      Lock : Holder (System.Lock'Access);
      File : Node_Handles.Handle;
   begin
      Find (System, Name, File, Error);

The implementation of Set_File_Time searches for the file specified.

File memory_fs.adb (continuation):
      if Error = 0 then
         declare

            Item : Node'Class renames Ptr (File).all;
         begin
            Item.Created  := Created;
            Item.Accessed := Accessed;
            Item.Written  := Written;
         end;
      end if;
   end Set_File_Time;

If the file or directory exists, the times in the file system node are set.

File memory_fs.adb (continuation):
   procedure Set_Trace_File
             (  System    : in out Memory_File_System;
                File_Name : String
             )  is
      use Ada.Text_IO;
      Lock : Holder (System.Lock'Access);
   begin
      if
System.Into_File then
         Close (System.Trace_File);
         System.Into_File := False;
      end if;
      Create (System.Trace_File, Out_File, File_Name);
      Trace (System, "Memory file system trace");
      System.Into_File := True;
   end Set_Trace_File;

When a trace file is set the old trace file is closed if open. Then the new file is created.

File memory_fs.adb (continuation):
   procedure Set_Trace_File (System : in out Memory_File_System) is
      use
Ada.Text_IO;
   begin
      if
System.Into_File then
         Close (System.Trace_File);
         System.Into_File := False;
      end if;
   end Set_Trace_File;

When no trace file path is given, the existing trace file is closed if any.

File memory_fs.adb (continuation):
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String
             )  is
      use
Ada.Text_IO;
   begin
      if
System.Into_File then
         Put_Line (System.Trace_File, Text);
         Flush (System.Trace_File);
      else
         Put_Line (Text);
         Flush;
      end if;
   end Trace;

The implementation of Trace writes into the trace file or else to the standard output.

File memory_fs.adb (continuation):
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String;
                Name   : LPCWSTR
             )  is
   begin
     
Trace (System, Text & ": " & Quote (To_UTF8_String (Name)));
   end Trace;

This variant of trace adds file name to the trace message.

File memory_fs.adb (continuation):
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String;
                Error  : Exception_Occurrence
             )  is
   begin

      Trace (System, Text & ". " & Exception_Information (Error));
   end Trace;

This is a variant of tracing that adds exception occurrence to the trace message.

File memory_fs.adb (continuation):
   procedure Trace
             (  System : in out Memory_File_System;
                Text   : String;
                Name   : LPCWSTR;
                Error  : Exception_Occurrence
             )  is
   begin

      Trace
      (  System,
         (  Text
         &  ": "
         &  Quote (To_UTF8_String (Name))
         &  ". "
         &  Exception_Information (Error)
      )  );
   end Trace;

This trace that adds file name and exception occurrence to the trace message.

File memory_fs.adb (continuation):
   procedure Write
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : Storage_Array;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Self   : File_Node'Class renames File.File.all;
      Length : Storage_Offset  renames Self.Length;
   begin
      if
0 = (File.Mode and Write_Access) then
         Error := -ERROR_ACCESS_DENIED;

The implementation of Write access the file node and checks of the write-access is granted. If not the implementation fails with ERROR_ACCESS_DENIED.

File memory_fs.adb (continuation):
      else
         for
Index in Buffer'Range loop
            Put (Self.Data, Length + 1, Buffer (Index));
            Length := Length + 1;
         end loop;
         Error := 0;
      end if;

The contents of the buffer is appended to file starting from Length.

File memory_fs.adb (continuation):
   exception
      when
Storage_Error =>
         Error := -ERROR_HANDLE_DISK_FULL;
   end Write;

On storage error the implementation fails with ERROR_HANDLE_DISK_FULL.

File memory_fs.adb (continuation):
   procedure Write
             (  File       : in out Memory_File;
                Name       : LPCWSTR;
                System     : in out Abstract_File_System'Class;
                Process_ID : ULONG;
                Buffer     : Storage_Array;
                Offset     : Byte_Count;
                Error      : out int
             )  is
      Volume : Memory_File_System'Class renames
               Memory_File_System'Class (System);
      Lock   : Holder (Volume.Lock'Access);
      Self   : File_Node'Class renames File.File.all;
      Length : Storage_Offset := Self.Length;
   begin
      if
0 = (File.Mode and Write_Access) then
         Error := -ERROR_ACCESS_DENIED;
      elsif Offset > Byte_Count (Self.Length) then
         Error := -ERROR_HANDLE_EOF;
      else
         for
Index in Buffer'Range loop
            Put (Self.Data, Length + 1, Buffer (Index));
            Length := Length + 1;
         end loop;
         Self.Length := Storage_Offset'Max (Self.Length, Length);
         Error := 0;
      end if;
   exception
      when
Storage_Error =>
         Error := -ERROR_HANDLE_DISK_FULL;
   end Write;

end Memory_FS;

This variant of Write is different that it starts at the middle of the file. The file length is set to the maximum of the old length and the end of the overwritten file part.

The test application in the subdirectory example/memory-fs/test illustrates usage of the virtual file system:

File test.adb:
with Ada.Exceptions;     use Ada.Exceptions;
with Dokan.File_System;  use Dokan.File_System;
with Dokan.Thin;         use Dokan.Thin;
with Memory_FS;          use Memory_FS;
with Text_IO;            use Text_IO;

procedure Test is
   FS : Memory_File_System;
   Mount_Point : String := "R:\";

The object FS is an instance of the virtual file system. The file system is not visible until it gets mounted. Mount_Point is where the file system must be mounted at.

File test.adb:
begin
   Set_Trace_File (FS, "trace.txt");
   Enable_Tracing (FS, True);

This activates tracing into the file trace.txt.

File test.adb:
   Put_Line ("Mounting the files system on " & Mount_Point);
   Mount (FS, Mount_Point, Debug or Stderr, 1);

Here the file system is mounted, Debug and Stderr options are passed to the Dokan library.

File test.adb:
   Put_Line ("Hit enter to exit");
   declare
      Input : String (1..80);
      Last  : Integer;
   begin
      Get_Line (Input, Last);
      Put_Line ("Exiting");
   end;

 This awaits user input to complete test. When user hits enter the application exists and finalization of the file system object automatically dismounts the file system.

File test.adb:
exception
   when
Error : others =>
      Put_Line ("Error: " & Exception_Information (Error));
end Test;

This prints unanticipated exceptions.


[Back][TOC][Next]

3. Packages

The root directory contains only the packages required for software use. The examples are located in the subdirectory example/memory_fs. The Dokan distribution is contained in the subdirectory dokan-0.6.0.

[Back][TOC][Next]

3.1. Source packages

The following table describes the packages and other compilation units provided by the software.

Package Provides
Dokan The base package
       File_System Thick bindings to the Dokan library
Thin Thin bindings to the Dokan library

[Back][TOC][Next]

3.2. Tests and examples

The subdirectory example/memory_fs contains a sample of virtual memory-resident file system.


[Back][TOC][Next]

4. Installation

For being able to use the Windows API bindings the Win32Ada bindings must be installed. Win32Ada is a part of GNAT GPL and other GNAT Windows distributions. The software provides gpr project files, which can be used in the Gnat Programming Studio (GPS):

Project files Provides
dokan.gpr Bindings to the Dokan library
memory_fs.gpr Sample virtual  memory-resident file system

The Dokan driver must be installed to be able to run applications using the library. The driver marshals I/O requests from the Windows kernel to the user-space library and ultimately to the application. The installation executable is DokanInstall_0.6.0.exe in the subdirectory dokan-0.6.0.


[Back][TOC][Next]

5. Changes log

The following versions were tested with the compilers:

First version released.


[Back][TOC]

6. Table of Contents

1. Thick bindings
    1.1. File system
    1.2. Abstract node
    1.3. Abstract directory
    1.4. Abstract file
    1.5. Utility operations
2. Samples
    2.1. Memory-resident file system
3. Packages
    3.1. Source packages
    3.2. Test and examples
4. Installation
5. Changes log
6. Table of contents