Power-Programmierung/CD1.mdf/basic/library/qb_pds/qbfaqr01/dos/dos.bas

BASIC Source File | 1992-07-24 | 12.3 KB | 469 lines

DECLARE SUB MSDOS ()
DECLARE SUB MSDOSX ()
DECLARE SUB GETDTA (DTA.SEG%, DTA.OFS%)
DECLARE SUB OPENFILE (F$, OMODE%, FHANDLE%)
DECLARE SUB CLOSEFILE (FHANDLE%)
DECLARE SUB WRITEFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%)
DECLARE SUB LSEEK (FHANDLE%, SMODE%, FLEN!)
DECLARE SUB GETFIRST (SEARCH$, ATTRIB%)
DECLARE SUB GETNEXT (NERR%)
'   *********************************************************************
'   *                                                                   *
'   *    PROGRAM:  DOS                                                  *
'   *                                                                   *
'   *    DESCRIPTION: DOS FUNCTIONS FOR QUICK BASIC                     *
'   *                                                                   *
'   *                                                                   *
'   *    08/05/87     JOHN M. TAL                                       *
'   *                 ROLLINS MEDICAL/DENTAL SYSTEMS                    *
'   *                 SOUTHFIELD, MI                                    *
'   *                                                                   *
'   *                                                                   *
'   *********************************************************************

'   LAST EDIT:  08/05/87      PROGRAMMER: JMT

'$INCLUDE: 'QB.BI'

OPTION BASE 1
DEFDBL A-Z
DIM inreg%(10), outreg%(10)
COMMON SHARED inreg%(), outreg%(), ax%, bx%, cx%, dx%, DP%, si%, di%, FL%, ds%, es%

ax% = 1
bx% = 2
cx% = 3
dx% = 4
bp% = 5
si% = 6
di% = 7
FL% = 8
ds% = 9
es% = 10

DEF FNWORD% (N!)
   ' --------------------------------------------
   '  CONVERT A SINGLE PRECISION NUMBER 0 - 65535
   '  INTO EQUIVELANT WORD/INTEGER(%) FOR USE BY
   '  CALL INT86
   ' --------------------------------------------

   IF N! > 32767 THEN
      FNWORD% = N! - 65536
   ELSE
      FNWORD% = N!
   END IF

END DEF  ' FNWORD%

DEF FNWORD! (N%)
   ' --------------------------------------------
   '  CONVERT A WORD INTO SINGLE PRECISION
   '  NUMBER 0 - 65535
   ' --------------------------------------------

   IF N% < 0 THEN
      FNWORD! = N% + 32767
   ELSE
      FNWORD! = N%
   END IF
END DEF  ' FNWORD!

DEF FNSMOD% (N!, M!)
   WHILE N! > M!
      N! = N! - M!
   WEND
   FNSMOD% = FNWORD%(N!)
END DEF   ' FNSMOD%


 '  &H00 PROGRAM TERMINATE
 '  &H01 KEYBOARD INPUT
 '  &H02 DISPLAY OUTPUT
 '  &H03 AUXILIARY INPUT
 '  &H04 AUXILIARY OUTPUT
 '  &H05 PRINTER OUTPUT
 '  &H06 DIRECT CONSOLE I/O
 '  &H07 DIRECT CONSOLE INPUT WITHOUT ECHO
 '  &H08 CONSOLE INPUT WITHOUT ECHO
 '  &H09 PRINT (DISPLAY) STRING
 '  &H00 PROGRAM TERMINATE
 '  &H01 KEYBOARD INPUT
 '  &H02 DISPLAY LIFEUP
 '  &H0A BUFFERED KEYBOARD INPUT
 '  &H0B CHECK STANDARD INPUT STATUS
 '  &H0C CLEAR KEYBOARD BUFFER AND INVOKE A KEYBOARD FUNCTION
 '  &H0D DISK RESET

 '  &H0F FCB OPEN FILE
 '  &H10 FCB CLOSE FILE
 '  &H11 FCB SEARCH FIRST FILE
 '  &H12 FCB SEARCH NEXT FILE
 '  &H13 FCB DELETE FILE
 '  &H14 FCB SEQUENTIAL READ
 '  &H15 FCB SEQUENTIAL WRITE
 '  &H16 FCB CREATE FILE
 '  &H17 FCB RENAME FILE

 '  &H10 FCB CLOSE FILE
 '  &H11 FCB SEARCH FIRS15      NDX
 '  &H1A SET DTA
 '  &H1B ALLOCATION TABKE INFORMATION / DEFAULT DRIVE
 '  &H1C ALLOCATION TABLE INFORMATION FOR SPECIFIC DEVICE / DRIVE INFO
 '  &H21 RANDOM READ
 '  &H22 RANDOM WRITE
 '  &H23 FCB FILE SIZE
 '  &H24 FCB SET RELATIVE RECORD FIELD
 '  &H25 SET INTERRUPT VECTOR
 '  &H26 CREATE NEW PROGRAM SEGMENT
 '  &H27 FCB RANDOM BLOCK READ
 '  &H28 FCB RANDOM BLOCK WRITE
 '  &H29 FCB PARSE FILENAME
 '  &H2A GET DATE
 '  &H2B SET DATE
 '  &H2C GET TIME
 '  &H2D SET TIME

 '  &H31 TERMINATE AND STAY RESIDENT
 '  &H33 CONTROL BREAK CHECK
 '  &H35 GET VECTOR

 '  &H38 COUNTRY DEPENDENT INFORMATION

 '  &H44 I/O CONTROL FOR DEVICES (IOCTL)
 '  &H45 DUPLICATE A FILE HANDLE (DUP)
 '  &H46 FORCE A DUPLICATE OF A HANDLE (FORCDUP)

 '  &H48 ALLOCATE MEMORY
 '  &H49 FREE ALLOCATED MEMORY
 '  &H50 MODIFY ALLOCATED MEMORY BLOCKS (SETBLOCK)
 '  &H4B LOAD OR EXECUTE A PROGRAM (EXEC)
 '  &H4C TERMINATE A PROCESS (EXIT)
 '  &H4D GET RETURN CODE OF A SUBPROCESS (WAIT)

 '  &H56 RENAME A FILE
 '  &H57 GET/SET A FILES DATE AND TIME

 '  &H5A CREATE UNIQUE FILE
 '  &H5B CREATE NEW FILE
 '  &H5C LOCK/UNLOCK FILE ACCESS

 '  ---  NETWORK SUPPORT ---
 '  &H5E00 GET MACHINE NAME
 '  &H5E02 SET PRINTER SETUP
 '  &H5E03 GET PRINTER SETUP
 '  &H5F02 GET REDIRECTION LIST ENTRY
 '  &H5F03 REDIRECT DEVICE
 '  &H5F04 CANCEL REDIRECTION

 '  &H62 GET PROGRAM SEGMENT PREFIX ADDRESS (PSP)
 '  &H65 GET EXTENDED COUNTRY INFORMATION
 '  &H66 GET/SET GLOBAL CODE PAGE (CHARACTER SET)
 '  &H67 SET HANDLE COUNT
 '  &H68 COMMIT FILE

'**************************************************************************

PRINT

 SUB CHMOD (F$, ATTRIB%, FUNC%) STATIC
    inreg%(ax%) = &H4300 + FUNC%
    F$ = F$ + CHR$(0)
    inreg%(dx%) = SADD(F$)
    inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
    inreg%(cx%) = ATTRIB%
    CALL MSDOSX
    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
    ELSE
      RES% = 0
      ATTRIB% = outreg%(cx%)  ' ATTRIB RETURNED IF FUNCTION IS GETTING
    END IF
 END SUB

 SUB CHNGDIR (F$, RES%) STATIC
    inreg%(ax%) = &H3B00
    F$ = F$ + CHR$(0)
    inreg%(dx%) = SADD(F$)
    inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
    CALL MSDOSX
    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
    ELSE
      RES% = 0
    END IF
 END SUB

 SUB CLOSEFILE (FHANDLE%) STATIC
    inreg%(ax%) = &H3E00   ' CLOSE FILE
    inreg%(bx%) = FHANDLE%
    CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
 END SUB

 SUB CREAT (F$, ATTRIB%) STATIC
    inreg%(ax%) = &H3C00
    F$ = F$ + CHR$(0)
    inreg%(dx%) = SADD(F$)
    inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
    CALL MSDOSX
    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
    ELSE
      RES% = 0
    END IF
 END SUB

 SUB CURDRIVE (DRIVE%) STATIC
    inreg%(ax%) = &H1900
    CALL MSDOS
    DRIVE% = outreg%(ax%) MOD 256
 END SUB

 SUB DIRFILE (FIRST%, SEARCH$, FOUND$) STATIC

 '  CALL DIRFILE(1,"*.BAS",FOUND$)   INITS SEARCH$ AND RETURNS FIRST FOUND$
 '  CALL DIRFILE(2,"*.BAS",FOUND$)   USE ANY VALUE OTHER THAN 1 TO GET NEXT
 '                                     ANY CALL CAN RETURN "EOF"
 '                                     WHICH MEANS NO MORE FILES
 '

 FOUND$ = ""
 IF FIRST% = 1 THEN
   ' GET DTA
   CALL GETDTA(DTA.SEG%, DTA.OFS%)

   ' MAKE SURE SET TO BASIC SEGMENTS
   DEF SEG

   ATTRIB% = 0
   CALL GETFIRST(SEARCH$, ATTRIB%)

   IF ATTRIB% <> -1 THEN ' NO FILES
     DEF SEG = DTA.SEG%
     I% = DTA.OFS% + 30
     B% = PEEK(I%)
     WHILE (I% < DTA.OFS% + 42) AND (B% <> 0)
       FOUND$ = FOUND$ + CHR$(B%)
       I% = I% + 1
       B% = PEEK(I%)
     WEND
   ELSE
     FOUND$ = "EOF"
   END IF

 ELSE ' NOT FIRST CALL

   CALL GETNEXT(NERR%)

   IF NERR% = 0 THEN
     DEF SEG = DTA.SEG%
     I% = DTA.OFS% + 30
     B% = PEEK(I%)
     WHILE (I% < DTA.OFS% + 42) AND (B% <> 0)
       FOUND$ = FOUND$ + CHR$(B%)
       I% = I% + 1
       B% = PEEK(I%)
     WEND

   ELSE ' LAST FILE
     FOUND$ = "EOF"
   END IF


 END IF


 END SUB

 SUB GETCURDIR (BUFFER$, DRIVE%) STATIC
    inreg%(ax%) = &H4700
    inreg%(si%) = SADD(BUFFER$)  ' BUFFER$ = 64 BYTES
    inreg%(ds%) = -1  ' QUICK BASICS DATA SEGMENT
    inreg%(dx%) = DRIVE%
    CALL MSDOSX
    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET
       DRIVE% = -1
    END IF
 END SUB

 SUB GETDISKFREE (DRIVE%, DFREE!, DMAX!) STATIC
    inreg%(ax%) = &H3600
    inreg%(dx%) = DRIVE%
    CALL MSDOS
    AVAIL.CL! = FNWORD!(outreg%(bx%))
    CL.DRIVE! = FNWORD!(outreg%(dx%))
    BYTE.SEC! = FNWORD!(outreg%(cx%))
    SEC.P.CL! = FNWORD!(outreg%(ax%))
    IF SEC.P.CL! = &HFFFF THEN ' INVALID DRIVE
      DFREE! = -1
      DMAX! = -1
    ELSE
      DFREE! = AVAIL.CL! * SEC.P.CL! * BYTE.SEC!
      DMAX! = CL.DRIVE! * SEC.P.CL! * BYTE.SEC!
    END IF
 END SUB

SUB GETDOSV (MAJOR%, MINOR%) STATIC
   inreg%(ax%) = &H3000
   CALL MSDOS
   MAJOR% = outreg%(ax%) MOD 256
   MINOR% = outreg%(ax%) \ 256
END SUB

 SUB GETDTA (DTA.SEG%, DTA.OFS%) STATIC

   '  &H25 SET INTERRU34      NDX   FIELD
   inreg%(ax%) = &H2F00
   CALL MSDOSX
   DTA.SEG% = outreg%(es%)
   DTA.OFS% = outreg%(bx%)
 END SUB

SUB GETFIRST (SEARCH$, ATTRIB%) STATIC
   inreg%(ax%) = &H4E00
   inreg%(cx%) = ATTRIB%  ' ATTRIBUTE
   SEARCH$ = SEARCH$ + CHR$(0)
   inreg%(dx%) = SADD(SEARCH$)
   inreg%(ds%) = -1
   CALL MSDOSX
   IF (outreg%(FL%) AND 1) = 1 THEN
      ATTRIB% = -1
   END IF
END SUB

 SUB GETNEXT (NERR%) STATIC
    inreg%(ax%) = &H4F00
    CALL MSDOS
    IF (outreg%(FL%) AND 1) = 1 THEN
       NERR% = outreg%(ax%)
    ELSE
       NERR% = 0
    END IF
 END SUB

 SUB GETVERIFY (VER%) STATIC
    inreg%(ax%) = &H5400
    CALL MSDOS
    VER% = outreg%(ax%) MOD 256
 END SUB

 SUB GETXERROR (EXERR!, ERCLASS%, SUGGACT%, LOCUS%) STATIC
    inreg%(ax%) = &H5900
    inreg%(bx%) = 0   ' DOS 3.00 TO 3.30
    CALL MSDOS
    EXERR! = FNWORD!(outreg%(ax%))
    ERCLASS% = outreg%(bx%) \ 256
    SUGACT% = outreg%(bx%) MOD 256
    LOCUS% = outreg%(cx%) \ 256
 END SUB

 SUB LSEEK (FHANDLE%, SMODE%, FLEN!) STATIC
    inreg%(ax%) = &H4200 + SMODE%   ' AH = &H42, AL = SMODE%/SEEK MODE
    inreg%(cx%) = INT(FLEN! / 65536)
    inreg%(dx%) = FNSMOD%(FLEN!, 65536)
    inreg%(bx%) = FHANDLE%
    CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
 END SUB

SUB MAKEDIR (F$, RES%) STATIC
   inreg%(ax%) = &H3900
   F$ = F$ + CHR$(0)
   inreg%(dx%) = SADD(F$)
   inreg%(ds%) = -1  'QUICK BASIC'S DATA SEGMENT
   CALL MSDOSX
   IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
   ELSE
      RES% = 0
   END IF
END SUB

SUB MSDOS STATIC
   CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
END SUB

SUB MSDOSX STATIC
    CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
END SUB

SUB OPENFILE (F$, OMODE%, FHANDLE%) STATIC
    inreg%(ax%) = &H3D00 + OMODE%   ' AH = &H3D, AL = OMODE%
    F$ = F$ + CHR$(0)
    inreg%(dx%) = SADD(F$)
    inreg%(ds%) = -1
    CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
    IF (outreg%(FL%) AND 1) <> 1 THEN ' CARRY NOT SET
       FHANDLE% = outreg%(ax%)
    ELSE
       FHANDLE% = -1
    END IF
END SUB

 SUB READFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%) STATIC
    ' CALL READFILE(FHANDLE%,-1,SADD(BUFFER$),255)
    inreg%(ax%) = &H3F00   ' READ FROM FILE
    inreg%(bx%) = FHANDLE%
    inreg%(ds%) = FNWORD%(BUF.SEG!)
    inreg%(dx%) = FNWORD%(BUF.ADR!)
    inreg%(cx%) = BYTES%
    CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
 END SUB

SUB REMDIR (F$, RES%) STATIC
   inreg%(ax%) = &H3A00
   F$ = F$ + "0"
   inreg%(dx%) = SADD(F$)
   inreg%(ds%) = -1  'QUICK BASIC'S DATA SEGMENT
   CALL MSDOSX
   IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
   ELSE
      RES% = 0
   END IF
END SUB

SUB SELDISK (DRIVE%) STATIC
    inreg%(ax%) = &HE00 + DRIVE%
END SUB

 ' ------ SPECIAL CONGLOMERATES OF ABOVE FUNCTIONS --------
 SUB TRUNCFILE (F$, FLEN!) STATIC
   ' TRUNCATATES FILE (F$) AT LENGTH (FLEN!)
   CALL OPENFILE(F$, 2, FHANDLE%)
   IF FHANDLE% <> -1 THEN
     CALL LSEEK(FHANDLE%, 0, FLEN!)
     IF (outreg%(FL%) AND 1) <> 1 THEN ' CARRY NOT SET
        CALL WRITEFILE(FHANDLE%, -1, 0, 0)
     END IF
     CALL CLOSEFILE(FHANDLE%)
   END IF
 END SUB

 SUB UNLINK (F$) STATIC
    inreg%(ax%) = &H4100
    F$ = F$ + CHR$(0)
    inreg%(dx%) = SADD(F$)
    inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
    CALL MSDOSX
    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
      RES% = outreg%(ax%)
    ELSE
      RES% = 0
    END IF
 END SUB

 SUB VERIFY (VSWITCH%) STATIC
    inreg%(ax%) = &H2E + VSWITCH%
    CALL MSDOS
 END SUB

 SUB WRITEFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%) STATIC
    inreg%(ax%) = &H4000   ' WRITE TO FILE
    inreg%(bx%) = FHANDLE%
    inreg%(cx%) = BYTES%        ' TRUNCATE FILE
    inreg%(dx%) = FNWORD%(BUF.ADR!)
    inreg%(ds%) = FNWORD%(BUF.SEG!)
    CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
 END SUB