Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing frmMain.vb (21.90 KB)
Option Explicit On
Imports System.IO
Imports System.Threading
Public Class frmMain
Private workerThread As Thread = Nothing
Private silentMode As Boolean = False
Private shifterBegin As DateTime = Nothing
Private Delegate Sub shifterCompletedSub(ByVal filesShifted 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 INFOLDER_CMDLINEARG As String = "/infolder"
Private Const OUTFOLDER_CMDLINEARG As String = "/outfolder"
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 Function preparePath(ByVal strPath As String, ByVal vars As Hashtable)
For Each thisEntry As DictionaryEntry In vars
Dim var As String = "{" + thisEntry.Key + "}"
If strPath.Contains(var) Then strPath = strPath.Replace(var, thisEntry.Value)
Next
Return strPath
End Function
Private Sub moveFile(ByVal inFile As String, ByVal outPath As String, _
Optional ByVal inBasePath As String = "", Optional ByVal includeSubfolders As Boolean = False)
' prepare the destination path
Dim outFile As String = outPath
If inBasePath <> "" And includeSubfolders Then
Dim inPath As String = Path.GetDirectoryName(inFile)
inPath = inPath.Substring(inBasePath.Length, inPath.Length - inBasePath.Length)
If Not outFile.EndsWith("\") Then outFile += "\"
outFile += inPath
End If
If outFile.Contains("{") Then
Dim fileMod As DateTime = File.GetLastWriteTime(inFile)
Dim vars As New Hashtable
vars.Add("file_name", Path.GetFileName(inFile))
vars.Add("file_ext", Path.GetExtension(inFile))
vars.Add("file_mod_MM", fileMod.ToString("MM"))
vars.Add("file_mod_MMM", fileMod.ToString("MMM"))
vars.Add("file_mod_dd", fileMod.ToString("dd"))
vars.Add("file_mod_ddd", fileMod.ToString("ddd"))
vars.Add("file_mod_yy", fileMod.ToString("yy"))
vars.Add("file_mod_yyyy", fileMod.ToString("yyyy"))
vars.Add("file_mod_HH", fileMod.ToString("HH"))
vars.Add("file_mod_mm", fileMod.ToString("mm"))
vars.Add("file_mod_ss", fileMod.ToString("ss"))
outFile = preparePath(outFile, vars)
End If
If Not Directory.Exists(outFile) Then Directory.CreateDirectory(outFile)
If Not outFile.EndsWith("\") Then outFile += "\"
outFile += Path.GetFileName(inFile)
' move the file
File.Move(inFile, outFile)
End Sub
Private Sub BeginShifter(ByVal threadObj As Object)
Dim _threadObj As clsThreadingObj = threadObj
Dim inFolder As String = _threadObj.arg0
Dim outFolder As String = _threadObj.arg1
Dim inWildcard As String = _threadObj.arg2
Dim inSubfolders As Boolean = _threadObj.arg3
Dim inFileAgeDays As Integer = _threadObj.arg4
Dim inFileAgeMinutes As Integer = _threadObj.arg5
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 filesShifted 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
moveFile(strFile, outFolder, inFolder, inSubfolders)
filesShifted += 1
Else
filesIgnored += 1
End If
ElseIf inFileAgeDays > 0 Then
If File.GetCreationTime(strFile).AddDays(inFileAgeDays).Ticks < Now.Ticks Then
moveFile(strFile, outFolder, inFolder, inSubfolders)
filesShifted += 1
Else
filesIgnored += 1
End If
ElseIf inFileAgeMinutes > 0 Then
If File.GetCreationTime(strFile).AddMinutes(inFileAgeMinutes).Ticks < Now.Ticks Then
moveFile(strFile, outFolder, inFolder, inSubfolders)
filesShifted += 1
Else
filesIgnored += 1
End If
Else
moveFile(strFile, outFolder, inFolder, inSubfolders)
filesShifted += 1
End If
Catch
filesRemaining += 1
End Try
progressProgressVal += progressProgressIncr
setProgress(CInt(progressProgressVal))
Next
setStatusText("File Shifter complete!")
shifterCompleted(filesShifted, filesIgnored, filesRemaining, Nothing)
Catch ex As Exception
If Not (TypeOf ex Is ThreadAbortException) Then _
shifterCompleted(0, 0, 0, ex)
End Try
End Sub
Public Sub shifterCompleted(ByVal filesShifted As Integer, ByVal filesIgnored As Integer, ByVal filesRemaining As Integer, ByVal ex As Exception)
If Me.InvokeRequired Then
Me.Invoke(New shifterCompletedSub(AddressOf shifterCompleted), filesShifted, filesIgnored, filesRemaining, ex)
Else
workerThread = Nothing
lblStatus.Text = "Ready"
lblCancel.Visible = False
pbarStatus.Visible = False
txtInput.Enabled = True
btnBrowseInput.Enabled = True
txtOutput.Enabled = True
btnBrowseOutput.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 shifterDuration As TimeSpan = Now.Subtract(shifterBegin)
MessageBox.Show("File Shifter completed." + vbCrLf + vbCrLf + _
"Files Shifted: " + filesShifted.ToString("#,##0") + vbCrLf + _
"Files Ignored: " + filesIgnored.ToString("#,##0") + vbCrLf + _
"Files Remaining: " + filesRemaining.ToString("#,##0") + vbCrLf + vbCrLf + _
"Total Time: " + shifterDuration.Hours.ToString("#0") + "h " + _
shifterDuration.Minutes.ToString("#0") + "m " + _
shifterDuration.Seconds.ToString("#0") + "s", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
MessageBox.Show("Unable to complete the File Shifter 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
btnBrowseInput.Enabled = True
txtOutput.Enabled = True
btnBrowseOutput.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)
btnBrowseInput.Font = New Font(btnBrowseInput.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)
btnBrowseInput.Font = New Font(btnBrowseInput.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowseInput_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowseInput.GotFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Bold)
btnBrowseInput.Font = New Font(btnBrowseInput.Font, FontStyle.Bold)
End Sub
Private Sub btnBrowseInput_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowseInput.LostFocus
lblInput.Font = New Font(lblInput.Font, FontStyle.Regular)
btnBrowseInput.Font = New Font(btnBrowseInput.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowseInput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowseInput.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 txtOutput_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtOutput.GotFocus
lblOutput.Font = New Font(lblOutput.Font, FontStyle.Bold)
btnBrowseOutput.Font = New Font(btnBrowseOutput.Font, FontStyle.Bold)
End Sub
Private Sub txtOutput_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtOutput.LostFocus
lblOutput.Font = New Font(lblOutput.Font, FontStyle.Regular)
btnBrowseOutput.Font = New Font(btnBrowseOutput.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowseOutput_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowseOutput.GotFocus
lblOutput.Font = New Font(lblOutput.Font, FontStyle.Bold)
btnBrowseOutput.Font = New Font(btnBrowseOutput.Font, FontStyle.Bold)
End Sub
Private Sub btnBrowseOutput_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBrowseOutput.LostFocus
lblOutput.Font = New Font(lblOutput.Font, FontStyle.Regular)
btnBrowseOutput.Font = New Font(btnBrowseOutput.Font, FontStyle.Regular)
End Sub
Private Sub btnBrowseOutput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowseOutput.Click
' set the path
fldrOutput.SelectedPath = txtOutput.Text
If fldrOutput.ShowDialog() = Windows.Forms.DialogResult.OK Then
' store the path
txtOutput.Text = fldrOutput.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 txtOutput.Text.Trim = "" Then
If silentMode Then
Me.Close()
Exit Sub
End If
MessageBox.Show("Missing the output folder location." + _
vbCrLf + vbCrLf + "Please choose the output folder and try again.", _
Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
txtOutput.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
btnBrowseInput.Enabled = False
txtOutput.Enabled = False
btnBrowseOutput.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 shifter...")
setProgress(0)
pbarStatus.Visible = True
lblCancel.Visible = True
_showWaitCursor(True)
shifterBegin = Now()
Dim inputFolder As String = txtInput.Text
Dim outputFolder As String = txtOutput.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 BeginShifter)
workerThread.IsBackground = True
workerThread.Start(New clsThreadingObj(inputFolder, outputFolder, 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 outFolder 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 in-folder cmdline
If .Contains(INFOLDER_CMDLINEARG) AndAlso _
.IndexOf(INFOLDER_CMDLINEARG) + 1 < .Count Then _
inFolder = .Item(.IndexOf(INFOLDER_CMDLINEARG) + 1)
' check for the out-folder cmdline
If .Contains(OUTFOLDER_CMDLINEARG) AndAlso _
.IndexOf(OUTFOLDER_CMDLINEARG) + 1 < .Count Then _
outFolder = .Item(.IndexOf(OUTFOLDER_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 outFolder <> "" Then txtOutput.Text = outFolder
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