VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Auto Find & Delete"
   ClientHeight    =   3075
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5925
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "frmMain"
   MaxButton       =   0   'False
   ScaleHeight     =   3075
   ScaleWidth      =   5925
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "E&xit"
      Height          =   615
      Index           =   1
      Left            =   3060
      TabIndex        =   4
      Top             =   2280
      Width           =   2675
   End
   Begin VB.Frame Frame1 
      Caption         =   " Results "
      Height          =   2055
      Left            =   195
      TabIndex        =   5
      Top             =   120
      Width           =   5535
      Begin VB.CommandButton Command1 
         Caption         =   "&Add/Remove Shell Access"
         Height          =   375
         Index           =   4
         Left            =   3120
         TabIndex        =   2
         Top             =   1200
         Width           =   2175
      End
      Begin VB.CommandButton Command1 
         Caption         =   "&Specify a bad file manually"
         Height          =   375
         Index           =   3
         Left            =   3120
         TabIndex        =   1
         Top             =   720
         Width           =   2175
      End
      Begin VB.CommandButton Command1 
         Caption         =   "&View/Edit Bad File List"
         Height          =   375
         Index           =   2
         Left            =   3120
         TabIndex        =   0
         Top             =   240
         Width           =   2175
      End
      Begin VB.Label lblresults 
         AutoSize        =   -1  'True
         Caption         =   "file name and path being searched go here"
         Height          =   195
         Index           =   4
         Left            =   360
         TabIndex        =   10
         Top             =   1680
         Visible         =   0   'False
         Width           =   3030
      End
      Begin VB.Label lblresults 
         AutoSize        =   -1  'True
         Caption         =   "Progress: Not Started"
         Height          =   195
         Index           =   3
         Left            =   1185
         TabIndex        =   9
         Top             =   1080
         Width           =   1515
      End
      Begin VB.Label lblresults 
         AutoSize        =   -1  'True
         Caption         =   "Files Searched For: 0"
         Height          =   195
         Index           =   0
         Left            =   480
         TabIndex        =   8
         Top             =   360
         Width           =   1500
      End
      Begin VB.Label lblresults 
         AutoSize        =   -1  'True
         Caption         =   "Files Deleted: 0"
         Height          =   195
         Index           =   2
         Left            =   885
         TabIndex        =   7
         Top             =   840
         Width           =   1095
      End
      Begin VB.Label lblresults 
         AutoSize        =   -1  'True
         Caption         =   "Files Found: 0"
         Height          =   195
         Index           =   1
         Left            =   990
         TabIndex        =   6
         Top             =   600
         Width           =   990
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "&Find && Delete Bad Files"
      Default         =   -1  'True
      Height          =   615
      Index           =   0
      Left            =   195
      TabIndex        =   3
      Top             =   2280
      Width           =   2675
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private is_cancelled As Boolean
Private old_button_string As String

Private Sub btnExit_Click()
 Unload Me
End Sub

Private Sub ReadFromBadFile()
On Error Resume Next

  command1(0).Enabled = False
  command1(2).Enabled = False
  command1(3).Enabled = False
  lblresults(3).Caption = "Progress: Deleting..."
  lblresults(4).Visible = True
  command1(4).Caption = "&Cancel"
  
  Dim fso As FileSystemObject
  Dim fso1 As FileSystemObject
  Dim textfile As File
  Dim a_textstream As TextStream
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fso1 = CreateObject("Scripting.FileSystemObject")
  Dim path As String
  Dim one_item_string As String
  Dim files_searched_for As Long
  Dim files_found As Long
  Dim files_deleted As Long
  files_searched_for = 0
  files_found = 0
  files_deleted = 0
  path = App.path
  If Right$(path, 1) <> "\" Then path = path & "\"

  If AFDTextFileExists = False Then 'file does not exist, so create it
   fso.CreateTextFile (path & SAVE_TO_FILE)
  End If

  Set textfile = fso.GetFile(path & SAVE_TO_FILE)
  Set a_textstream = textfile.OpenAsTextStream(ForReading)

  Do While a_textstream.AtEndOfStream = False And is_cancelled = False
   one_item_string = a_textstream.ReadLine
   lblresults(4).Caption = one_item_string
   files_searched_for = files_searched_for + 1
   lblresults(0).Caption = "Files Searched For: " & files_searched_for
   
   If fso1.FileExists(one_item_string) Then
    files_found = files_found + 1
    lblresults(1).Caption = "Files Found: " & files_found
    fso1.DeleteFile one_item_string, True 'forcefully delete it
    'if the item doesn't exist, it means it was sucessfully deleted
    If fso1.FileExists(one_item_string) = False Then files_deleted = files_deleted + 1
    lblresults(2).Caption = "Files Deleted: " & files_deleted
   End If
   DoEvents
  Loop

  a_textstream.Close
  Set fso = Nothing
  Set fso1 = Nothing
  
  command1(0).Enabled = True
  command1(2).Enabled = True
  command1(3).Enabled = True
  If files_searched_for = 0 Then
   lblresults(3).Caption = "Progress: File is empty."
  Else
   lblresults(3).Caption = "Progress: ALL DONE"
  End If
  lblresults(4).Visible = False
  command1(4).Caption = old_button_string
  Exit Sub

End Sub
Private Sub Command1_Click(Index As Integer)

Select Case Index

Case 0 'Find & Delete Bad Files Clicked

 If AFDTextFileExists = False Then 'file doesn't exist, so create it
  If MsgBox("Bad file list does not exist. Create it?", vbYesNo + vbQuestion) = vbYes Then
   CreateAFDTextFile
  End If
 Else 'file exists, so read from it
  old_button_string = command1(4).Caption
  lblresults(3).Caption = "Progress: Starting..."
  lblresults(0).Caption = "Files Searched For: 0"
  lblresults(1).Caption = "Files Found: 0"
  lblresults(2).Caption = "Files Deleted: 0"
  Call ReadFromBadFile
 End If
 
Case 1 'Exit Clicked
 Unload Me
 
Case 2 'View/Edit Bad File List Clicked
 Load frmBadFiles
 frmBadFiles.Show vbModal
 
Case 3 'Specify a bad file manually Clicked
 AddAFileManually True, Me
 
Case 4 'Cancel Search / AddRemove Shell Access Clicked
 If command1(Index).Caption = "&Cancel Search" Then 'Cancel Search Clicked
  If MsgBox("Are you sure you want to cancel the search?", vbYesNo) = vbYes Then
   'put cancel code here
  is_cancelled = True
  lblresults(3).Caption = "Progress: Cancelled"
  lblresults(4).Visible = False
  command1(0).Enabled = True
  command1(2).Enabled = True
  command1(3).Enabled = True
  command1(4).Caption = "&Add/Remove Shell Access"
  End If
  
 Else 'Add/Remove Shell Access Clicked
  'right-click context menu exists, so delete it
  If RegKeyExists(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List") = True Then
   Call DeleteSubkey(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List\command")
   Call DeleteSubkey(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List")
   MsgBox "Successfully REMOVED right-click shell access.", vbInformation + vbOKOnly
   command1(4).Caption = "&Add Shell Access"
  Else 'right-click context menu does not exist, so create it
   Dim path As String
   path = App.path
   If Right$(path, 1) <> "\" Then path = path & "\"
   path = path & App.EXEName & ".exe"
   Call WriteRegistry(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List", "", ValString, "&Add to Bad File List")
   Call WriteRegistry(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List\command", "", ValString, """" & path & """" & " %1")
   MsgBox "Successfully ADDED right-click shell access.", vbInformation + vbOKOnly
   command1(4).Caption = "&Remove Shell Access"
  End If
 
 End If
 
 
End Select

End Sub

Private Sub Form_Initialize()
'check command line argument
If Command$ <> Empty Then
 AddThisFile Command$
 End
End If
End Sub

Private Sub Form_Load()

If RegKeyExists(HKEY_CLASSES_ROOT, "*\shell\Add to Bad File List") = True Then
 command1(4).Caption = "&Remove Shell Access"
Else
 command1(4).Caption = "&Add Shell Access"
End If

'---------------- Set up the Open File Dialog -----------------------
With OFN
.nStructSize = IIf(IsWin2000Plus(), Len(OFN), Len(OFN) - 12)
.hWndOwner = Me.hwnd
.sFilter = "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
.nFilterIndex = 1
.sFile = "*.*" & Space$(1024) & vbNullChar & vbNullChar
.nMaxFile = Len(.sFile)
.sDefFileExt = "*" & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = App.path & vbNullChar & vbNullChar
.sDialogTitle = "Select which file(s) to add to the bad file list"
.flags = OFS_FILE_OPEN_FLAGS Or OFN_ENABLEHOOK
.fnHook = FARPROC(AddressOf OFNHookProc)
End With
'-----------------------------------------------------------------------
    
End Sub

Public Sub AddThisFile(a_file As String)
 On Error GoTo AddThisFileError
 
 Dim fso As FileSystemObject
 Dim textfile As File
 Dim a_textstream As TextStream
 Dim path As String
 Set fso = CreateObject("Scripting.FileSystemObject")
 path = App.path
 If Right$(path, 1) <> "\" Then path = path & "\"
 'file does not exist, so create it
 If AFDTextFileExists = False Then fso.CreateTextFile (path & SAVE_TO_FILE)
 Set textfile = fso.GetFile(path & SAVE_TO_FILE)
 Set a_textstream = textfile.OpenAsTextStream(ForAppending)
 a_textstream.WriteLine a_file
 a_textstream.Close
 Set fso = Nothing
 MsgBox "Successfully added file to bad files list!", vbOKOnly + vbInformation
 
 Exit Sub
 
AddThisFileError:
 MsgBox "There was an error." & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description & vbNewLine & "Occured in function: AddThisFile" & vbNewLine, vbCritical + vbOKOnly
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Unload frmBadFiles 'just in case
End Sub