home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2001 May
/
PCWorld_2001-05_cd.bin
/
Software
/
Vyzkuste
/
tiptrik
/
tiptrik.exe
/
Pwsearch.bas
< prev
next >
Wrap
BASIC Source File
|
2001-03-04
|
4KB
|
141 lines
ON ERROR GOTO Fehler
SCREEN 0
COLOR 15, 1
CLS
DIM eingb$(20)
DIM such$(15, 4)
DIM zmenge AS DOUBLE
DIM text AS STRING * 1024
COLOR 4, 15
PRINT " *** SIMPLE SEARCH *** Zastavit: <CTRL>-<Pause>"
COLOR 15, 1
PRINT STRING$(80, 205)
PRINT "Zadejte sloºku nebo masku pro hledání (DOS-Standard with Wildcards)"
LOCATE 7, 1
newlist:
ini$ = ENVIRON$("winbootdir") + "\command\pwsearch.ini"
OPEN ini$ FOR INPUT AS #1
IF LOF(1) = 0 THEN
CLOSE #1
LOCATE CSRLIN + 2
DO
d = d + 1
PRINT STR$(d) + ". Zadejte sloºku, která se má prohledat (nap². c:\archiv[\*.txt]): "
LOCATE CSRLIN - 2, 69
INPUT "", eingb$(d)
LOOP UNTIL eingb$(d) = ""
PRINT "Vytvá²í se seznam souborà..."
FOR n = 1 TO d
bef$ = "command.com /c dir /a-d /s /b /z " + eingb$(n) + " >> " + ini$
SHELL bef$
NEXT
ELSE
CLOSE #1
PRINT "Vytvo²it nov∞ seznam souborà " + ini$ + " (a-n)"
DO
i$ = INKEY$
LOOP WHILE i$ = ""
IF LCASE$(i$) = "a" THEN
OPEN ini$ FOR OUTPUT AS #1
CLOSE
GOTO newlist
END IF
END IF
DO
s% = s% + 1
CLS
COLOR 4, 15
PRINT " *** SIMPLE SEARCH *** Zastavit: <CTRL>-<Pause>"
COLOR 15, 1
PRINT ""
PRINT "Definujte pojem, kter∞ se má v souborech hledat: Maximáln╪ 8 pojmà"
PRINT "Ke kaºdém pojmu zadejte maximáln╪ 4 kontextová slova"
PRINT STRING$(80, 196)
COLOR 15, 1
LOCATE CSRLIN + 2, 1
PRINT (STR$(s%)) + ". Pojem: "
LOCATE CSRLIN - 1, 11: INPUT "", such$(s%, k%)
IF such$(s%, k%) = "" THEN GOTO stopit
DO
k% = k% + 1
INPUT " Kontext: ", such$(s%, k%)
LOOP UNTIL such$(s%, k%) = "" OR k% = 4
k% = 0
LOOP UNTIL s% = 8
LOCATE 23, 1: PRINT "Je dovoleno maximáln╪ 8 pojmà."
stopit:
s% = s% - 1: : text$ = STR$(s%)
IF s% = 0 THEN CLS : PRINT "*** ª╡DNφ POJEM NEBYL DEFINOV╡N - PROGRAM ZASTAVEN ***": SYSTEM
FOR n% = 1 TO s%
ausgabe$ = "c:\ausgabe." + LTRIM$(STR$(n%))
OPEN ausgabe$ FOR OUTPUT AS #n%
IF such$(n%, 1) = "" THEN
PRINT #n%, UCASE$(such$(n%, 0))
ELSE
PRINT #n%, UCASE$(such$(n%, 0)) + " A " + UCASE$(such$(n%, 1)) + "..."
END IF
PRINT #n%, CHR$(13)
NEXT n%
ON ERROR GOTO 0
CLS
COLOR 4, 15
PRINT " *** SIMPLE SEARCH *** Zastavit: <CTRL>-<Pause>"
COLOR 15, 1
PRINT ""
PRINT "Zaƒíná vyhledávání ..."
OPEN ini$ FOR INPUT AS #30
DO
LINE INPUT #30, dat$
OPEN dat$ FOR RANDOM AS #31 LEN = 1024
zmenge = zmenge + LOF(31)
LOCATE 10, 1: PRINT "Prohledávám soubor: " + dat$ + " "
LOCATE 14, 1: PRINT "Nalezeno: "
DO
GET #31, , text
FOR n% = 1 TO s%
DO
i% = INSTR(LCASE$(text), LCASE$(such$(n%, k%)))
IF i% = 0 THEN GOTO jump
k% = k% + 1
LOOP UNTIL such$(n%, k%) = ""
jump:
IF such$(n%, k%) = "" THEN
PRINT #n%, STRING$(60, "=")
PRINT #n%, STRING$(2, CHR$(13)) + dat$
PRINT #n%, text
PRINT #n%, CHR$(13)
treffer% = treffer% + 1
LOCATE 14, 19: PRINT treffer%
END IF
k% = 0
NEXT n%
LOOP UNTIL (EOF(31))
CLOSE #31
counter% = counter% + 1
LOCATE 12, 1: PRINT "Doposud prohledáno:" + STR$(counter%) + " soubor(à) und " + STR$(zmenge) + " znakà..."
LOOP UNTIL (EOF(30))
CLOSE
CLS
SHELL "copy /b c:\ausgabe.* c:\pwsearch.doc > nul"
IF ENVIRON$("windir") <> "" THEN SHELL "start c:\pwsearch.doc"
PRINT "Soubor s v∞sledky vyhledávání: C:\PWSEARCH.DOC"
Fehler:
CLOSE
KILL "c:\ausgabe.*"
SYSTEM