Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing frmMain.vb (17.02 KB)
Option Explicit On
Imports System.IO
Imports System.Threading
Public Class frmMain
Private workerThread As Thread = Nothing
Private silentMode As Boolean = False
Private shredderBegin As DateTime = Nothing
Private Delegate Sub shredderCompletedSub(ByVal filesShredded As Integer, ByVal filesIgnored As Integer, ByVal filesRemaining As Integer, ByVal ex As Exception)
Private Delegate Sub setProgressSub(ByVal value As Integer)
Private Delegate Sub setStatusTextSub(ByVal msg As String)
Private Const FOLDER_CMDLINEARG As String = "/folder"
Private Const WILDCARD_CMDLINEARG As String = "/wildcard"
Private Const SUBFOLDERS_CMDLINEARG As String = "/subfolders"
Private Const FILEAGE_CMDLINEARG As String = "/fileage"
Private Const FILEAGEMIN_CMDLINEARG As String = "/fileagemin"
Private Const SILENT_CMDLINEARG As String = "/silent"
Private Sub _showWaitCursor(ByVal bShow As Boolean)
' show/hide the hourglass
If bShow Then
Me.Cursor = Cursors.WaitCursor
Me.UseWaitCursor = True
Else
Me.UseWaitCursor = False
Me.Cursor = Cursors.Arrow
End If
End Sub
Private Sub BeginShredder(ByVal threadObj As Object)
Dim _threadObj As clsThreadingObj = threadObj
Dim inFolder As String = _threadObj.arg0
Dim inWildcard As String = _threadObj.arg1
Dim inSubfolders As Boolean = _threadObj.arg2
Dim inFileAgeDays As Integer = _threadObj.arg3
Dim inFileAgeMinutes As Integer = _threadObj.arg4
Try
Dim filesList As String() = Directory.GetFiles(inFolder, inWildcard, _
IIf(inSubfolders, SearchOption.AllDirectories, SearchOption.TopDirectoryOnly))
setProgress(5)
setStatusText(String.Format("Found {0} file(s).", filesList.Length.ToString("###,##0")))
Thread.Sleep(1000)
Dim filesShredded As Integer = 0
Dim filesIgnored As Integer = 0
Dim filesRemaining As Integer = 0
Dim progressWeight As Integer = 95
Dim progressProgressIncr As Double = progressWeight / filesList.Length
Dim progressProgressVal As Double = 5
' enumerate the files matching the wildcard in the specified folder
For Each strFile As String In filesList
Try
If inFileAgeDays > 0 And inFileAgeMinutes > 0 Then
If File.GetCreationTime(strFile).AddDays(inFileAgeDays).AddMinutes(inFileAgeMinutes).Ticks < Now.Ticks Then
' delete the file
File.Delete(strFile)
filesShredded += 1
Else
filesIgnored += 1
End If
ElseIf inFileAgeDays > 0 Then
If File.GetCreationTime(strFile).AddDays(inFileAgeDays).Ticks < Now.Ticks Then
' delete the file
File.Delete(strFile)
filesShredded += 1
Else
filesIgnored += 1
End If
ElseIf inFileAgeMinutes > 0 Then
If File.GetCreationTime(strFile).AddMinutes(inFileAgeMinutes).Ticks < Now.Ticks Then
' delete the file
File.Delete(strFile)
filesShredded += 1
Else
filesIgnored += 1
End If
Else
' delete the file
File.Delete(strFile)
filesShredded += 1
End If
Catch
filesRemaining += 1
End Try
progressProgressVal += progressProgressIncr
setProgress(CInt(progressProgressVal))
Next
setStatusText("File Shredder complete!")
shredderCompleted(filesShredded, filesIgnored, filesRemaining, Nothing)
Catch ex As Exception
If Not (TypeOf ex Is ThreadAbortException) Then _
shredderCompleted(0, 0, 0, ex)
End Try
End Sub
Public Sub shredderCompleted(ByVal filesShredded As Integer, ByVal filesIgnored As Integer, ByVal filesRemaining As Integer, ByVal ex As Exception)
If Me.InvokeRequired Then
Me.Invoke(New shredderCompletedSub(AddressOf shredderCompleted), filesShredded, filesIgnored, filesRemaining, ex)
Else
workerThread = Nothing
lblStatus.Text = "Ready"
lblCancel.Visible = False
pbarStatus.Visible = False
txtInput.Enabled = True
btnBrowse.Enabled = True
txtWildcard.Enabled = True
chkSubfolders.Enabled = True
chkAge.Enabled = True
If chkAge.Checked Then txtAgeDays.Enabled = True
If chkAge.Checked Then txtAgeMinutes.Enabled = True
btnStart.Enabled = True
btnClose.Enabled = True
_showWaitCursor(False)
If Not silentMode Then
If ex Is Nothing Then
Dim shredderDuration As TimeSpan = Now.Subtract(shredderBegin)
MessageBox.Show("File Shredder completed." + vbCrLf + vbCrLf + _
"Files Shredded: " + filesShredded.ToString("#,##0") + vbCrLf + _
"Files Ignored: " + filesIgnored.ToString("#,##0") + vbCrLf + _
"Files Remaining: " + filesRemaining.ToString("#,##0") + vbCrLf + vbCrLf + _
"Total Time: " + shredderDuration.Hours.ToString("#0") + "h " + _
shredderDuration.Minutes.ToString("#0") + "m " + _
shredderDuration.Seconds.ToString("#0") + "s", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
MessageBox.Show("Unable to complete the File Shredder operation." + vbCrLf + vbCrLf + _
"Reason: " + ex.Message, Application.ProductName, _
MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
btnStart.Focus()
Else
Me.Close()
End If
End If
End Sub
Public Sub setProgress(ByVal value As Integer)
If Me.InvokeRequired Then
Me.Invoke(New setProgressSub(AddressOf setProgress), value)
Else
If value < 0 Then
value = 0
ElseIf value > 100 Then
value = 100
End If
If value = 0 Or Not (workerThread Is Nothing) Then
SyncLock pbarStatus
pbarStatus.Value = value
End SyncLock
End If
End If
End Sub
Public Sub setStatusText(ByVal msg As String)
If Me.InvokeRequired Then
Me.Invoke(New setStatusTextSub(AddressOf setStatusText), msg)
Else
lblStatus.Text = msg
End If
End Sub
Private Sub frmMain_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If Not btnStart.Enabled Then _
lblCancel.PerformClick()
End Sub
Private Sub lblCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblCancel.Click
If Not (workerThread Is Nothing) Then
workerThread.Abort()
workerThread = Nothing
Thread.Sleep(100)
Application.DoEvents()
lblStatus.Text = "Ready"
lblCancel.Visible = False
pbarStatus.Visible = False
txtInput.Enabled = True
btnBrowse.Enabled = True
txtWildcard.Enabled = True
chkSubfolders.Enabled = True
chkAge.Enabled = True
If chkAge.Checked Then txtAgeDays.Enabled = True
If chkAge.Checked Then txtAgeMinutes.Enabled = True
btnStart.Enabled = True
btnClose.Enabled = True
btnStart.Focus()
_showWaitCursor(False)
If silentMode Then Me.Close()
End If
End Sub
Private Sub txtInput_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtInput.GotFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Bold)
btnBrowse.Font = New Font(btnBrowse.Font, FontStyle.Bold)
End Sub
Private Sub txtInput_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtInput.LostFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Regular)
btnBrowse.Font = New Font(btnBrowse.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowse_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowse.GotFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Bold)
btnBrowse.Font = New Font(btnBrowse.Font, FontStyle.Bold)
End Sub
Private Sub btnBrowse_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowse.LostFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Regular)
btnBrowse.Font = New Font(btnBrowse.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
' set the path
fldrInput.SelectedPath = txtInput.Text
If fldrInput.ShowDialog() = Windows.Forms.DialogResult.OK Then
' store the path
txtInput.Text = fldrInput.SelectedPath
End If
System.Environment.CurrentDirectory = Application.StartupPath
End Sub
Private Sub txtWildcard_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtWildcard.GotFocus
lblWildcard.Font = New Font(lblWildcard.Font, FontStyle.Bold)
End Sub
Private Sub txtWildcard_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtWildcard.LostFocus
lblWildcard.Font = New Font(lblWildcard.Font, FontStyle.Regular)
End Sub
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
If txtInput.Text.Trim = "" Then
If silentMode Then
Me.Close()
Exit Sub
End If
MessageBox.Show("Missing the input folder location." + _
vbCrLf + vbCrLf + "Please choose the input folder and try again.", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
txtInput.Focus()
Exit Sub
ElseIf txtWildcard.Text.Trim = "" Then
If silentMode Then
Me.Close()
Exit Sub
End If
MessageBox.Show("Missing the wildcard." + _
vbCrLf + vbCrLf + "Please type the wildcard and try again.", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
txtWildcard.Focus()
Exit Sub
ElseIf chkAge.Checked And IsNumeric(txtAgeDays.Text) And Val(txtAgeDays.Text.Trim) < 0 Then
If silentMode Then
Me.Close()
Exit Sub
End If
MessageBox.Show("Invalid file age (day) entered. Must be zero or greater." + _
vbCrLf + vbCrLf + "Please type the file age (day) and try again.", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
txtAgeDays.Focus()
Exit Sub
ElseIf chkAge.Checked And IsNumeric(txtAgeMinutes.Text) And Val(txtAgeMinutes.Text.Trim) < 0 Then
If silentMode Then
Me.Close()
Exit Sub
End If
MessageBox.Show("Invalid file age (minute) entered. Must be zero or greater." + _
vbCrLf + vbCrLf + "Please type the file age (minute) and try again.", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
txtAgeMinutes.Focus()
Exit Sub
End If
txtInput.Enabled = False
btnBrowse.Enabled = False
txtWildcard.Enabled = False
chkSubfolders.Enabled = False
chkAge.Enabled = False
txtAgeDays.Enabled = False
txtAgeMinutes.Enabled = False
btnStart.Enabled = False
btnClose.Enabled = False
setStatusText("Starting shredder...")
setProgress(0)
pbarStatus.Visible = True
lblCancel.Visible = True
_showWaitCursor(True)
shredderBegin = Now()
Dim inputFolder As String = txtInput.Text
Dim inputWildcard As String = txtWildcard.Text.Trim
Dim inputSubfolders As Boolean = chkSubfolders.Checked
Dim inputAgeDays As Integer = IIf(chkAge.Checked, Val(txtAgeDays.Text.Trim), 0)
Dim inputAgeMinutes As Integer = IIf(chkAge.Checked, Val(txtAgeMinutes.Text.Trim), 0)
workerThread = New Thread(AddressOf BeginShredder)
workerThread.IsBackground = True
workerThread.Start(New clsThreadingObj(inputFolder, inputWildcard, inputSubfolders, inputAgeDays, inputAgeMinutes))
End Sub
Private Sub btnClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClose.Click
Me.Close()
End Sub
Private Sub frmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim inFolder As String = ""
Dim inWildcard As String = ""
Dim inSubfolders As Boolean = True
Dim inFileAge As String = ""
Dim inFileAgeMin As String = ""
With My.Application.CommandLineArgs
' check for the folder cmdline
If .Contains(FOLDER_CMDLINEARG) AndAlso _
.IndexOf(FOLDER_CMDLINEARG) + 1 < .Count Then _
inFolder = .Item(.IndexOf(FOLDER_CMDLINEARG) + 1)
' check for the wildcard cmdline
If .Contains(WILDCARD_CMDLINEARG) AndAlso _
.IndexOf(WILDCARD_CMDLINEARG) + 1 < .Count Then _
inWildcard = .Item(.IndexOf(WILDCARD_CMDLINEARG) + 1)
' check for the subfolders cmdline
inSubfolders = .Contains(SUBFOLDERS_CMDLINEARG)
' check for the file age cmdline
If .Contains(FILEAGE_CMDLINEARG) AndAlso _
.IndexOf(FILEAGE_CMDLINEARG) + 1 < .Count Then _
inFileAge = .Item(.IndexOf(FILEAGE_CMDLINEARG) + 1)
' check for the file age min cmdline
If .Contains(FILEAGEMIN_CMDLINEARG) AndAlso _
.IndexOf(FILEAGEMIN_CMDLINEARG) + 1 < .Count Then _
inFileAgeMin = .Item(.IndexOf(FILEAGEMIN_CMDLINEARG) + 1)
' check for the silent cmdline
silentMode = .Contains(SILENT_CMDLINEARG)
End With
If inFolder <> "" Then txtInput.Text = inFolder
If inWildcard <> "" Then txtWildcard.Text = inWildcard
chkSubfolders.Checked = inSubfolders
If inFileAge <> "" And IsNumeric(inFileAge) Then
chkAge.Checked = True
txtAgeDays.Text = inFileAge
End If
If inFileAgeMin <> "" And IsNumeric(inFileAgeMin) Then
chkAge.Checked = True
txtAgeMinutes.Text = inFileAgeMin
End If
End Sub
Private Sub frmMain_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
If silentMode Then btnStart.PerformClick()
End Sub
Private Sub chkAge_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAge.CheckedChanged
txtAgeDays.Enabled = chkAge.Checked
txtAgeMinutes.Enabled = chkAge.Checked
If txtAgeDays.Enabled Then
txtAgeDays.Focus()
ElseIf txtAgeMinutes.Enabled Then
txtAgeMinutes.Focus()
End If
End Sub
Private Sub txtAge_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtAgeDays.KeyPress
If Asc(e.KeyChar) <> 8 And _
(Asc(e.KeyChar) < 48 Or Asc(e.KeyChar) > 57) Then
e.Handled = True
End If
End Sub
Private Sub txtAgeMinutes_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtAgeMinutes.KeyPress
If Asc(e.KeyChar) <> 8 And _
(Asc(e.KeyChar) < 48 Or Asc(e.KeyChar) > 57) Then
e.Handled = True
End If
End Sub
End Class