Option Explicit
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim FindNextHandle As Long
Dim filestring As String
Sub findfilesapi(DirPath As String, FileSpec As String)
Dim txtCheck2() As String
Dim txtCheck1 As String
Dim isSame As Boolean
Dim isThere As Boolean
Dim isAdded As Boolean
Dim x As Integer
Dim strProgram() As String
Dim strExe As String
Dim strPath As String
Dim strName As String
DirPath = Trim$(DirPath)
If Right(DirPath, 1) <> "\" Then
DirPath = DirPath & "\"
End If
' Find the first file in the selected directory
FindHandle = FindFirstFile(DirPath & FileSpec, FindData)
If FindHandle <> 0 Then
If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
' It's a directory
If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
filestring = DirPath & Trim$(FindData.cFileName) & "\"
lstsearch.AddItem filestring, 1
End If
Else
filestring = DirPath & Trim$(FindData.cFileName)
txtCheck2 = Split(filestring, "\", , 0)
x = UBound(txtCheck2)
txtCheck1 = txtCheck2(x)
txtCheck1 = LTrim$(txtCheck1)
isSame = LCase(txtCheck1) Like "*.exe*"
If isSame = True Then
strProgram = Split(txtCheck1, ".", , 0)
strName = strProgram(0)
strPath = LTrim(filestring)
strExe = txtCheck1
isThere = objData.CheckProgram(strExe)
If isThere = False Then
isAdded = objData.AddProgramItem(strName, strPath, strExe)
End If
End If
End If
End If
' Now loop and find the rest of the files
If FindHandle <> 0 Then
Do
DoEvents
FindNextHandle = FindNextFile(FindHandle, FindData)
If FindNextHandle <> 0 Then
If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
' It's a directory
If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
filestring = DirPath & Trim$(FindData.cFileName) & "\"
lstsearch.AddItem filestring, 1
End If
Else
filestring = DirPath & Trim$(StripNulls(FindData.cFileName))
txtCheck2 = Split(filestring, "\", , 0)
x = UBound(txtCheck2)
txtCheck1 = txtCheck2(x)
txtCheck1 = LTrim$(txtCheck1)
isSame = LCase(txtCheck1) Like "*.exe*"
If isSame = True Then
strProgram = Split(txtCheck1, ".", , 0)
strName = strProgram(0)
strPath = LTrim(filestring)
strExe = txtCheck1
isThere = objData.CheckProgram(strExe)
If isThere = False Then
isAdded = objData.AddProgramItem(strName, strPath, strExe)
End If
End If
End If
Else
Exit Do
End If
Loop
End If
' It is important that you close the handle for FindFirstFile
Call FindClose(FindHandle)
End Sub
Private Sub cmdDone_Click()
Dim intCount As Integer
Dim lngNum As Long
Dim arrProgs() As String
lngNum = objData.enumPrograms(arrProgs)
If lngNum > 0 Then
frmremovecom.List1.Clear
lngNum = lngNum - 1
For intCount = 0 To lngNum
If arrProgs(intCount) > "" Then
frmremovecom.List1.AddItem (arrProgs(intCount))
End If
Next intCount
End If
Unload Me
frmremovecom.SetFocus
End Sub
Private Sub Form_Activate()
Dim SearchPath As String, FindStr As String
Dim intCount As Integer
Screen.MousePointer = vbHourglass
SearchPath = "c:\Program Files\"
FindStr = "*.*"
lstsearch.List(0) = SearchPath
ProgressBar1.Min = 0
ProgressBar1.Max = 5000
intCount = 1
Do
ProgressBar1.Value = intCount
findfilesapi lstsearch.List(0), FindStr
lstsearch.RemoveItem 0
intCount = intCount + 1
Loop Until lstsearch.ListCount = 0
Screen.MousePointer = vbDefault
Picture3.Visible = True
cmdDone.Visible = True
ProgressBar1.Value = 5000
End Sub
Private Sub Form_Load()
Picture3.Visible = False
cmdDone.Visible = False
ProgressBar1.Visible = True
End Sub