Thorough search.

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dodicat
Posts: 5978
Joined: Jan 10, 2006 20:30
Location: Scotland

Thorough search.

Postby dodicat » May 08, 2019 16:10

Find words in text or binary files in folders . . .

Code: Select all


#include "file.bi"
#include "crt.bi"
Declare Function stats Cdecl Alias "_stat"(As zstring Ptr,As Any Ptr) As Integer

Function String_Split(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=Len(chars)
    Dim As boolean tally(Len(s_in))
    #macro check_instring()
    n=0
    While n<Lc
        If chars[n]=s_in[k] Then
            tally(k)=true
            If (ctr2-1) Then ctr+=1
            ctr2=0
            Exit While
        End If
        n+=1
    Wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function

Function _Remove(Byval Text As String,Char As String) As String
    Var index = 0,asci=Asc(char)
    For i As Integer = 0 To Len(Text) - 1
        If Text[i] <> ASCi Then Text[index] = Text[i] : index =index+ 1
    Next
    Return Left(Text,index)
End Function

Function loadfile(file As String) As String
    file= _remove(file,Chr(34))
    If file="" Then Exit Function
    If Fileexists(file)=0 Then Print file;" CAN'T READ OR EMPTY FOLDER":Exit Function
    Var  f=Freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Function isfolder(path As zstring Ptr) As Long
    #define S_ISDIR(m)   (((m) And &hF000) = &h4000)
    Dim As stat statbuf
    If (stats(path, @statbuf) <> 0) Then Return 0
    Return S_ISDIR(statbuf.st_mode)
End Function

Function isfile(fname As String) As boolean
    Return Iif(isfolder(fname),0,1)
End Function

Function pipeout(Byval s As String="") Byref As String
    Var f=Freefile
    Dim As String tmp
    Open Pipe s For Input As #f
    s=""
    Do Until Eof(f)
        Line Input #f,tmp
        s+=tmp+Chr(10)
    Loop
    Close #f
    Return s
End Function

function search(inputs As String,st As String) as long
    st=Lcase(st)
    If isfile(inputs) Then 'for a single file
        Var L=Lcase(loadfile(inputs))
        If Instr(L,st) Then Print inputs:Return 1 Else Return 0
    End If
    Dim As String file
    If Instr(inputs," ") Then inputs=Chr(34)+inputs+Chr(34)
    Dim As String s=pipeout("dir /b " + inputs)
    Dim As String a()
    Static As Long counter
    string_split(s,Chr(13,10),a())
    inputs=_remove(inputs,Chr(34))
    redim as string tmp()
    string_split(inputs,"\/",tmp())
    if instr(tmp(ubound(tmp)),st) then print inputs;" >> (In folder name)":counter+=1
    For n As Long=Lbound(a) To Ubound(a)
        Dim As String path=(inputs+"\"+a(n))
        If isfile(path) Then
            Redim As String tmp()
            string_split(path,"\",tmp())
            file= tmp(Ubound(tmp))
            If Instr(file,st) Then Print path;" >> (In file name)":counter+=1
            If Instr(file," ") Then file=Chr(34)+file+Chr(34)
            Var L=Lcase(loadfile(path))
            If Len(L) Andalso Instr(L,st) Then Print path:counter+=1
        Else
            search(path,st) 'for nested folders
        End If
    Next n
    return counter
End function


Dim  As String location="C:\Users\User\Desktop\fbv1.06"  ''<---------  search path here.

Print "Searching . . ."
var c=search(location,"extends object")
Print "Done ",c; "  locations"
Sleep
 

 
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Thorough search.

Postby Tourist Trap » May 16, 2019 13:13

dodicat wrote:Find words in text or binary files in folders . . .

Looks very useful, but I fail using it. Is there a type of file searched? First I changed the path with "E:\" then I tried a search of a given string in a .bas, it didn't work, neither .txt.
Searching . . .
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
La syntaxe du nom de fichier, de répertoire ou de volume est incorrecte.
Done 0 locations
dodicat
Posts: 5978
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Thorough search.

Postby dodicat » May 16, 2019 23:05

Hi TT
Thanks for testing.
Confine your search to some folder, not a drive.
I'll fix it for a drive letter, but My Win 10 is down, and I am using Linux which has different shell commands.
nimdays
Posts: 219
Joined: May 29, 2014 22:01
Location: ID

Re: Thorough search.

Postby nimdays » May 17, 2019 1:03

Nice one

Code: Select all

Searching . . .
C:\FreeBASIC-1.06.0-win32\examples\manual\operator\is.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\udt\abstract1.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\udt\extends2.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\udt\override.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\udt\virtual1.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\udt\virtual2.bas
C:\FreeBASIC-1.06.0-win32\examples\manual\variable\byref4.bas
C:\FreeBASIC-1.06.0-win32\examples\virtuals.bas
Done           8  locations

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest