DataMuseum.dk

top - metrics - download

    Length: 2432 (0x980)
    Types: TextFile
    Names: »REGN1.PAS«

└─⟦5c8344fa1⟧ Bits:30004223 REGN version 2.1 til ICL Comet
    └─⟦this⟧ »REGN1.PAS« 

TextFile

(* INCLUDE FILE REGN1.PAS SYSTEMAFHÆNGIGE *)

(* DEFINITION AF TASTER ELLER SPECIELLE TEGN *)
PROCEDURE TASTER;

 FUNCTION RAMDREV:boolean; (* ONLY COMET - TEST FOR POSSIBLE RAMDISK *)
 begin
  code $F3; (* DISABLE INTERRUPTS *)
  portÆ132Å:=123;
  RAMDREV:=(portÆ132Å=123);
  code $FB; (* ENABLE INTERRUPTS *) 
 end;

begin
 (* Determin if multiusersystem *)
 multi:=((memÆ$FFFAÅ<>70) and (memÆ$FFFAÅ<>87) and (memÆ$F7FFÅ<>128));
 
 default:=bdosb(25); (* Return current disk *)
 ovdrive(default+1);
 ramdisk:=RAMDREV;
end;

(*$I-*)

PROCEDURE RESETDISK;
begin
 bdos(13);              (* Reset Disk  *)
 bdos(14,default);      (* Select Disk *)
end;

PROCEDURE DISKDIR(drev:      char;      æ Drive on which to search          å
                                        æ @ = default drive                 å
                  filmaske:  str11;     æ filemask without "."              å
                  efternavn: boolean;   æ filename extension to be written? å
                  streng:    anystring);æ part of header                    å
                  
var
 linje:stringÆ79Å;
 fcb:arrayÆ1..36Å of byte;
 dma:stringÆ128Å;
 a,b,c,d:byte;
 
 FUNCTION STRIP(tegn:byte):char; (* Removes RO- and SYS-flags from filename *)
 begin
  if tegn>127 then tegn:=tegn-128;
  STRIP:=chr(tegn);
 end;
 
begin
 æ
   SETUP DMA
 å
 dma:='';
 for a:=1 to 8 do dma:=dma+'                ';
 bdos(26,addr(dma)+1);

 for a:=1 to 36 do fcbÆaÅ:=0;                   æ construction of FCB å
 c:=ord(drev);
 if c>96 then c:=c-32;
 drev:=chr(c);
 fcbÆ1Å:=c-64;
 for a:=2 to 12 do fcbÆaÅ:=ord(filmaskeÆa-1Å);
 
 a:=bdosb(17,addr(fcb));                        æ    SEARCH FIRST    å
 linje:=copy(tom,1,(68-len(streng)) div 2)+streng+' PÅ DREV '+drev+':'+tom;
 write(clrhom);
 writeln(rvson,linje,rvsoff);
 if a=255 then begin
  gotoxy(23,3);
  write(rvson,' Der er ingen ark på disketten. ',rvsoff);
 end; 
 while a<>255 do begin

  æ
    GET FILENAME and SEARCH NEXT
  å
  if ord(dmaÆa*32+10Å)>127 then write(rvson);
  for d:=1 to 8 do
   write(STRIP(ord(dmaÆa*32+1+dÅ)));
  if efternavn then begin
   write('.');
   for d:=9 to 11 do
    write(STRIP(ord(dmaÆa*32+1+dÅ)));
   write(rvsoff,'    ');
  end else
   write(rvsoff,'  ');
  a:=bdosb(18,addr(fcb));                       æ SEARCH NEXT å
 end; 
end;

PROCEDURE AFSLUT;
begin
 writeln(alloff);
end;«eof»