#include "vbcompat.bi"

Dim srchf As Integer            '  file handle of file to be searched
Dim listf As Integer            '  file handle of list of files to be searched
Dim outf As Integer             '  file handle of batch file for files to be deleted
Dim srchfilnam As String        '  name of file to be searched
Dim listfilnam As String        '  name of list of files to be searched
Dim outfilnam As String         '  name of batch/log/list file for files to be deleted
Dim srchfilsize As ULong        '  size (in bytes) of file to be searched
Dim listcount As ULong          '  number of files in list
Dim percent As UShort           '  percentage of files processed
Dim footerloc As ULong          '  location of footer in file
Dim shdrdata As String          '  header data from file
Dim sftrdata As String          '  footer data from file
Dim nextblock As ULong          '  number of files to process before next progress report 
Dim delflg As Boolean           '  True if file is to be deleted
Dim deleteLater As Boolean      '  matching files are written to batch file (True) for later deletion 
Dim deleteList As Boolean       '  matching files are written to list file (True)
Dim deleteNow As Boolean        '  matching files are deleted immediately (True)
Dim killresult As UByte         '  0 if file was successfully deleted, 1 if deletion was unsuccessful
Dim i As ULong                  '  counter
Dim j As ULong                  '  counter
Dim sArg1 As String             '  1st command line argument
Dim sArg2 As String             '  2nd command line argument
Dim sArg3 As String             '  3rd command line argument
Dim sArg4 As String             '  4th command line argument
Dim sArg5 As String             '  5th command line argument
Dim sArg6 As String             '  6th command line argument
Dim sArg7 As String             '  7th command line argument
Dim sArg8 As String             '  8th command line argument
Dim sHdr As String              '  header parameter in command line
Dim sBool As String             '  AND / OR Boolean parameter in command line
Dim sFtr As String              '  footer parameter in command line
Dim invhdrflg As Boolean        '  True if header must not match any of data1, data2, ... dataN
Dim invftrflg As Boolean        '  True if footer must not match any of data1, data2, ... dataN
Dim searchtyp As UByte          '  choice of matching rules according to 12 possible command line combinations
Dim maxlenhdr As UShort         '  length of longest header
Dim maxlenftr As UShort         '  length of longest footer
Dim numhdrs As UShort           '  number of headers
Dim numftrs As UShort           '  number of footers
Dim hdrpos1 As UShort           '  current character position in header parameter
Dim hdrpos2 As UShort           '  next character position in header parameter
Dim ftrpos1 As UShort           '  current character position in footer parameter
Dim ftrpos2 As UShort           '  next character position in footer parameter
Dim hdrnum As UShort            '  current header number
Dim ftrnum As UShort            '  current footer number
ReDim hdr( 1 To 1 ) As String       '  nth header
ReDim ftr( 1 To 1 ) As String       '  nth footer
ReDim lenhdr( 1 To 1 ) As UShort    '  length of nth header
ReDim lenftr( 1 To 1 ) As UShort    '  length of nth footer
Dim hdrmatch As Boolean         '  True if desired header matches the file header
Dim ftrmatch As Boolean         '  True if desired footer matches the file footer
Dim keypress As String          '  user keypress
Dim decdig As UByte             '  decimal digit
Dim sftrblksize As String       '  size of footer block on command line (in decimal)
Dim shdrblksize As String       '  size of header block on command line (in decimal)
Dim decchar As String           '  decimal character
Dim ftrblksize As ULong         '  size of footer block
Dim hdrblksize As ULong         '  size of header block
Dim adjftrblksiz As ULong       '  size of footer block ajusted for files whose size is less than the footer block
Dim sAnswer As String           '  user input

Sub Usage
    
    Print
    Print "Usage:"
    Print
    Print "  SRCHHDFT inf=file_list outf=log/bat/list_file delete=[now/later/list] hdrlen=size_of_header_block ftrlen=size_of_footer_block [+/-]hdr=data1/data2/dataN [AND/OR] [+/-]ftr=data1/data2/dataN"
    Print
    Print "This program searches for all files in the file list with matching header and footer."
    Print
    Print "If ""delete=now"" is specified, then the matching files are deleted and the results logged to ""outf""."
    Print "If ""delete=later"" is specified, then the del commands are written to the BATch file specified by ""outf""."
    Print "If ""delete=list"" is specified, then the file specs are written to the list file specified by ""outf""."
    Print    
    Print "The header/footer can be any of data1, data2, ... dataN (hexadecimal only)."
    Print
    Print "Both header and footer are optional."
    Print
    Print "If ""+hdr"" or ""+ftr"" is specified, then the header/footer must match one of data1, data2, ... dataN."
    Print "If ""-hdr"" or ""-ftr"" is specified, then the header/footer must not match any of data1, data2, ... dataN."
    Print
    Print "Hexadecimal strings must have an even number of characters."
    Print "Use a leading 0 if necessary, eg 0ABC." 
    Print
    Print "Specifying hdrlen = 0 searches for a header at the start of the file."
    Print "Hdrlen = N (decimal) searches for headers in the first N bytes of the file."
    Print
    Print "Specifying ftrlen = 0 searches for a footer at the end of the file."
    Print "Ftrlen = N (decimal) searches for footers in the last N bytes of the file."
    Print
    Print "Examples:"
    Print
    Print "  SRCHHDFT inf=DATlist.txt outf=delold.log delete=now hdrlen=0 ftrlen=0 hdr=41424344 AND -ftr=ff0123FF"
    Print "  SRCHHDFT inf=DATlist.txt outf=delold.lst delete=list hdrlen=64 ftrlen=4096 -hdr=012345 OR ftr=ffFFFF/414E44"
    Print "  SRCHHDFT inf=""list of files to search.txt"" outf=""delete bad files.bat"" delete=later hdrlen=0 ftrlen=0 hdr=424144"
    Print
    Print "A file count is displayed after every 1000 files have been processed."
    Print
    Print "Type F to print the current file count."
    Print "Type Q to save results and quit program."
    Print
    End
    
End Sub


Function ConvHex( srchdat As String ) As String

    Dim hexstrg As String           '  hexadecimal search string
    Dim hexchar As UByte            '  ASCII value of nibble
    Dim lownibble As UByte          '  hexadecimal value of low nibble
    Dim hinibble As UByte           '  hexadecimal value of high nibble
    Dim hinibflg As UByte           '  = 1 if high nibble, = 0 if low nibble
    Dim isHex As UByte              '  = 0 if search string is text, = 1 if hexadecimal string
    Dim lendat As UShort            '  length of hexadecimal search string in nibbles
    Dim i As Integer                '  counter

    lendat = Len( srchdat )
    
    If lendat Mod 2 <> 0 Then
    
        Print
        Print "Odd number of characters in hexadecimal string ( "; srchdat; " ) -- aborting"
        Usage
        
    End If
    
    hexstrg = ""
    hinibflg = 1
    srchdat = UCase( srchdat )

    For i = 1 To lendat

        hexchar = Asc( Mid( srchdat, i, 1 ) )
        
        
        If ( hexchar > &H2F ) AndAlso ( hexchar < &H3A ) Then
        
            hexchar = hexchar - &H30
        
        ElseIf ( hexchar > &H40 ) AndAlso ( hexchar < &H47 ) Then
        
            hexchar = hexchar - 55
        Else
            Print
            Print "Invalid character(s) in hexadecimal string ( "; srchdat; " ) -- aborting"
            Usage
            
        End If
        
        
        If hinibflg = 1 Then
        
            hinibble = hexchar
            hinibflg = 0
        Else
            lownibble = hexchar
            hexstrg = hexstrg & Chr( lownibble + ( hinibble Shl 4 ) )
            hinibflg = 1
            
        End If

    Next i

    Return hexstrg 

End Function



' Parse the command line

listfilnam = ""
outfilnam = ""

' Parse INF parameter

sArg1 = Ucase( Command(1) )

If Left( sArg1, 4 ) <> "INF=" Then

    Usage
Else
    listfilnam = Mid( Command(1), 5 )
    
End If

' Check if list file exists

If Not FileExists( listfilnam ) Then
    
    Print "List file not found: " & listfilnam
    Usage
    
End If


' Parse OUTF parameter

sArg2 = Ucase( Command(2) )

If Left( sArg2, 5 ) <> "OUTF=" Then

    Usage
Else
    outfilnam = Mid( Command(2), 6 )
    
End If

' Check if batch/log/list file exists

If FileExists( outfilnam ) Then

'    Print "Batch/log/list file already exists: " & outfilnam

' Clear keyboard buffer

    Do
    Loop Until Inkey = ""

    Print "WARNING: "; outfilnam; " already exists, the old file will be erased !! Continue (Y/N)?" ;

    sAnswer = ""
    
    Do Until ( sAnswer = "Y" ) Or ( sAnswer = "N" )
        
        sAnswer = UCase( Input(1) )

        If sAnswer = "N" Then
            
            Print "No"
            Print
            Print "Old batch/log/list file was not deleted - program aborted."
            End
            
        ElseIf sAnswer = "Y" Then
            
            Print "Yes"
            Print
            
            killresult = Kill( outfilnam )

            If killresult = 0 Then

                Print "Old batch/log/list file was deleted - continuing."    
            Else
                Print "Deletion error ( "; killresult; " ):  "; outfilnam; "  - program aborted."
                End
                
            End If
            
        End If
            
    Loop

End If


' Check for delete=now/later/list

sArg3 = Ucase( Command(3) )

If Left( sArg3, 7 ) <> "DELETE=" Then

    Usage
Else
    If Mid( sArg3, 8 ) = "NOW" Then

        deleteLater = False: deleteNow = True: deleteList = False

    ElseIf Mid( sArg3, 8 ) = "LATER" Then

        deleteLater = True: deleteNow = False: deleteList = False
        
    ElseIf Mid( sArg3, 8 ) = "LIST" Then

        deleteLater = False: deleteNow = False: deleteList = True
        
    Else
        Print "Syntax error - unrecognised delete option."
        Usage
    End If
End If


' parse the HDRLEN parameter

sArg4 = Ucase( Command( 4 ) )

If Left( sArg4, 7 ) <> "HDRLEN=" Then

    Usage
Else
    shdrblksize = Mid( sArg4, 8 )
    
End If

If shdrblksize = "" Then

    Print "Syntax error -- empty hdrlen parameter."
    Usage
End If 

hdrblksize = 0

For i = 1 To Len( shdrblksize )

    decchar = Mid( shdrblksize, i, 1 )
    decdig = Asc( decchar )

    If ( ( decdig > &H2F ) AndAlso ( decdig < &H3A ) ) Then

        decdig -= &H30
        hdrblksize = ( hdrblksize * 10 ) + decdig
    Else
        Print "Syntax error -- invalid decimal digit in hdrlen parameter."
        Usage
    End If

Next i


' parse the FTRLEN parameter


sArg5 = Ucase( Command( 5 ) )

If Left( sArg5, 7 ) <> "FTRLEN=" Then

    Usage
Else
    sftrblksize = Mid( sArg5, 8 )
End If

If sftrblksize = "" Then

    Print "Syntax error -- empty ftrlen parameter."
    Usage
End If 

ftrblksize = 0

For i = 1 To Len( sftrblksize )

    decchar = Mid( sftrblksize, i, 1 )
    decdig = Asc( decchar )

    If ( ( decdig > &H2F ) AndAlso ( decdig < &H3A ) ) Then

        decdig -= &H30
        ftrblksize = ( ftrblksize * 10 ) + decdig
    Else
        Print "Syntax error -- invalid decimal digit in ftrlen parameter."
        Usage
    End If

'    If ftrblksize > &HFFFF Then

'        Print "Syntax error -- ftrlen parameter must be less than 65536 (64KB)."
'        Usage
'    End If
Next i

If ( Command( 9 ) <> "" ) Then

    Print "Syntax error -- too many arguments"
    Usage
End If


' Parse the header and footer command parameters

sArg6 = Ucase( Command(6) )
sArg7 = Ucase( Command(7) )
sArg8 = Ucase( Command(8) )

' Check for [+/-]header

If  ( ( Mid( sArg6, 2, 4 ) = "HDR=" ) AndAlso _
    ( sArg7 ="" ) AndAlso _
    ( sArg8 ="" ) ) Then

    sHdr = sArg6
    sBool = ""
    sFtr = ""

    If Left( sHdr, 1 ) = "+" Then

        invhdrflg = False
        searchtyp = 1

    ElseIf Left( sHdr, 1 ) = "-" Then

        invhdrflg = True
        searchtyp = 2
    Else
        Print "Syntax Error - found """; Left( sHdr, 1 ) ; """ when expecting ""+"" or ""-"" in header parameter."
        Usage
    End If


' Check for [+/-]footer

ElseIf  ( ( Mid( sArg6, 2, 4 ) = "FTR=" ) AndAlso _
        ( sArg7 ="" ) AndAlso _
        ( sArg8 ="" ) ) Then

    sHdr = ""
    sBool = ""
    sFtr = sArg6

    If Left( sFtr, 1 ) = "+" Then

        invftrflg = False
        searchtyp = 3

    ElseIf Left( sFtr, 1 ) = "-" Then

        invftrflg = True
        searchtyp = 4
    Else
        Print "Syntax Error - found """; Left( sFtr, 1 ) ; """ when expecting ""+"" or ""-"" in footer parameter."
        Usage
    End If


' Check for [+/-]header AND/OR [+/-]footer

ElseIf  ( ( Mid( sArg6, 2, 4 ) = "HDR=" ) AndAlso _
        (( sArg7 ="AND" ) OrElse ( sArg7 ="OR" )) AndAlso _
        ( Mid( sArg8, 2, 4 ) = "FTR=" ) ) Then

    sHdr = sArg6
    sBool = sArg7
    sFtr = sArg8

    If Left( sHdr, 1 ) = "+" Then

        invhdrflg = False

    ElseIf Left( sHdr, 1 ) = "-" Then

        invhdrflg = True
    Else
        Print "Syntax Error - found """; Left( sHdr, 1 ) ; """ when expecting ""+"" or ""-"" in header parameter."
        Usage
    End If


    If Left( sFtr, 1 ) = "+" Then

        invftrflg = False

    ElseIf Left( sFtr, 1 ) = "-" Then

        invftrflg = True
    Else
        Print "Syntax Error - found """; Left( sFtr, 1 ) ; """ when expecting ""+"" or ""-"" in footer parameter."
        Usage
    End If


    If ( ( Not invhdrflg ) AndAlso Cbool( sBool = "AND" ) AndAlso ( Not invftrflg ) ) Then

        searchtyp = 5

    ElseIf ( ( Not invhdrflg ) AndAlso Cbool( sBool = "AND" ) AndAlso invftrflg ) Then

        searchtyp = 6

    ElseIf ( invhdrflg AndAlso Cbool( sBool = "AND" ) AndAlso ( Not invftrflg ) ) Then

        searchtyp = 7

    ElseIf ( invhdrflg AndAlso Cbool( sBool = "AND" ) AndAlso invftrflg ) Then

        searchtyp = 8

    ElseIf ( ( Not invhdrflg ) AndAlso Cbool( sBool = "OR" ) AndAlso ( Not invftrflg ) ) Then

        searchtyp = 9

    ElseIf ( ( Not invhdrflg ) AndAlso Cbool( sBool = "OR" ) AndAlso invftrflg ) Then

        searchtyp = 10

    ElseIf ( invhdrflg AndAlso Cbool( sBool = "OR" ) AndAlso ( Not invftrflg ) ) Then

        searchtyp = 11

    ElseIf ( invhdrflg AndAlso Cbool( sBool = "OR" ) AndAlso invftrflg ) Then

        searchtyp = 12
        
    End If
Else
    Print "Syntax error - unrecognised header and footer parameters"
    Usage
    
End If


' Parse header parameter

maxlenhdr = 0

If ( sHdr = "" ) Then

    numhdrs = 0
    Goto Footer 
    
End If


If ( Mid( sHdr, 6 ) = "" ) Then

    Print "Syntax error -- empty header parameter"
    Usage
    
End If


' Extract the headers (delimited by "/")

hdrpos1 = 6
hdrnum = 1

Do
    hdrpos2 = Instr( hdrpos1, sHdr, "/" )

    If ( hdrpos2 <> 0 ) Then

        If ( hdrpos1 = hdrpos2 ) Then

            Print "Syntax error -- invalid header parameter"
            Usage
        End If

        hdr( hdrnum ) = Mid( sHdr, hdrpos1, hdrpos2 - hdrpos1 )

    Else
        hdr( hdrnum ) = Mid( sHdr, hdrpos1 )
        
    End If
    

    hdr( hdrnum ) = ConvHex( hdr( hdrnum ) )
    lenhdr( hdrnum ) = Len( hdr( hdrnum ) )
    

    If ( lenhdr( hdrnum ) > maxlenhdr ) Then

        maxlenhdr = lenhdr( hdrnum )
        
    End If


    If ( hdrpos2 <> 0 ) Then

        hdrpos1 = hdrpos2 + 1
        hdrnum += 1
        Redim Preserve hdr( 1 To hdrnum )
        Redim Preserve lenhdr( 1 To hdrnum )
    Else
        Exit Do
        
    End If
Loop


numhdrs = hdrnum


' Parse footer parameter

maxlenftr = 0

If ( sFtr = "" ) Then

    numftrs = 0
    Goto Search
    
End If


If ( Mid( sFtr, 6 ) = "" ) Then

    Print "Syntax error -- empty footer parameter"
    Usage
    
End If



' Extract the footers (delimited by "/")

Footer:

ftrpos1 = 6
ftrnum = 1

Do
    ftrpos2 = Instr( ftrpos1, sftr, "/" )

    If ( ftrpos2 <> 0 ) Then

        If ( ftrpos1 = ftrpos2 ) Then

            Print "Syntax error -- invalid footer parameter"
            Usage
        End If

        ftr( ftrnum ) = Mid( sftr, ftrpos1, ftrpos2 - ftrpos1 )

    Else
        ftr( ftrnum ) = Mid( sftr, ftrpos1 )
        
    End If
    

    ftr( ftrnum ) = ConvHex( ftr( ftrnum ) )
    lenftr( ftrnum ) = Len( ftr( ftrnum ) )
    

    If ( lenftr( ftrnum ) > maxlenftr ) Then

        maxlenftr = lenftr( ftrnum )
        
    End If


    If ( ftrpos2 <> 0 ) Then

        ftrpos1 = ftrpos2 + 1
        ftrnum += 1
        Redim Preserve ftr( 1 To ftrnum )
        Redim Preserve lenftr( 1 To ftrnum )
    Else
        Exit Do
        
    End If
Loop


numftrs = ftrnum


Search:

' Count number of files in list file

listf = FreeFile
Open listfilnam For Input As #listf

listcount = 0

Do Until EOF( listf )

    Line Input #listf, srchfilnam
    listcount += 1
Loop

If listcount = 0 Then

    Print "List file is empty."
    Print
    Print "Create a list of files to be searched as in the following example:"
    Print
    Print " dir ""c:\pathname\*.dat"" /s /b > datlist.txt"
    Usage
Else
    Print "Processing "; listcount; " file(s) ..."
    Print
    
End If

Seek #listf, 1


If hdrblksize = 0 Then

    shdrdata = Space( maxlenhdr )
Else
    shdrdata = Space( hdrblksize )
    
End If


If ftrblksize = 0 Then

    sftrdata = Space( maxlenftr )
Else
    sftrdata = Space( ftrblksize )
    
End If

nextblock = 1000

outf = FreeFile
Open outfilnam For Output As #outf

For i = 1 To listcount

    Line Input #listf, srchfilnam

' Check for user input    

' F = print current file count
' Q = save results and quit program

    keypress = Inkey

    If ( keypress = "f" ) OrElse ( keypress = "F" ) Then

        percent = 100 * i \ listcount
        Print "Processing file number "; i ; " of "; listcount; " ("; percent; "%) -- "; srchfilnam

    ElseIf ( keypress = "q" ) OrElse ( keypress = "Q" ) Then

        percent = 100 * i \ listcount
        Print i; " files of "; listcount; " ("; percent; "%) processed. Program aborted by user."
        Close
        End
        
    End If

' Check if we should display progress report

    If i = nextblock Then

        Print "Processing file number "; i ; " of "; listcount; " ("; percent; "%) -- "; srchfilnam
        nextblock += 1000
    End If

' Check that file exists otherwise process the next file

    If Not FileExists( srchfilnam ) Then
        Continue For
    End If

    srchf = FreeFile
    Open srchfilnam For Binary As #srchf

    srchfilsize = FileLen( srchfilnam )

    If srchfilsize < ( maxlenhdr + maxlenftr ) Then

        Continue For
        
    End If

    If ( maxlenhdr <> 0 ) Then

        Get #srchf, 1, shdrdata
        
    End If


    If ( maxlenftr <> 0 ) Then

        If ftrblksize = 0 Then

            footerloc = srchfilsize - maxlenftr + 1
        Else

' Allow for footer blocks which are as large as, or larger than, the file to be searched

            If ftrblksize < maxlenftr Then

                ftrblksize = maxlenftr
                
            End If

            footerloc = srchfilsize - ftrblksize + 1

            If footerloc < ( maxlenhdr + 1 ) Then

                footerloc = maxlenhdr + 1
                
            End If
        End If

        Get #srchf, footerloc, sftrdata
    End If

' Check the headers and footers and determine whether the file is to be deleted


' Check whether any of the specified headers are present

    hdrmatch = False
    

    If ( maxlenhdr <> 0 ) Then

        If hdrblksize = 0 Then

            For j = 1 To numhdrs
    
                If Left( shdrdata, lenhdr( j ) ) = hdr( j ) Then
    
                    hdrmatch = True
                    
                End If
                
            Next j
        Else
            For j = 1 To numhdrs

' better if use Do While hdrmatch = False

                If Instr( shdrdata, hdr( j ) ) <> 0 Then

                    hdrmatch = True
                    
                End If

            Next j            
        End If
    End If

' Check whether any of the specified footers are present

    ftrmatch = False
    

    If ( maxlenftr <> 0 ) Then

        If ftrblksize = 0 Then

            For j = 1 To numftrs

                If Right( sftrdata, lenftr( j ) ) = ftr( j ) Then

                    ftrmatch = True
                    
                End If
            Next j

        Else

' Reduce range of search of sftrdata for small files to exclude 0x00 padding

            adjftrblksiz = srchfilsize - footerloc + 1

' better if use Do While ftrmatch = False

            For j = 1 To numftrs

                If InstrRev( sftrdata, ftr( j ), adjftrblksiz ) <> 0 Then

                    ftrmatch = True
                    
                End If
            Next j
        End If
    End If


    delflg = False


    Select Case As Const searchtyp

' [+/-]header

    Case 1
        delflg = hdrmatch
    Case 2
        delflg = Not hdrmatch

' [+/-]footer

    Case 3
        delflg = ftrmatch
    Case 4
        delflg = Not ftrmatch

' [+/-]header AND [+/-]footer

    Case 5
        delflg = hdrmatch AndAlso ftrmatch
    Case 6
        delflg = hdrmatch AndAlso ( Not ftrmatch )
    Case 7
        delflg = ( Not hdrmatch ) AndAlso ftrmatch
    Case 8
        delflg = ( Not hdrmatch ) AndAlso ( Not ftrmatch )

' [+/-]header OR [+/-]footer

    Case 9
        delflg = hdrmatch OrElse ftrmatch
    Case 10
        delflg = hdrmatch OrElse ( Not ftrmatch )
    Case 11
        delflg = ( Not hdrmatch ) OrElse ftrmatch
    Case 12
        delflg = ( Not hdrmatch ) OrElse ( Not ftrmatch )

    End Select

    Close #srchf

    If delflg Then

        If deleteLater Then

            Print #outf, "del /f "; """"; srchfilnam; """"
                        
        ElseIf deleteList Then
        
            Print #outf, srchfilnam

        ElseIf deleteNow Then
        
            killresult = Kill( srchfilnam )

            If killresult = 0 Then

                Print #outf, "Deleted:  "; srchfilnam
            Else
                Print #outf, "Deletion error ( "; killresult; " ):  "; srchfilnam
                
            End If
            
        End If
    End If
Next i

Close #listf, #outf
End