Attribute VB_Name = "modFileSearch"
Option Explicit
'Type RECT
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type

 Type TRIVERTEX
   x As Long
   y As Long
   Red As Integer
   Green As Integer
   Blue As Integer
   Alpha As Integer
End Type

Private Type GRADIENT_RECT
   UPPERLEFT As Long
   LOWERRIGHT As Long
End Type
Private Declare Function GradientFill Lib "msimg32" (ByVal hDC As Long, pVertex As Any, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Const GRADIENT_FILL_RECT_H    As Long = &H0
Private Const GRADIENT_FILL_RECT_V    As Long = &H1
Private Const GRADIENT_FILL_TRIANGLE  As Long = &H2
Private GRADIENT_FILL_RECT_DIRECTION  As Long

Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function DrawFrameControl Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
Declare Function SHChangeIconDialog Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_NOTOPMOST = -2

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CMETRICS = 44
Public Const SM_CMOUSEBUTTONS = 43
Public Const SM_CXBORDER = 5
Public Const SM_CXCURSOR = 13
Public Const SM_CXDLGFRAME = 7
Public Const SM_CXDOUBLECLK = 36
Public Const SM_CXFIXEDFRAME = SM_CXDLGFRAME
Public Const SM_CXFRAME = 32
Public Const SM_CXFULLSCREEN = 16
Public Const SM_CXHSCROLL = 21
Public Const SM_CXHTHUMB = 10
Public Const SM_CXICON = 11
Public Const SM_CXICONSPACING = 38
Public Const SM_CXMIN = 28
Public Const SM_CXMINTRACK = 34
Public Const SM_CXSCREEN = 0
Public Const SM_CXSIZE = 30
Public Const SM_CXVSCROLL = 2
Public Const SM_CYBORDER = 6
Public Const SM_CYCAPTION = 4
Public Const SM_CYCURSOR = 14
Public Const SM_CYDLGFRAME = 8
Public Const SM_CYDOUBLECLK = 37
Public Const SM_CYFRAME = 33
Public Const SM_CYFULLSCREEN = 17
Public Const SM_CYHSCROLL = 3
Public Const SM_CYICON = 12
Public Const SM_CYICONSPACING = 39
Public Const SM_CYKANJIWINDOW = 18
Public Const SM_CYMENU = 15
Public Const SM_CYMIN = 29
Public Const SM_CYMINTRACK = 35
Public Const SM_CYSCREEN = 1
Public Const SM_CYSIZE = 31
Public Const SM_CYVSCROLL = 20
Public Const SM_CYVTHUMB = 9
Public Const SM_DBCSENABLED = 42
Public Const SM_DEBUG = 22
Public Const SM_MENUDROPALIGNMENT = 40
Public Const SM_MOUSEPRESENT = 19
Public Const SM_PENWINDOWS = 41
Public Const SM_RESERVED1 = 24
Public Const SM_RESERVED2 = 25
Public Const SM_RESERVED3 = 26
Public Const SM_RESERVED4 = 27
Public Const SM_SWAPBUTTON = 23
Public Const SM_CXSIZEFRAME = SM_CXFRAME
Public Const SM_CYFIXEDFRAME = SM_CYDLGFRAME
Public Const SM_CYSIZEFRAME = SM_CYFRAME

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Const MAX_PATH = 260
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const ERROR_NO_MORE_FILES = 18&
Private Const INVALID_HANDLE_VALUE = -1
Private Const DDL_DIRECTORY = &H10
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Public Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Public Declare Function GetCurrentThread Lib "kernel32" () As Long

Public Const THREAD_BASE_PRIORITY_IDLE = -15
Public Const THREAD_BASE_PRIORITY_LOWRT = 15
Public Const THREAD_BASE_PRIORITY_MAX = 2
Public Const THREAD_BASE_PRIORITY_MIN = -2
Public Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Public Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Public Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Public Const THREAD_PRIORITY_NORMAL = 0
Public Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Public Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Public Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
Public Enum Priorities
    Lowest = THREAD_PRIORITY_LOWEST
    Idle = THREAD_PRIORITY_IDLE
    BelowNormal = THREAD_PRIORITY_BELOW_NORMAL
    Normal = THREAD_PRIORITY_NORMAL
    AboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
    Highest = THREAD_PRIORITY_HIGHEST
    TimeCritical = THREAD_PRIORITY_TIME_CRITICAL
End Enum
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Const SC_CLOSE = &HF060&
Public Const SC_MAXIMIZE = &HF030&
Public Const SC_MINIMIZE = &HF020&

Private Function LongToSignedShort(dwUnsigned As Long) As Integer
   If dwUnsigned < 32768 Then
      LongToSignedShort = CInt(dwUnsigned)
   Else
      LongToSignedShort = CInt(dwUnsigned - &H10000)
   End If
End Function
Sub SetRect(R As RECT, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long)
With R
    .Left = Left
    .Top = Top
    .Right = Width '+ Left
    .Bottom = Height ' + Top
End With
End Sub

Sub FillGradient(lHdc As Long, rRect As RECT, ByVal clrFirst As OLE_COLOR, ByVal clrSecond As OLE_COLOR, Optional ByVal bVertical As Boolean, Optional ByVal clrThird As Long = 0)
    Dim pVert(0 To 1)   As TRIVERTEX
    Dim pGradRect       As GRADIENT_RECT
'    Dim pVert(0 To 2)   As TRIVERTEX
'    Dim pGradRect(0 To 1)       As GRADIENT_RECT
    
    With pVert(0)
        .x = rRect.Left
        .y = rRect.Top
        .Red = LongToSignedShort((clrFirst And &HFF&) * 256)
        .Green = LongToSignedShort(((clrFirst And &HFF00&) / &H100&) * 256)
        .Blue = LongToSignedShort(((clrFirst And &HFF0000) / &H10000) * 256)
        .Alpha = 0
    End With
'
    With pVert(1)
        .x = rRect.Right
        .y = rRect.Bottom
        .Red = LongToSignedShort((clrSecond And &HFF&) * 256)
        .Green = LongToSignedShort(((clrSecond And &HFF00&) / &H100&) * 256)
        .Blue = LongToSignedShort(((clrSecond And &HFF0000) / &H10000) * 256)
        .Alpha = 0
    End With
    With pGradRect
        .UPPERLEFT = 0
        .LOWERRIGHT = 1
    End With
   
    GradientFill lHdc, pVert(0), 2, pGradRect, 1, IIf(Not bVertical, GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V)
'    GradientFill lhDC, pVert(0), 3, pGradRect(0), 2, IIf(Not bVertical, GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V)
End Sub
Sub BringWindowtoFront(ByVal hwnd As Long, Optional ByVal Top As Boolean = True)
Dim flags As Long
    If Top = True Then
        flags = HWND_TOPMOST
    Else
        flags = HWND_NOTOPMOST
    End If
SetWindowPos hwnd, flags, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

' List all files below the directory that
' match the pattern.
Sub ListFiles(ByVal start_dir As String, ByVal pattern As String, Pic As PictureBox, VS As VScrollBar, Prog As PictureBox)
Const MAXDWORD = 2 ^ 32
Dim dir_names() As String
Dim num_dirs As Long
Dim I As Long
Dim fName As String
Dim attr As Integer
Dim search_handle As Long
Dim file_data As WIN32_FIND_DATA
Dim file_size As Double
Dim sVirus As String, nLen As Long
On Error Resume Next
        If Right(start_dir, 1) <> "\" Then start_dir = start_dir & "\"
    search_handle = FindFirstFile( _
        start_dir & pattern, file_data)
    If search_handle <> INVALID_HANDLE_VALUE Then
        ' Get the rest of the files.
        Do
        DoEvents
            fName = file_data.cFileName
            fName = Left$(fName, InStr(fName, Chr$(0)) - 1)
            file_size = (file_data.nFileSizeHigh * MAXDWORD) + file_data.nFileSizeLow
                    If file_size > 0 Then
                        On Error Resume Next
                            Dim hBmp As IPictureDisp
'                                Set hBmp = LoadPicture(start_dir & fName)
'                            Prog.Cls
''                                Prog.Print StretchText(Prog.hDC, start_dir & fName)
                                
'                        If hBmp.Type <> vbPicTypeIcon Then
                        If IsvalidPictureFile(fName) = True Then
'                            DispNewThumb Pic, start_dir & fName, hBmp, VS, False, Prog
                            AddThumb start_dir & fName
                        End If
'                            Set hBmp = Nothing
                    Else
'                        lst.AddItem start_dir & fname
                    End If
            ' Get the next file.
            If FindNextFile(search_handle, file_data) = 0 Then Exit Do
        Loop
        
        ' Close the file search hanlde.
        FindClose search_handle
    End If
'If chkAuto.Value = 0 Then
        ' Get the list of subdirectories.
        search_handle = FindFirstFile( _
            start_dir & "*.*", file_data)
        If search_handle <> INVALID_HANDLE_VALUE Then
            ' Get the rest of the files.
            Do
            DoEvents
                If file_data.dwFileAttributes And DDL_DIRECTORY Then
                    fName = file_data.cFileName
                    fName = Left$(fName, InStr(fName, Chr$(0)) - 1)
                    If fName <> "." And fName <> ".." Then
                        num_dirs = num_dirs + 1
                        ReDim Preserve dir_names(1 To num_dirs)
                        dir_names(num_dirs) = fName
                    End If
                End If
                ' Get the next file.
                If FindNextFile(search_handle, file_data) = 0 Then Exit Do
            Loop
            ' Close the file search handle.
            FindClose search_handle
        End If
        ' Search the subdirectories.
        For I = 1 To num_dirs
            ListFiles start_dir & dir_names(I) & "\", pattern, Pic, VS, Prog
                Progress Prog.hwnd, num_dirs, I
        Next I
'End If
End Sub
Function IsFolder(ByVal str As String) As Boolean
On Error GoTo E
If (GetAttr(str) And vbDirectory) = vbDirectory Then
    IsFolder = True
Else
    IsFolder = False
End If
Exit Function
E:
IsFolder = False
End Function
Function IsvalidPictureFile(ByVal sFile As String) As Boolean
    sFile = LCase$(sFile)
If InStr(sFile, ".jpg") Or InStr(sFile, ".jpeg") Or InStr(sFile, ".bmp") Or InStr(sFile, ".gif") Or InStr(sFile, ".tif") Or InStr(sFile, ".wmf") Or InStr(sFile, ".emf") Or InStr(sFile, ".png") Or InStr(sFile, ".dib") Then
    IsvalidPictureFile = True
End If
End Function
Function SplitCommandFiles(ByVal sCmd As String, Optional ByRef Count As Long = 0) As String()
Dim tmp() As String, str() As String, C As Long, st As String, n As Long
    Screen.MousePointer = 11
st = sCmd
    C = InStr(st, Chr(34))
        n = 0
    Count = 1
If C Then
        tmp = Split(st, Chr(34))
    For C = 0 To UBound(tmp)
        st = Trim(tmp(C))
            If st <> "" Then
                ReDim Preserve str(n)
                    str(n) = st
                n = n + 1
            End If
    Next
Else
    st = Trim(sCmd)
        If st <> "" Then
            ReDim Preserve str(n)
                str(n) = st
            n = n + 1
        End If
End If
        Count = n
    SplitCommandFiles = str
    Screen.MousePointer = 0
End Function


