home *** CD-ROM | disk | FTP | other *** search
/ Chip: Special Survival Kit / Chip_Special_Survival_Kit_fuer_PC_Anwender.iso / 01tools / diet / dietger / dietctrl.pas < prev    next >
Pascal/Delphi Source File  |  1994-09-01  |  13KB  |  529 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
  2.          
  3. PROGRAM DIETControl;   {28.5.1992}
  4.  
  5. USES
  6.   crt,dos;
  7.  
  8. CONST
  9.   recomp = $1;
  10.   newcomp = $2;
  11.   manucomp = $4;
  12.   info = $8;
  13.   origsize = $10;
  14.  
  15.   normcol = 23;
  16.   highcol = 31;
  17.   invcol = 112;
  18.  
  19.   lastopt = 7;
  20.   box_x = 5;
  21.   box_y = 6;
  22.  
  23.   BS       = 8;                   {Tastaturkonstanten für "keycode"}
  24.   Tab      = 9;
  25.   ShTab    = 1015;
  26.   RET      = 13;
  27.   CtrlY    = 25;
  28.   esc      = 27;
  29.  
  30.   F1       = 1059;     F2       = 1060;     F3       = 1061;
  31.   F4       = 1062;     F5       = 1063;     F6       = 1064;
  32.   F7       = 1065;     F8       = 1066;     F9       = 1067;
  33.   F10      = 1068;
  34.  
  35.   Up       = 1072;     Down     = 1080;     Left     = 1075;
  36.   Right    = 1077;     Home     = 1071;     Ende     = 1079;
  37.   PgUp     = 1073;     PgDn     = 1081;     Ins      = 1082;
  38.   Del      = 1083;     
  39.  
  40. TYPE
  41.   optionobj = object
  42.                 x,y : byte;
  43.                 titel : pathstr;
  44.                 CONSTRUCTOR setzen (nx,ny : byte ; ntitel : pathstr);
  45.                 PROCEDURE zeigen (aktiv : boolean); virtual;
  46.                 FUNCTION aktion : word;virtual;
  47.                 PROCEDURE sichern (var t : text);virtual;
  48.                 PROCEDURE laden (var t : text); virtual;
  49.               end;
  50.  
  51.   schalterobj = object (optionobj)
  52.                  status : boolean;
  53.                  CONSTRUCTOR setzen (nx,ny : byte ; nstat : boolean ; ntitel: pathstr);
  54.                  PROCEDURE zeigen (aktiv : boolean); virtual;
  55.                  FUNCTION aktion : word;virtual;
  56.                  PROCEDURE sichern (var t : text); virtual;
  57.                  PROCEDURE laden (var t : text); virtual;
  58.                end;
  59.  
  60.   stringobj = object (optionobj)
  61.                  str : pathstr;
  62.                  laenge : byte;
  63.                  CONSTRUCTOR setzen (nx,ny,nlaenge : byte ; nstr : pathstr ; ntitel : pathstr);
  64.                  PROCEDURE zeigen (aktiv : boolean); virtual;
  65.                  FUNCTION aktion : word;virtual;
  66.                  PROCEDURE sichern (var t : text); virtual;
  67.                  PROCEDURE laden (var t : text); virtual;
  68.                end;
  69.  
  70.   optobjarray = array [1..lastopt] of ^optionobj;
  71.  
  72. VAR
  73.   dietoptionen : optobjarray;
  74.   decompschalter,
  75.   recompschalter,
  76.   newcompschalter,
  77.   manucompschalter,
  78.   infoschalter,
  79.   osizeschalter : schalterobj;
  80.   tempdirstr : stringobj;
  81.   aktopt,
  82.   i : byte;
  83.   code : word;
  84.  
  85.   origexit : pointer;
  86.   atextattr : byte;
  87.  
  88.  
  89. PROCEDURE DIET_aufrufen (var r : registers);
  90. Begin
  91.   r.ah := $37;
  92.   r.bx := $899D;
  93.   intr ($21,r);
  94. End;
  95.  
  96.  
  97. FUNCTION DIETver : extstr;
  98. VAR
  99.   r : registers;
  100.   help : extstr;
  101. Begin
  102.   with r do begin
  103.     al := $D0;
  104.     DIET_aufrufen (r);
  105.     if (ax <> 0) or (cx <> $899D) then DIETver := ''
  106.      else begin
  107.       help := '1.  ';
  108.       help[3] := char(dh-49);
  109.       help[4] := char(dl-32);
  110.       DIETver := help;
  111.     end;
  112.   end;
  113. End;
  114.  
  115.  
  116. FUNCTION TSRDIET_aktiv : boolean;
  117. VAR
  118.   r : registers;
  119. Begin
  120.   with r do begin
  121.     al := $D2;
  122.     DIET_aufrufen (r);
  123.     TSRDIET_aktiv := (dl = 0);
  124.   end;
  125. End;
  126.  
  127.  
  128. PROCEDURE TSRDIET_aktivieren (aktiv : boolean);
  129. VAR
  130.   r : registers;
  131. Begin
  132.   with r do begin
  133.     al := $D3;
  134.     dl := byte(aktiv) xor 1;
  135.     dh := 0;
  136.     DIET_aufrufen (r);
  137.   end;
  138. End;
  139.  
  140.  
  141. FUNCTION TSRDIET_Optionen : word;
  142. VAR
  143.   r : registers;
  144.   help : extstr;
  145. Begin
  146.   with r do begin
  147.     al := $D4;
  148.     DIET_aufrufen (r);
  149.     TSRDIET_Optionen := dx;
  150.   end;
  151. End;
  152.  
  153.  
  154. PROCEDURE TSRDIET_konfigurieren (optionen : word);
  155. VAR
  156.   r : registers;
  157. Begin
  158.   with r do begin
  159.     al := $D5;
  160.     dx := optionen;
  161.     DIET_aufrufen (r);
  162.   end;
  163. End;
  164.  
  165.  
  166. FUNCTION Tempdir : dirstr;
  167. VAR
  168.   r : registers;
  169.   help : char;
  170.   pstr : ^dirstr;
  171. Begin
  172.   with r do begin
  173.     al := $D6;
  174.     DIET_aufrufen (r);
  175.     pstr := ptr(ds-1,dx+15);
  176.     help := pstr^[0];
  177.     pstr^[0] := #255;
  178.     tempdir := copy(pstr^,1,pos(#0,pstr^)-1);
  179.     pstr^[0] := help;
  180.   end;
  181. End;
  182.  
  183.  
  184. PROCEDURE TempDir_setzen (tempdir : dirstr);
  185. VAR
  186.   r : registers;
  187. Begin
  188.   with r do begin
  189.     al := $D7;
  190.     tempdir := tempdir+#0;
  191.     ds := seg (tempdir[1]);
  192.     dx := ofs (tempdir[1]);
  193.     DIET_aufrufen (r);
  194.   end;
  195. End;
  196.  
  197.  
  198. FUNCTION keycode (caps : boolean) : word;
  199. VAR code : byte;
  200. Begin
  201.   if caps then code := ord (upcase (readkey))
  202.           else code := ord (readkey);
  203.   if code = 0 then keycode := 1000 + ord (readkey)
  204.               else keycode := code;
  205. End;
  206.  
  207.  
  208. FUNCTION optcode (caps : boolean) : word;
  209. VAR code : word;
  210. Begin
  211.   code := keycode (caps);
  212.        if code = up   then code := ShTab
  213.   else if code = down then code := Tab;
  214.   optcode := code;
  215. End;
  216.  
  217.  
  218. CONSTRUCTOR optionobj.setzen (nx,ny : byte ; ntitel : pathstr);
  219. Begin
  220.   if nx <> 0 then x := nx;
  221.   if ny <> 0 then y := ny;
  222.   if ntitel <> ' ' then titel := ntitel;
  223. End;
  224.  
  225.  
  226. PROCEDURE optionobj.zeigen (aktiv : boolean);
  227. Begin
  228. End;
  229.  
  230.  
  231. FUNCTION optionobj.aktion : word;
  232. Begin
  233.   aktion := 0;
  234. End;
  235.  
  236.  
  237. PROCEDURE optionobj.sichern (var t : text);
  238. Begin
  239. End;
  240.  
  241.  
  242. PROCEDURE optionobj.laden (var t : text);
  243. Begin
  244. End;
  245.  
  246.  
  247. CONSTRUCTOR schalterobj.setzen (nx,ny : byte ; nstat : boolean ; ntitel : pathstr);
  248. Begin
  249.   optionobj.setzen (nx,ny,ntitel);
  250.   status := nstat;
  251. End;
  252.  
  253.  
  254. PROCEDURE schalterobj.zeigen (aktiv : boolean);
  255. Begin
  256.   if aktiv then textattr := invcol
  257.            else textattr := normcol;
  258.   gotoxy (x,y);
  259.   write ('[');
  260.   if status then write ('X] ')
  261.             else write (' ] ');
  262.   write (titel);
  263. End;
  264.  
  265.  
  266. FUNCTION schalterobj.aktion : word;
  267. VAR
  268.   code : word;
  269.   ende : boolean;
  270. Begin
  271.   zeigen (true);
  272.   ende := false;
  273.   repeat
  274.     gotoxy (x+1,y);
  275.     code := optcode (false);
  276.     case code of
  277.       ret,32 : begin
  278.         code := ret;
  279.         setzen (0,0,not status,' ');
  280.         zeigen (true);
  281.         ende := true;
  282.       end;
  283.      else
  284.       ende := true;
  285.     end;
  286.   until ende;
  287.   aktion := code;
  288.   zeigen (false);
  289. End;
  290.  
  291.  
  292. PROCEDURE schalterobj.sichern (var t : text);
  293. Begin
  294.   writeln (t,status);
  295. End;
  296.  
  297.  
  298. PROCEDURE schalterobj.laden (var t : text);
  299. VAR
  300.   help : extstr;
  301. Begin
  302.   readln (t,help);
  303.   status := (help = 'TRUE');
  304. End;
  305.  
  306.  
  307. CONSTRUCTOR stringobj.setzen (nx,ny,nlaenge : byte ; nstr : pathstr ; ntitel : pathstr);
  308. Begin
  309.   optionobj.setzen (nx,ny,ntitel);
  310.   if nlaenge <> 0 then laenge := nlaenge;
  311.   if nstr[0] > char(laenge) then nstr[0] := char(laenge);
  312.   if nstr <> ' ' then str := nstr;
  313. End;
  314.  
  315.  
  316. PROCEDURE stringobj.zeigen (aktiv : boolean);
  317. Begin
  318.   if aktiv then textattr := invcol
  319.            else textattr := normcol;
  320.   gotoxy (x,y);
  321.   write (titel,': ',str,'':(laenge-length(str)));
  322. End;
  323.  
  324.  
  325. FUNCTION stringobj.aktion : word;
  326. VAR
  327.   ende : boolean;
  328.   code : word;
  329.   str_x : byte;
  330. Begin
  331.   zeigen (true);
  332.   ende := false;
  333.   str_x := x+length(titel+': ');
  334.   repeat
  335.     gotoxy (str_x,y);
  336.     write (str,'':laenge-length(str));
  337.     gotoxy (str_x+length(str),y);
  338.     code := optcode (true);
  339.     case code of
  340.       32..255 : if length(str) < laenge then str := str + chr(code);
  341.       Home,CtrlY : str := '';
  342.       BS : delete (str,length(str),1);
  343.      else
  344.       ende := true;
  345.     end;
  346.   until ende;
  347.   aktion := code;
  348.   zeigen (false);
  349. End;
  350.  
  351.  
  352. PROCEDURE stringobj.sichern (var t : text);
  353. Begin
  354.   writeln (t,str);
  355. End;
  356.  
  357.  
  358. PROCEDURE stringobj.laden (var t : text);
  359. Begin
  360.   readln (t,str);
  361. End;
  362.  
  363.  
  364. PROCEDURE Box_zeichnen;
  365. VAR
  366.   y : byte;
  367. PROCEDURE Zeile_zeichnen (s : pathstr);
  368. Begin
  369.   gotoxy (box_x,y);
  370.   write (s);
  371.   inc (y);
  372. End;
  373.  
  374. Begin
  375.   textattr := invcol;
  376.   clrscr;
  377.   textattr := normcol;
  378.   y := box_y;
  379.   Zeile_zeichnen ('╔══════════════════════════════════════════════════════════════════════╗');        
  380.   Zeile_zeichnen ('║                                                                      ║');        
  381.   Zeile_zeichnen ('╟──────────────────────────────────────────────────────┬───────────────╢');        
  382.   Zeile_zeichnen ('║                                                      │ F2 : Sichern  ║');        
  383.   Zeile_zeichnen ('║                                                      │ F3 : Laden    ║');        
  384.   Zeile_zeichnen ('║                                                      │ Esc: Ende     ║');        
  385.   Zeile_zeichnen ('║                                                      └───────────────╢');        
  386.   Zeile_zeichnen ('║                                                                      ║');        
  387.   Zeile_zeichnen ('║                                                                      ║');        
  388.   Zeile_zeichnen ('║                                                                      ║');        
  389.   Zeile_zeichnen ('║                                                                      ║');
  390.   Zeile_zeichnen ('║                                                                      ║');
  391.   Zeile_zeichnen ('╟──────────────────────────────────────────────────────────────────────╢');        
  392.   Zeile_zeichnen ('║ DIET-Control 1.0 (c) 1992 Axel Orth                                  ║');        
  393.   Zeile_zeichnen ('╚══════════════════════════════════════════════════════════════════════╝');        
  394.                                                                                                       
  395.   gotoxy (box_x+25,box_y+1);                                                                          
  396.   write ('DIET ',dietver,' resident');                                                                
  397. End;                                                                                                  
  398.                                                                                                       
  399.                                                                                                       
  400. FUNCTION bit_gesetzt (w : word ; bit : byte) : boolean;
  401. Begin
  402.   bit_gesetzt := w and bit <> 0;
  403. End;
  404.  
  405.  
  406. PROCEDURE Schalter_initialisieren;
  407. CONST
  408.   opt_x = 2;
  409.   opt_y = 2;
  410. VAR
  411.   optionen : word;
  412. Begin
  413.   dietoptionen[1] := @decompschalter;
  414.   dietoptionen[2] := @recompschalter;
  415.   dietoptionen[3] := @newcompschalter;
  416.   dietoptionen[4] := @manucompschalter;
  417.   dietoptionen[5] := @infoschalter;
  418.   dietoptionen[6] := @osizeschalter;
  419.   dietoptionen[7] := @tempdirstr;
  420.   optionen := TSRDIET_Optionen;
  421.   decompschalter.setzen (box_x+opt_x,box_y+opt_y+1,TSRDIET_aktiv,'Komprimierte Dateien entkomprimieren');
  422.   optionen := TSRDIET_Optionen;
  423.   recompschalter.setzen (box_x+opt_x,box_y+opt_y+3,bit_gesetzt (optionen,recomp),'Entkomprimierte Dateien rück-komprimieren');
  424.   newcompschalter.setzen (box_x+opt_x,box_y+opt_y+4,bit_gesetzt (optionen,newcomp),'Neu erzeugte Dateien komprimieren');
  425.   manucompschalter.setzen (box_x+opt_x,box_y+opt_y+5,bit_gesetzt (optionen,manucomp),
  426.                            'Komprimierung manuell starten ("diet -$")');
  427.   infoschalter.setzen (box_x+opt_x,box_y+opt_y+6,bit_gesetzt (optionen,info),'Komprimierungsmeldungen nicht zeigen');
  428.   osizeschalter.setzen (box_x+opt_x,box_y+opt_y+7,bit_gesetzt (optionen,origsize),'Originalgröße zurückmelden');
  429.   tempdirstr.setzen (box_x+opt_x,box_y+opt_y+9,35,tempdir,'Verzeichnis für Temporärdateien');
  430. End;
  431.  
  432.  
  433. PROCEDURE Optionen_uebertragen;
  434.  
  435. FUNCTION bitwert (sch : schalterobj; by : byte) : byte;
  436. Begin
  437.   bitwert := byte(sch.status)*by;
  438. End;
  439.  
  440. Begin
  441.   TSRDIET_aktivieren (decompschalter.status);
  442.   TSRDIET_konfigurieren (bitwert(recompschalter,recomp)
  443.                         +bitwert(newcompschalter,newcomp)
  444.                         +bitwert(manucompschalter,manucomp)
  445.                         +bitwert(infoschalter,info)
  446.                         +bitwert(osizeschalter,origsize));
  447.   with tempdirstr do begin
  448.     if (str <> '') and (str[length(str)] <> '\') then begin
  449.       setzen (0,0,0,str+'\',' ');
  450.       zeigen (false);
  451.     end;
  452.     tempdir_setzen (str);
  453.   end;
  454. End;
  455.  
  456.  
  457. FUNCTION cfgpathname : pathstr;
  458. VAR
  459.   pfad : dirstr;
  460.   help : namestr;
  461. Begin
  462.   fsplit (paramstr(0),pfad,help,help);
  463.   cfgpathname := pfad+'DIETCTRL.CFG';
  464. End;
  465.  
  466.  
  467. PROCEDURE Optionen_sichern;
  468. VAR
  469.   i : byte;
  470.   t : text;
  471. Begin
  472.   assign (t,cfgpathname);
  473.   rewrite (t);
  474.   for i := 1 to lastopt do dietoptionen[i]^.sichern (t);
  475.   close (t);
  476. End;
  477.  
  478.  
  479. PROCEDURE Optionen_laden;
  480. VAR
  481.   i : byte;
  482.   t : text;
  483. Begin
  484.   assign (t,cfgpathname);
  485.   reset (t);
  486.   for i := 1 to lastopt do with dietoptionen[i]^ do begin
  487.     laden (t);
  488.     zeigen (false);
  489.   end;
  490.   Optionen_uebertragen;
  491.   close (t);
  492. End;
  493.  
  494.  
  495. PROCEDURE dcexit;far;
  496. Begin
  497.   exitproc := origexit;
  498.   textattr := atextattr;
  499.   clrscr;
  500. End;
  501.  
  502.  
  503. BEGIN
  504.  
  505.   if dietver <> '' then begin
  506.     atextattr := textattr;
  507.     origexit := exitproc;
  508.     exitproc := @dcexit;
  509.     Box_zeichnen;
  510.     Schalter_initialisieren;
  511.     for i := 1 to lastopt do dietoptionen[i]^.zeigen(false);
  512.     aktopt := 1;
  513.     repeat
  514.       code := dietoptionen[aktopt]^.aktion;
  515.       Optionen_uebertragen;
  516.       case code of
  517.         tab : if aktopt < lastopt then inc (aktopt)
  518.                                   else aktopt := 1;
  519.         shtab : if aktopt > 1 then dec (aktopt)
  520.                               else aktopt := lastopt;
  521.         F2 : Optionen_sichern;
  522.         F3 : Optionen_laden;
  523.       end;
  524.     until code = esc;
  525.    end
  526.   else writeln ('DIET ist nicht resident installiert; starten Sie dazu "diet -z".');
  527.  
  528. END.
  529.