Power-Programmierung/CD1.mdf/pascal/library/dos/install/inifile/ini.pas

Pascal/Delphi Source File | 1992-05-02 | 20.0 KB | 748 lines

Unit Ini;

{* An interface to .INI files, created by Max Maischein    02.05.1992 *}

{* The code is for Turbo Pascal 6.0 ( and above ), TPW-users might    *}
{* use it too, but you should have a look at the Windows-API-         *}
{* Functions Write/ReadProfileString and Write/                       *}
{* ReadPrivateProfileString, which do mainly the same as TConfigFile. *}

{* This code is freeware, you are allowed to use it in your own       *}
{* applications, but if you make interesting changes or detect any    *}
{* bugs, send them to me rather than redistributing the fix on your   *}
{* own. And please don't change anything in this text !               *}

{* The only thing I ask of you is that the programmers notice stays   *}
{* in place. I don't think, that this is too much !                   *}

{* There are five procedures. UpperCase and BruteSearch are string    *}
{* procedures needed by the code, but are very unsophisticated. I     *}
{* wrote them, as I don't want to distribute all my units. Use OPro's *}
{* Strings unit, assembler ports, and a Boyer-Moore-Search for better *}
{* results.                                                           *}
{* The same applies for CurrentDate and CurrentTime, they construct   *}
{* strings containing the date and time. Just look in the .INI file,  *}
{* after you called Flush. ;-)                                        *}

{* Now to the Tech-Stuff :                                            *}

{* The interface is programmed in pseudo-OOP, i.e., it could have     *}
{* been done as well in procedural coding, but as everybody today is  *}
{* deep into OOP, why not ;-)                                         *}

{* The unit declares the types TConfigFile and PConfigFile, their     *}
{* names are selfexplanatory and according to Borlands naming         *}
{* strategy.                                                          *}

(*

The object TConfigFile looks like this :

      TConfigFile = Object

                      Changed : Boolean;
        This is the flag, if the items in the file were changed.
        This flag will be set by SetItem, CreateGroup and EraseGroup.
        To avoid saving the changes to the file, you have to set the
        flag to false directly.

                      TheSize : Word;
        After the above assumption, a word will suffice to hold the
        size of the .INI file.

                      TheBuffer : Pointer;
        This is the buffer, that holds the current version of the
        .INI file. As all changes will be made in memory, the file
        won't be updated until you call Flush or Done. The size
        of the block allocated to TheBuffer is TheSize.

                      TheName : String;
        This is the DOS file name of the .INI file.

                      TheApp : String;
        This is the name of your application, it will be inserted
        by about into the date-time-stamp-line.

                      Group : String;
        This is the name of the current group. Please do not change
        it directly, as there is other data related to it.

                      GroupStart : Word;
        This is the zero based offset of the current goup in the
        .INI file.

                      GroupSize : Word;
        This is the size in bytes of the current group.

                      Constructor Init( FileName : String; ApplicationName : String; AGroup : String );
        This is the constructor. You should call it immediately
        with the allocation of the Object. Init allocates a buffer
        big enough to hold the whole .INI file, and initializes
        some variables.
        - FileName is the DOS file name of the .INI file. The .INI
        file must exist, no error checking is done.
        - ApplicationName is the name of your application. It will be
        inserted in the date-time-stamp.
        - AGroup specifies the group, that will be set first with
        SetGroup. If this group does not exist, it will be created.

                      Function SetGroup( NewGroup : String ) : Boolean;
        - Sets Group to NewGroup. All variables will be searched and
        set only local to this group. This prevents your program from
        overwriting the variables of other programs in the WIN.INI,
        and faciliates different setups for different users.
        If NewGroup is empty, the group spans the whole file. This
        can be very dangerous, but has its uses sometimmes ...

                      Procedure CreateGroup( NewGroup : String );
        - Creates a new group with the name NewGroup, and sets
        the current group to it.

                      Procedure EraseGroup( GroupName : String );
        - Erases a whole group, including any variables contained
        in it. After a call to this procedure, Group is undefined.
        Make sure, that after each EraseGroup a new group is set !

                      Function GetItem( ItemName : String ) : String;
        Just like GetEnv, this returns the value of the variable
        ItemName. If the variable is undefined in the current group,
        the result is an empty string.

                      Procedure SetItem( ItemName, Value : String );
        Sets the variable ItemName in the current group to the value
        Value. If the variable was previously undefined, it is created,
        if it had another value, it is overwritten, if value is empty,
        the variable is erased from the file.

                      Procedure Flush( CreateBackup : Boolean );
        Writes the current version of the .INI file out on disk.
        A backup ( .BAK ) will onyl be created, if CreateBackup
        is true.

                      Destructor Done( CreateBackup : Boolean );
        Frees all memory allocated by TConfigFile, and calls Flush.

                      Private

                      Procedure About;
        This procedure takes care of my message being inserted
        into the .INI file, and inserts the date-time-stamp of
        your application. Don't leave it out, please !

                    End;

*)

{* Caveats :                                                          *}

{* The unit assumes, that enough memory will be available to hold the *}
{* entire .INI file in memory, and that the size if the .INI file     *}
{* will be less than 65535 bytes.                                     *}

{* Memory requirements when changing .INI file will be at least twice *}
{* the size of the old .INI file.                                     *}

{* No changes to the .INI file will actually be made until the        *}
{* destructor Done was called. A backup file will only be created,    *}
{* if specified with the Destructor Done.                             *}

Interface

Uses DOS
     ;

Type TConfigFile = Object

                      Changed : Boolean; { True, if items in file were changed }

                      TheSize : Word;  { After the above assumption ... }
                      TheBuffer : Pointer; { Size is same as TheSize }
                      TheName : String; { The file name of the .INI file }

                      TheApp : String;

                      Group : String;
                      GroupStart : Word;
                      GroupSize : Word;

                      Constructor Init( FileName : String; ApplicationName : String; AGroup : String );

                      Function SetGroup( NewGroup : String ) : Boolean;
                      Procedure CreateGroup( NewGroup : String );
                      Procedure EraseGroup( GroupName : String );

                      Function GetItem( ItemName : String ) : String;
                      Procedure SetItem( ItemName, Value : String );

                      Procedure Flush( CreateBackup : Boolean );

                      Destructor Done( CreateBackup : Boolean );

                      Private

                      Procedure About;
                    End;

     PConfigFile = ^TConfigFile;

{* DISCLAIMER:                                                        *}
{* In no event shall I, Max Maischein, be liable for any damage to    *}
{* your software or hardware. By using it in your program, you agree  *}
{* to the above terms.                                                *}

Implementation
{$DEFINE Debug }         { define these, if you have to debug something }
{$DEFINE DUMPinput }
{$DEFINE DUMPoutput}

{****************************************************************}
{ The following functions are q&d replacements from other units. }
{ use OPro's String-unit, or something like this for better performance }

Function UpperCase( Var S : String ) : String;
{ Convert string to all uppercase letters }
Var SLen : Byte absolute S;
    Result : String;
    RLen : Byte absolute Result;
    I : Byte;
Begin

  RLen := SLen;

  For I := 1 to SLen do
    Result[ I ] := UpCase( S[ I ]);

  UpperCase := Result;
End;

{ Search a string in a 64K buffer. Very unsophisticated. }
{ Use a Boyer-Moore-Search or port to assembler. }
{ Returns 0 if string was not found. }

Function BruteSearch( Var Buffer; BufSize : Word; Target : String ) : Word;
Type TSearch = Array[ 0..65534 ] of Char;
Var I : Word;
    J : Byte;

    P : TSearch absolute Buffer;

    Ch : Char;

    Found : Boolean;
Begin

  If Target = ''
    then BruteSearch := 0
    else
      Begin

        Target := UpperCase( Target );

        I := 0;
        Ch := Target[ 1 ];

        Repeat

          While ( UpCase( P[ I ]) <> Ch ) and ( I < BufSize ) do
              Inc( I );

          Found := False;

          If UpCase( P[ I ] ) = Ch
            then
              Begin

                J := 1;

                Found := True;

                While Found and ( J < Length( Target )) do
                  Begin

                    Inc( J );
                    Found := ( UpCase( P[ I + J -1 ]) = Target[ J ]);
                  End;

                If not Found
                  then Inc( I );

              End
            else I := BufSize;

        Until Found or ( I = BufSize );

        If I = BufSize
          then BruteSearch := 0
          else BruteSearch := Succ( I );
      End;
End;

CONST
Months : Array[ 1..12 ] Of String[ 9 ] =
  ( 'January',
    'February',
    'March',
    'April',
    'May',
    'June',
    'July',
    'August',
    'September',
    'October',
    'November',
    'December' );

DayOfWeek : Array[ 0..7 ] Of String[ 9 ] =
  ( 'Sunday',
    'Monday',
    'Tuesday',
    'Wednesday',
    'Thursday',
    'Friday',
    'Saturday',
    'Sunday' );

Function Ordinal( W : Word ) : String;
Var Internal : String[ 7 ];
Begin

  Str( W,Internal );
  If W > 3 Then Internal := Internal + 'th' Else
  If W = 1 Then Internal := Internal + 'st' Else
  If W = 2 Then Internal := Internal + 'nd' Else
  If W = 3 Then Internal := Internal + 'rd';
  Ordinal := Internal;
End;

Function CurrentDate : String;
Var Year, Month, Day, DOW : Word;
    S : String[ 4 ];
Begin

  GetDate( Year, Month, Day, DOW );

  Str( Year, S );

  CurrentDate := DayOfWeek[ DOW ] + ', the '+ Ordinal( Day ) +' of '+Months[ Month ] + ' ' + S;
End;

Function CurrentTime : String;
Var Hour, Minute, Second, HS : Word;
    S : String[ 2 ];
    Q : String[ 2 ];
    Internal : String[ 8 ];
Begin

  GetTime( Hour, Minute, Second, HS );
  Str( Hour : 2, Q );
  If Hour < 10 then Q[ 1 ] := '0';
  Str( Minute : 2, S );
  If Minute < 10 then S[ 1 ] := '0';
  CurrentTime := Q + ':' + S;
End;

{****************************************************************}
Const CopyRight : Array[ 1..95 ] of Char =
  '; Ini Version 1.0 -- A freeware interface to .INI files. Created by Max Maischein 2:249/6.17.'#$0D#$0A;

Type TSearch = Array[ 1..65535 ] of Char;
     PSearch = ^TSearch;

{$IFDEF Debug}
Procedure WriteChar( Ch : Char );
Begin

  If Ch < ' '
    then Write('#',Ord( Ch ))
    else Write( Ch );
End;

Procedure Dump( P1 : Pointer; S1 : Word; P2 : Pointer; S2 : Word );
Var I : Word;
    P : PSearch;
Begin

  P := P1;

  WriteLn( 'Contents of P1( ',S1,' ) :' );
  For I := 1 to S1 do
    WriteChar( P^[ I ]);
  WriteLn;

  P := P2;

  WriteLn( 'Contents of P2( ',S2,' ) :' );
  For I := 1 to S2 do
    WriteChar( P^[ I ]);
  ReadlN;
End;
{$ENDIF}

Constructor TConfigFile.Init;
Var P : PSearch absolute TheBuffer;
    TheFile : File;

Begin

  TheName := FileName;

  Assign( TheFile, FileName );
  Reset( TheFile,1 );

  TheSize := FileSize( TheFile );
  GetMem( TheBuffer, TheSize ); { Get enough memory to hold the entire File }
  BlockRead( TheFile, TheBuffer^, TheSize );

  Close( TheFile );

  {$IFDEF DumpInput}
  WriteLn( 'Input read from file ',FileName );
  Dump( TheBuffer, TheSize, nil, 0 );
  {$ENDIF}

  If P^[ TheSize ] = ^Z
    then Dec( TheSize );

  GroupSize := 0;
  GroupStart := 0;

  If not SetGroup( AGroup )
    then CreateGroup( AGroup );

  Changed := False;

  TheApp := ApplicationName;

End;

Procedure TConfigFile.Flush;
Var TheFile : File;
Begin

  About;

  {$IFDEF DUMPoutput}
    WriteLn( 'Writing out :' );
    Dump( TheBuffer, TheSize, nil, 0 );
  {$ENDIF}

  Assign( TheFile, TheName );

  If CreateBackup
    then
      Begin

        Rename( TheFile, Copy( TheName, 1, Byte( TheName[ 0 ] ) -3)+'BAK' );
        Assign( TheFile, TheName );
      End;

  ReWrite( TheFile, 1 );

  BlockWrite( TheFile, TheBuffer^, TheSize );

  Close( TheFile );

  Changed := False;
End;

Destructor TConfigFile.Done;
Begin

  If Changed
    then Flush( CreateBackup );

  If TheBuffer <> nil
    then FreeMem( TheBuffer, TheSize );
End;

Function TConfigFile.SetGroup;

Var Table1, Table2 : Array[ Char ] of Byte;
    Found : Boolean;
    MyPos : Word;

    P : PSearch;
    S : String;

    Size : Byte;

    Search : String;

Begin

  If NewGroup = ''
    then
      Begin

        GroupStart := 0;
        GroupSize := TheSize;

        SetGroup := True;

        Exit; { could be better, but ;-) }
      End;

  If NewGroup[ 1 ] <> '['
    then NewGroup := '[' + NewGroup;

  If NewGroup[ Byte( NewGroup[ 0 ])] <> ']'
    then NewGroup := NewGroup + ']';

  Search := NewGroup;

  MyPos := BruteSearch( TheBuffer^, TheSize, Search );

  If MyPos <> 0
    then
      Begin

        GroupStart := MyPos-1;
        Group := NewGroup;

        MyPos := Length( NewGroup )+2;
        P := TheBuffer;

        GroupSize := 0;
        Repeat

          Inc( GroupSize );
        Until ( GroupStart + GroupSize = TheSize ) or ( P^[ GroupStart + GroupSize + 1 ] = '[');

        SetGroup := True;
      End
    else
      SetGroup := False;
End;

Procedure TConfigFile.CreateGroup;
Var NewSize : Word;

    NewBuffer : Pointer;
    P : PSearch absolute NewBuffer;

Begin

  If NewGroup[ 1 ] <> '['
    then NewGroup := '[' + NewGroup;

  If NewGroup[ Byte( NewGroup[ 0 ])] <> ']'
    then NewGroup := NewGroup + ']';

  NewSize := TheSize;

  Inc( NewSize, Length( NewGroup ) + 2 );
  GetMem( NewBuffer, NewSize );

  Move( TheBuffer^, NewBuffer^, TheSize );
  Move( NewGroup[ 1 ], P^[ TheSize+1 ], Byte( NewGroup[ 0 ] ));
  P^[ Pred( NewSize )] := #$0D;
  P^[ NewSize ] := #$0A;

  FreeMem( TheBuffer, TheSize );
  TheBuffer := NewBuffer;
  TheSize := NewSize;

  If SetGroup( NewGroup ) then ;

  Changed := True;

End;

Procedure TConfigFile.EraseGroup;
Var P : PSearch absolute TheBuffer;
    NewBuffer : Pointer;
    Q : PSearch absolute NewBuffer;
    NewSize : Word;
Begin

  If SetGroup( GroupName )
    then
      Begin

        NewSize := TheSize - GroupSize;
        GetMem( NewBuffer, NewSize );

        Move( TheBuffer^, NewBuffer^, GroupStart );
        Move( P^[ GroupStart + GroupSize ], Q^[ GroupStart ], TheSize - GroupStart - GroupSize +1 );

        If SetGroup( '' )
          then;

        Freemem( TheBuffer, TheSize );
        TheBuffer := NewBuffer;
        TheSize := NewSize;

        Changed := True;
      End;
End;

Function TConfigFile.GetItem;
Var Table1, Table2 : Array[ Char ] of Byte;
    Found : Boolean;
    MyPos : Word;

    P : PSearch absolute TheBuffer;
    Result : String;

    I : Byte;

    Search : String;
Begin

  If ItemName[ Byte( ItemName[ 0 ])] <> '='
    then ItemName := ItemName + '=';

  MyPos := BruteSearch( P^[ GroupStart+1 ], GroupSize, UpperCase( ItemName ));

  Result := '';

  If MyPos <> 0
    then
      Begin
        Inc( MyPos, Byte( ItemName[ 0 ]));

        Result[ 0 ] := #255;
        Move( P^[ GroupStart+MyPos ], Result[ 1 ], 255 );

        Result[ 0 ] := Char( Pred( Pos( #$0D,Result )));
        GetItem := Result;

      End
    else
      GetItem := '';
End;

Procedure TConfigFile.SetItem;
Var NewBuffer : Pointer;
    P,Q : PSearch;
    NewSize : Word;
    NewString : String;

    Table1, Table2 : Array[ Char ] of Byte;

    Pos : Word;

    Search : String;

Begin

  If ItemName[ Byte( ItemName[ 0 ])] <> '='
    then ItemName := ItemName + '=';

  P := TheBuffer;

  If GetItem( ItemName ) <> ''
    then { remove old Item + Value }
      Begin

        NewString := ItemName + GetItem( ItemName );
        NewSize := TheSize - Byte( NewString[ 0 ]) - 2;
        GetMem( NewBuffer, NewSize );

        Search := ItemName;

        P := TheBuffer;
        Pos := BruteSearch( P^[ GroupStart ], GroupSize, UpperCase( ItemName ));
        Dec( Pos );

        Q := NewBuffer;

        Move( TheBuffer^, NewBuffer^, GroupStart + Pos );
        Move( P^[ GroupStart + Pos +
          Byte( NewString[ 0 ]) +1], Q^[ GroupStart + Pos-1 ], TheSize - GroupStart - Pos - Byte( NewString[ 0 ] ) + 1 );

        FreeMem( TheBuffer, TheSize );
        TheBuffer := NewBuffer;
        TheSize := NewSize;

        Dec( GroupSize, Byte( NewString[ 0 ]) +2 );
      End;

  If Value <> ''
    then
      Begin

        NewString := ItemName + Value + #$0D#$0A;

        NewSize := TheSize + Byte( NewString[ 0 ]);
        GetMem( NewBuffer, NewSize );

        P := NewBuffer;
        Q := TheBuffer;
        Move( TheBuffer^, NewBuffer^, GroupStart + GroupSize );
        Move( NewString[ 1 ], P^[ GroupStart + GroupSize +1 ], Byte( NewString[ 0 ]));
        Move( Q^[ GroupStart + GroupSize+1 ], P^[ 1 + GroupStart + GroupSize + Byte( NewString[ 0 ])],
          TheSize - ( GroupStart + GroupSize ));

        Inc( GroupSize, Byte( NewString[ 0 ]));

        FreeMem( TheBuffer, TheSize );
        TheSize := NewSize;
        TheBuffer := NewBuffer;

    End;

  Changed := True;
End;

Procedure TConfigFile.About;
Var NewBuffer : Pointer;
    NewSize : Word;
    P : PSearch absolute NewBuffer;
    Q : PSearch absolute TheBuffer;

    AboutMsg : String;

    M : Word;
    Pos : Word;

Begin

  AboutMsg := '; Last modification by '+TheApp+' to this file was on '+CurrentDate+' at '+CurrentTime+'h.'#$0D#$0A;

  M := BruteSearch( TheBuffer^, TheSize, CopyRight );
  If M <> 0
    then
      Begin

        Move( Q^[ M + SizeOf( CopyRight )], Q^[ M ], TheSize - M - SizeOf( CopyRight ) +1 );

        Dec( TheSize, SizeOf( CopyRight ));
      End;

  M := BruteSearch( TheBuffer^, TheSize, Copy( AboutMSG, 1, 32 ));
  If M <> 0
    then
      Begin

        Pos := 0;
        Repeat

          Inc( Pos );
        Until Q^[ M + Pos ] = #$0A;

        Inc( Pos );

        Move( Q^[ M + Pos ], Q^[ M ], TheSize - M - Pos + 1 );

        Dec( TheSize, Pos );
      End;

  NewSize := TheSize;

  Inc( NewSize, SizeOf( CopyRight ));
  Inc( NewSize, Byte( AboutMsg[ 0 ]));

  GetMem( NewBuffer, NewSize );

  Move( CopyRight, NewBuffer^, SizeOf( CopyRight ));
  Move( AboutMsg[ 1 ], P^[ SizeOf( CopyRight )+1], Byte( AboutMsg[ 0 ]));
  Move( TheBuffer^, P^[ Byte( AboutMsg[ 0 ] )+ 1 + SizeOf( CopyRight )], TheSize );

  FreeMem( TheBuffer, TheSize );
  TheSize := NewSize;
  TheBuffer := NewBuffer;
End;

End.