ts.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

#DEFINE			CRLF						CHR(13) + CHR(10)
#DEFINE			BASE_PATH		"c:\dev\Codebook\"
* Customize the above line to fit your development path.

LPARAMETERS tcText, tlRecurse
LOCAL lcRetVal, lcFileName
PRIVATE pnFound
pnFound = 0

lcRetVal = "Search String: " + tcText + CRLF + CRLF  + ;
	"Scanning run at " + TRANS(DATETIME()) + CRLF + ;
	"Root Path: " + FULLPATH(BASE_PATH) + CRLF + CRLF

* You can add additional search paths here, or comment out the above and add lines to search wherever you want.
lcRetVal = lcRetVal + CRLF + ScanDir(tcText, ".", "PRG", .F.) + CRLF

lcRetVal = lcRetVal + CRLF + ScanDir(tcText, "LIBS\", "VCX", tlRecurse) + CRLF
lcRetVal = lcRetVal + CRLF + ScanDir(tcText, "PROGS\", "VCX", tlRecurse) + CRLF

lcRetVal = lcRetVal + CRLF + ScanDir(tcText, BASE_PATH + "COMMON\LIBS\", "VCX", tlRecurse) + CRLF
lcRetVal = lcRetVal + CRLF + ScanDir(tcText, BASE_PATH + "COMMON\LIBS\", "PRG", tlRecurse) + CRLF
lcRetVal = lcRetVal + CRLF + ScanDir(tcText, BASE_PATH + "COMMON\PROGS\", "PRG", tlRecurse) + CRLF

IF pnFound > 0
	lcFileName = KosherChars(tcText) + ".ts"

	lnH = FCREATE(lcFileName)
	FWRITE(lnH, lcRetVal)
	FCLOSE(lnH)

	IF MESSAGEBOX ([There were ] + TRANSFORM(pnFound) + [ instances of the text '] + tcText + ;
			[' found. The results have been written to the file '] + tcText + [.txt'. Do you want to view it now?], ;
			32 + 4, "View File?") = 6
		MODI FILE (lcFileName) NOWAIT
	ENDIF

ELSE

	MESSAGEBOX([There were no instances of the text '] + tcText + [' found.])

ENDIF

RETURN



FUNCTION ScanDir(tcText, tcDir, tcExt, tlRecurse)

	LOCAL lcDir, lnDir, laDir[1], lnCnt, lcFile, lcText, lcRetVal, lcType
	lcDir = ADDBS(tcDir)

	WAIT WIND NOWAIT "Processing " + JUSTPATH(lcDir)

	DO CASE
		CASE tcEXT = "VCX"
			lcType = "Classlibs"
		CASE tcEXT = "SCX"
			lcType = "Forms"
		OTHERWISE
			lcType = "Programs"
	ENDCASE

	lcRetVal = "Directory: " + tcDir + SPACE(4) + "Inspecting: " + lcType

	lnDir = ADIR(laDir, lcDir + "*." + tcExt)
	IF tcExt $ "SCX,VCX"

		FOR lnCnt = 1 TO lnDir
			lcFile = laDir[lnCnt, 1]
			USE (lcDir + lcFile) ALIAS LIB
			SCAN
				IF ATC(tcText, methods) > 0
					pnFound = pnFound + 1
					lcRetVal = lcRetVal + CRLF + CHR(9) + "File: " + FULL(lcFile)
					lcRetVal = lcRetVal + CRLF + CHR(9) + CHR(9) + "Object: " + objname
				ELSE
					IF ATC(tcText, properties) > 0
						pnFound = pnFound + 1
						lcRetVal = lcRetVal + CRLF + CHR(9) + "File: " + FULL(lcFile)
						lcRetVal = lcRetVal + CRLF + CHR(9) + CHR(9) + "Object: " + objname
					ENDIF
				ENDIF
			ENDSCAN
			USE
		ENDFOR

	ELSE

		FOR lnCnt = 1 TO lnDir
			lcFile = laDir[lnCnt, 1]
			lcText = FILETOSTR(lcDir + lcFile)

			IF ATC(tcText, lcText) > 0
				pnFound = pnFound + 1
				lcRetVal = lcRetVal + CRLF + CHR(9) + "File: " + FULL(lcFile)
			ENDIF
		ENDFOR
	ENDIF

	IF tlRecurse
		lnDir = ADIR(laDir, lcDir + "*.", "D")
		FOR lnCnt = 1 TO lnDir
			IF (laDir[lnCnt, 1] == ".") OR laDir[lnCnt, 1] == ".."
				LOOP
			ENDIF
			lcRetVal = lcRetVal + CRLF + ScanDir(tcText, lcDir + laDir[lnCnt, 1], tlVCX, tlRecurse) + CRLF
		ENDFOR
	ENDIF

	RETURN lcRetVal

ENDFUNC


FUNCTION KosherChars(tcStr)
	LOCAL lcRetVal, lcGoodChars, lcBadChars

	lcGoodChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789"
	* This will create a string of all non-allowed characters.
	lcBadChars = CHRTRAN(tcStr, lcGoodChars, "")
	
	* This will remove those non-allowed characters
	lcRetVal = CHRTRAN(tcStr, lcBadChars, "")

	RETURN lcRetVal
ENDFUNC