home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PRUS101.ZIP / FCONFIG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-19  |  4.2 KB  |  167 lines
  1. unit FConfig;
  2.  
  3.  { FIDO unit to Read text Configs like the configs of xOR or Reqman
  4.  (*************************************************************************)
  5.  
  6.      RELEASE 1.00 - as first contained in the file PRUS101.LZH
  7.         by Matthias Tichy, 2:2440/210.14, GERMANY
  8.  
  9.            --------------------------------------------
  10.         organized for Fido's PASCAL related echoes
  11.            --------------------------------------------
  12.  
  13.      21/11/1994 to --/--/---- by Matthias Tichy, 2:2440/210.14, GERMANY
  14.  
  15.  
  16.        As far as third party copyrights are not violated this
  17.        source code is hereby placed to the public domain. Use
  18.        it whatever way you want, but use AT YOUR OWN RISK.
  19.  
  20.        In case you should modify the source rather send your
  21.        modifications to the unit's current organizer (see above for
  22.        NM address) than to spread it on your own. This will help to
  23.        keep the unit updated and grant a certain standard to all
  24.        other users as well.
  25.  
  26.        The unit is currently still under work. So it might greatly
  27.        benefit of your participation.
  28.  
  29.        Those who contributed to the following piece of source,
  30.        listed in alphabethical order:
  31.     ================================================================
  32.         Matthias Tichy ...
  33.     ================================================================
  34.        YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
  35.  
  36.        Credits in your own programs are as welcome as unnecessary.
  37.  
  38. (***************************************************************************}
  39.  
  40. {$I FDEFINE.DEF} { Use the general include file for conditional defines and
  41.            common compiler directives ... }
  42.  
  43.          { ... and set the unit's specific defines aftwerwards. }
  44.  
  45. interface
  46.  
  47. const
  48.   CFirst = true;
  49.   CNext = false;
  50.  
  51. type
  52.   PKette = ^TKette;
  53.   TKette = record
  54.              text : string;
  55.              next : PKette;
  56.            end;
  57.  
  58.   PConfig = ^RConfig;
  59.   RConfig = record
  60.               anfang, next : PKette;
  61.             end;
  62.  
  63. function LoadConfig(name : string) : PConfig;
  64. function ReadEntry(var entry : string;conf : PConfig;first : boolean) : integer;
  65. procedure DisposeConfig(var conf : PConfig);
  66.  
  67. implementation
  68.  
  69. uses dos, fstr;
  70.  
  71. function FileExists(FileName: string; attr : Word) : Boolean;
  72.  
  73. var
  74.   f: SearchRec;
  75.  
  76. begin
  77.   findfirst(Filename, attr, f);
  78.   if doserror = 0 then Fileexists := true else Fileexists := false;
  79. end;
  80.  
  81. function LoadConfig(name : string) : PConfig;
  82.  
  83. var
  84.   f : text;
  85.   Conf : PConfig;
  86.   Kette : PKette;
  87.   dummy : string;
  88.  
  89. begin
  90.   if not fileexists(name, anyfile) then
  91.     begin
  92.       LoadConfig := nil;
  93.       exit;
  94.     end;
  95.   New(Conf);
  96.   conf^.next := nil;
  97.   conf^.anfang := New(PKette);
  98.   Kette := Conf^.anfang;
  99.   Kette^.next := nil;
  100.   filemode := 64;
  101.   assign(f, name);
  102.   reset(f);
  103.   while not eof(f) do
  104.     begin
  105.       readln(f, dummy);
  106.       dummy := stripLeadingSpaceTab(dummy);
  107.       if (dummy <> '') and (dummy[1] <> ';') then
  108.         begin
  109.           kette^.text := dummy;
  110.           if not eof(f) then
  111.             begin
  112.               New(kette^.next);
  113.               kette := kette^.next;
  114.               kette^.next := nil;
  115.             end;
  116.         end;
  117.     end;
  118.   close(f);
  119.   LoadConfig := Conf;
  120. end;
  121.  
  122. function readEntry(var entry : string;Conf : PConfig;first : boolean) : Integer;
  123.  
  124. var
  125.   dummy : string;
  126.   anfang : PKette;
  127.  
  128. begin
  129.   entry := upperstring(entry);
  130.   if first then
  131.     anfang := conf^.anfang
  132.   else anfang := conf^.next;
  133.   repeat
  134.     dummy := anfang^.text;
  135.     dummy := copy(dummy, 1, pos(' ',dummy)-1);
  136.     dummy := upperstring(dummy);
  137.     if dummy <> entry then anfang := anfang^.next;
  138.   until (anfang = nil) or (dummy = entry);
  139.   if dummy = entry then
  140.     begin
  141.       dummy := anfang^.text;
  142.       entry := copy(dummy, pos(' ',dummy)+1, length(dummy)-pos(' ',dummy));
  143.       entry := StripLeadingSpaceTab(entry);
  144.       readEntry := 0;
  145.     end
  146.   else readEntry := -1;
  147.   conf^.next := anfang^.next;
  148. end;
  149.  
  150. procedure DisposeConfig(var conf : PConfig);
  151.  
  152. var
  153.   kette, kette2 : PKette;
  154.  
  155. begin
  156.   kette := conf^.anfang;
  157.   Dispose(conf);
  158.   while Kette <> nil do
  159.     begin
  160.       kette2 := kette^.next;
  161.       dispose(kette);
  162.       kette := kette2;
  163.     end;
  164.   conf := nil;
  165. end;
  166.  
  167. end.