Code: Select all
' File search example program.
' Copyright 1988-1991 Microsoft Corp.
' Written in Microsoft QuickBASIC Version 1.00 for Apple Macintosh.
' Microsoft makes no claims about support for or performance of
' this example program.
' [4/23/91 Program corrected in three places per SR# S890831-4, and
' should now work ok.]
' globals
DIM SHARED TRUE, FALSE
FALSE = 0 :TRUE = NOT FALSE
' i/o parameter block (see Inside Macintosh Vol. 4)
DIM SHARED IOPB%(60)
' stack globals
DIM SHARED stack$(20), dS&(20), iS%(20), top%
' globals for refresh
DIM SHARED nr%(3) 'file name rectangle
'--------------------------------------------------------
' set up variables and draw window
w% = 395 : h% = 80 'window width & height
SetRect nr%(0),10,30,w%-10,h%-10
l% = (SYSTEM(5)-w%)\2 :t% = (SYSTEM(6)-h%)\4
WINDOW 1,"Find File",(l%,t%)-(l%+w%,t%+h%),6
refresh
TEXTFONT 3 :EDIT FIELD 1,"",(54,7)-(w%-70,21),5
'--------------------------------------------------------
WHILE 1 'main event loop
d% = DIALOG(0)
SELECT CASE d%
CASE 0 'do nothing
CASE 4 :END 'window closed: quit
CASE 5 :refresh 'refresh
CASE 6 'carriage return pressed in edit field
TEDEACTIVATE WINDOW(6) 'disable the edit field
t$ = EDIT$(1) 'get file name to look for
TextBox "", nr%(0), 0
find t$,found%
IF found% THEN BEEP ELSE BEEP:BEEP:t$ = t$ + " Not Found"
TextBox t$, nr%(0), 0
TEACTIVATE WINDOW(6) 'enable the edit field
TESETSELECT 0,32767,WINDOW(6) 'select all
CASE ELSE 'ignore anything else
END SELECT
WEND
END
'--------------------------------------------------------
' refresh
' Draw window contents
'
SUB refresh STATIC
LINE (54,6)-(WINDOW(2)-69,22),,b
InsetRect nr%(0), -2,-2
FRAMERECT VARPTR(nr%(0))
InsetRect nr%(0), 2,2
TEXTFONT 0 :TEXTFACE 0
MOVETO 10,18 :drawText "Find:"
TEXTFONT 3
END SUB
'--------------------------------------------------------
' Find
'
' Find first file with simple name s$.
' returns found% = -1 if found, else 0.
' s$ = full path name if found
'
' This program searches alphabetically through the
' file system, descending each directory as it is
' encountered until a case-insensitive match is found.
' Searching stops at the first match.
'
SUB Find( s$, found% ) STATIC
ChangeCursor 4 :SHOWCURSOR
ptr& = &H352 'pointer to default Volume Control Block
vol& = PEEKL(ptr&)
found% = FALSE
WHILE vol&<0>= 0 AND NOT found%
dir ok%,iS%(top%),dS&(top%),n$,directory%
IF ok% THEN
iS%(top%) = iS%(top%) + 1
IF directory% THEN
dirID& = PEEKL(VARPTR(IOPB%(24)))
push n$, dirID&, 1
ELSE
IF UCASE$(n$) = UCASE$(s$) THEN
s$ = n$ :getPath s$
found% = TRUE
END IF
END IF
ELSE 'finished searching this directory
pop 'go back to where we left off
END IF
WEND
END IF 'vol& <0> BASIC string
' set directory flag (attributes, bit 4)
directory% = ( PEEK(VARPTR(IOPB%(15))) AND 16 ) = 16
END IF
END SUB
'--------------------------------------------------------
' stack utilities
' assume OPTION BASE 0
'
SUB initStack STATIC
top% = -1
END SUB
SUB push( x$, l&, i% ) STATIC
IF top%>UBOUND(stack$) THEN BEEP :PRINT "Stack overflow" :END
top% = top% + 1
stack$(top%) = x$
dS&(top%) = l&
iS%(top%) = i%
END SUB
' We never need popped contents in this program, so pop just
' decrements the stack pointer.
SUB pop STATIC
IF top% < 0 THEN BEEP :PRINT "StringStack underflow" :END
top% = top% - 1
END SUB
'--------------------------------------------------------
' getPath
' Prepend colon-separated stack contents to p$
' without changing the stack.
'
SUB getPath( p$ ) STATIC
FOR j% = top% TO 0 STEP -1 :p$ = stack$(j%) + ":" + p$ :NEXT
END SUB
http://support.microsoft.com/kb/35509
It is pretty cool. Thought I would share it.