File "ickvdo.bas"
Path: /ickvdo/ickvdo.bas
File size: 19.71 KB
MIME-type:
Charset: utf-8
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "AppData.inc"
#RESOURCE "ickvdo.pbr"
$VER = "1.2"
' CHANGELOG:
' v1.2 (2025-07-04) display cleaner video names in vlc
' v1.1 (2025-06-09) make video search recursive in subfolders
' v1.0 (2025-01-28) initial release
'------------------------------------------------------------------------------
' Global variables
'------------------------------------------------------------------------------
GLOBAL gStartPath AS STRING ' path to start search from
GLOBAL gFiles() AS STRING ' array for found files
GLOBAL gFileCount AS LONG ' counter for found files
GLOBAL gMatch() AS STRING ' array for matching files
GLOBAL gMatchCount AS LONG ' counter for matching files
GLOBAL gHistoNb AS LONG ' counter for "ickvdo.000" files
GLOBAL gHistoIdx() AS LONG ' search history > index in "ickvdo.000" files
GLOBAL gHistoUri() AS STRING ' search history > URIs
GLOBAL gHistoLst() AS STRING ' search history > searches
GLOBAL gList() AS STRING ' combobox array for current folder
GLOBAL gAbort AS LONG ' to enable cancel operation
GLOBAL gBusy AS LONG ' signal that the search is running
'------------------------------------------------------------------------------
' Used to subclass the combobox and trap the Del key:
'------------------------------------------------------------------------------
GLOBAL ghDlg, ghCbFocus, ghCBList, gOldProc AS DWORD
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Lib "AES256.dll" prototypes
'------------------------------------------------------------------------------
DECLARE FUNCTION Encrypt LIB "AES256.DLL" ALIAS "Encrypt" (BYVAL sText AS STRING,BYVAL sPassword AS STRING) AS STRING
DECLARE FUNCTION Decrypt LIB "AES256.DLL" ALIAS "Decrypt" (BYVAL sText AS STRING,BYVAL sPassword AS STRING) AS STRING
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
MACRO SECONDS = * 1000
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION EXISTS(BYVAL f AS STRING) AS LONG
LOCAL i AS LONG
i = GETATTR(f)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION Grab_and_Decrypt_File(BYVAL file AS STRING) AS STRING
LOCAL enc AS STRING
LOCAL ff AS LONG
ff = FREEFILE
OPEN file FOR BINARY ACCESS READ LOCK SHARED AS #ff
GET$ #ff, LOF(#ff), enc
CLOSE #ff
FUNCTION = Decrypt(enc, "mougino.free.fr/ickvdo")
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB Encrypt_and_Write_File(BYVAL file AS STRING, BYVAL dec AS STRING)
LOCAL enc AS STRING
LOCAL ff AS LONG
enc = Encrypt(dec, "mougino.free.fr/ickvdo")
ff = FREEFILE
OPEN file FOR BINARY ACCESS WRITE LOCK WRITE AS #ff
PUT$ #ff, enc
CLOSE #ff
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB GetAllHistoryLists()
' History lists are stored in "%RoamingAppData%\ickvdo.001" to "ickvdo.999"
' Contents are encrypted with AES256.
' All files contain:
' - "C:\Target\Folder\" (ending with "\")
' - followed by "|"
' - followed by searchTerm1 + $LF + SearchTerm2 + $LF + ...
LOCAL db, dbl, buf AS STRING
LOCAL n AS LONG
gHistoNb = 0
n = -1
DO
INCR gHistoNb
' Handle manual backups if needed
dbl = CURDIR$ + "\ickvdo." + FORMAT$(gHistoNb, "000") ' local DB
db = RoamingAppData() + "ickvdo." + FORMAT$(gHistoNb, "000") ' roaming DB
IF EXISTS(dbl) AND NOT EXISTS(db) THEN NAME dbl AS db
' Locate history databases in %RoamingAppData%
IF EXISTS(db) THEN
buf = Grab_and_Decrypt_File(db)
IF LEN(buf) > 0 THEN ' useful content (able to decrypt)
INCR n
REDIM PRESERVE gHistoIdx(n)
gHistoIdx(n) = gHistoNb
REDIM PRESERVE gHistoUri(n)
gHistoUri(n) = PARSE$(buf, "|", 1)
REDIM PRESERVE gHistoLst(n)
gHistoLst(n) = PARSE$(buf, "|", 2) ' all search terms separated by $LF
END IF
END IF
LOOP UNTIL ISFALSE EXISTS(db)
DECR gHistoNb
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB PopulateCombo(BYVAL hDlg AS DWORD)
LOCAL e AS STRING
LOCAL i AS LONG
ARRAY SCAN gHistoUri(), COLLATE UCASE, =gStartPath, TO i
IF i <> 0 THEN
e = gHistoLst(i-1)
REDIM gList(PARSECOUNT(e,$LF))
PARSE e, gList(), $LF
END IF
CONTROL ADD COMBOBOX, hDlg, 99, gList(), 18, 32, 244, 120
CONTROL SET FOCUS hDlg, 99
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB AddToHistory(BYVAL searchTerm AS STRING)
LOCAL dec, db AS STRING
LOCAL i, n AS LONG
ARRAY SCAN gHistoUri(), COLLATE UCASE, =gStartPath, TO i
' No history yet for this folder > create one
IF i = 0 THEN
dec = gStartPath + "|" + searchTerm
n = gHistoNb + 1
' Existing history for this folder
ELSE
' Only add search term if it doesn't already exists
IF INSTR ($LF+LCASE$(gHistoLst(i-1))+$LF, _
$LF+LCASE$(searchTerm)+$LF) <> 0 THEN
EXIT SUB
ELSE
dec = gHistoUri(i-1) + "|" + gHistoLst(i-1) + $LF + searchTerm
n = gHistoIdx(i-1)
END IF
END IF
db = RoamingAppData() + "ickvdo." + FORMAT$(n, "000")
Encrypt_and_Write_File db, dec
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB RemoveFromHistory(BYVAL searchTerm AS STRING)
LOCAL dec, db AS STRING
LOCAL i, j AS LONG
ARRAY SCAN gHistoUri(), COLLATE UCASE, =gStartPath, TO i
' No history yet for this folder (should not happen) > cancel
IF i = 0 THEN EXIT SUB
' Existing history for this folder > search index of term
j = INSTR ($LF+LCASE$(gHistoLst(i-1))+$LF, _
$LF+LCASE$(searchTerm)+$LF)
' Term not present (should not happen) > cancel
IF j = 0 THEN EXIT SUB
IF j = 1 THEN INCR j
' Term present > remove it!
gHistoLst(i-1) = LEFT$(gHistoLst(i-1), MAX(0,j-2)) _
+ MID$(gHistoLst(i-1), j+LEN(searchTerm))
' Update DB
dec = gHistoUri(i-1) + "|" + gHistoLst(i-1)
db = RoamingAppData() + "ickvdo." + FORMAT$(gHistoIdx(i-1), "000")
Encrypt_and_Write_File db, dec
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB BackupHisto()
LOCAL i AS LONG
FOR i = LBOUND(gHistoIdx) TO UBOUND(gHistoIdx)
KILL CURDIR$ + "\ickvdo." + FORMAT$(gHistoIdx(i),"000")
FILECOPY RoamingAppData() + "ickvdo." + FORMAT$(gHistoIdx(i),"000"), _
CURDIR$ + "\ickvdo." + FORMAT$(gHistoIdx(i),"000")
NEXT
?"Backup done.", %MB_ICONINFORMATION, EXE.NAME$
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION PBMAIN
LOCAL c, y AS LONG
gStartPath = TRIM$(COMMAND$,$DQ)
IF gStartPath = "/backup" THEN ' Special CLI option
GetAllHistoryLists()
BackupHisto()
EXIT FUNCTION
ELSEIF gStartPath = "" THEN ' No argument
?"Usage: "+$CRLF+$CRLF _
+"- By command line:"+$CRLF _
+"ickvdo "+$DQ+"C:\Video\Target\"+$DQ _
+$CRLF+$CRLF _
+"- or drag & drop a folder onto this executable" _
, %MB_ICONINFORMATION, "ickvdo (I seek a video)"
EXIT FUNCTION
END IF
gStartPath = RTRIM$(gStartPath, "\") + "\"
' Create dialog
DIALOG NEW PIXELS, 0, "ickvdo (I seek a video)",,, 280, 120, _
%WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO gHdlg
DIALOG SET ICON gHdlg, "AICO"
CONTROL ADD GRAPHIC, gHdlg, 88, "", 0, 0, 280, 120
GRAPHIC ATTACH gHdlg, 88
' Gray background
FOR y = 0 TO 280*2
c = 125+150*(y+140)/(280*2)
GRAPHIC LINE (0,y)-(y,0), RGB(c,c,c)
NEXT
' Magnifying glass
FOR y = 1 TO 6
GRAPHIC BOX (11+y/2,84+y/2)-(37-y/2,109-y/2), 120, %GRAY+RND(-30,30)
GRAPHIC LINE (19-y/2,105)-(2-y/2,130), %GRAY+RND(-30,30)
GRAPHIC LINE (17-y,110)-(-y,135), %GRAY+RND(-30,30)
NEXT
GRAPHIC BOX (10,83)-(38,110), 100, %GRAY+RND(-30,30)
' left reflection
GRAPHIC LINE (14,95)-(19,100), %GRAY+RND(-30,30)
GRAPHIC LINE (16,94)-(20,98), %GRAY+RND(-30,30)
' right reflection
GRAPHIC LINE (28,94)-(33,99), %GRAY+RND(-30,30)
GRAPHIC LINE (30,93)-(34,97), %GRAY+RND(-30,30)
' running lines
GRAPHIC LINE (40,88)-(47,88), %GRAY+RND(-30,30)
GRAPHIC LINE (40,92)-(57,92), %GRAY+RND(-30,30)
GRAPHIC LINE (40,96)-(67,96), %GRAY+RND(-30,30)
' version
GRAPHIC SET POS (27,107)
GRAPHIC COLOR %GRAY, -2
GRAPHIC PRINT "v" + $VER
' Search result labels
CONTROL ADD LABEL, gHdlg, 100, "", 18, 62, 70, 20
CONTROL SET COLOR gHdlg, 100, -1, -2
CONTROL ADD LABEL, gHdlg, 101, "", 88, 57, 182, 20
CONTROL SET COLOR gHdlg, 101, -1, -2
' About label
CONTROL ADD LABEL, gHdlg, 102, "[?]", 75, 91, 14, 20, %SS_NOTIFY
CONTROL SET COLOR gHdlg, 102, %BLUE, -2
' Path label
CONTROL ADD LABEL, gHdlg, 103, RTRIM$(gStartPath,"\"), 22, 12, 240, 14, %SS_PATHELLIPSIS
CONTROL SET COLOR gHdlg, 103, -1, -2
CONTROL ADD BUTTON, gHdlg, %IDOK, "&Search", 94, 88, 80, 22
CONTROL ADD BUTTON, gHdlg, %IDCANCEL, "E&xit", 182, 88, 80, 22
DIALOG SHOW MODAL gHdlg CALL ProcMain
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain () AS LONG
LOCAL txt, r AS STRING
LOCAL hCB, hFnt AS DWORD
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
RANDOMIZE TIMER
KILL EXE.PATH$ + "\temp.m3u8" ' Remove any previous M3U8
SetTimer(CB.HNDL, 0, 50, 0)
CASE %WM_TIMER ' Scan 'history' databases
KillTimer(CB.HNDL, 0)
GetAllHistoryLists()
PopulateCombo CB.HNDL ' Create populated combobox
hCB = GetDlgItem(CB.HNDL, 99)
ghCbFocus = GetWindow(hCB, %GW_CHILD) ' The Edit part is child of CB %CBS_DROPDOWN
CASE %WM_CTLCOLORLISTBOX ' sent when a combobox (CB) list needs repainting
IF GetFocus = ghCbFocus THEN ' ensure we get correct CB list
IF gOldProc = 0 THEN
ghCBList = CB.LPARAM ' CB list handle - we can subclass (CB listbox is tricky - owner/parent is not CB)
gOldProc = SetWindowLong(ghCbFocus, %GWL_WNDPROC, CODEPTR(CBProc))
END IF
END IF
CASE %WM_SETCURSOR ' change cursor to link-hand when hovering over controls
IF GetDlgCtrlId(CB.WPARAM) = 102 THEN ' [?]
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
CASE %WM_COMMAND
IF CB.CTLMSG <> %BN_CLICKED THEN EXIT SELECT
IF CB.CTL = %IDOK THEN
SeekStart CB.HNDL ' Start search procedure
CONTROL GET TEXT CB.HNDL, 99 TO txt
DoFilter(txt)
CONTROL SET TEXT CB.HNDL, 100, "Files found:"
r = FORMAT$(gMatchCount) + " / " + FORMAT$(gFileCount)
IF gMatchCount = 0 THEN
CONTROL SET COLOR CB.HNDL, 101, %RED, -2
ELSE
CONTROL SET COLOR CB.HNDL, 101, %RGB_DARKGREEN, -2
END IF
FONT NEW "", 14 TO hFnt
CONTROL SET FONT CB.HNDL, 101, hFnt
CONTROL SET TEXT CB.HNDL, 101, r
DIALOG DOEVENTS
SLEEP 650
CONTROL SET FOCUS CB.HNDL, %IDCANCEL
IF gMatchCount > 0 THEN
CreateM3U8()
AddToHistory(txt)
IF EXISTS("vlcrun.exe") THEN
ShellExecute %NULL, "open", "vlcrun.exe", EXE.PATH$+"\temp.m3u8", "", %SW_SHOW
ELSE
ShellExecute %NULL, "open", EXE.PATH$+"\temp.m3u8", "", "", %SW_SHOW
END IF
DIALOG SHOW STATE CB.HNDL, %SW_HIDE ' hide the main dialog
SLEEP 45 SECONDS
DO ' wait until the M3U8 is released, then remove it!
KILL EXE.PATH$ + "\temp.m3u8"
SLEEP 500
LOOP UNTIL ISFALSE EXISTS(EXE.PATH$ + "\temp.m3u8")
END IF
DIALOG END CB.HNDL
ELSEIF CB.CTL = %IDCANCEL THEN
DIALOG END CB.HNDL
ELSEIF CB.CTL = 102 THEN ' About
ShellExecute %NULL, "open", "http://mougino.free.fr/freeware", "", "", %SW_SHOW
END IF
CASE %WM_DESTROY
gAbort = 1 ' Cancel eventual recursive action on exit
IF gOldProc THEN SetWindowLong ghCBList, %GWL_WNDPROC, gOldProc
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Combobox list subclass procedure
'------------------------------------------------------------------------------
FUNCTION CBProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL LBitem AS LONG
LOCAL e AS STRING
IF wMsg = %WM_KEYUP AND wParam = %VK_DELETE THEN
LBitem = SendMessage(ghCBList, %LB_GETCURSEL, 0, 0)
COMBOBOX GET TEXT ghDlg, 99, 1+LBitem TO e
RemoveFromHistory e
COMBOBOX DELETE ghDlg, 99, 1+LBitem
END IF
FUNCTION = CallWindowProc(gOldProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB CreateM3U8()
LOCAL i AS LONG
LOCAL ff AS LONG
LOCAL fo AS STRING
fo = RTRIM$(gStartPath, "\") + "\"
REPLACE "\" WITH "/" IN fo
REPLACE " " WITH "%20" IN fo
ff = FREEFILE
OPEN EXE.PATH$ + "\temp.m3u8" FOR OUTPUT AS #ff
PRINT #ff, "#EXTM3U"
FOR i = LBOUND(gMatch) TO UBOUND(gMatch)
PRINT #ff, "#EXTINF:-1," + RTRIM$(gStartPath, "\") + "\" + gMatch(i)
REPLACE "\" WITH "/" IN gMatch(i)
REPLACE " " WITH "%20" IN gMatch(i)
PRINT #ff, "file:///" + fo + gMatch(i)
NEXT
CLOSE #ff
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' File search procedure
'------------------------------------------------------------------------------
SUB ReadDirs (BYVAL Path AS STRING)
LOCAL hSearch AS DWORD ' Search handle
LOCAL WFD AS WIN32_FIND_DATA ' FindFirstFile structure
LOCAL curpath AS ASCIIZ * %MAX_PATH ' What to search for
curpath = Path + "*" ' This is what we want to find
hSearch = FindFirstFile(curpath, WFD) ' Get search handle, if success
IF hSearch <> %INVALID_HANDLE_VALUE THEN ' Loop through directory for files
DO
IF (WFD.dwFileAttributes AND %FILE_ATTRIBUTE_DIRECTORY) _ ' If not directory bit is set
<> %FILE_ATTRIBUTE_DIRECTORY THEN ' (files only here...)
IF gFileCount MOD 200 = 0 THEN
REDIM PRESERVE gFiles(gFileCount + 200) AS GLOBAL STRING
DIALOG DOEVENTS ' let the system "breathe" ..
IF gAbort THEN EXIT DO ' Has user cancelled?
END IF
gFiles(gFileCount) = REMOVE$(Path, gStartPath) + WFD.cFileName
INCR gFileCount
ELSEIF WFD.cFileName <> "." AND WFD.cFileName <> ".." THEN ' Not these..
ReadDirs Path + RTRIM$(WFD.cFileName, $NUL) + "\" ' Recursive call for Subdirs
END IF
LOOP WHILE FindNextFile(hSearch, WFD)
FindClose hSearch
END IF
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB DoFilter(BYVAL txt AS STRING)
LOCAL i AS LONG
LOCAL fn AS STRING
txt = LCASE$(txt) ' case insensitive search
REDIM gMatch(0)
gMatchCount = 0
FOR i = LBOUND(gFiles) TO UBOUND(gFiles)
fn = LCASE$(PATHNAME$(NAME, gFiles(i)))
IF INSTR(fn, txt) > 0 THEN
INCR gMatchCount
IF gMatchCount MOD 20 = 1 THEN REDIM PRESERVE gMatch(gMatchCount+20)
gMatch(gMatchCount-1) = gFiles(i)
END IF
NEXT
REDIM PRESERVE gMatch(gMatchCount-1)
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' Start and end point of a file search action
'------------------------------------------------------------------------------
SUB SeekStart (BYVAL hDlg AS DWORD)
LOCAL txt AS STRING, t AS SINGLE
DIALOG DOEVENTS
CONTROL GET TEXT hDlg, %IDOK TO txt
IF txt = "&Cancel" THEN
' User has cancelled action
gAbort = 1
gBusy = %FALSE
DIALOG DOEVENTS
EXIT SUB
END IF
' Else: Go!
t = TIMER
gBusy = %TRUE
gAbort = 0
gFileCount = 0
REDIM gFiles(0) AS GLOBAL STRING ' Clear array
' Disable system menu's close item
MENU SET STATE GetSystemMenu(hDlg, 0), %SC_CLOSE, %MF_GRAYED
' Change Search button into a Cancel-button
CONTROL SET TEXT hDlg, %IDOK, "&Cancel"
' Disable other controls
CONTROL DISABLE hDlg, 99
CONTROL DISABLE hDlg, %IDCANCEL
DIALOG DOEVENTS
' Terminate with backslash
gStartPath = RTRIM$(gStartPath, ANY "\/") + "\"
' Call the search procedure
ReadDirs gStartPath
' Resize array
REDIM PRESERVE gFiles(gFileCount - 1) AS GLOBAL STRING
' Time taken
t = TIMER - t
'control set text hDlg, 100, format$(gFileCount)+" found in "+FORMAT$(t,"0.000")+"s"
' Make it search-button again
CONTROL SET TEXT hDlg, %IDOK, "&Search"
' Reenable controls
CONTROL ENABLE hDlg, %IDCANCEL
CONTROL ENABLE hDlg, 99
' Reenable system menu's close item
MENU SET STATE GetSystemMenu(hDlg, 0), %SC_CLOSE, %MF_ENABLED
' Allow the GUI to work fully again.
gBusy = %FALSE
DIALOG DOEVENTS
END SUB
'------------------------------------------------------------------------------