home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PRMASTR3.ZIP / SPOOLER.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-18  |  8.4 KB  |  366 lines
  1. {$F+}
  2. Unit Spooler;
  3.  
  4. { This is an enhanced version of a unit created by               }
  5. { Brian Ebarb Power Software Company - Houston, TX (713)781-9784 }
  6. { The modifications allow the user access to the spooler Q list. }
  7. { The changes were made by John Gatewood Ham. (J.HAM3 on GEnie)  }
  8.  
  9. InterFace
  10.  
  11. Uses Dos,Search;
  12.  
  13. Type
  14.       Qentry   = array[1..64] of byte;
  15.       Qtype    = array[1..32] of Qentry;
  16.       Qpointer = ^Qtype;
  17.       slistptr    = ^slist;
  18.       slist       = record
  19.                       next : slistptr;
  20.                       fname: string;
  21.                     end;
  22. var
  23.    numsfilesinlist:integer;
  24.    sfilelist,
  25.    endofsfilelist:slistptr;
  26.    some_in_q:boolean;
  27.  
  28. function print_installed:boolean;
  29. function queue_empty:boolean;
  30. function fileinqueue(searchname:string):boolean;
  31. function filesetinqueue(searchname:string):boolean;
  32. function spool_a_file(Filestring:string):boolean;
  33. function unspool_a_file(Filestring:string):boolean;
  34. function unspool_all_files:boolean;
  35. procedure deletesfilelist;
  36. procedure getspoolfilelist(fileset:string);
  37.  
  38. Implementation
  39.  
  40. var print_not_installed:boolean;   {this variable is local to this unit}
  41.  
  42. function queue_empty:boolean;
  43. var
  44.    tq:^byte;
  45.    regs:registers;
  46.  
  47. begin      { Hold queue, Get Status,             }
  48.            { Get pointer to names, Release queue }
  49.   Regs.AH:=$1;
  50.   Regs.AL:=$4;
  51.   Intr($2F, Regs);
  52. { if error we'll say queu not empty }
  53.   if Regs.Flags AND FCarry = FCarry then
  54.     {error is in Regs.AX }
  55.     queue_empty:=false
  56.   else
  57.     begin
  58.       { mov seg(TheQ),ds; }
  59.       { mov ofs(TheQ),si; }
  60.       { put the contents of DS:SI into TQ}
  61.       TQ:=ptr(regs.ds,regs.si);
  62.  
  63.       if tq^ = $00 then
  64.         queue_empty := true
  65.       else
  66.         queue_empty := false;
  67.     end;
  68.  
  69.   { restart the queue }
  70.     Regs.AH := $1;
  71.     Regs.AL := $5;
  72.     Intr($2F, Regs);
  73. end;
  74.  
  75. {Is a file in print queue?}
  76. function fileinqueue(searchname:string):boolean;
  77. var testname:pathstr;
  78.     i,k:integer;
  79.     foundit:boolean;
  80.     regs:registers;
  81.     tq:qpointer;
  82.  
  83. begin
  84.  
  85.   Regs.AH:=$1;
  86.   Regs.AL:=$4;
  87.   Intr($2F, Regs);
  88.   TQ:=ptr(regs.ds,regs.si);
  89.   Regs.AH := $1;
  90.   Regs.AL := $5;
  91.   Intr($2F, Regs);
  92.  
  93.   i:=1;
  94.   foundit:=false;
  95.   while (tq^[i,1] <> $00) and
  96.         (i < 33) and
  97.         (not foundit) do
  98.     begin
  99.       k:=1;
  100.       testname:='';
  101.       while tq^[i,k] <> $00 do
  102.         begin
  103.           testname:=testname+chr(tq^[i,k]);
  104.           k:=k+1;
  105.         end;
  106.       if testname = searchname then
  107.          foundit:=true;
  108.       i:=i+1;
  109.     end;
  110.  
  111.   fileinqueue:=foundit;
  112. end;
  113.  
  114. function print_installed:boolean;
  115. var 
  116.     v1,v2:integer;
  117.     version:word;
  118.     regs:registers;
  119. begin
  120.   version:=dosversion;
  121.   v1:=lo(version);
  122.   v2:=hi(version);
  123.   if v1 < 3 then
  124.      begin
  125.        writeln('You have DOS ',v1,'.',v2,' and it has no PRINT.COM capability.');
  126.        print_installed:=false;
  127.        exit;
  128.      end;
  129.   Regs.AH := $1;
  130.   Regs.AL := $0;
  131.   Intr($2F, Regs);
  132.   if Regs.AL <> 255 then
  133.      print_installed:=false
  134.   else
  135.      print_installed:=true;
  136. end;
  137.  
  138. function valid_file_name(fname:string):boolean;
  139. var testfile:file;
  140.     holdresult:integer;
  141. begin
  142.    {make sure file really exists.... This dos function takes anything
  143.     and who knows what it will do with junk?}
  144.   assign(testfile,fname);
  145.   {$I-}
  146.   reset(testfile,1);
  147.   {$I+}
  148.   holdresult:=ioresult;
  149.   case holdresult of
  150.        0 : close(testfile); {don't forget to release that file handle!}
  151.                             {took me 3 hours to find this bug........ }
  152.        2 : writeln('File not found ---> ',fname);
  153.        3 : writeln('Path not found ---> ',fname);
  154. {      5 : writeln('Access denied  ---> ',fname);  that's ok - it's out there}
  155. { so we'll just let the program say no error on reset                        }
  156.        5 : holdresult := 0;
  157.        6 : writeln('Invalid handle ---> ',fname);
  158.        8 : writeln('Not enough ram ---> ',fname);
  159.       11 : writeln('Invalid format ---> ',fname);
  160.   else
  161.       writeln('Unknown error #',holdresult:3,' on open of ',fname);
  162.   end;
  163.   if holdresult = 0 then
  164.     valid_file_name := true
  165.   else
  166.     valid_file_name := false;
  167. end;
  168.  
  169. function spool_a_file(Filestring:string):boolean;
  170. var
  171.    Regs : Registers;
  172.    Fname : array[1..64] of byte;
  173.    TheFile : record
  174.                    Byt  : Byte;
  175.                    Loc  : array[1..2] of Word;
  176.              end;
  177.    i:integer;
  178. begin;
  179.   FileString := FileString+#0;
  180.   FillChar(Fname, 64, #0);
  181.   for i := 1 to Length(FileString) do
  182.     Fname[i] := ord(FileString[i]);
  183.   TheFile.Byt := 0;
  184.   TheFile.Loc[2] := Seg(Fname);
  185.   TheFile.Loc[1] := Ofs(Fname);
  186.  
  187.   if (not valid_file_name(filestring)) then
  188.     begin
  189.       spool_a_file:=false;
  190.       exit;
  191.     end;
  192.  
  193.   with Regs do
  194.         begin
  195.            AH:=$1;
  196.            AL:=$1;
  197.            DS:=Seg(TheFile);
  198.            DX:=Ofs(TheFile);
  199.         end;
  200.   Intr($2F, Regs);
  201.   if Regs.Flags AND FCarry = FCarry then
  202.      spool_a_file := false
  203.   else
  204.      spool_a_file := true;
  205. end;
  206.  
  207. function unspool_a_file(Filestring:string):boolean;
  208. var
  209.    Regs : Registers;
  210.    Fname : array[1..64] of byte;
  211.    i:integer;
  212. begin
  213.    FileString := FileString+#0;
  214.    FillChar(Fname, 64, #0);
  215.    for i:= 1 to Length(FileString) do
  216.        Fname[i] := ord(FileString[i]);
  217.  
  218.    if not valid_file_name(filestring) then
  219.       begin
  220.         unspool_a_file:=false;
  221.         exit;
  222.       end;
  223.    if queue_empty then
  224.       begin
  225.         unspool_a_file:=false;
  226.         exit;
  227.       end;
  228.    if not fileinqueue(copy(filestring,1,length(filestring)-1)) then
  229.       begin
  230.         unspool_a_file:=false;
  231.         exit;
  232.       end;
  233.  
  234.    with Regs do
  235.        begin
  236.          AH:=$1;
  237.          AL:=$2;
  238.          DS:=seg(fname);
  239.          DX:=ofs(fname);
  240.        end;
  241.    Intr($2F, Regs);
  242.    if Regs.Flags AND FCarry = FCarry then
  243.       unspool_a_file := false
  244.    else
  245.       unspool_a_file := true;
  246. end;
  247.  
  248. function unspool_all_files:boolean;
  249. var
  250.   Regs : Registers;
  251. begin
  252.   Regs.AH := $1;
  253.   Regs.AL := $3;
  254.   Intr($2F, Regs);
  255.   if Regs.Flags AND FCarry = FCarry then
  256.      unspool_all_files := false
  257.   else
  258.      unspool_all_files := true;
  259. end;
  260.  
  261. {delete the filelist}
  262. procedure deletesfilelist;
  263. var tnode:slistptr;
  264.     tnode2:slistptr;
  265. begin
  266.   tnode:=sfilelist;
  267.   while tnode <> nil do
  268.     begin
  269.       tnode2:=tnode;
  270.       tnode:=tnode^.next;
  271.       dispose(tnode2);
  272.     end;
  273.   sfilelist:=nil;
  274.   endofsfilelist:=nil;
  275.   numsfilesinlist:=0;
  276. end;
  277.  
  278. {create a list of files on spooler from a fileset with wildcards}
  279. procedure getspoolfilelist(fileset:string);
  280. var
  281.   tnode:slistptr;
  282.   i,k:integer;
  283.   filename:string;
  284.   regs:registers;
  285.   queue:qpointer;
  286. begin
  287.   numsfilesinlist:=0;
  288.   sfilelist:=nil;                {start with no files}
  289.   endofsfilelist:=nil;
  290.  
  291.   {freeze queue and get pointer to queue}
  292.   Regs.AH:=$1;
  293.   Regs.AL:=$4;
  294.   Intr($2F, Regs);
  295.   if Regs.Flags AND FCarry = FCarry then
  296.      exit
  297.   else
  298.      queue:=ptr(regs.ds,regs.si);
  299.  
  300.   {put files from queue into qarray}
  301.   i:=1;
  302.   while (queue^[i,1] <> $00) and (i < 33) do   {load queue}
  303.     begin
  304.       k:=1;
  305.       filename:='';
  306.       while queue^[i,k] <> $00 do
  307.         begin
  308.           filename:=filename+chr(queue^[i,k]);
  309.           k:=k+1;
  310.         end;
  311.       new(tnode);
  312.       endofsfilelist^.next:=tnode;
  313.       with tnode^ do
  314.         begin
  315.           next:=nil;
  316.           fname:=filename;
  317.         end;
  318.       if sfilelist = nil then   {if start of list point filelist to it}
  319.          sfilelist:=tnode;
  320.       endofsfilelist:=tnode;
  321.       numsfilesinlist:=numsfilesinlist+1;
  322.       i:=i+1;
  323.     end;
  324.  
  325.   {unfreeze queue}
  326.   Regs.AH := $1;
  327.   Regs.AL := $5;
  328.   Intr($2F, Regs);
  329. {
  330.   if Regs.Flags AND FCarry = FCarry then
  331.      exit;
  332. }
  333. end;
  334.  
  335. function look4file(fname:string):byte;
  336. var res:boolean;
  337. begin
  338.   res:=fileinqueue(fexpand(fname));
  339.   if res then
  340.      begin
  341.        some_in_q:=true;
  342.        look4file:=$69;  {force error condition so search will end}
  343.      end
  344.   else
  345.      look4file:=0;
  346. end;
  347.  
  348. function filesetinqueue(searchname:string):boolean;
  349. var dummy:byte;
  350.  
  351. begin
  352.    some_in_q:=false;
  353.    searchname:=fexpand(searchname);
  354.    searchdirectory(searchname,
  355.                    look4file,
  356.                    anyfile-directory,
  357.                    false,
  358.                    false,
  359.                    dummy);
  360.    filesetinqueue:=some_in_q;
  361. end;
  362.  
  363. begin
  364.    print_not_installed:=(not print_installed);
  365. end.
  366.