Home | Reviews | GUIpedia | Forum | Fun500
| Interrupt DirectoryDECLARE FUNCTION exename$ () DECLARE FUNCTION freediskspace& (dr$) DECLARE FUNCTION GetFileDate$ (File$) DECLARE FUNCTION timeslices% () ' frees timeslices DECLARE FUNCTION getfirstfile$ (FileSpec$, attr%) 'get firstfile/dir like dir$ DECLARE FUNCTION GetNextFile$ () 'get nextfile/dir like dir$ ' Fileroutines for QuickBasic PDS 7.1 by Tomppa ' ' Routines are also usable in Qb4.5 with small modifications DEFINT A-Z CONST true = -1, false = 0 ' $INCLUDE: 'qbx.bi' ' If you're using QuickBasic, make the above statement with 'qb.bi' REM $DYNAMIC FUNCTION exename$ ' ' This function returns the name of the exefile which is running ' DIM regs AS RegTypeX tmp$ = "" regs.ax = &H6200 CALL InterruptX(&H21, regs, regs) DEF SEG = regs.bx DEF SEG = PEEK(&H2C) + PEEK(&H2D) * 256 byte = 0 DO IF PEEK(byte) = 0 THEN IF PEEK(byte + 1) = 0 THEN byte = byte + 2 EXIT DO END IF END IF byte = byte + 1 LOOP IF PEEK(byte) = 1 THEN byte = byte + 2 DO WHILE PEEK(byte) tmp$ = tmp$ + CHR$(PEEK(byte)) byte = byte + 1 LOOP exename$ = tmp$ END IF END FUNCTION DEFSNG A-Z FUNCTION freediskspace& (dr$) ' Returns free disk space on drive dr$ 'Define registers. DIM regs AS RegType Curd$ = CURDIR$ CHDRIVE dr$ 'Get current drive info; set up input and do system call. regs.ax = &H1900 CALL Interrupt(&H21, regs, regs) 'Convert drive info to readable form. Drive$ = CHR$((regs.ax AND &HFF) + 65) + ":" 'Get disk free space; set up input values and do system call. regs.ax = &H3600 regs.dx = ASC(UCASE$(Drive$)) - 64 CALL Interrupt(&H21, regs, regs) 'Decipher the results. SectorsInCluster = regs.ax BytesInSector = regs.cx IF regs.dx >= 0 THEN ClustersInDrive = regs.dx ELSE ClustersInDrive = regs.dx + 65536 END IF IF regs.bx >= 0 THEN ClustersAvailable = regs.bx ELSE ClustersAvailable = regx.bx + 65536 END IF CHDRIVE Curd$ freediskspace& = ClustersAvailable * SectorsInCluster * BytesInSector END FUNCTION FUNCTION GetFileDate$ (File$) ' returnd date and time of file$ ' DIM InRegs AS RegTypeX, OutRegs AS RegTypeX ' Get [DTA] address InRegs.ax = &H2F00 CALL InterruptX(&H21, InRegs, OutRegs) dtasegment% = OutRegs.es dtaoffset% = OutRegs.bx NameFile$ = File$ + CHR$(0) InRegs.ds = SSEG(NameFile$) InRegs.dx = SADD(NameFile$) InRegs.cx = 63 InRegs.ax = &H4E00 CALL InterruptX(&H21, InRegs, OutRegs) IF OutRegs.flags AND 1 THEN GetFileDate$ = "" EXIT FUNCTION END IF DEF SEG = dtasegment% matchoffset% = dtaoffset% + &H16 kello1$ = CHR$(PEEK(matchoffset% + 0)) kello2$ = CHR$(PEEK(matchoffset% + 1)) pvm1$ = CHR$(PEEK(matchoffset% + 2)) pvm2$ = CHR$(PEEK(matchoffset% + 3)) DEF SEG aika% = CVI(kello1$ + kello2$) sek = 0 IF (aika% AND 1) = 1 THEN sek = sek + 1 '0 IF (aika% AND 2) = 2 THEN sek = sek + 2 '1 IF (aika% AND 4) = 4 THEN sek = sek + 4 '2 IF (aika% AND 8) = 8 THEN sek = sek + 8 '3 IF (aika% AND 16) = 16 THEN sek = sek + 16 '4 sek = sek * 2 min = 0 IF (aika% AND 32) = 32 THEN min = min + 1 IF (aika% AND 64) = 64 THEN min = min + 2 IF (aika% AND 128) = 128 THEN min = min + 4 IF (aika% AND 256) = 256 THEN min = min + 8 IF (aika% AND 512) = 512 THEN min = min + 16 IF (aika% AND 1024) = 1024 THEN min = min + 32 hh = 0 IF (aika% AND 2048) = 2048 THEN hh = hh + 1 IF (aika% AND 4096) = 4096 THEN hh = hh + 2 IF (aika% AND 8192) = 8192 THEN hh = hh + 4 IF (aika% AND 16384) = 16384 THEN hh = hh + 8 IF (aika% AND 32768) = 32768 THEN hh = hh + 16 ' day pvm% = CVI(pvm1$ + pvm2$) pv = 0 IF (pvm% AND 1) = 1 THEN pv = pv + 1 IF (pvm% AND 2) = 2 THEN pv = pv + 2 IF (pvm% AND 4) = 4 THEN pv = pv + 4 IF (pvm% AND 8) = 8 THEN pv = pv + 8 IF (pvm% AND 16) = 16 THEN pv = pv + 16 ' month kk = 0 IF (pvm% AND 32) = 32 THEN kk = kk + 1 IF (pvm% AND 64) = 64 THEN kk = kk + 2 IF (pvm% AND 128) = 128 THEN kk = kk + 4 IF (pvm% AND 256) = 256 THEN kk = kk + 8 ' year vv = 0 IF (pvm% AND 512) = 512 THEN vv = vv + 1 IF (pvm% AND 1024) = 1024 THEN vv = vv + 2 IF (pvm% AND 2048) = 2048 THEN vv = vv + 4 IF (pvm% AND 4096) = 4096 THEN vv = vv + 8 IF (pvm% AND 8192) = 8192 THEN vv = vv + 16 IF (pvm% AND 16384) = 16384 THEN vv = vv + 32 IF (pvm% AND 32768) = 32768 THEN vv = vv + 64 vv = 1980 + vv filetime$ = STRING$(2 - LEN(LTRIM$(STR$(hh))), "0") + LTRIM$(STR$(hh)) + ":" + STRING$(2 - LEN(LTRIM$(STR$(min))), "0") + LTRIM$(STR$(min)) + "." + STRING$(2 - LEN(LTRIM$(STR$(sek))), "0") + LTRIM$(STR$(sek)) filedate$ = STRING$(2 - LEN(LTRIM$(STR$(pv))), "0") + LTRIM$(STR$(pv)) + "." + STRING$(2 - LEN(LTRIM$(STR$(kk))), "0") + LTRIM$(STR$(kk)) + "." + RIGHT$(STR$(vv), 2) GetFileDate$ = filedate$ + " " + filetime$ END FUNCTION REM $STATIC FUNCTION getfirstfile$ (FileSpec$, attr%) ' ' returns first filename (pattern) with attribute attr% ' Attr% ' ' 0 Files only ' 1 read only ' 2 hidden ' 4 system ' 8 volume label ' 16 subdirectory name ' 32 archive DIM inregsx AS RegTypeX, outregsx AS RegTypeX inregsx.ax = &H2F00 CALL InterruptX(&H21, inregsx, outregsx) dtasegment% = outregsx.es dtaoffset% = outregsx.bx NameFile$ = FileSpec$ + CHR$(0) inregsx.ds = SSEG(NameFile$) inregsx.dx = SADD(NameFile$) inregsx.cx = attr% inregsx.ax = &H4E00 CALL InterruptX(&H21, inregsx, outregsx) IF outregsx.flags AND 1 THEN getfirstfile$ = "" EXIT FUNCTION END IF DEF SEG = dtasegment% matchoffset% = dtaoffset% + 29 match$ = "" FOR i = 1 TO 13 newchar$ = CHR$(PEEK(matchoffset% + i)) IF newchar$ = CHR$(0) THEN EXIT FOR match$ = match$ + newchar$ NEXT i DEF SEG getfirstfile$ = match$ END FUNCTION FUNCTION GetNextFile$ ' returns next filename (use getfirstfile first!) with attribute attr% ' Attr% ' ' 0 Files only ' 1 read only ' 2 hidden ' 4 system ' 8 volume label ' 16 subdirectory name ' 32 archive DIM inregsx AS RegTypeX, outregsx AS RegTypeX inregsx.ax = &H2F00 CALL InterruptX(&H21, inregsx, outregsx) dtasegment% = outregsx.es dtaoffset% = outregsx.bx inregsx.ax = &H4F00 CALL InterruptX(&H21, inregsx, outregsx) IF outregsx.flags AND 1 THEN GetNextFile$ = "" EXIT FUNCTION END IF DEF SEG = dtasegment% matchoffset% = dtaoffset% + 29 match$ = "" FOR i = 1 TO 13 newchar$ = CHR$(PEEK(matchoffset% + i)) IF newchar$ = CHR$(0) THEN EXIT FOR match$ = match$ + newchar$ NEXT i DEF SEG GetNextFile$ = match$ END FUNCTION DEFINT A-Z SUB MonoMem2Scr (x%) STATIC ' ' Copy screen to memory for a while (x%=0) or return it (x%=1) ' IF x% = 0 THEN REDIM MemPic(80 * 25 * 2) DEF SEG = &HB000 FOR T% = 0 TO 80 * 25 * 2 MemPic(T%) = PEEK(T%) NEXT DEF SEG END IF IF x% = 1 THEN DEF SEG = &HB000 FOR T% = 0 TO 80 * 25 * 2 POKE T%, MemPic(T%) NEXT DEF SEG ERASE MemPic END IF END SUB REM $DYNAMIC FUNCTION timeslices% ' ' If timeslices%=true then those are in use (Windows etc) ' Call timeslices% to free system resources ' DIM regs AS RegType regs.ax = &H1680 'CALL interruptx(&H2F, inregsx, outregsx) CALL Interrupt(&H2F, regs, regs) IF (regs.ax AND 255) = 0 THEN timeslices = true ELSE timeslices = false END IF END FUNCTION | 2009-02-05 | 4:21 AM |
2021 Brandon Cornell