home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1318 / gepackt.exe / UTILITY / SOURCE / INITENV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-30  |  11.6 KB  |  267 lines
  1. {$M 5520,2000,10000}
  2. {{$define test}
  3. program initenv;
  4.  
  5.   uses
  6.     fdisks,uupcase,autodel,uenv,uexist,upath;
  7.  
  8.   var
  9.     s,s1                               : string;
  10.     l                                  : byte absolute s;
  11.     b                                  : byte;
  12.     fn                                 : string[80];
  13.     vn                                 : string;
  14.     f                                  : text;
  15.     st,st1,enverr,st2                  : boolean;
  16.     ch                                 : char;
  17.     disk                               : byte;
  18.  
  19.   begin
  20.     if paramcount>0 then fn:=paramstr(1)
  21.     else begin
  22.       b:=length(fn);
  23.       fn:=getpathname(envname)+'initenv.par';
  24.       if not exist(fn,existfile) then begin
  25.         delete(fn,3,b-2);
  26.         if not exist(fn,existfile) then fn:='c:\initenv.par';
  27.       end;
  28.     end;
  29.     if (fn='?') or not exist(fn,existfile) then begin
  30.       writeln('----------------------------');
  31.       writeln('INITENV          Version 1.1');
  32.       writeln('Copywrigth  Dieter Ferdinand');
  33.       writeln('----------------------------');
  34.       writeln('Wird in der Kommandozeile kein Parameterfile angebeben, dann wird');
  35.       writeln('automatisch nach einer Datei INITENV.PAR gesucht. Zuerst wird im');
  36.       writeln('Verzeichnis nachgesehen, in dem sich das Programm befindet, danach');
  37.       writeln('im Hauptverzeichnis des Laufwerks, auf dem sich das Programm befindet');
  38.       writeln('und zuletzt im Hauptverzeichnis von Laufwerk C:.');
  39.       writeln('Aufbau der Parameter-Datei:');
  40.       writeln(';text                            Komentar');
  41.       writeln('variable=daten                   feste Zuweisung');
  42.       writeln('variable=$laufwerk:path\filename path wird zugewiesen, wenn die Datei');
  43.       writeln('                                 existiert.');
  44.       writeln('variable=*path\filename          alle vorhanden Festplatten werden durchsucht');
  45.       writeln('                                 wird das file gefunden, wird der Path');
  46.       writeln('                                 zugewiesen.');
  47.       writeln('variable=?path\filename          alle vorhanden Festplatten werden durchsucht');
  48.       writeln('                                 wird das File gefunden, wird der Path');
  49.       writeln('                                 mit dem Filenamen zugewiesen.');
  50.       writeln('variable=!path                   alle vorhanden Festplatten werden durchsucht');
  51.       writeln('                                 wird das Directory gefunden, wird der Path');
  52.       writeln('                                 zugewiesen.');
  53.       writeln('variable=|label                  alle vorhanden Festplatten werden nach dem');
  54.       writeln('                                 Label durchsucht, eine Liste mit allen');
  55.       writeln('                                 Laufwerken bis zum auffinden des Labels');
  56.       writeln('                                 wird der VARIABLEN zugewiesen. Die Liste');
  57.       writeln('                                 hat die Form C,D,..,Z. Dadurch kann sie');
  58.       writeln('                                 beim FOR-Befehl als Liste verwendet werden.');
  59.       writeln('variable=|!label                 wie |label, allerdings wird nur das Laufwerk');
  60.       writeln('                                 zugewiesen.');
  61.       writeln('variable=|*filename              wie bei |label, allerdings wird nach einem');
  62.       writeln('                                 File gesucht.');
  63.       writeln('variable=|$                      wie bei |label, allerdings werden alle');
  64.       writeln('                                 anprechbaren Festplatten eingetragen.');
  65.       writeln('variable=%variable               Variable kopieren');
  66.       writeln('variable=%variable%text          Variablen mit Konstanten verknüpfen');
  67.       writeln('                                 Soll als erstes ein Text stehen,');
  68.       writeln('                                 dann %% an den Anfang setzen.');
  69.       writeln;
  70.       writeln('Ist das 1. Zeichen einer Zeile ein ";", dann wird diese Zeile nicht');
  71.       writeln('bearbeitet.');
  72.       writeln('Bei den Funktionen, bei denen kein Filename gespeichert wird, dürfen');
  73.       writeln('auch * und ? im Filenamen verwendet werden.');
  74.       writeln('Die Suchfunktionen werden abgebrochen, sobald etwas passendes gefunden');
  75.       writeln('wurde.');
  76.       writeln('Variablen, die bereits existieren werden nicht verändert.');
  77.       writeln('Die zur Steuerung benutzten Zeichen können nicht zugewiesen werden.');
  78.     end
  79.     else begin
  80.       assign(f,fn);
  81.       filemode:=0;
  82.       reset(f);
  83.       writeln('Initialisiere Variablen:');
  84.       while not eof(f) do begin
  85.         readln(f,s);
  86.         writeln(s);
  87.         b:=l;
  88.         if b>0 then b:=pos('=',s);
  89.         if (l>0) and (s[1]<>';') then if b>0 then begin
  90.           vn:=copy(s,1,pred(b));
  91. {$ifndef test}
  92.           if (gethauptenv(vn)='') then
  93. {$endif}
  94.           if l>0 then begin
  95.             delete(s,1,b);
  96.             enverr:=true;
  97.             case s[1] of
  98.               '$' : if exist(s,existfile) then begin
  99.                       s:=getpathname(s);
  100.                       if l>0 then dec(s[0]);
  101. {$ifndef test}
  102.                       enverr:=sethauptenv(vn+'='+s);
  103. {$endif}
  104.                     end;
  105.               '%' : begin
  106.                       s1:='';
  107.                       st:=true;
  108.                       delete(s,1,1);
  109.                       repeat
  110.                         b:=pos('%',s);
  111.                         if (b=0) then begin
  112.                           if st then s1:=s1+gethauptenv(s) else s1:=s1+s;
  113.                           s:='';
  114.                         end
  115.                         else begin
  116.                           if st then s1:=s1+gethauptenv(copy(s,1,pred(b)))
  117.                           else s1:=s1+copy(s,1,pred(b));
  118.                           delete(s,1,b);
  119.                           st:=not st;
  120.                         end;
  121.                       until s='';
  122.                       vn:=upcasestr(vn);
  123.                       if vn='PATH' then begin
  124.                         repeat
  125.                           b:=pos(';;',s1);
  126.                           if b>0 then delete(s1,b,1)
  127.                           else begin
  128.                             b:=pos(';\;',s1);
  129.                             if b>0 then delete(s1,b,2)
  130.                             else begin
  131.                               b:=pos('=\;',s1);
  132.                               if b>0 then delete(s1,succ(b),2)
  133.                               else begin
  134.                                 b:=pos(';\',s1);
  135.                                 if b>0 then delete(s1,b,2)
  136.                                 else begin
  137.                                   b:=ord((s1[0]>#0) and (s1[1]=';'));
  138.                                   if b=0 then b:=ord(s1[0])*ord((s1[0]>#0) and (s1[ord(s1[0])]=';'));
  139.                                   if b>0 then delete(s1,b,1)
  140.                                   else begin
  141.                                     b:=ord((s1[0]>#0) and (s1[1]='\'));
  142.                                     if b>0 then delete(s1,b,1);
  143.                                   end;
  144.                                 end;
  145.                               end;
  146.                             end;
  147.                           end;
  148.                         until b=0;
  149.                       end;
  150. {$ifndef test}
  151.                       enverr:=sethauptenv(vn+'='+s1);
  152. {$endif}
  153.                     end;
  154.               '|' : begin
  155.                       delete(s,1,1);
  156.                       b:=pos(':',s);
  157.                       if b>0 then delete(s,1,b);
  158.                       if l>0 then begin
  159.                         st1:=s[1]='*';
  160.                         st2:=s[1]='!';
  161.                         if st1 or st2 then delete(s,1,1);
  162.                         fn:='B:'+s;
  163.                         l:=0;
  164.                         st:=fn[0]>#2;
  165.                         s:='';
  166.                         disk:=0;
  167.                         if st then if s[1]='$' then for disk:=1 to lastdisk do begin
  168.                           fn[1]:=disks[disk];
  169.                           s:=s+fn[1];
  170.                           if (l>0) and (lastdisk<>disk) then s:=s+',';
  171.                         end
  172.                         else if lastdisk>0 then repeat
  173.                           inc(disk);
  174.                           fn[1]:=disks[disk];
  175.                           if l>0 then s:=s+',';
  176.                           s:=s+fn[1];
  177.                           if st1 then st:=exist(fn,existfile)
  178.                           else st:=exist(fn,existlabel);
  179.                         until (lastdisk=disk) or st;
  180.                         if st then begin
  181.                           if st2 then begin
  182.                             delete(s,1,pred(l));
  183.                             s:=s+':';
  184.                           end;
  185. {$ifndef test}
  186.                           enverr:=sethauptenv(vn+'='+s);
  187. {$endif}
  188.                         end;
  189.                       end;
  190.                     end;
  191.               '*' : begin
  192.                       delete(s,1,1);
  193.                       b:=pos(':',s);
  194.                       if b>0 then delete(s,1,b);
  195.                       if (l>0) and (lastdisk>0) then begin
  196.                         fn:='B:'+s;
  197.                         disk:=0;
  198.                         repeat
  199.                           inc(disk);
  200.                           fn[1]:=disks[disk];
  201.                           st:=exist(fn,existfile);
  202.                         until (lastdisk=disk) or st;
  203.                         if st then begin
  204.                           fn:=getpathname(fn);
  205.                           dec(fn[0]);
  206. {$ifndef test}
  207.                           enverr:=sethauptenv(vn+'='+fn);
  208. {$endif}
  209.                         end;
  210.                       end;
  211.                     end;
  212.               '!' : begin
  213.                       delete(s,1,1);
  214.                       b:=pos(':',s);
  215.                       if b>0 then delete(s,1,b);
  216.                       if (l>0) and (lastdisk>0) then begin
  217.                         fn:='B:'+s;
  218.                         disk:=0;
  219.                         repeat
  220.                           inc(disk);
  221.                           fn[1]:=disks[disk];
  222.                           st:=exist(fn,existdir);
  223.                         until (lastdisk=disk) or st;
  224.                         if st then begin
  225. {$ifndef test}
  226.                           enverr:=sethauptenv(vn+'='+fn);
  227. {$endif}
  228.                         end;
  229.                       end;
  230.                     end;
  231.               '?' : begin
  232.                       delete(s,1,1);
  233.                       b:=pos(':',s);
  234.                       if b>0 then delete(s,1,b);
  235.                       if (l>0) and (lastdisk>0) then begin
  236.                         fn:='B:'+s;
  237.                         disk:=0;
  238.                         repeat
  239.                           inc(disk);
  240.                           fn[1]:=disks[disk];
  241.                           st:=exist(fn,existfile);
  242.                         until (lastdisk=disk) or st;
  243. {$ifndef test}
  244.                         if st then enverr:=sethauptenv(vn+'='+fn);
  245. {$endif}
  246.                       end;
  247.                     end;
  248. {$ifndef test}
  249.               else enverr:=sethauptenv(vn+'='+s);
  250. {$endif}
  251.             end;
  252.             enverr:=not enverr;
  253.             if enverr then writeln('Variable ',vn,' konnte nicht gesetzt werden!');
  254.           end
  255.           else writeln('Kein Befehl in der Befehlszeile gefunden');
  256. (*{$ifndef test}
  257.           else writeln('Variable ',vn,' existiert bereits!');
  258. {$endif}*)
  259.         end
  260.         else writeln('Kein Variablenname in der Befehlszeile gefunden!');
  261.       end;
  262.       writeln('Ende der Initialisierung.');
  263.       close(f);
  264.       writeln;
  265.     end;
  266.   end.
  267.