TMapTextfile v.99/1

By Hellinger Software.

Class to handle text files as memory mapped files.

Including efficient methodes for access like sequentiell read

or random access read to text, high performance search routines

and many more.

 

{
  ==============================================================================
  MapTextfiles - Release 99/1  14.03.1999
  for Delphi 4, should also run with Delphi 3

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

  MapTextfiles is FREEWARE. Freeware means, that you can use this software
  without paying anything for it, but it is not public domain! This software
  is protected through the law of the Federal Republic of Germany, the European
  Union and other countries.

  (C)1999 by Peter Hellinger Software, All rights are reserved.

  Peter Hellinger Software, Zerzabelshofstrasse 41, D-90480 N黵nberg

  email: mail@helli.de
  homepage: http://www.helli.de

  ==============================================================================

  Installation:
  Copy MAPTEXTFILE.PAS into your library path. Use ist. 8-)

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

  In Delphi you have many ways to manipulate text files. But all of these have
  a handicap: You must read the whole file (StringList) or you can only access
  data sequential (Assign/Readln).

  The Windows API provides the so called Memory Mapped Files. Windows self
  uses MMFs to load EXE or DLL. Therefore the mechanism is very efficient, but
  simple to handle. The only handicap is, that you must know the size of the
  file before you access it. This means for typical text files, that the
  operation is normally limited to read from the file or manipulate inside.

  The class TMapTextfile wraps the neccesary API calls and povides efficent
  functions for accessing the data.

  TMapTextfiles provides the following properties and methods:

  Methodes:
  =========

  Create         Creates an instace of the class

  Destroy        Destroys the instance

  Open           Opens a file as a memory mapped file.

  filename = name of the file
  mode =     open mode:
  mmRead =      Open only for read
  mmReadWrite = Open for read and wrie

  Returns INVALID_HANDLE_VALUE if the file not exist.
  If the result > 0 all is OK.

  NOTE:
  1. The file must exist!
  2. You cannot write behind the end of the file.

  Close          Close the memory mapped file and frees all handles.

  EndOfFile      Returns TRUE, if the End of the file is reached.

  GetSize        Returns the Size of the file in Bytes

  GetPos         Returns the actual file read/write position
  NOTE: Position 0 is the start of the file

  SetPos         Sets the actual read/write position
  NOTE: Position 0 is the start of the file

  ReadChar       Reads a character from the actual read/write position.
  The r/w position is incremented.

  ReadString     Returns a string, starting at the actual r/w position.
  The string is delimited by characters < SPACE, but not
  by ESC (#27) and TAB. The r/w position moves to the
  end of the string, delimiter chararcters are skiped.

  ReadLn         Same as ReadSring, but as a Procedure.

  ReadCharAt     Reads a charater from an arbitray possition.
  The r/w position is NOT moved!

  pos = position to read from (0 = start of the file!)

  ReadChars      Reads a line of charactes from the MMF.
  The r/w position is NOT moved!

  str = The buffer to read to
  pos = position to read from (0 = Start of the file!)
  len = number of characters to read.

  ReadStringAt   Returns a string, starting at an arbitray possition.
  The string is delimited by characters < SPACE, but not
  by ESC (#27) and TAB. The r/w position is NOT moved.

  FindString     Findes a substring in the MMF and Returns the position.

  str = rhe substring to search for
  pos = position to start the search (0 = start of the file)
  max = position to end the search. If this is 0 or less
  then 0 the end of the file is the limit.

  Returns the position of the substring or -1 if the
  substring is not found.

  FindWildCard   Same as Findstring, but supports wildcard search.

  str =   the substring to search for
  pos =   position to start the search (0 = start of the file)
  max =   position to end the search. If this is 0 or less
  then 0 the end of the file is the limit.
  wild =  the character used as wildcard (i.e. "*")
  joker = the character used as joker (i.e. "?")

  Returns the position of the substring or -1 if the
  substring is not found.

  ReadBytes      Reads a number of bytes to a anonymous variable.
  The r/w position is NOT moved!

  b =   the anonymous variable
  pos = position to read from (0 = start of the file)
  len = number of bytes to read.

  WriteBytes     Writes a number of bytes to the file.
  NOTE: You can not write behind the end of the file!!!

  b =   the anonymous variable
  pos = position to write to (0 = start of the file)
  len = number of bytes to write

  ==============================================================================
}

unit uMapTextfile;

interface

uses Classes, Windows;

type
  tMapMode = ( mmRead, mmReadWrite );

type
  TMapTextfile = class
  private
    f_file : THandle;
    f_MMF : THandle;
    f_size : INTEGER;
    f_view : PByte;
    f_data : PChar;
    f_pos : INTEGER;
    f_open : BOOLEAN;
    function CalcPos( pos : INTEGER ) : PChar;
  public
    constructor Create;
    destructor Destroy; override;
    function Open( const filename : string; mode : tMapMode ) : INTEGER;
    procedure Close;
    function ReadChar : CHAR;
    function ReadString : string;
    procedure ReadLn( var str : string );
    function ReadCharAt( pos : LONGINT ) : CHAR;
    procedure ReadChars( str : PChar; pos, len : LONGINT );
    function ReadStringAt( pos : LONGINT ) : string;
    function GetSize : LONGINT;
    function GetPos : LONGINT;
    procedure SetPos( pos : LONGINT );
    function EndOfFile : BOOLEAN;
    function FindString( const str : string; pos, max : INTEGER ) : INTEGER;
    function FindWildCard( const str : string; pos, max : INTEGER;
      wild, joker : CHAR ) : INTEGER;
    procedure ReadBytes( var b; pos, len : LONGINT );
    procedure WriteBytes( var b; pos, len : LONGINT );
  end;

implementation

constructor TMapTextfile.Create;
begin
  f_open := FALSE;
end;

function TMapTextfile.Open( const filename : string; mode : tMapMode )
  : INTEGER;
var
  m1, m2, m3 : CARDINAL;
begin
  f_open := FALSE;
  if mode = mmRead then
  begin
    m1 := GENERIC_READ;
    m2 := PAGE_READONLY;
    m3 := FILE_MAP_READ;
  end else begin
    m1 := GENERIC_READ + GENERIC_WRITE;
    m2 := PAGE_READWRITE;
    m3 := FILE_MAP_WRITE;
  end;

  f_file := CreateFile( PChar( filename ), m1, FILE_SHARE_READ, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );

  if f_file = INVALID_HANDLE_VALUE then
  begin
    Result := INVALID_HANDLE_VALUE;
    EXIT;
  end;
  try

    f_size := GetFileSize( f_file, nil );

    f_MMF := CreateFileMapping( f_file, nil, m2, 0, f_size, nil );

    if f_MMF = 0 then
    begin
      Result := -1;
      EXIT;
    end;
  finally

    CloseHandle( f_file );
  end;

  try
    f_view := MapViewOfFile( f_MMF, m3, 0, 0, f_size );
    if f_view = nil then
    begin
      Result := -1;
      EXIT;
    end;
  finally
    CloseHandle( f_MMF );
  end;
  f_data := PChar( f_view );
  f_pos := 0;
  f_open := TRUE;
  Result := 0;
end;

destructor TMapTextfile.Destroy;
begin
  if f_open then
    Close;
  inherited;
end;

procedure TMapTextfile.Close;
begin
  if f_open then
  begin
    UnmapViewOfFile( f_view );
    f_open := FALSE;
  end;
end;

function TMapTextfile.CalcPos( pos : INTEGER ) : PChar;
begin
  Result := nil;
  if f_open then
  begin
    if pos < 0 then
      pos := 0;
    if pos > f_size then
      pos := f_size;
    Result := PChar( LONGINT( f_view ) + pos );
  end;
end;

function TMapTextfile.ReadChar : CHAR;
begin
  Result := #0;
  if f_open then
  begin
    f_data := PChar( LONGINT( f_view ) + f_pos );
    Result := f_data^;
    INC( f_pos );
  end;
end;

function TMapTextfile.ReadString : string;
begin
  Result := '';
  if f_open then
  begin
    f_data := PChar( LONGINT( f_view ) + f_pos );
    while ( f_pos < f_size ) do
    begin
      case f_data^ of
        #0 .. #31 :
          case f_data^ of
            #9, #27 :
              Result := Result + f_data^; // Tab und Escape weiterreichen
            #10 :
              begin
                INC( f_pos );
                EXIT;
              end;
            #13 :
              begin // Carriage Return terminiert
                INC( f_pos );
                INC( f_data );
                if f_data^ = #10 then
                  INC( f_pos );
                EXIT;
              end;
          end;
      else
        Result := Result + f_data^;
      end;
      INC( f_pos );
      INC( f_data );
    end;
  end;
end;

function TMapTextfile.ReadCharAt( pos : LONGINT ) : CHAR;
begin
  if f_open then
    Result := CalcPos( pos )^
  else
    Result := #0;
end;

procedure TMapTextfile.ReadChars( str : PChar; pos, len : LONGINT );
var
  i : INTEGER;
  p : PChar;
begin
  if f_open then
  begin
    if len <= 0 then
      EXIT;
    i := 0;
    p := CalcPos( pos );
    while ( i <= f_size ) and ( i <= len ) do
    begin
      str^ := p^;
      INC( str );
      INC( p );
      INC( i );
    end;
  end;
end;

procedure TMapTextfile.ReadBytes( var b; pos, len : LONGINT );
var
  p : PChar;
begin
  if f_open then
  begin
    p := CalcPos( pos );
    Move( p^, b, len );
  end;
end;

procedure TMapTextfile.WriteBytes( var b; pos, len : LONGINT );
var
  p : PChar;
begin
  if f_open then
  begin
    p := CalcPos( pos );
    Move( b, p^, len );
  end;
end;

function TMapTextfile.ReadStringAt( pos : LONGINT ) : string;
var
  i : INTEGER;
  p : PChar;
begin
  Result := '';
  if f_open then
  begin
    p := CalcPos( pos );
    i := 0;
    while ( i <= f_size ) do
    begin
      case p^ of
        #0 .. #31 :
          case p^ of
            #9, #27 :
              Result := Result + p^; // Tabs und Escape weiterreichen
            #10, #13 :
              EXIT; // Linefeed and Carriage Return terminiert
          end;
      else
        Result := Result + p^;
      end;
      INC( p );
    end;
  end;
end;

procedure TMapTextfile.ReadLn( var str : string );
begin
  str := ReadString;
end;

function TMapTextfile.GetSize : LONGINT;
begin
  if f_open then
    Result := f_size
  else
    Result := -1;
end;

function TMapTextfile.GetPos : LONGINT;
begin
  if f_open then
    Result := f_pos
  else
    Result := -1;
end;

procedure TMapTextfile.SetPos( pos : LONGINT );
begin
  if f_open then
  begin
    if pos < 0 then
      pos := 0;
    if pos > f_size then
      pos := f_size;
    f_pos := pos;
  end;
end;

function TMapTextfile.EndOfFile : BOOLEAN;
begin
  if f_open then
    Result := f_pos >= f_size
  else
    Result := TRUE;
end;

function TMapTextfile.FindString( const str : string; pos, max : INTEGER )
  : INTEGER;
var
  s, l1, j : INTEGER;
  p, x : PChar;
begin
  Result := -1;
  if f_open then
  begin
    if max <= 0 then
      max := f_size;
    if pos < 0 then
      pos := f_pos;
    if pos > max then
      EXIT;
    x := PChar( str );
    p := PChar( f_view );
    l1 := 0;
    while ( x[ l1 ] > #0 ) do
      INC( l1 );
    if ( l1 > 0 ) then
    begin
      s := pos;
      repeat (* 1 *)
        j := 0;
        while ( s + j < max ) and ( j < l1 ) and ( x[ j ] = p[ s + j ] ) do
        begin
          INC( j );
          if ( j = l1 ) then
          begin
            Result := s;
            EXIT;
          end;
        end;
        INC( s );
      until s >= f_size;
    end;
  end;
end;

function TMapTextfile.FindWildCard( const str : string; pos, max : INTEGER;
  wild, joker : CHAR ) : INTEGER;
var
  s, l1, j : INTEGER;
  p, x : PChar;
begin
  Result := -1;
  if f_open then
  begin
    if max <= 0 then
      max := f_size;
    if pos < 0 then
      pos := f_pos;
    if pos > max then
      EXIT;

    x := PChar( str );
    p := PChar( f_view );
    l1 := 0;
    while ( x[ l1 ] > #0 ) do
      INC( l1 );

    if ( l1 > 0 ) then
    begin
      s := pos;
      repeat (* 1 *)
        j := 0;
        while ( s + j < max ) and ( j < l1 ) and
          ( ( x[ j ] = p[ s + j ] ) or ( x[ j ] = joker ) ) do
        begin
          INC( j );
          if ( x[ j ] = wild ) or ( j >= l1 ) then
          begin
            Result := s;
            EXIT;
          end;
        end;
        INC( s );
      until s >= f_size;
    end;
  end;
end;

end.

 

posted @ 2014-10-20 09:38  IAmAProgrammer  阅读(347)  评论(0编辑  收藏  举报