home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / sevques.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-26  |  9.0 KB  |  216 lines
  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 395                                          Date: 17 Apr 94  06:01:12
  3. '  From: Joe Negron                                   Read: Yes    Replied: No 
  4. '    To: Larry Thacker                                Mark:                     
  5. '  Subj: Several questions
  6. '──────────────────────────────────────────────────────────────────────────────
  7. 'LT> I know that there is an area in memory from which you can get the
  8. '  > path of the program that is currently executing.  How can I do it
  9. '  > with Quick BASIC? I've tried some crude memory searches, but they're
  10. '  > extremely slow and didn't give me what I was looking for.  The
  11. '  > manual was no help.
  12.  
  13. '----------------------------Begin PROGNAME.BAS-------------------------
  14. DEFINT A-Z
  15.  
  16. '$INCLUDE: 'qb.bi'                           'Needed for Interrupt calls
  17.  
  18. DECLARE FUNCTION ProgramName$ ()
  19.  
  20. '***********************************************************************
  21. '* FUNCTION ProgramName$
  22. '*
  23. '* PURPOSE
  24. '*    Uses DOS ISR 21H, Function 51H (Get PSP Address) to return the
  25. '*    name of the currently executing program.  Note that this FUNCTION
  26. '*    requires DOS 3.0 or >.
  27. '***********************************************************************
  28. FUNCTION ProgramName$ STATIC
  29.    DIM Regs AS RegType                       'Allocate space for TYPE
  30.                                              '  RegType
  31.    Regs.ax = &H5100                          'DOS function 51h
  32.    Interrupt &H21, Regs, Regs                '  Get PSP Address
  33.  
  34.    DEF SEG = Regs.bx                         'Regs.bx returns PSP sgmnt.
  35.    EnvSeg% = PEEK(&H2C) + PEEK(&H2D) * 256   'Get environment address
  36.    DEF SEG = EnvSeg%                         'Set environment address
  37.  
  38.    DO
  39.       Byte% = PEEK(Offset%)                  'Take a byte
  40.  
  41.       IF Byte% = 0 THEN                      'Items are ASCIIZ
  42.          Count% = Count% + 1                 '  terminated
  43.  
  44.          IF Count% AND EXEFlag% THEN         'EXE also ASCIIZ terminated
  45.             EXIT DO                          'Exit at the end
  46.          ELSEIF Count% = 2 THEN              'Last entry in env. is
  47.             EXEFlag% = -1                    '  terminated with two
  48.             Offset% = Offset% + 2            '  NULs.  Two bytes ahead
  49.          END IF                              '  is the EXE file name.
  50.       ELSE                                   'If Byte% <> 0, reset
  51.          Count% = 0                          '  zero counter
  52.  
  53.          IF EXEFlag% THEN                    'If EXE name found,
  54.             Temp$ = Temp$ + CHR$(Byte%)      '  build string
  55.          END IF
  56.       END IF
  57.  
  58.       Offset% = Offset% + 1                  'To grab next byte...
  59.    LOOP                                      'Do it again
  60.  
  61.    DEF SEG                                   'Reset default segment
  62.    ProgramName$ = Temp$                      'Return value
  63.    Temp$ = ""                                'Clean up
  64. END FUNCTION
  65.  
  66. 'LT> How can I read a directory and load the files into a table so I can
  67. '  > work on them?  I've seen some crude methods where you redirect DIR
  68. '  > to a file and then read it, but I'd like to have a better way.  Can
  69. '  > I read the directory directly?
  70.  
  71. '========================== Begin LOADNAME.BAS ==========================
  72. DEFINT A-Z
  73.  
  74. DECLARE SUB LoadNames (FileSpec$, Array$(), Attr%)
  75.  
  76. DECLARE FUNCTION FileCnt% (FileSpec$, Attr%)
  77.  
  78. '$INCLUDE: 'qb.bi'                           'Needed for Interrupt call
  79.  
  80. TYPE DTARec                                  'used by Find First/Next
  81.    Reserved  AS STRING * 21
  82.    Attr      AS STRING * 1
  83.    NotNeeded AS STRING * 8                   'Time/date/size (not needed)
  84.    FileName  AS STRING * 13
  85. END TYPE
  86.  
  87. DIM SHARED DTA AS DTARec                     'SHARED lets both FileCnt%()
  88. DIM SHARED RegsX AS RegTypeX                 '  and LoadNames access them.
  89.                                              '  Use COMMON SHARED for access
  90.                                              '  among multiple modules
  91. REDIM FileName$(1 TO 1)                      'Create a dynamic arrray
  92.  
  93. Spec$ = "C:\*.*"
  94.  
  95. 'Note that this code does *not* return files with
  96. 'the Hidden, System, or Read-Only attributtes
  97. Attr% = 16                                   'Directories only
  98. Attr% = 32                                   'Files only
  99. Attr% = 48                                   'Files and Directories
  100. LoadNames Spec$, FileName$(), Attr%
  101.  
  102. IF FileName$(1) = "" THEN
  103.    PRINT "No matching files"
  104. ELSE
  105.    FOR I% = 1 TO UBOUND(FileName$)
  106.       PRINT USING "###: \           \"; I%; FileName$(I%)
  107.    NEXT I%
  108. END IF
  109.  
  110. END
  111.  
  112. '***********************************************************************
  113. '* FUNCTION FileCnt%
  114. '*
  115. '* PURPOSE
  116. '*    Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
  117. '*    (Find First Matching Name), and Function 4FH (Find Next Matching
  118. '*    Name) to obtain a count of files matching FileSpec$.
  119. '***********************************************************************
  120. FUNCTION FileCnt% (FileSpec$, Attr%) STATIC
  121.    RegsX.dx = VARPTR(DTA)                    'Set new DTA address
  122.    RegsX.ds = -1                             'DTA is in DGROUP
  123.    RegsX.ax = &H1A00                         'Set DTA
  124.    InterruptX &H21, RegsX, RegsX             'Call DOS
  125.  
  126.    Count% = 0                                'Initialize counter
  127.  
  128.    FBuff$ = FileSpec$ + CHR$(0)              'Needs to be ASCIIZ string
  129.  
  130.    RegsX.cx = Attr%
  131.    RegsX.dx = SADD(FBuff$)                   'FBuff$'s address
  132.    RegsX.ds = -1                             'For QB, sgmnt is always DGROUP
  133.    RegsX.ax = &H4E00                         'Find First Matching Name
  134.  
  135.    DO
  136.       InterruptX &H21, RegsX, RegsX          'Call DOS
  137.  
  138.       IF RegsX.flags AND 1 THEN              'Error flag
  139.          EXIT DO                             'No more files
  140.       END IF
  141.  
  142.       SELECT CASE Attr%                      'Which attrs. are we to include?
  143.       CASE 16                                'Do we want to count only dirs?
  144.          IF (ASC(DTA.Attr) \ 16) AND 1 THEN  'Is this one a directory?
  145.             IF ASC(DTA.FileName) <> 46 THEN  'Ignore "." and ".."
  146.                Count% = Count% + 1           'Found another dir name
  147.             END IF
  148.          END IF
  149.       CASE 0, 32                             'We only want to count files
  150.          Count% = Count% + 1                 'Found another file name
  151.       CASE 48                                'We want to count files & dirs
  152.          Count% = Count% + 1
  153.       END SELECT
  154.  
  155.       RegsX.ax = &H4F00                      'Find next name service
  156.    LOOP
  157.  
  158.    FileCnt% = Count%                         'Assign value to function
  159. END FUNCTION
  160.  
  161. '***********************************************************************
  162. '* SUB LoadNames
  163. '*
  164. '* PURPOSE
  165. '*    Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
  166. '*    (Find First Matching Name), and Function 4FH (Find Next Matching
  167. '*    Name) to load the files matching FileSpec$ into an array.
  168. '***********************************************************************
  169. SUB LoadNames (FileSpec$, Array$(), Attr%) STATIC
  170.    Spec$ = FileSpec$ + CHR$(0)               'Needs to be ASCIIZ string
  171.  
  172.    NumFiles% = FileCnt%(Spec$, Attr%)        'How many files match Spec$?
  173.    IF NumFiles% = 0 THEN                     'If there are none,
  174.       EXIT SUB                               '  exit
  175.    END IF
  176.  
  177.    REDIM Array$(1 TO NumFiles%)              'Allocate enough elements
  178.  
  179.    RegsX.dx = SADD(Spec$)                    'the file spec address
  180.    RegsX.ds = VARSEG(Spec$)
  181.    RegsX.cx = Attr%
  182.    RegsX.ax = &H4E00                         'Find First Matching Name
  183.   
  184.    Count% = 0                                'Initialize the counter
  185.   
  186.    DO
  187.       InterruptX &H21, RegsX, RegsX          'Call DOS
  188.       IF RegsX.flags AND 1 THEN              'Error flag
  189.          EXIT DO                             'No more files
  190.       END IF
  191.  
  192.       Valid% = 0                             'Assume invalid
  193.  
  194.       SELECT CASE Attr%                      'Which attrs. are we to include?
  195.       CASE 16                                'Do we want to count only dirs?
  196.          IF (ASC(DTA.Attr) \ 16) AND 1 THEN  'Is this one a directory?
  197.             IF ASC(DTA.FileName) <> 46 THEN  'Ignore "." and ".."
  198.                Valid% = -1                   'Found another dir name
  199.             END IF
  200.          END IF
  201.       CASE 0, 32                             'We only want to count files
  202.          Valid% = -1                         'Found another file name
  203.       CASE 48                                'We want to count files & dirs
  204.          Valid% = -1
  205.       END SELECT
  206.  
  207.       IF Valid% THEN                         'Add the file to array if
  208.          Count% = Count% + 1                 '  it's valid
  209.          Z% = INSTR(DTA.FileName, CHR$(0))   'Find terminating NUL
  210.          Array$(Count%) = LEFT$(DTA.FileName, Z% - 1) 'assign the name
  211.       END IF
  212.  
  213.       RegsX.ax = &H4F00                      'Find Next Matching Name
  214.    LOOP
  215. END SUB
  216.