home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / 4utils83.zip / HANDLEIN.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  8KB  |  293 lines
  1. UNIT HandleINIFile;
  2. {$X+}
  3.  
  4. (* ----------------------------------------------------------------------
  5.    Part of 4DESC - A Simple 4DOS File Description Editor
  6.        and 4FF   - 4DOS File Finder
  7.  
  8.    (c) 1992, 1993 Copyright by
  9.  
  10.        David Frey,         & Tom Bowden
  11.        Urdorferstrasse 30    1575 Canberra Drive
  12.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  13.        Switzerland           USA
  14.  
  15.        Code created using Turbo Pascal 7.0 (c) Borland International 1990
  16.  
  17.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  18.                and change it free of charge, but you may not sell or hire
  19.                this part of 4DESC. The copyright remains in our hands.
  20.  
  21.                If you make any (considerable) changes to the source code,
  22.                please let us know. (send a copy or a listing).
  23.                We would like to see what you have done.
  24.  
  25.                We, David Frey and Tom Bowden, the authors, provide absolutely
  26.                no warranty of any kind. The user of this software takes the
  27.                entire risk of damages, failures, data losses or other
  28.                incidents.
  29.  
  30.    This unit handles the reading of settings stored in 4UTILS.INI. It uses
  31.    a TStringCollection to hold the various .INI-file settings.
  32.    ----------------------------------------------------------------------- *)
  33.  
  34. INTERFACE USES Objects;
  35.  
  36. VAR INIFileExists : BOOLEAN;
  37.  
  38. TYPE  PINIStrings   = ^TINIStrings;
  39.       TINIStrings   = OBJECT(TCollection)
  40.                        CONSTRUCTOR Init;
  41.                        PROCEDURE FreeItem(Item: POINTER); VIRTUAL;
  42.                       END;
  43.  
  44. VAR   INIStrings : PINIStrings;
  45.  
  46. FUNCTION  ReadSettingsChar(Section,Name: STRING; Default: CHAR): CHAR;
  47. FUNCTION  ReadSettingsString(Section,Name: STRING; Default: STRING): STRING;
  48. FUNCTION  ReadSettingsInt(Section,Name: STRING; Default: INTEGER): INTEGER;
  49. FUNCTION  ReadSettingsColor(Section,Name: STRING; Default: INTEGER): BYTE;
  50.  
  51. IMPLEMENTATION USES Memory,
  52.                     Dos, StringDateHandling;
  53.  
  54. CONST INIFileName = '4UTILS.INI';
  55.  
  56. CONSTRUCTOR TINIStrings.Init;
  57. (* Reads the contents of the 4DOS.INI and the 4UTILS.INI files.
  58.    A heuristical search method is used to locate the files.      *)
  59.  
  60.  VAR INIFile : TEXT;
  61.      INIPath : DirStr;
  62.  
  63.      Name    : NameStr;
  64.      Ext     : ExtStr;
  65.      IORes   : INTEGER;
  66.  
  67.  PROCEDURE ReadIniFile(FilePath: PathStr);
  68.  (* At the entry in this procedure the file is already open. *)
  69.  
  70.  VAR semicol : BYTE;
  71.      ReadLine: STRING; (* a single line from a .INI file *)
  72.  
  73.  BEGIN
  74.   WHILE NOT Eof(INIFile) DO
  75.    BEGIN
  76.     ReadLn(INIFile,ReadLine);
  77.     StripLeadingSpaces(ReadLine);
  78.  
  79.     IF (ReadLine[1] <> ';') THEN
  80.      BEGIN
  81.       semicol := Pos(';',ReadLine);
  82.       IF (semicol > 0) AND
  83.          (DownStr(Copy(ReadLine,1,10)) <> 'delimiters') THEN
  84.        ReadLine := Copy(ReadLine,1,semicol-1);
  85.  
  86.       IF Length(ReadLine) > 0 THEN
  87.        BEGIN
  88.         StripTrailingSpaces(ReadLine);
  89.  
  90.         IF MemAvail < SizeOf(ReadLine) THEN
  91.          BEGIN
  92.           WriteLn;
  93.           WriteLn('OUT OF MEMORY while reading ''',FilePath,'''!');
  94.           WriteLn('Line "',ReadLine,'"');
  95.           WriteLn('will not be stored and its contents is lost.');
  96.           WriteLn;
  97.          END
  98.         ELSE
  99.          BEGIN
  100.           ReadLine := DownStr(ReadLine);
  101.  
  102.           TCollection.Insert(NewStr(ReadLine));
  103.          END;
  104.        END;
  105.      END; (* IF Line[1] <> ';' .. *)
  106.    END; (* WHILE *)
  107.  
  108.   {$I-}
  109.   Close(INIFile); IORes := IOResult;
  110.   {$I+}
  111.  END; (* ReadIniFile *)
  112.  
  113.  PROCEDURE SearchPath;
  114.  (* Search for INIFile in the PATH *)
  115.  
  116.   BEGIN
  117.    INIPath := FSearch(INIFileName,GetEnv('PATH'));
  118.    IF INIPath > '' THEN
  119.      BEGIN
  120.        {$I-}
  121.        Assign(INIFile,INIPath); Reset(INIFile);
  122.        INIFileExists := (IOResult = 0) AND (DosError = 0);
  123.        {$I+}
  124.      END;
  125.   END; (* SearchPath *)
  126.  
  127. BEGIN
  128.  TCollection.Init(100,10);
  129.  
  130.  (* 4DOS.INI:
  131.     i)  at the normal place: the same location where the
  132.         4DOS.COM command interpreter lives.
  133.     ii) in the root directory.
  134.  
  135.     P.S: the SHELL variable is not examined.                              *)
  136.  
  137.   FSplit(GetEnv('COMSPEC'),INIPath,Name,Ext);
  138.   {$I-}
  139.   Assign(INIFile,INIPath+'4DOS.INI'); Reset(INIFile);
  140.   {$I+}
  141.   INIFileExists := (IOResult = 0) AND (DosError = 0);
  142.  
  143.   IF INIFileExists THEN ReadIniFile(INIPath+'4DOS.INI')
  144.   ELSE
  145.    BEGIN
  146.      {$I-}
  147.      Assign(INIFile,'C:\4DOS.INI'); Reset(INIFile);
  148.      {$I+}
  149.      INIFileExists := (IOResult = 0) AND (DosError = 0);
  150.  
  151.      IF INIFileExists THEN ReadIniFile('\4DOS.INI')
  152.    END;
  153.  
  154.  (* Search strategy for 4UTILS.INI :
  155.     i)  Directory where this application was started from.
  156.     ii) Environment variable called 4UTILS
  157.     ii) in the Path                                                       *)
  158.  
  159.   FSplit(ParamStr(0),INIPath,Name,Ext);
  160.   {$I-}
  161.   Assign(INIFile,INIPath+INIFileName); Reset(INIFile);
  162.   {$I+}
  163.   INIFileExists := (IOResult = 0) AND (DosError = 0);
  164.  
  165.   IF NOT INIFileExists THEN
  166.     BEGIN
  167.       INIPath := GetEnv('4UTILS');
  168.       IF INIPath > '' THEN
  169.         BEGIN
  170.           IF INIPath[Length(INIPath)] <> '\' THEN INIPath := INIPath + '\';
  171.           {$I-}
  172.           Assign(INIFile,INIPath+INIFileName); Reset(INIFile);
  173.           {$I+}
  174.           INIFileExists := (IOResult = 0) AND (DosError = 0);
  175.  
  176.           IF NOT INIFileExists THEN SearchPath;
  177.         END
  178.       ELSE
  179.        SearchPath;
  180.     END;
  181.  
  182.   IF INIFileExists THEN ReadIniFile(INIPath+INIFileName)
  183. END; (* TINIStrings.Init *)
  184.  
  185. PROCEDURE TINIStrings.FreeItem(Item: POINTER);
  186. (* Free a string by using DisposeStr. This is necessary, since we are not
  187.    using TStringCollection (which is unfortunately sorted), so we have to
  188.    free the strings manually                                              *)
  189.  
  190. BEGIN
  191.  DisposeStr(Item);
  192. END;
  193.  
  194. (* A collection of functions to read Strings/Values/Color names out of
  195.    a initialisation file.                                              *)
  196.  
  197. FUNCTION  ReadSettingsString(Section, Name: STRING; Default: STRING): STRING;
  198. (* An empty section means: scan the whole .INI file                    *)
  199.  
  200. VAR LineNr: BYTE;
  201.     eq    : BYTE;
  202.     s,res : STRING;
  203.     sp    : PString;
  204.  
  205. BEGIN
  206.  LineNr := 0;
  207.  IF Section <> '' THEN Section := '['+DownStr(Section)+']';
  208.  s := '';
  209.  WHILE (s <> Section) AND (LineNr < INIStrings^.Count) DO
  210.   BEGIN
  211.     sp := INIStrings^.At(LineNr);
  212.     IF sp <> NIL THEN s := STRING(sp^)
  213.                  ELSE s := '';
  214.     INC(LineNr);
  215.   END;
  216.  
  217.  IF (s = Section) AND (LineNr < INIStrings^.Count) THEN
  218.   BEGIN
  219.    DownString(Name); res := ''; s := '';
  220.    REPEAT
  221.     sp := INIStrings^.At(LineNr);
  222.     IF sp <> NIL THEN s := STRING(sp^)
  223.                  ELSE s := '';
  224.     eq := Pos('=',s);
  225.     IF eq > 0 THEN s := Copy(s,1,eq-1);
  226.     StripTrailingSpaces(s);
  227.     INC(LineNr);
  228.    UNTIL (s = Name) OR (LineNr = INIStrings^.Count);
  229.  
  230.    IF s = Name THEN
  231.     BEGIN
  232.      res := Copy(STRING(sp^),eq+1,255);
  233.      StripLeadingSpaces(res);
  234.     END
  235.    ELSE res := Default;
  236.   END
  237.  ELSE res:= Default;
  238.  ReadSettingsString := res;
  239. END;
  240.  
  241. FUNCTION  ReadSettingsChar(Section,Name: STRING; Default: CHAR): CHAR;
  242.  
  243. VAR s : STRING;
  244.  
  245. BEGIN
  246.  s := ReadSettingsString(Section,Name,Default);
  247.  ReadSettingsChar := s[1];
  248. END;
  249.  
  250. FUNCTION  ReadSettingsInt(Section,Name: STRING; Default: INTEGER): INTEGER;
  251.  
  252. VAR s  : STRING;
  253.     res: INTEGER;
  254.     v  : INTEGER;
  255.  
  256. BEGIN
  257.  Str(Default,s);
  258.  s := ReadSettingsString(Section,Name,s);
  259.  Val(s,v,res);
  260.  IF res > 0 THEN v := Default;
  261.  ReadSettingsInt := v;
  262. END;
  263.  
  264. FUNCTION  ReadSettingsColor(Section,Name: STRING; Default: INTEGER): BYTE;
  265.  
  266. CONST color : ARRAY[0..15] OF STRING[12] =
  267.               ('black'   ,'blue'        ,'green'     ,'cyan'     ,
  268.                'red'     ,'magenta'     ,'brown'     ,'lightgray',
  269.                'darkgray','lightblue'   ,'lightgreen','lightcyan',
  270.                'lightred','lightmagenta','yellow'    ,'white');
  271.  
  272. VAR s  : STRING;
  273.     c  : BYTE;
  274.  
  275. BEGIN
  276.  Str(Default,s);
  277.  s := ReadSettingsString(Section,Name,'');
  278.  
  279.  IF s > '' THEN
  280.   BEGIN
  281.    c := 0;
  282.    WHILE (color[c] <> s) AND (c<16) DO INC(c);
  283.    IF color[c] <> s THEN c := Default;
  284.   END
  285.  ELSE c := Default;
  286.  ReadSettingsColor := c;
  287. END;
  288.  
  289. BEGIN
  290.  INIFileExists := FALSE;
  291.  INIStrings := NIL; (* never leave a Pointer uninitialized ! *)
  292. END.
  293.