'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
END FUNCTION