home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / sedio.inc < prev    next >
Encoding:
Text File  |  1986-05-22  |  1.4 KB  |  60 lines
  1. { disk input/output routines for sed.inc }
  2.  
  3. procedure intext(filename:fnametype; var textbuf:texttype);
  4. var i:integer; infile:text;
  5. begin
  6.   i:=1;
  7.   assign(infile,filename); {$I-} reset(infile); {$I+}
  8.   if ioresult<>0 then
  9.     begin  writeln('*** new file ***'); delay(500) end
  10.   else
  11.     while not eof(infile) and (i<maxtext) do
  12.       begin read(infile,textbuf[i]); i:=i+1 end;
  13.   close(infile); textbuf[i]:=#$1A
  14. end;
  15.  
  16. procedure outtext(filename:fnametype; var textbuf:texttype);
  17. var i:integer; infile:text;
  18. begin
  19.   if filename<>'' then begin
  20.     i:=1;
  21.     assign(infile,filename); rewrite(infile);
  22.     while textbuf[i]<>#$1A do
  23.       begin write(infile,textbuf[i]); i:=i+1 end;
  24.     close(infile)
  25.   end
  26. end;
  27.  
  28. procedure ls(ext:exttype);
  29. const num=5;
  30.       dev=#0;
  31. var   dmabuf :array [1..128] of char;
  32.       fcb    :string[36];
  33.       n,count:integer;
  34.  
  35. procedure putdir;
  36. var i:integer; s:exttype;
  37. begin
  38.   n:=n shl 5;
  39.   s:=''; for i:=10 to 12 do s:=s+dmabuf[i+n];
  40.   if (s=ext) or (ext='???') then
  41.     begin
  42.       if (count mod num)<>0 then write(' : ');
  43.       for i:=2 to 9 do write(dmabuf[i+n]);
  44.       write('.',s); count:=count+1;
  45.       if (count mod num)=0 then writeln
  46.     end
  47. end;
  48.  
  49. begin
  50.   count:=0;
  51.   bdos(26,addr(dmabuf));
  52.   fcb:=dev+'???????????'+#0;
  53.   n:=bdos(17,addr(fcb[1]));
  54.   if n<>255 then
  55.     repeat
  56.       putdir; n:=bdos(18,0)
  57.     until n=255;
  58.   if (count mod num)<>0 then writeln
  59. end;
  60.