home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / alt / sources / 2888 < prev    next >
Encoding:
Internet Message Format  |  1992-12-27  |  3.6 KB
  1. Xref: sparky alt.sources:2888 comp.lang.pascal:7694
  2. Path: sparky!uunet!munnari.oz.au!spool.mu.edu!yale.edu!yale!gumby!destroyer!cs.ubc.ca!unixg.ubc.ca!kakwa.ucs.ualberta.ca!ersys!alpha3!news
  3. From: russell@alpha3.ersys.edmonton.ab.ca (Russell Schulz)
  4. Newsgroups: alt.sources,comp.lang.pascal
  5. Subject: ms-dog turbo pascal device detection
  6. Message-ID: <921227.135811.0f0.rusnews.w164w@alpha3.ersys.edmonton.ab.ca>
  7. Date: Sun, 27 Dec 92 13:58:11 MST
  8. Followup-To: alt.sources.d,comp.lang.pascal
  9. Organization: Private System, Edmonton, AB, Canada
  10. X-Newsreader: rusnews v0.97
  11. Lines: 120
  12.  
  13. Archive-name: isdev.pas
  14. Submitted-by: russell@alpha3.ersys.edmonton.ab.ca
  15.  
  16. as ms-dog doesn't keep devices in the /dev tree, and there is no small amount
  17. of grief that can result from writing to a dynamically reserved filename (it
  18. can be reserved on your system, but not on the one next to you) I wrote this
  19. function which will return true iff use of the filename would be intercepted
  20. as an attempt to access a device instead of a file.
  21.  
  22. please don't repeat the comments that old ms-dog used to be able to restrict
  23. devices to \dev, and newer versions don't, unless it's something no one else
  24. has ever heard before... :-)
  25.  
  26.   isdev('con') should return true
  27.   isdev('c:/faq/aux.faq') should return true
  28.   isdev('..\emmxxxx0') could return true or false - thus this function
  29.  
  30. I'm using turbo pascal 4 on dr-dos 6, and it's working here.  please let
  31. me know if it fails on your system!  thanks.
  32.  
  33. followups redirected (barely).
  34.  
  35. function unslash(s: string): string;
  36.  
  37. var
  38.   i: integer;
  39.   result: string;
  40.  
  41. begin
  42.   result := s;
  43.   for i := 1 to length(result) do
  44.     if result[i]='/' then
  45.       result[i] := '\';
  46.   unslash := result;
  47. end;
  48.  
  49. function upper(s: string): string;
  50.  
  51. var
  52.   result: string;
  53.   i: integer;
  54.  
  55. begin
  56.   result := s;
  57.   for i := 1 to length(s) do
  58.     result[i] := upcase(result[i]);
  59.   upper := result;
  60. end;
  61.  
  62. function isdev(s: string): boolean;
  63.  
  64. var
  65.   offs: word;
  66.   segm: word;
  67.   oldsegm: word;
  68.   foundnul: boolean;
  69.   result: boolean;
  70.   basename: string;
  71.   i: integer;
  72.  
  73. begin
  74.   result := false;
  75.   segm := 0;
  76.   offs := $400;
  77.  
  78.   basename := upper(unslash(s));
  79.  
  80. {handle lpt1: case}
  81.   if copy(basename,length(basename),1)=':' then
  82.     basename := copy(basename,1,length(basename)-1);
  83.  
  84. {strip disk and path designators}
  85.   while pos(':',basename)<>0 do
  86.     basename := copy(basename,pos(':',basename)+1,255);
  87.   while pos('\',basename)<>0 do
  88.     basename := copy(basename,pos('\',basename)+1,255);
  89.  
  90. {strip anything after the first period}
  91.   if pos('.',basename)<>0 then
  92.     basename := copy(basename,1,pos('.',basename)-1);
  93.  
  94. {NUL is supposed to be the very last in the chain of installed drivers}
  95.   foundnul := false;
  96.   while (not foundnul) and (offs>0) do
  97.     begin
  98.       if (mem[segm:offs]=ord('N')) and (mem[segm:offs+1]=ord('U')) and
  99.        (mem[segm:offs+2]=ord('L')) and (mem[segm:offs+3]=ord(' ')) and
  100.        (mem[segm:offs+4]=ord(' ')) and (mem[segm:offs+5]=ord(' ')) and
  101.        (mem[segm:offs+6]=ord(' ')) and (mem[segm:offs+7]=ord(' ')) then
  102.         if memw[segm:offs-6]=$8004 then
  103.           foundnul := true;
  104.  
  105.       if not foundnul then
  106.         inc(offs);
  107.     end;
  108.  
  109.   if foundnul then
  110.     begin
  111.  
  112.       while length(basename)<8 do
  113.         basename := basename+' ';
  114.  
  115.       while not result and (meml[segm:offs-10]<>$ffffffff) do
  116.         begin
  117.  
  118.           result := true;
  119.           for i := 0 to 7 do
  120.             result := result and (chr(mem[segm:offs+i])=basename[1+i]);
  121.  
  122.           oldsegm := segm;
  123.           segm := memw[oldsegm:offs-8];
  124.           offs := memw[oldsegm:offs-10]+10;
  125.  
  126.         end;
  127.  
  128.     end;
  129.   isdev := result;
  130. end;
  131. -- 
  132. Russell Schulz  russell@alpha3.ersys.edmonton.ab.ca  ersys!rschulz  Shad 86c
  133.