Re: Binary opperations under Ada?

[Gerd <GerdM.O@t-online.de>]

On 21 Aug., 01:23, Trogdor <bga...@aol.com> wrote:
> Greetings!
>
> -) I want to read in a raw binary file and perform bit manipulation
> on the data.
>
> -) I vaguely remember seeing a post about a module package for low
> level stuff, cut han no longer find it in the group.
>
> -) All (four) of my Ada books were written in the '90's and don't
> help much with this subject.
>
> -) I am running GNAT under MinGW under WinXP 64.
>
> Could some kind soul please...
> - Let me know just what I am looking for.
> - Where do I get it?
> - Where do I read about it so I don't have to pester the group with
> dozens of questions?
>
> Thanks in Advance!
>
> --
> --------------------------------- --- -- -
> Posted with NewsLeecher v3.9 Final
> Web @http://www.newsleecher.com/?usenet
> ------------------- ----- ---- -- -


You can use the code below. I've found it on the net some years ago.

But - be aware, this is not the "Ada way", and - it's not portable,
it's pure Windows.


First the spec:
--------------------------------------------------------------------------
with Ada.IO_Exceptions;
with Win32.Winnt; use win32.Winnt;

package UnstructuredFile is
  --
------------------------------------------------------------------------------
--
  -- This package implements a file processing which is similar to
that of Modula-2 --
  -- It provides fast and easy access on unstructured files
(e.g. .exe)             --
 
--
--
  -- Maintenance level:
1.04A00                                         19.10.2004  --
  --
------------------------------------------------------------------------------
--

  type File_Type is limited private;

  procedure Open (f : in out File_Type; Name : STRING);
  --
------------------------------------------------------------------------------
--
  -- Opens the file "Name" for read access:  It fails if the file does
not exist.   --
  -- In this case the exeption Name_Error is raised. If the file is
already open    --
  -- the exception Status_Error is
raised.                                          --
  --
------------------------------------------------------------------------------
--

  procedure Create (f : in out File_Type; Name : STRING);
  --
------------------------------------------------------------------------------
--
  -- Creates a new file named "Name" and opens it for write access. If
a file with  --
  -- this name already exists it is overwritten. If the file is
already open the    --
  -- exception Status_Error is
raised.                                              --
  --
------------------------------------------------------------------------------
--

  procedure Append (f : in out File_Type; Name : STRING);
  --
------------------------------------------------------------------------------
--
  -- Opens the file "Name" for append. This means, it has write access
and it is    --
  -- positioned at the end, so that subsequent writes append data at
the end. If    --
  -- If the file is already open the exception Status_Error is
raised.              --
  --
------------------------------------------------------------------------------
--

  procedure Close (f : in out File_Type);
  --
------------------------------------------------------------------------------
--
  -- Closes the file represented by "f". Exception Status_Error is
raised if the    --
  -- file is not
open.                                                              --
  --
------------------------------------------------------------------------------
--

  procedure ReadNBytes (f : in out File_Type; Buffer : out STRING;
BytesRead : out INTEGER);
  --
------------------------------------------------------------------------------
--
  -- Reads as many bytes as will fit into buffer, execpt there are not
enough bytes --
  -- remaining in file "f". "BytesRead" returns the number of bytes
actually read.  --
  -- Exception Status_Error is raised if the file is not open,
exception Mode_Error --
  -- is raised if the file was "Created" for write
acccess.                         --
  --
------------------------------------------------------------------------------
--

  procedure WriteNBytes (f : in out File_Type; Buffer : STRING;
BytesWritten : out INTEGER);
  --
------------------------------------------------------------------------------
--
  -- Writes the bytes from "Buffer" to the file. "BytesWritten"
returns the number  --
  -- of bytes actually written (this should always be the number of
bytes of        --
  -- "Buffer" except in case of
errors).                                            --
  -- Exception Status_Error is raised if the file is not open,
exception Mode_Error --
  -- is raised if the file was "Opened" for read
acccess.                           --
  --
------------------------------------------------------------------------------
--

  function Is_Eof (f : File_Type) return boolean;
  --
------------------------------------------------------------------------------
--
  -- Returns TRUE if a file opened for read access was beyond the end
of file on    --
  -- the last read operation. The exception Status_Error is raised if
the file is   --
  -- not open, the exception Mode_Error is raised if the file was
"Created" for     --
  -- write
access.
--
  --
------------------------------------------------------------------------------
--

  procedure SetFilePos (f : File_Type; FilePos : INTEGER);
  --
------------------------------------------------------------------------------
--
  -- Sets the file position to "FilePos". "FilePos" specifies the
number of bytes   --
  -- relative to the begining of the file. The exception Status_Error
is raised if  --
  -- the file is not
open.                                                          --
  --
------------------------------------------------------------------------------
--

  function GetFilePos (f : File_Type) return INTEGER;
  --
------------------------------------------------------------------------------
--
  -- Gets the current position within the file. The returned value is
relative to   --
  -- the beginning of the file. The exception Status_Error is raised
if the file is --
  -- not
open.
--
  --
------------------------------------------------------------------------------
--

  function GetFileSize (f : File_Type) return INTEGER;
  --
------------------------------------------------------------------------------
--
  -- Returns the size of the file (up to
2GB).                                      --
  -- The exception Status_Error is raised if the file is not
open.                   --
  --
------------------------------------------------------------------------------
--

  Status_Error : exception renames Ada.IO_Exceptions.Status_Error;
  Mode_Error   : exception renames Ada.IO_Exceptions.Mode_Error;
  Name_Error   : exception renames Ada.IO_Exceptions.Name_Error;
  Use_Error    : exception renames Ada.IO_Exceptions.Use_Error;
  Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
  End_Error    : exception renames Ada.IO_Exceptions.End_Error;
  Data_Error   : exception renames Ada.IO_Exceptions.Data_Error;
  Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error;

private
  type Access_Mode is (Read_Only, Write_Only);

  type File_Type is record
                      Is_Open      : boolean := FALSE;
                      Current_Mode : Access_Mode;
                      Is_At_Eof    : boolean;
                      File_Handle  : HANDLE;
                    end record;
end UnstructuredFile;

--------------------------------------------------------------------------

Next the body:
--------------------------------------------------------------------------
-- with TEXT_IO;
with SYSTEM; use SYSTEM;
with UNCHECKED_CONVERSION;
with Win32; use Win32;
with Win32.Winerror; use Win32.Winerror;
--with Win32.Winnt; use win32.Winnt;
with Win32.Winbase; use Win32.Winbase;

package body UnstructuredFile is
  --
------------------------------------------------------------------------------
--
  -- This package implements a file processing which is similar to
that of Modula-2 --
  -- It provides fast and easy access on unstructured files
(e.g. .exe)             --
 
--
--
  -- Maintenance level:
1.04A00                                         19.10.2004  --
  --
------------------------------------------------------------------------------
--

  function LPVOID_from_ADDRESS  is new UNCHECKED_CONVERSION (ADDRESS,
LPCVOID);
  function LPCVOID_from_ADDRESS is new UNCHECKED_CONVERSION (ADDRESS,
LPCVOID);
  function LPDWORD_from_ADDRESS is new UNCHECKED_CONVERSION (ADDRESS,
LPDWORD);
  function LPCSTR_from_ADDRESS  is new UNCHECKED_CONVERSION (ADDRESS,
LPCSTR);
  function LPOVERLAPPED_from_INTEGER  is new UNCHECKED_CONVERSION
(INTEGER, LPOVERLAPPED);
  function To_Handle is new Unchecked_Conversion (Integer,
Win32.Winnt.HANDLE);

  use type Win32.DWORD;

  procedure Open (f : in out File_Type; Name : STRING) is
    F_Name : STRING := Name &  ASCII.NUL;
  begin
    if f.Is_Open
    then
      raise Status_Error;
    else
      f.FILE_HANDLE := CreateFile (LPCSTR_from_ADDRESS
(F_NAME'address),
                                   WinNT.GENERIC_READ,
                                   FILE_SHARE_READ, null,
                                   OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, TO_HANDLE (0));

      if f.FILE_HANDLE = INVALID_HANDLE_VALUE
      then
        if GETLASTERROR = ERROR_FILE_NOT_FOUND
        then
          raise Name_Error;
        else
          raise Device_Error;
        end if;
      else
        f.Is_Open := TRUE;
        f.Is_At_Eof := FALSE;
        f.Current_Mode := Read_Only;
      end if;
    end if;
  end Open;

  procedure Create (f : in out File_Type; Name : STRING) is
    F_Name : STRING := Name &  ASCII.NUL;
  begin
    if f.Is_Open
    then
      raise Status_Error;
    else
      f.FILE_HANDLE := CreateFile (LPCSTR_from_ADDRESS
(F_NAME'address),
                                   WinNT.GENERIC_WRITE,
                                   0, null,
                                   CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL, TO_HANDLE (0));

      if f.FILE_HANDLE = INVALID_HANDLE_VALUE
      then
        if GETLASTERROR = ERROR_FILE_NOT_FOUND
        then
          raise Name_Error;
        else
          raise Device_Error;
        end if;
      else
        f.Is_Open := TRUE;
        f.Is_At_Eof := FALSE;
        f.Current_Mode := Write_Only;
      end if;
    end if;
  end Create;

  procedure Append (f : in out File_Type; Name : STRING) is
    F_Name : STRING := Name &  ASCII.NUL;
    NewPos : DWORD;
  begin
    if f.Is_Open
    then
      raise Status_Error;
    else
      f.FILE_HANDLE := CreateFile (LPCSTR_from_ADDRESS
(F_NAME'address),
                                   WinNT.GENERIC_WRITE,
                                   0, null,
                                   Open_ALWAYS, FILE_ATTRIBUTE_NORMAL,
TO_HANDLE (0));

      if f.FILE_HANDLE = INVALID_HANDLE_VALUE
      then
        if GETLASTERROR = ERROR_FILE_NOT_FOUND
        then
          raise Name_Error;
        else
          raise Device_Error;
        end if;
      else
        f.Is_Open := TRUE;
        f.Is_At_Eof := FALSE;
        f.Current_Mode := Write_Only;
      end if;
    end if;

    NewPos := SetFilePointer (f.FILE_HANDLE, LONG (0), null,
FILE_END);
  end Append;

  procedure Close (f : in out File_Type) is
    CloseResult : BOOL;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    end if;

    CloseResult := CloseHandle (f.FILE_HANDLE);

    f.Is_Open := FALSE;
  end Close;

  procedure ReadNBytes (f : in out File_Type; Buffer : out STRING;
BytesRead : out INTEGER) is
    ReadResult   : BOOL;
    BytesToRead : DWORD;
    NumBytesRead : DWORD;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    elsif f.Current_Mode = Write_Only
    then
      raise Mode_Error;
    elsif f.Is_At_Eof
    then
      raise End_Error;
    end if;

    BytesToRead := DWORD (Buffer'LAST - Buffer'First + 1);

    ReadResult := ReadFile (f.FILE_HANDLE, Buffer'ADDRESS,
                            BytesToRead, LPDWORD_from_ADDRESS
(NumBytesRead'ADDRESS),
                            LPOVERLAPPED_from_INTEGER (0));

    BytesRead := INTEGER (NumBytesRead);

    if ReadResult = Win32.FALSE
    then
      raise Device_Error;
    end if;

    f.Is_At_Eof := (ReadResult = Win32.TRUE) AND (BytesRead = 0);
  end ReadNBytes;

  procedure WriteNBytes (f : in out File_Type; Buffer : STRING;
BytesWritten : out INTEGER) is
    WriteResult : BOOL;
    BytesToWrite : DWORD;
    NumBytesWritten : DWORD;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    elsif f.Current_Mode = Read_Only
    then
      raise Mode_Error;
    end if;

    BytesToWrite := DWORD (Buffer'LAST - Buffer'First + 1);

    WriteResult := WriteFile (f.FILE_HANDLE, Buffer'ADDRESS,
                              BytesToWrite, LPDWORD_from_ADDRESS
(NumBytesWritten'ADDRESS),
                              LPOVERLAPPED_from_INTEGER (0));

    BytesWritten := INTEGER
(NumBytesWritten);

    if WriteResult = Win32.FALSE
    then
      raise Device_Error;
    end if;
  end WriteNBytes;

  function Is_Eof (f : File_Type) return boolean is
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    elsif f.Current_Mode = Write_Only
    then
      raise Mode_Error;
    end if;

    return f.Is_At_Eof;
  end Is_Eof;

  procedure SetFilePos (f : File_Type; FilePos : INTEGER) is
    NewPos : DWORD;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    end if;

    NewPos := SetFilePointer (f.FILE_HANDLE, LONG (FilePos), null,
FILE_BEGIN);
  end SetFilePos;

  function GetFilePos (f : File_Type) return INTEGER is
    NewPos : DWORD;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    end if;

    NewPos := SetFilePointer (f.FILE_HANDLE, 0, null, FILE_CURRENT);

    return INTEGER (NewPos);
  end GetFilePos;

  function GetFileSize (f : File_Type) return INTEGER is
    SizeVal : DWORD;
  begin
    if not f.Is_Open
    then
      raise Status_Error;
    end if;

    SizeVal := GetFileSize (f.FILE_HANDLE, null);

    return INTEGER (SizeVal);
  end GetFileSize;

end UnstructuredFile;

--------------------------------------------------------------------------