ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PNL010.ZIP/READINI.PAS

Pascal/Delphi Source File | 1992-02-29 | 10.2 KB | 399 lines

Unit ReadIni;
(*Copyright (c) 1992 KHIRON Software

  All rights reserved. KHIRON Software hereby grants
  permission for free distribution of this software,
  and for use of this software within commercial and
  non-commercial applications. This software itself
  may not be distributed commercially without obtaining
  written permission from KHIRON Software.

  Should you use this software or it's techniques in commercial
  products send me a postcard at the following address to fulfill
  a licensing commitment:

    Richard A. Morris
    C/- KHIRON Software
    P.O. Box 544
    INDOOROOPILLY Qld 4068
    AUSTRALIA
*)
(* A Demonstration of a usefull Collection.
  This unit once inserted in a Uses statement in your program
  will read a Windows style ini file, and store in Dynamic memory
  a collection of startup parameters.  This unit provides you access
  functions to query the collection;

  Format of INI File {Name - Filename.INI wher Filename is Path/Name of your App}
  ~~~~~~~~~~~~~
  ;Comment
  [TAG]
    PARAM=VALUE
  ~~~~~~~~~~~~~
  eg:
  ~~~~~~~~~~~~~~~~~~~~~
  [System]
    DataDir=C:\Data\
  [ScreenMode]
  ; Name=Mode,Xres,Yres
  B&W_80x25=2,80,25
  Colour_80x25=3,80,25
  Mono_80x25=7,80,25
  ~~~~~~~~~~~~~~~~~~~~~
  (all items case insensitive, white space neutral)

Interface Functions
  GETPARAM(TAG,PARAM) : VALUE
    Return the Value for Param in the group TAG
     ie: GETPARAM('SYSTEM','DATADIR') will return 'C:\DATA\'
  ParamsFor(TAG) : Number
    Return the number of Param
     ie: PARAMS(ScreenMode) will return 3
  PItem(TAG,INDEX) : String
    Return the PARAMLine for item INDEX of group TAG
     ie: PItem('SCREENMODE',2) will return 'Colour_80x25=3,80,25'
  VarParam(String) : Longint;
    Encapsulation of System.Val
  ParamNum(PARAMLINE,INDEX) : String
    Return the INDEXth item from a comma delimited PARAMLINE
     ie: ParamNum('Colour_80x25=3,80,25',1) will return '3'
*)
{$O+,F+}
INTERFACE
  Uses Objects,
       Dos;
Function GetParam(Tag : String;
                  Param : String) : String;
Function ParamsFor(Tag : String) : Byte;
Function PItem(TAG : String;
               Ind : Byte) : String;
Function VarParam(S : String) : Longint;
Function ParamNum(S : String;
                  I : Integer) : String;
Type
  pParamItem = ^tParamItem;
  tParamItem = Object(TObject)
    Param : pString;
    Vars  : pString;
    Constructor Init(S : String);
    Destructor Done;virtual;
  end;
  pParamCollection = ^tParamCollection;
  tParamCollection = Object(tCollection)
    Tag : pString;
    Constructor Init(T : String);
    Destructor Done;virtual;
    Function FindParam(Param : String) : String;
    Procedure AddParam(S : String);
  end;
  pTagCollection = ^tTagCollection;
  tTagCollection = Object(tCollection)
    CurrentTag : pParamCollection;
    Constructor Init(F : FNameStr);
    Function FindTag(Tag : String) : pParamCollection;
    Procedure SelectTag( T : String);
  end;
IMPLEMENTATION
Var
  Parameters     : pTagCollection;
  Pre_Param_Exit : Pointer;

Function Trim(S : String) : String;
Var B : Byte;
begin
  While S[1] = ' ' do
    System.Delete(S,1,1);
  While S[Length(S)] = ' ' do
    System.Delete(S,Length(S),1);
  For B := 1 to Length(S) do
    S[B]:= UpCase(S[B]);
  Trim := S;
end;
(***************** Interface Functions ******************)
Function GetParam(Tag   : String;
                  Param : String) : String;
Var
  P : pParamCollection;
begin
  Tag := Trim(Tag);
  Param := Trim(Param);
  P := Parameters^.FindTag(TAG);
  If P = nil then
    GetParam := ''
  Else
    GetParam := P^.FindParam(Param);
end;
Function VarParam(S : String) : Longint;
Var
  L : Longint;
  I : Integer;
begin
  Val(S,L,I);
  VarParam := L;
end;
Function ParamNum(S : String;
                  I : Integer) : String;
Var
  C : Integer;
  R : String;
  Start,
  Fini : Integer;
  Function PosOf(I:Byte) : Byte;
  Var
    B : Byte;
    N : Byte;
  begin
    N := 0;
    For B := 1 to Length(S) do
    begin
      If S[B] = ',' then
        inc(N);
      If N = I then
      begin
        PosOf := B;
        Exit;
      end;
    end;
    PosOf := 0;
  end;
begin  {Find Parameter Number I}
  S := ','+Trim(S)+',';
  If PosOf(I) = 0 then
    ParamNum := ''
  else
  begin
    {Find String between Comma I and I+1}
    Start := PosOf(I);
    Fini := PosOf(I+1);
    If Fini = 0 then
      ParamNum := ''
    else
      ParamNum := Trim(Copy(S,Start+1,Fini-Start-1));
  end;
end;
Function ParamsFor(Tag : String) : Byte;
Var
  P : pParamCollection;
begin
  Tag := Trim(Tag);
  P := Parameters^.FindTag(TAG);
  If P = nil then
    ParamsFor := 0
  else
    ParamsFor := P^.Count;
end;
Function PItem(TAG : String;
               Ind : Byte) : String;
Var
  P : pParamCollection;
begin
  Tag := Trim(Tag);
  P := Parameters^.FindTag(TAG);
  If P = nil then
    PItem := ''
  else
    If (Ind > P^.Count) OR
       (Ind <=0) then
      PItem := ''
    else
      PItem := pparamItem(P^.AT(Ind-1))^.Param^;
end;
(***************************************************)
Constructor tParamItem.Init(S : String);
Var
  T : String;
begin
  TObject.Init;
  If Pos('=',S) <> 0 then
  begin
    T := Copy(S,1,Pos('=',S)-1);
    System.Delete(S,1,Pos('=',S));
  end;
  If T = '' then
    T := 'DEFAULT';
  Param := NewStr(T);
  Vars := NewStr(S);
end;
Destructor tParamItem.Done;
begin
  disposeStr(Param);
  disposeStr(Vars);
  TObject.Done;
end;
(***************************************************)
Constructor tParamCollection.Init(T : String);
begin
  TCollection.Init(10,10);
  Tag := NewStr(T);
end;
Destructor tParamCollection.Done;
begin
  disposeStr(Tag);
  TCollection.Done;
end;
Function tParamCollection.FindParam(Param : String) : String;
Var
  I : Integer;
  P : PParamItem;
begin   {Search for PARAM in collection return VALUE Line}
  P := nil;
  For I := 0 to Count-1 do
    If pParamItem(At(I))^.Param^ = Param then
      P := pParamItem(At(I));
  If P = nil then
    FindParam := ''
  else
    FindParam := P^.Vars^;
end;
Procedure tParamCollection.AddParam(S : String);
Var
  I : Integer;
  P : PParamItem;
  T : String;
begin  {Add the Parameter S to this Tag Collection}
  P := nil;
  If Pos('=',S) <> 0 then
  begin {Separate everything BEFORE and AFTER the Equals}
    T := Copy(S,1,Pos('=',S)-1);
  end;
  If T = '' then
    T := 'DEFAULT';
  For I := 0 to Count-1 do
    If pParamItem(At(I))^.Param^ = T then
      P := pParamItem(At(I));
  If P <> nil then
    Delete(P);
  TCollection.Insert(New(pParamItem,Init(S)));
end;
(***************************************************)
Constructor tTagCollection.Init(F : FNameStr);
Var
  T : Text;
  S : String;
  CurrPath : PathStr;
  D : DirStr;
  E : ExtStr;
  N : NameStr;
  OMD : Byte;
  Procedure TrimLead(Var S : String);
  begin  {Trim Leading blanks from a string}
    While S[1] = ' ' do
      System.Delete(S,1,1);
  end;
  Procedure TrimTrail(Var S : String);
  begin  {Trim trailing blanks from a String}
    While S[Length(S)] = ' ' do
      System.Delete(S,Length(S),1);
  end;
  Procedure Upper(Var S : String);
  Var B : Byte;
  begin {Convert a string to uppercase}
    For B := 1 to Length(S) do
      S[B]:= UpCase(S[B]);
  end;
begin
  TCollection.Init(10,10);
  Assign(T,F);
  OMD := FileMode;
  FileMode := 64;  {ReadOnly/DenyNone for network sharing}
  {$I-}
  Reset(T);
  {$I+}
  FileMode := OMD;  {Reset the Old File Mode}
  if IOResult <> 0 then  {File Doesn't exist - Fail and Halt}
    Fail
  else
  begin
    While Not EOF(T) do
    begin
      Readln(T,S);    {Read a Line}
      TrimLead(S);    {Trim Leading Blanks}
      if S[1] <> ';' then      {If SemiColon - Comment Abort}
        If S <> '' then        {If Blank Line - Abort}
        begin
          Upper(S);      {Uppercase it}
          If S[1] = '[' then
          begin  {Its a Group Tag line}
            System.Delete(S,1,1); {Remove the first [}
            If Pos(']',S) <> 0 then
              System.Delete(S,Pos(']',S),1); {Remove the last Blank}
            TrimLead(S);  {Trim leading blanks}
            TrimTrail(S); {Trim trailing blanks}
            SelectTag(S); {Find the TAG in the collection, insert if not there}
          end
          else
          begin
            If CurrentTag = nil then
              SelectTag('SYSTEM'); {If there was no tag whack it into System group}
            If CurrentTag <> nil then
              CurrentTag^.AddParam(S);   {Add to Curr Tag This Line}
          end;
        end;
    end;
    Close(T);
  end;
end;
Procedure tTagCollection.SelectTag(T : String);
Var
  Current : pParamCollection;
  I : Integer;
begin
  Current := nil;
  If Count <> 0 then
    For I := 0 to Count-1 do
      If pParamCollection(AT(I))^.TAG^ = T then
        Current := pParamCollection(AT(I));
  If Current = Nil then
  begin
    Current := new(pParamCollection,Init(T));
    TCollection.Insert(Current);
  end;
  CurrentTag := Current;
end;
Function tTagCollection.FindTag(Tag : String) : pParamCollection;
Var
  I : Integer;
  P : PParamCollection;
begin   {Search for TAG}
  P := nil;
  For I := 0 to Count-1 do
    If pParamCollection(At(I))^.TAG^ = TAg then
      P := pParamCollection(At(I));
  FindTag := P;
end;
(***************************************************)
Procedure DisposeParam; far;
begin
  ExitProc := Pre_Param_Exit;
  Dispose(Parameters,Done);
end;
Function ParamFileName : fNameStr;
{build the INI file name from the path/filename of your app,
 with the extension .INI}
Var
  S : String;
  B : Byte;
  D : DirStr;
  E : ExtStr;
  N : NameStr;
begin
  S := ParamStr(0);
  If S = '' then
    S := 'Dental.Exe';
  FSplit(FExpand(S),D,N,E);
  ParamFileName := D+N+'.INI';
end;

begin
   {Create Param Collection}
  Parameters := New(pTagCollection,Init(ParamFileName));
  if Parameters=nil then
  begin {No Ini File}
    Writeln('Can''t find INI file',paramFileName);
    Halt(255);
  end;
   {Make sure that when the program is finished it disposes the Collection}
  Pre_Param_Exit := ExitProc;
  ExitProc := @DisposeParam;
end.