(*****************************************************************************)
(*                                                                           *)
(*        filename        : XINI.PAS                                         *)
(*        author          : Max Maischein  /       FidoNet :  2:249/6.17     *)
(*        adapted         : Stefan Boether / Compuserve Id : 100023,275      *)
(*                                                 FidoNet :  2:243/91.331   *)
(*                                  Internet: 100023.275@CompuServe.COM      *)
(*        system          : BP 7.0                                           *)
(*        changes         :                                                  *)
(*        when    what                                                who    *)
(*---------------------------------------------------------------------------*)
(*       16.01.93 Use the PChar-Type came with BP 7.0 also for DOS    Stefc  *)
(*****************************************************************************)
(*  Description :  An object for handling *.INI files !                      *)
(*****************************************************************************)
{Header-End}
(*
   Notification :  The most of the work came from Max !! Many thanks
                   to him from me. I adapated it to my Xlibary's for
                   my own suppose, so if you want the original
                   unit please contact Max not me ! In his original
                   unit there also is a little more flexible than
                   my version. But my is smaller because many of
                   the function he has in his, I've in my own libs !
                   And I have use the IScan function from the
                   EDITORS Unit here, so it may be some faster !
                   If you find some bugs in this source, please
                   let me know ?

                                       - Mfg Stefc -

*)

UNIT   xIni; {$O+,D+,I-}

INTERFACE

USES   Dos,
       Objects,
       Strings;

TYPE   PProfile= ^TProfile;
       TProfile= object( TObject )
         constructor Init( FileName: PathStr; AGroup: String );
         destructor  Done; virtual;
         function    GetString  ( ItemName:String; Default:String) : String;
         procedure   WriteString( ItemName:String; Value  :String );
         function    GetInt     ( ItemName:String; Default:Integer):Integer;
         procedure   WriteInt   ( ItemName:String; Value  :Integer);
       private
         Changed    : Boolean;
         TheBuffer  : PChar;
         TheFile    : file;

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

         Function  SetGroup( NewGroup : String ) : Boolean;
         Procedure CreateGroup( NewGroup : String );
       End;

IMPLEMENTATION

const  cr   = #$0D;
       lf   = #$0A;
       crlf = cr+lf;

{ Thanks to Borland for their fast string search asm procs ! }
const sfSearchFailed = $FFFF;

function IScan(var Block; Size: Word; Str: String): Word; assembler;
 var S: String;
asm
	PUSH	DS
	MOV	AX,SS
	MOV	ES,AX
	LEA	DI,S
	LDS	SI,Str
	XOR	AH,AH
	LODSB
	STOSB
	MOV	CX,AX
	MOV	BX,AX
	JCXZ	@@9
@@1:	LODSB
	CMP	AL,'a'
	JB	@@2
	CMP	AL,'z'
	JA	@@2
	SUB	AL,20H
@@2:	STOSB
	LOOP	@@1
	SUB	DI,BX
	LDS	SI,Block
	MOV	CX,Size
	JCXZ	@@8
	CLD
	SUB	CX,BX
	JB	@@8
	INC	CX
@@4:	MOV	AH,ES:[DI]
	AND	AH,$DF
@@5:	LODSB
	AND	AL,$DF
	CMP	AL,AH
	LOOPNE	@@5
	JNE	@@8
	DEC	SI
	MOV	DX,CX
        MOV	CX,BX
@@6:	REPE	CMPSB
	JE	@@10
	MOV	AL,DS:[SI-1]
	CMP	AL,'a'
	JB	@@7
	CMP	AL,'z'
	JA	@@7
	SUB	AL,20H
@@7:	CMP	AL,ES:[DI-1]
	JE	@@6
	SUB	CX,BX
	ADD	SI,CX
	ADD	DI,CX
	INC	SI
	MOV	CX,DX
        OR      CX,CX
	JNE	@@4
@@8:	XOR	AX,AX
	JMP	@@11
@@9:    MOV	AX, 1
	JMP	@@11
@@10:	SUB	SI,BX
	MOV	AX,SI
	SUB	AX,WORD PTR Block
	INC	AX
@@11:	DEC	AX
	POP	DS
end;

{  - Thanks to Freddy Ertl and Ralph Machholz for the following two procs ! }
function Str2PChar(var St:String):PChar;
  var i : Integer;
begin
  i := Length(St);
  Move( St[1], St[0], I );
  St[i] := #0;
  Str2PChar := PChar(@St);
end;

function PChar2Str(var St:String):String;
  var i : Integer;
begin
  i := 0 ;
  while (St[i] <> #0) do inc(i);
  If i > 254 then RunError(255);
  Move(St[0],St[1],I);
  St[0]:=Chr(i);
  PChar2Str := St;
end;

{ - Some stuff came from me ! }
function UpCaseStr( St:String):string;
  var I : BYTE;
begin
  for I := 1 TO LENGTH( St ) DO
    St[I] := UpCase( St[i] );
  UpCaseStr := St;
END;

procedure CheckGroup(var NewGroup:String);
begin
  If NewGroup[ 1 ] <> '[' then
     NewGroup := '[' + NewGroup;
  If NewGroup[Length(NewGroup)] <> ']' then
     NewGroup := NewGroup + ']';
end;

procedure CheckItem(var ItemName:String);
begin
  if ItemName[Length(ItemName)] <> '=' then
     ItemName := ItemName + '=';
end;

(************************************************************************)
 (*                                                                      *)
  (*        Object : TProFile                                             *)
   (*                                                                      *)
    (************************************************************************)

constructor TProfile.Init;
  const fmDenyWrite  = $20;
  var   TheSize : word;
        SavFileMode : Word;
begin
  inherited Init;
  If Pos( '.',FileName)= 0 then FileName := FileName + '.INI';

  SavFileMode := filemode;
  filemode := fmDenyWrite;     { Other only can read the file !!! }
  Assign( TheFile, FileName );
  Reset ( TheFile, 1 );
  if ioresult <> 0 then begin
     rewrite( TheFile, 1 );
     if ioresult <> 0 then
        fail
     else
        TheSize := 0;
  end else
     TheSize := filesize(TheFile);
  filemode := SavFilemode;

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

  GroupSize  := 0;
  GroupStart := TheBuffer;

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

  Changed := False;
End;

Destructor TProfile.Done;
Begin
  If Changed then begin
     ReWrite( TheFile, 1 );
     BlockWrite( TheFile, TheBuffer^, StrLen(TheBuffer));
  end;
  Close( TheFile );
  StrDispose(TheBuffer);
  inherited Done;
End;

{ - Go to the specific group }
Function TProfile.SetGroup;
  Var MyPos  : Word;
      P      : PChar;
Begin
  If NewGroup = '' then Begin
     GroupStart := TheBuffer;
     GroupSize  := StrLen(TheBuffer);
     SetGroup   := True;
     Exit; { could be better, but ;-) }
  End;

  CheckGroup(NewGroup);
  MyPos    := IScan( TheBuffer^, StrLen(TheBuffer), UpcaseStr(NewGroup));
  If MyPos <> sfSearchFailed then Begin
     GroupStart := TheBuffer + MyPos;
     Group      := NewGroup;
     P          := StrScan( GroupStart+Length(NewGroup), '[' );
     If P = nil then
        GroupSize := StrLen(GroupStart)
     else
        GroupSize := P-GroupStart;
     SetGroup := True;
  End else
     SetGroup := False;
End;

{ - Append a new group into the INI-File - }
Procedure TProfile.CreateGroup;
 Var NewBuffer : PChar;
Begin
  CheckGroup(NewGroup);
  NewGroup := NewGroup + CRLF;

  GetMem  ( NewBuffer, StrLen(TheBuffer)+Length(NewGroup));
  StrLCopy( NewBuffer, TheBuffer,StrLen(TheBuffer));
  StrCat  ( NewBuffer, Str2PChar(NewGroup));

  StrDispose(TheBuffer);
  TheBuffer := NewBuffer;
  PChar2Str(NewGroup);
  Delete( NewGroup, Pred(Length(NewGroup)), 2 );
  SetGroup(NewGroup);
  Changed := True;
End;

{ - Get a string-item from the group }
Function TProfile.GetString;
Var MyPos : Word;
    P,Q   : PChar;
    Tmp   : array[0..255] of char;
Begin
  GetString := Default;
  CheckItem( ItemName );
  MyPos := IScan(GroupStart^,GroupSize,UpcaseStr(ItemName));
  If MyPos <> sfSearchFailed then begin
     Q := GroupStart + (MyPos + Length(ItemName));
     P := StrScan(Q, CR );
     If P <> nil then
        GetString := StrPas(StrLCopy(Tmp,Q,P-Q));
  end
End;

{ - Write a string-item to the group }
Procedure TProfile.WriteString;
  Var NewBuffer : PChar;
      NewString : String;
      MyPos     : Word;

  procedure ResetBuffer;
  begin
    StrDispose(TheBuffer);
    TheBuffer := NewBuffer;
    SetGroup(Group);
    Changed := True;
  end;

Begin
  CheckItem(ItemName);
  If GetString(ItemName,'') <> '' then begin { remove old Item + Value }
     NewString := ItemName + GetString( ItemName,'') + CRLF;
     GetMem( NewBuffer, StrLen(TheBuffer)-Length(NewString));
     MyPos:= IScan( GroupStart^, GroupSize, UpcaseStr(ItemName));
     StrLCopy( NewBuffer, TheBuffer,(GroupStart-TheBuffer)+MyPos);
     StrCat  ( NewBuffer, GroupStart + MyPos + Length(NewString));
     ResetBuffer;
  End;

  If Value <> '' then Begin  { add new item + value }
     NewString:= ItemName + Value + CRLF;
     GetMem  ( NewBuffer, StrLen(TheBuffer)+Length(NewString));
     StrLCopy( NewBuffer, TheBuffer, (GroupStart-TheBuffer)+GroupSize);
     StrCat  ( NewBuffer, Str2PChar( NewString ));
     StrCat  ( NewBuffer, GroupStart + GroupSize );
     ResetBuffer;
  End;
End;

{- Get am integer value from the INI-file }
function TProfile.GetInt;
  var St:String; V,C: Integer;
begin
  St:=GetString(ItemName,'');
  IF St = '' then
     GetInt := Default
  else begin
     Val(St,V,C);
     IF C = 0 then GetInt := V
              else GetInt := Default;
  end;
end;

{- Write an integer value to the INI-file }
procedure TProfile.WriteInt;
  var St:String[6];
begin
  str(Value,St);
  WriteString(ItemName,St);
end;

end.