home *** CD-ROM | disk | FTP | other *** search
- 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.