Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBII/ECO_INFO.PAS

Pascal/Delphi Source File | 1993-03-02 | 9.5 KB | 299 lines

{$F+}
(*

         ┌────────────────[ File Information Report ]────────────────┐
         │                                                           │
         │   Sourcefile for The Fast Commander, V3.51 and higher.    │
         │   All material is protected and licensed.                 │
         │   (C) Copyright 1992 by EUROCON PANATIONAL CORPORATION.   │
         │   Written exclusively by Floor Naaijkens for              │
         │   UltiHouse Software / The ECO Group All Rights Reserved. │
         │   See various documentory files for further information   │
         │   on how to handle these files.                           │
         │                                                           │
         │   Filename:      ECO_INFO.PAS                             │
         │   Version:       3.51                                     │
         │   Last change:   02-05-91  14:14                          │
         │   Dependencies:  FIL·, EXT·, MEM·, SCN·, DOS·, CRT·,      │
         │                  ····, ····, ····, ····, ····, ····.      │
         │                                                           │
         └───────────────────────────────────────────────────────────┘

*)


{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
unit eco_info;
interface uses
  dos, eco_lib

  ;


const
  riba : char = '╢';
  leba : char = '╟';
  veba : char = '║';
  bt   : byte =   0;


var
  mfree: longint;

const
  floppies: boolean = false;
  startdrv: byte    =     3;


  function __drvstr(drv,x1,x2: byte; f: boolean): string;
  procedure __updatinf(
    header: string;
    var x1, y1, x2, y2: byte; var fullscn: boolean;
    f1, b1, h, f2, b2, scr_f, scr_b, numdrives: byte; var retkey: word;
    show: boolean
  );






implementation






  function __drvstr(drv,x1,x2: byte; f: boolean): string; { drv 1 = a: }
  var
    error       :    word;
    dfr, dsize,
    perc        : longint;
    percstr     :  string;

  begin
    if __isdrvfil(chr(drv+64), error) then begin
      dfr := diskfree(drv); dsize := disksize(drv);
      perc := trunc((dfr / dsize) * 100);
      percstr := __juststr(__num(perc), ' ', 2, _right_just_str) + '%';

      if f then __drvstr := copy(chr(drv+64) + ' ' +
        __juststr(__pntstr(dsize), ' ', 11, _right_just_str) + ' ' +
        __juststr(__pntstr(dfr), ' ', 11, _right_just_str) + '  ' +
        percstr, 1, x2-x1-1) else if length(__num(dsize)) <= 7 then
        __drvstr := copy(chr(drv+64) + ' ' +
          __juststr(__pntstr(dsize div 1024)+ 'K', ' ', 7, _right_just_str) +' '+
          __juststr(__pntstr(dfr div 1024)+ 'K', ' ', 7, _right_just_str) + ' ' +
          percstr, 1, x2-x1-1
        ) else __drvstr := copy(chr(drv+64) + ' ' +
          __juststr(__pntstr(dsize div 1048576)+'M',' ',7,_right_just_str) +' '+
          __juststr(__pntstr(dfr div 1048576)+ 'M',' ',7,_right_just_str)+' ' +
          percstr, 1, x2-x1-1
        );
    end else __drvstr := 'Drive ' + chr(drv+64) + ' not available'
  end;



  procedure __updatinf;
  var
    msize,
    doslong,
    statusbits,
    mshellfree     :    longint;
    statusflags    : _keystatus;
    key,
    dosmem, extmem :       word;
    st             :     string;
    fullscnlen,
    i,j,hh         :       byte;
    ff             :       text;
    progsize       :  _progsize;
    sts            :     string;
    retkeypressed  :    boolean;


    procedure infoscn(cur: boolean);
    var i: byte;

      function __dirs: string;
      begin
        __dirs := __lo(
          __xlatestr(
            __packfil(
              __normfil(
                _doscurpath
              ),
              x2-x1-3
            ),
            '\', '/'
          )
        )
      end;

    begin
      __clrscn(x1,y1,x2,y2,f1,b1,' ');  __boxscn(x1, y1, x2, y2, bt, f1, b1);
      if cur then __betwscn(x1, x2, y1+00, b1, f1, ' Info ') else
        __betwscn(x1, x2, y1+00, f1, b1, ' Info ');
      __betwscn(x1, x2, y1+01, h,  b1, header);
      __betwscn(x1, x2, y1+02, h,  b1, 'All Rights Reserved');
      __betwscn(x1, x2, y1+03, h,  b1, '(C) MCMXCIII by UltiHouse');
      __betwscn(x1, x2, y1+04, f1, b1, leba + __rep(x2-x1-1, '─') + riba);
      __betwscn(x1, x2, y1+07, f1, b1, leba + __rep(x2-x1-1, '─') + riba);
      __betwscn(x1, x2, y1+07, h,  b1, '[Drives (Size/Free)]');
      __betwscn(x1, x2, y1+04, h,  b1, '[' + __dirs + ']');

      if __existfil('dirinfo') then hh := (y2-y1-4) div 2 -1 else begin
        hh := y2-y1-4-1;
        __betwscn(x1,x2,y2-1,h,b1,'No `dirinfo'' file')
      end;
      mfree := maxavail; mshellfree := __sizemem(progsize);
      mshellfree := mshellfree * 16 - 4000;

      __totalmem(dosmem, extmem); doslong := longint(dosmem);
      msize := doslong * 1024;

      if fullscn then
        __betwscn(x1+1,x2-1,y1+05, f1, b1, 'Mem: ' + __pntstr(msize) +
          ', Free: '+ __pntstr(mfree)) else
        __betwscn(x1+1,x2-1,y1+05, f1, b1, 'Mem: ' + __pntstr(msize div 1024) +
          'K, Free: '+ __pntstr(mfree div 1024) + 'K');

      if fullscn then
        __betwscn(x1+1,x2-1,y1+06, f1, b1, 'Shell: ' + __pntstr(mshellfree)) else
        __betwscn(x1+1,x2-1,y1+06, f1, b1, 'Shell: ' +
          __pntstr(mshellfree div 1024) + 'K');

      if hh <> (y2-y1-4-1) then begin
        __betwscn(x1, x2, y1+04+hh, f1, b1, leba + __rep(x2-x1-1, '─') + riba);
        __betwscn(x1, x2, y1+04+hh, h,  b1, '[Directory]');
        assign(ff,'dirinfo'); reset(ff); i := 1;
        while (i<=hh+1) and not eof(ff) do begin
          readln(ff,st); __write(x1+1, y1+04+hh+i, f1, b1,
            ' ' + copy(st,1,x2-x1-1-2) + ' ');
          inc(i);
        end; close(ff);
      end;


       { dec(hh,2); if hh > numdrives then hh := numdrives;}
      j := 1; hh := __min(numdrives, hh-2);
      if floppies then startdrv := 1 else startdrv := 3;
      for i := startdrv to hh do begin
        sts := __drvstr(i,x1,x2,fullscn);
       if copy(sts,1 ,4)<>'Driv' then begin
          inc(j); __write(x1+2, y1+04+2+j,f1,b1, sts)
        end;
      end;
    end; { infoscn }



  begin
    retkeypressed := false;
    infoscn(false);

    if show then exit;
    __betwscn(x1, x2, y1+00, b1, f1, ' Info ');
    __attrib(x1+1, y2-1, x2-1, y2-1, scr_f, scr_b);

    fullscnlen := x2-x1-1; key := retkey;
    repeat
      if retkey=$0000 then key := __retkey else begin
        key := retkey; retkey := $0000
      end;
      statusbits := __statkey(statusflags);

      case key of

        _up, _padup: begin
          if statusflags._scrollstate then begin
            if statusflags._capsstate then begin
              if (y1>1) then begin
                __copyscn(x1,y1,x2,y2,x1,y1-1);
                {__partscn(scn4, x1, y2, x2, y2, true);}
                dec(y1); dec(y2);
              end{ else smallbeep;}
            end else begin
              if y2 > y1+12 then begin
                __copyscn(x1, y2-2, x2, y2, x1, y2-3);
                __write(x1, y2+0, f1, b1, __rep(x2-x1+1, ' '));
                dec(y2);
                {__partscn(scn4,x1,y2+1,x2,_currows-2, true);}
                infoscn(true)
              end {else smallbeep;}
            end;
          end; { status }
        end;

        _down, _paddown: begin
          if statusflags._scrollstate then begin
            if statusflags._capsstate then begin
              if (y2<_currows-2) then begin
                __copyscn(x1,y1,x2,y2,x1,y1+1);
                {__partscn(scn4, x1, y1, x2, y1, true);}
                inc(y1); inc(y2);
              end {else smallbeep;}
            end else begin
              if y2 < _currows - 2 then begin
                __copyscn(x1, y2-2, x2, y2, x1, y2-1);
                __write(x1, y2-2, f1, b1, veba);
                __write(x2, y2-2, f1, b1, veba);
                inc(y2);
                infoscn(true)
              end {else smallbeep;}
            end;
          end; { status }
        end;

        _left, _padleft: begin
          if statusflags._scrollstate then begin
            if statusflags._capsstate then begin
              if (x1>1) then begin
                __copyscn(x1,y1,x2,y2,x1-1,y1);
                {__partscn(scn4, x2, y1, x2, y2, true);}
                dec(x1); dec(x2);
              end {else smallbeep;}
            end else begin
              if fullscn then begin
                {__partscn(scn4,x2-13,y1,x2,y2,true);}
                fullscn := false; {smallbeep;}
                dec(x2, 13); fullscnlen := x2-x1-1;
                infoscn(true)
              end;
            end;
          end;
        end;

        _right, _padright: begin
          if statusflags._scrollstate then begin
            if statusflags._capsstate then begin
              if (x2<_curcolumns) then begin
                __copyscn(x1,y1,x2,y2,x1+1,y1);
                {__partscn(scn4, x1, y1, x1, y2, true);}
                inc(x1); inc(x2);
              end {else smallbeep;}
            end else begin
              if not(fullscn) and (x2<80-13) then begin
                fullscn := true;{ smallbeep;} inc(x2, 13); fullscnlen := 23;
                infoscn(true)
              end;
            end;
          end;
        end;

        else if (key<>_tab) then retkeypressed := true;

      end; { case }

    until retkeypressed;
    retkey := key; __betwscn(x1, x2, y1+00, f1, b1, ' Info ');

  end; { __updatinf }



end. { unit }