home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_DSQV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-08  |  3.5 KB  |  129 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$F+,O+,I-}
  23.  
  24. unit ECO_dsqv;
  25.  
  26. interface
  27.  
  28. uses dos;
  29.  
  30. type   str2   = string[2];
  31.  
  32. var desqresult  : byte;
  33.   desqregs    : registers;
  34.   desqversion : word;
  35.  
  36. function desqviewpresent:boolean;
  37. procedure starttask(x: str2);
  38. procedure giveupcpu;
  39. procedure giveupidle;
  40. procedure exittask;
  41.  
  42. implementation
  43.  
  44.   function desqviewpresent;
  45.   begin
  46.     desqresult:=0;
  47.     with desqregs do begin
  48.       ax:=$2b01;
  49.       bx:=0;
  50.       cx:=$4445;
  51.       dx:=$5351;
  52.       msdos(desqregs);
  53.       if bx=2 then bx:=swap(bx);
  54.       if bx=0 then desqviewpresent:=false else desqviewpresent:=true;
  55.       desqversion:=bx;
  56.     end;
  57.   end;
  58.  
  59.   procedure starttask;
  60.   var fn: pathstr;
  61.     pif : array[0..415] of byte;
  62.     f   : file;
  63.   begin
  64.     desqresult:=0;
  65.     if (desqviewpresent) and (desqversion>=$200) then begin
  66.       fn:=fsearch(x+'-PIF.DVP',getenv('PATH'));
  67.       if fn='' then begin
  68.         desqresult:=1;
  69.         exit;
  70.       end;
  71.       assign(f,fn);
  72.       reset(f,1);
  73.       if ioresult<>0 then begin
  74.         desqresult:=2;
  75.         exit;
  76.       end;
  77.       if filesize(f)<>416 then begin
  78.         desqresult:=3;
  79.         close(f);
  80.         exit;
  81.       end;
  82.       blockread(f,pif,416);
  83.       if ioresult<>0 then begin
  84.         desqresult:=4;
  85.         close(f);
  86.         exit;
  87.       end;
  88.       close(f);
  89.       with desqregs do begin
  90.         ds:=seg(pif);
  91.         es:=seg(pif);
  92.         di:=ofs(pif);
  93.         bx:=$1a0;
  94.         ax:=$102c;
  95.         intr($15,desqregs);
  96.         if bx=0 then begin
  97.           desqresult:=6;
  98.           exit;
  99.         end;
  100.       end;
  101.     end else
  102.       desqresult:=5;
  103.   end;
  104.  
  105.   procedure giveupcpu;
  106.   begin
  107.     with desqregs do begin
  108.       ax:=$1000;
  109.       intr($15,desqregs);
  110.     end;
  111.   end;
  112.  
  113.   procedure giveupidle;
  114.   begin
  115.     with desqregs do begin
  116.       ah:=1;
  117.       intr($16,desqregs);
  118.       if (flags and fzero) <> 0 then giveupcpu;
  119.     end;
  120.   end;
  121.  
  122.   procedure exittask;
  123.   begin
  124.     if desqviewpresent then intr($19,desqregs);
  125.     desqresult:=1;
  126.   end;
  127.  
  128. end.
  129.