|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 3200 (0xc80) Types: TextFile Names: »REGN1.PAS«
└─⟦fff6648c2⟧ Bits:30004194/disk3.imd Data i Folkeskolen (Comet) └─⟦this⟧ »REGN1.PAS«
(* INCLUDE FILE REGN1.PAS SYSTEMAFHÆNGIGE *) (* DEFINITION AF TASTER *) PROCEDURE TASTER; begin end; (*$I-*) æ 16-bit version only PROCEDURE SYSKALD(kaldnr:integer); var regs:record ax,bx,cx,dx,bp,si,di,ds,es,flags:integer; end; begin regs.cx:=kaldnr; if kaldnr=16 then begin regs.dx:=filofs; regs.ds:=filseg; end; swint(224,regs); end; å PROCEDURE LUK(nr:byte; var fejl:integer); begin if nr=1 then begin close(mcfile); fejl:=iores; end else begin close(tekstfil); fejl:=iores; end; end; PROCEDURE L_DETACH; begin æ 16-bit version only SYSKALD(159); å end; (*$I+*) PROCEDURE RESETDISK; begin æ 8-bit vesion only å bdos(13); æ 16-bit version only - Not neccesary for PICCOLINE SYSKALD(13); å 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 regs:record ax,bx,cx,dx,bp,si,di,ds,es,flags:integer; end; linje:stringÆ79Å; fcb:arrayÆ1..36Å of byte; dma:stringÆ128Å; dma_ofs,dma_seg:integer; a,b,c,d:byte; æ 16-bit version only PROCEDURE SYSKALD2(kaldnr,fofs,fseg:integer); begin regs.cx:=kaldnr; regs.dx:=fofs; regs.ds:=fseg; swint(224,regs); if kaldnr=52 then begin dma_ofs:=regs.ax; dma_seg:=regs.es; end; if (kaldnr=17) or (kaldnr=18) then a:=regs.ax; end; å begin æ 8-bit version only SETUP DMA å dma:=''; for a:=1 to 8 do dma:=dma+' '; bdos(26,addr(dma)+1); æ 16-bit version only GET DMA ADRESS SYSKALD2(52,0,0); å 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Å); æ 8-bit version only SEARCH FIRST å a:=bdosb(17,addr(fcb)); æ 16-bit version only SEARCH FIRST SYSKALD2(17,ofs(fcb),seg(fcb)); å 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 æ 8-bit version only GET FILENAME and SEARCH NEXT å write(copy(dma,a*32+2,8)); if efternavn then begin write('.',copy(dma,a*32+10,3)); write(' '); end else write(' '); a:=bdosb(18,addr(fcb)); æ 16-bit version only GET FILENAME and SEARCH NEXT for d:=1 to 8 do write(chr(memÆdma_seg:dma_ofs+a*32+dÅ)); if efternavn then begin write('.'); for d:=9 to 11 do write(chr(memÆdma_seg:dma_ofs+a*32+dÅ)); write(' '); end else write(' '); SYSKALD2(18,ofs(fcb),seg(fcb)); å end; end; PROCEDURE AFSLUT; begin write(alloff); end; «eof»