'use PB/DLL 6 '========================================================================= '************************************************************************* '** This code is written by: Henk Broekhuizen, 21-JAN-2001 ** '** for use with PB/DLL 5.0 and later ** '** This codes uses portions of a public domain program PbRegEdit.bas ** '** written by Kerry S. Goodin and released into public domain January ** '** 1998. ** '************************************************************************* '** ** '** ** '************************************************************************* '** No responsibility is assumed or accepted. Use at your own risk. ** '** Parts of this code READ from the registry of Windows. Failure to ** '** correctly access the Registry can crash your system. ** '************************************************************************* '** ** '** Henk Broekhuizen ** '** http://pb.doorhet.net ** '** ** '************************************************************************* '========================================================================= $testfile="searcher.txt" 'op aanwezigheid van dit bestand wordt getest, is nu hetzelfde als de datafile $datafile="searcher.txt" 'datafile: zonder commando opgave wordt dit bestand verwacht in dezelfde directory 'met daarin naam-artiest.mp3 of net andersom #COMPILE EXE "searcher.exe" 'geef zelf de compileernaam op #INCLUDE "WIN32API.INC" 'wordt gebruikt! #RESOURCE "searcher.pbr" 'bestand met icoontje en de version informatie (tabblad die met Verkenner is te bekijken '------------------------------------------------------------------------------ GLOBAL hDlgMain AS LONG 'hoofddialoog GLOBAL hDlgResultaat AS LONG 'dialoog die automatisch wordt geopend zodra er een stukje invoer is gegeven GLOBAL hFont AS LONG 'variabele die verwijst naar het nieuw aangemaakte font Courier om met spaties de boel uit te kunnen lijnen GLOBAL keuze AS STRING 'keuze van wat gezocht wordt GLOBAL vorigekeuze AS STRING 'de keuze vóór de laatste toetsaanslag, dus waar vorige keer op gezocht moest worden GLOBAL Txt() AS STRING 'array met regels te vertonen GLOBAL Record() AS STRING 'ingelezen bestand records GLOBAL RecordAantal AS LONG 'aantal elementen in het bestand GLOBAL KeepOnTop AS LONG 'een variabele die bepaalt of het schermpje on-top moet blijven of niet %IDkeuzeregel=709 'id van het keuzeregeltje %IDResultaat=710 'id voor het resultaat %maxaantal=5000 'maximaal aantal records in the file %ShowAantal=150 'max aantal te vertonen %titel = 45 'lengte voor de titel %mp3 = 95 'plaats waar mp3 in beeld komt $titel="MP3-Searcher 1.0a" 'naam van het programma voor de titelbalk '------------------------------------------------------------------------------ FUNCTION MakeFont(BYVAL FONT AS STRING, BYVAL PointSize AS LONG) AS LONG ' Lettertype Puntgrootte van de tekst 'maakt een nu Courier font aan om een proportioneel lettertype te krijgen 'hiermee kan met spaties worden uitgelijnd. Bovendien is de grootte van 'de letters gemakkelijk te kiezen voor uw kippege medemens 'routine komt uit een PB/DLL voorbeeld (smtp.bas) LOCAL hDC AS LONG LOCAL CyPixels AS LONG 'haal de verwijzing naar het scherm op hDC = GetDC(%HWND_DESKTOP) 'gebruik die verwijzing om de vertical resolutie op te halen (90 op mijn systeem) CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC %HWND_DESKTOP, hDC PointSize = (PointSize * CyPixels) \ 72 '72 dpi is de grootte van resolutie van het scherm doorgaans 'maak het font aan, verwijs er naar via de middels function doorgegeven waarde FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _ %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _ %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY FONT) END FUNCTION '--------------------------------------------------------------------------------- FUNCTION formatregel(regel AS STRING) AS STRING 'zorgt ervoor dat de regel netjes wordt opgemaakt: 'artiesten onder elkaar in een kolom 'titels onder elkaar 'de suffix .MP3 netjes onder elkaar LOCAL resultaat AS STRING LOCAL tekst AS STRING LOCAL pos AS LONG resultaat=regel tekst=regel pos=INSTR(tekst,"-") IF pos=0 THEN 'als er geen streepje staat dan zetten we er een aan het eind 'geen streepje tussen artiest en plaatnaam REPLACE ".MP3" WITH "- .MP3" IN tekst REPLACE ".mp3" WITH "- .mp3" IN tekst 'variaties .mP3 en .Mp niet ondervangen, zonodig toevoegen 'bepaal opnieuw de positie van het streepje pos=INSTR(tekst,"-") END IF IF pos>0 THEN 'er zit een streepje in, altijd dus (wnat we hebben 'm zonodig toegevoegd 'pak het eerste stuk resultaat=LEFT$(tekst,pos-1) 'de rest naar tekst tekst=MID$(tekst,pos+1) 'zonodig het eerste stuk aanvullen met spaties tot de gewenste volgende positie 'te lange titels worden hier NIET afgebroken, kan eventueel met LEFT$(resultaat,%titel) als LEN(resultaat)>%titel IF LEN(resultaat)<%titel THEN resultaat=resultaat+SPACE$(%titel-LEN(resultaat)) END IF 'Eventuele spaties na het streepje weghalen tot de eerste letter/cijfer voor mooi uitlijnen tekst=LTRIM$(tekst) 'bepaal waar de suffix begint (.MP3) pos=INSTR(UCASE$(tekst),".MP3") 'indien gevonden: weer zoveel spaties toevoegen dat we op positie %mp3 terecht komen IF pos>0 THEN 'neem deel tot de komma over en voeg achter de eerdere tekst, voorzien van spaties resultaat=resultaat+LEFT$(tekst,pos-1) 'restant zonder komma in tekst tekst=MID$(tekst,pos) IF LEN(resultaat)<%mp3 THEN resultaat=resultaat+SPACE$(%mp3-LEN(resultaat)) END IF 'voeg beide weer samen resultaat=resultaat+tekst 'opgemaakte tekst nu teruggeven aan de aanroeper FUNCTION=resultaat END FUNCTION FUNCTION WelkeErr(fout AS LONG) AS STRING LOCAL tekst AS STRING 'een stel foutcodes toegevoegd, geknipt en geplakt uit de HELP file om veel voorkomende problemen te indentificeren 'alleen run-time errors zouden nodig zijn, maar ach . . . . de programma's worden toch al zo klein met PB/DLL 'let op: ik heb een HEEL breed scherm dus download de internet source of blijf doortypen op één regel wat logisch bijeen hoort SELECT CASE fout CASE 5 tekst="5 Illegal function call - This is a catch-all error related to passing an inappropriate argument to some statement or function." tekst=tekst+"A few of the 101 things that can cause it follow: * Trying to perform invalid mathematical operations, such as taking the " tekst=tekst+"square root of a negative number. * A record number is too large (or negative) in a GET or PUT. " tekst=tekst+"* Attempting to use the WIDTH statement on a sequential file." CASE 7 tekst="7 Out of memory - Many different situations can cause this message, including dimensioning too large an array." CASE 9 tekst="9 Subscript / Pointer out of range - You attempted to use a subscript smaller than the minimum or larger than the maximum value established when the array was dimensioned. Attempting to use a null pointer will also cause this error." CASE 24 tekst="24 Device Time-Out – The specified time-out value for a UDP or TCP communications operation has expired." CASE 51 tekst="51 Internal error - A malfunction occurred within the PowerBASIC run-time system. Contact the PowerBASIC Technical Support group with information about your program." CASE 52 tekst="52 Bad file name or number - The file number you gave in a file statement doesn't match one given in an OPEN statement, or the file number may be out of the range of valid file numbers." CASE 53 tekst="53 File not found - The file name specified could not be found on the indicated drive." CASE 54 tekst="54 Bad file mode - You attempted a PUT or a GET (or PUT$ or GET$) on a sequential file." CASE 55 tekst="55 File is already open - You attempted to open a file that was already open, or you tried to delete an open file." CASE 57 tekst="57 Device I/O error - A hardware problem occurred when trying to carry out some command." CASE 58 tekst="58 File already exists - The new name argument specified in your NAME statement already exists." CASE 61 tekst="61 Disk full - There isn't enough free space on the indicated or default disk to carry out a file operation. Create some more free disk space and retry your program." CASE 62 tekst="62 Input past end - You tried to read more data from a file than it had to read. Use the EOF (end of file) function to avoid this problem. Trying to read from a sequential file opened for output or append can also cause this error." CASE 63 tekst="63 Bad record number - A negative number or a number larger than 2,147,483,647 was specified as the record argument to a random file PUT or GET statement." CASE 64 tekst="64 Bad file name - The file name specified in a KILL, or NAME statement contains invalid characters." CASE 67 tekst="67 Too many files - This error can be caused either by trying to create too many files in a drive's root directory, or by an invalid file name that affects the performance of the Create File system call." CASE 68 tekst="68 Device unavailable - You tried to OPEN a device file on a machine without that device; for example, OPENing COM1 on a system without a serial adapter or modem." CASE 70 tekst="70 Permission denied - You tried to write to a write-protected disk. This error can also be generated as a result of network permission errors." CASE 71 tekst="71 Disk not ready - The door of a floppy disk drive is open, or there is no disk in the indicated drive." CASE 72 tekst="72 Disk media error - The controller board of a floppy or hard disk indicates a hard media error in one or more sectors." CASE 74 tekst="74 Rename across disks - You can't rename a file across disk drives." CASE 75 tekst="75 Path/file access error - During a command capable of specifying a path name (OPEN, NAME, or MKDIR, for example), you used a path inappropriately; trying to OPEN a subdirectory or to delete a directory in-use, for example." CASE 76 tekst="76 Path not found - The path you specified during a CHDIR, MKDIR, OPEN, etc., can't be found." CASE ELSE tekst="Fout "+FORMAT$(fout)+" is niet verder gespecificeerd. " END SELECT tekst=tekst+$CR+$LF+" " tekst=tekst+$CR+$LF+"Het programma kan niet verder op juiste manier worden uitgevoerd. " FUNCTION=tekst END FUNCTION CALLBACK FUNCTION CancelButton() AS LONG 'op STOP geklikt, dus beëindig het dialoog hDlgMain en hDlgResultaat (wel zo netjes) DIALOG END hDlgResultaat DIALOG END hDlgMain, 0 FUNCTION = 1 END FUNCTION '-------------------------------------------------------------------------------- CALLBACK FUNCTION DlgProc() AS LONG 'deze routine wordt bij elke aktiviteit van het dialoog aangeroepen, zelfs met de muis over 'zaken heen strijken roept deze routine aan LOCAL regel AS STRING LOCAL aantal AS LONG LOCAL ukeuze AS STRING LOCAL uregel AS STRING LOCAL bestand AS STRING LOCAL r AS LONG LOCAL boodschap AS STRING 'Purpose Return the wMsg parameter of a message within a callback function. 'Syntax wMsg = CBMSG 'When Windows sends a message to your callback, the lParam value contains different ' values depending on the wMsg command sent. IF CBMSG = %WM_USER + 999& THEN 'zet het window vooraan op het scherm SetForegroundWindow CBHNDL BringWindowtoTop CBHNDL FUNCTION = 1 EXIT FUNCTION ELSEIF CBMSG = %WM_DESTROY THEN 'blijkbaar beëindigen van het Window DIALOG END hDlgResultaat, 0 EXIT FUNCTION ELSEIF CBMSG <> %WM_COMMAND AND CBCTLMSG <> %EN_UPDATE THEN 'alles behalve een commando en een tekstupdate EXIT FUNCTION END IF 'Uit WIN32.HLP (bestand te downloaden bij www.PowerBASIC.COM): 'The SetForegroundWindow function puts the thread that created the specified window into the foreground 'and activates the window. Keyboard input is directed to the window, and various visual cues are changed for the user. 'The BringWindowToTop function brings the specified window to the top of the Z order. If the window is a 'top-level window, it is activated. If the window is a child window, the top-level parent window associated ' with the child window is activated. 'lees de courante invoer in (wat heeft de gebruiker getypt, opslaan in keuze CONTROL GET TEXT hDlgMain, %IDkeuzeregel TO keuze 'alleen maar wat doen als de selectie is veranderd IF keuze<>vorigekeuze THEN 'maak de array weer maximaal, inhoud wordt gewist, voorkom een GPF (fout) REDIM Txt(1:%ShowAantal) 'de huidige invoer niet weer laten leiden tot een aktie vorigekeuze=keuze 'vul de tekst vast in 'aantal gevonden aantal=0 'alles op hoofdletters vergelijken ukeuze=UCASE$(keuze) 'doorloop alle records FOR r=1 TO RecordAantal 'alle records langs regel=Record(r) uregel=UCASE$(regel) 'indien de tekst in KEUZE voorkomt, dan toevoegen aan toon-array IF INSTR(uregel,ukeuze)<>0 THEN INCR aantal Txt(aantal)=formatregel(regel) 'aantal gevonden verhogen, bij genoeg-2 eruit IF aantal>=%ShowAantal-2 THEN EXIT FOR END IF NEXT r 'niets gevonden: dan een regel vermelden dat er niets is gevonden IF aantal=0 THEN aantal=1: Txt(1)="Geen overeenkomst gevonden..." 'als het maximaal aantal te vertonen is bereikt, dan dat melden als laatste regel IF aantal=>%ShowAantal-2 THEN Txt(aantal)="Maximaal 150 worden vertoond....." 'maak de array weer precies groot genoeg om lege regels vertonen te vermijden REDIM PRESERVE Txt(1:aantal) 'PRESERVE zorgt voor behoud van de inhoud van de array IF ISFALSE LEN(keuze) THEN 'keuze is leeg, dus window verbergen DIALOG SHOW STATE hDlgResultaat, %SW_HIDE ELSE 'vertoon het windo als keuze>0 is DIALOG SHOW STATE hDlgResultaat, %SW_SHOWNA DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 0, 0 'forceer dat er hertekent wordt CONTROL KILL hDlgResultaat, %IDResultaat 'gooi het vorige resultaat weg als control 'vertoon de array met zoekresultaten en stel daarna het lettertype in op Courier CONTROL ADD LISTBOX, hDlgResultaat, %IDResultaat, Txt(), 5, 5, 590, 290, %WS_BORDER OR %LBS_WANTKEYBOARDINPUT OR %WS_VSCROLL OR %WS_GROUP OR %WS_TABSTOP OR %LBS_NOINTEGRALHEIGHT OR %LBS_DISABLENOSCROLL OR %LBS_USETABSTOPS CONTROL SEND hDlgResultaat, %IDResultaat, %WM_SETFONT, hFont, 1 'Lance 'laat het Window opnieuw opbouwen: opnieuw tekenen DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 1, 0 InvalidateRect hDlgResultaat, BYVAL 0&, 0& END IF ' nu een trigger geven om het hoofdscherm op de voorgrond te krijgen ' DIALOG POST CBHNDL, %WM_USER + 999&, 0, 0 FUNCTION = 1 'klaar END IF END FUNCTION '------------------------------------------------------- FUNCTION leesin() AS LONG LOCAL aantal AS LONG LOCAL regel AS STRING LOCAL uregel AS STRING OPEN $datafile FOR INPUT AS #1 DIM Record(1:%maxaantal+10) 'maximaal aantal records in the file IF ERR THEN MSGBOX "Fout bij openen van bestand "+$datafile+$CR+$LF+WelkeErr(ERR),%MB_ICONERROR,"Waarschuwing ! ! ! !" FUNCTION=0 EXIT FUNCTION ELSE aantal=1 'lees nu de regels uit het bestand in, tot het maximaal aantal %MaxAantal in Record() WHILE NOT EOF(1) AND aantal<%MaxAantal LINE INPUT #1,regel Record(aantal)=regel INCR aantal WEND CLOSE #1 RecordAantal=aantal-1 'de INCR aantal geeft 5 bij 4 regels, dus 1 eraf REDIM PRESERVE Record(1:RecordAantal) 'redimensioneren met behoud van inhoud FUNCTION=1 'klaar END IF END FUNCTION '------------------------------------------------------------------------------ FUNCTION leesdir() AS LONG LOCAL aantal AS LONG LOCAL mp3dir AS STRING LOCAL regel AS STRING LOCAL uregel AS STRING 'lees de bestanden van een opgegeven directory (op de commandolijn opgegeven) mp3dir=COMMAND$ IF INSTR(mp3dir,":\") =0 THEN 'command line opgave is er, maar er mist een drive aanduiding , bijv c:\ MSGBOX "Directorie op commando regel bevat geen drive en pad"+$CR+$CR+"Opgave is: drive:\pad\ "+ $CR+"Bijvoorbeeld: c:\mp3\",%MB_ICONERROR,"Waarschuwing ! ! ! !" FUNCTION=0 EXIT FUNCTION END IF 'als er geen backslash aan het eind staat er een toevoegen IF RIGHT$(mp3dir,1)<>"\" THEN mp3dir = mp3dir+"\" 'zoek alleen om MP3 bestanden mp3dir=mp3dir+"*.mp3" 'maak het gewenste bestandsmasker inclusief pad regel=DIR$(mp3dir) 'haal het eerste bestand op DIM Record(1:%maxaantal+10) 'maximaal aantal records in the file aantal=1 WHILE regel<>"" AND aantal<%MaxAantal 'zolang het maximum niet overschreden Record(aantal)=regel 'in array zetten regel=DIR$ 'volgende lezen INCR aantal 'volgnummer verhogen WEND RecordAantal=aantal-1 'aantal is één te hoog REDIM PRESERVE Record(1:RecordAantal) 'array aanpassen met behoud van inhoud FUNCTION=1 'klaar END FUNCTION '------------------------------------------------------------------------------ FUNCTION PBMAIN () AS LONG 'hoofdprogramma LOCAL ResultaatTxt AS LONG LOCAL Resultaat AS LONG LOCAL tekst AS STRING ResultaatTxt=10 'puntgrootte van de Resultaat dialoog tekst, nu dus een 10 punts letter KeepOnTop=%WS_EX_TOPMOST 'begin met on top blijven, indien nul komen andere windows eroverheen te liggen DIM Txt(1:%maxaantal) 'begin met het maximum '---------------------------- IF COMMAND$<>"" THEN 'lees opgegeven directory, op de commando lijn opgegeven Resultaat=Leesdir 'resultaat van inlezen directorie ELSE 'lees het standaard bestand, indien openen een fout geeft, gebruiker waarschuwen. OPEN $testfile FOR INPUT AS #1 IF ERR THEN MSGBOX "Bestand SEARCHER.TXT in deze directory niet gevonden."+$CR+"Bij opstarten zonder parameter wordt SEARCHER.TXT gebruikt"+$CR+"Of geef een directorie met MP3 bestanden op als parameter:"+$CR+"searcher c:\my-mp3\",,"WAARSCHUWING ! ! ! !" EXIT FUNCTION END IF CLOSE #1 Resultaat=LeesIn 'resultaat van inlezen bestand END IF IF Resultaat=0 THEN 'fout gegaan, dus afbreken EXIT FUNCTION END IF 'mini menuutje als TOOL window (dus geen systeemknoppen voor minimaliseren en maximaliseren en sluiten DIALOG NEW 0,$titel,0,0, 93, 30,%WS_DLGFRAME , KeepOnTop OR %WS_EX_TOOLWINDOW TO hDlgMain CONTROL ADD TEXTBOX,hDlgMain, %IDkeuzeregel , "", 1,3, 65 , 12, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE CONTROL ADD BUTTON, hDlgMain, %IDCANCEL, "&Stop", 70, 2, 20, 14, 0 CALL CancelButton 'als we genoeg ervan hebben DIALOG NEW 0, "Gevonden: ",,, 600, 300 TO hDlgResultaat 'maak een dialoog voor de zoekresultaten DIALOG SHOW MODELESS hDlgResultaat 'maak het dialoog, maar ga door met uitvoering DIALOG SHOW STATE hDlgResultaat, %SW_HIDE 'verberg het dialoog tot er iets is gekozen (invoer KEUZE) hFont = MakeFont("Courier New", ResultaatTxt) 'resultaat in dit Lettertype weergeven (niet-proportioneel) 'vanwege uitlijnen met spaties: Courier New, 10 punts letter DIALOG SHOW MODAL hDlgMain CALL DlgProc 'vertoon het KEUZE minimenu en wacht op invoer DeleteObject hFont 'gebruiker wil stoppen, vernieting het aangemaakte FONT 'klaar is Klara