Imports System.IO
Public Class frmArk
Public SaveFile As StreamWriter
Public NodeCount As Int32 = 0
Public AllowedFiles As String = "*.txt;*.html;*.htm;*.ini;*.inf;*.css;*.xml;*.vb;*.designer;*.vbproj;*.cs;*.#d;*.c;*.cpp;*.h;*.pas;*.js;*.asm;*.asp;*.bat;*.bak;*.bin;*.dat;*.dev;*.frm;*.bas;*.vbp;*.vbx;*.log;*.php;*.aspx;*.vba;*.sln;*.suo"
#Region "Methods"
Public Function GetDirName(ByVal Dir As String) As String
Return Dir.Remove(0, Dir.LastIndexOf("\") + 1)
End Function
'Procedure that fills the treeview
Public Sub AddDirectory(ByVal Dir As String, ByRef SelectedNode As TreeNode)
Dim Dirs() As String = Directory.GetDirectories(Dir)
Dim Files() As String = Directory.
GetFiles(Dir) Dim S As String
If SelectedNode Is Nothing Then
Dim N As TreeNode
SelectedNode = lstFiles.Nodes.Add(GetDirName(Dir))
SelectedNode.Tag = Dir
If AllowedFiles.Contains("*" + Path.GetExtension(S)) Then
N = SelectedNode.Nodes.Add(Path.GetFileName(S))
N.ImageIndex = 1
N.Tag = S
NodeCount += 1
End If
Next
If Dirs.Length > 0 Then
For Each S In Dirs
AddDirectory(S, SelectedNode)
Next
End If
Else
Dim N, F As TreeNode
N = SelectedNode.Nodes.Add(GetDirName(Dir))
N.Tag = Dir
If AllowedFiles.Contains("*" + Path.GetExtension(S)) Then
F = SelectedNode.Nodes(SelectedNode.Nodes.Count - 1).Nodes.Add(Path.GetFileName(S))
F.ImageIndex = 1
F.Tag = S
NodeCount += 1
End If
Next
If Dirs.Length > 0 Then
For Each S In Dirs
AddDirectory(S, N)
Next
End If
End If
End Sub
'Writes a new file
Public Sub WriteFile(ByVal Name As String)
Try
Dim R As New StreamReader(Name)
Dim FSize As Double = FileLen(Name)
Dim S As String
Dim Line As Double = 0
lblStatus.Text = "Copia di " + Path.GetFileName(Name) + " in corso..."
SaveFile.WriteLine("<file::" + Path.GetFileName(Name) + ">")
While Not R.EndOfStream
S = R.ReadLine
SaveFile.WriteLine(S)
Line += S.Length
If Line > FSize Then
Line = FSize
End If
Line += 1
prgFile.Value = Line * 100 / FSize
lblFile.Text = "Copying files: " & CInt(prgFile.Value) & "%"
Application.DoEvents()
End While
R.Close()
R = Nothing
prgFile.Value = 0
prgAll.Value += 1
Catch EX As Exception
MsgBox(Path.GetFileName(Name) + ": access denied!", MsgBoxStyle.Exclamation)
End Try
End Sub
'Saves the treeview
Public Sub Save(ByVal Node As TreeNode)
Static Count As Int16 = 0
lblStatus.Text = "Arkiviation's now working..."
If Node.Nodes.Count = 0 Then
If Path.HasExtension(Node.Tag) Then
WriteFile(Node.Text)
Else
SaveFile.WriteLine("<dir::" + Node.Text + ">")
SaveFile.WriteLine("</dir>")
End If
Exit Sub
End If
SaveFile.WriteLine("<dir::" + Node.Text + ">")
For Each File In Node.
Nodes If File.
Nodes.
Count = 0
And Path.
HasExtension(File.
Tag) Then Count += 1
lblAll.Text = "Total compression: " & CInt(Count * 100 / NodeCount) & "%"
Else
End If
Next
SaveFile.WriteLine("</dir>")
End Sub
'Reads an archive file and insert its content in the treeview
'Creates also a copy of all files in the Temp folder
Public Sub OpenArk(ByVal FileName As String)
Dim R As New IO.StreamReader(FileName)
Dim W As StreamWriter
Dim S, Dir As String
Dim N As New TreeNode(Path.GetFileName(FileName))
Dim Size, Index As Double
prgAll.Maximum = 100
Size = FileLen(FileName)
Dir = Application.StartupPath + "\Temp"
While Not R.EndOfStream
S = R.ReadLine
If S.StartsWith("<file::") Or S.StartsWith("<dir::") Or S.StartsWith("</dir>") Then
If S.StartsWith("<file::") Then
If Not W Is Nothing Then
W.Close()
End If
S = S.Remove(0, "<file::".Length)
S = S.Remove(S.Length - 1, 1)
W = New StreamWriter(Dir + "\" + S)
AddNodeWithInfo(N, Dir + "\" + S)
End If
If S.StartsWith("<dir::") Then
If Not W Is Nothing Then
W.Close()
End If
S = S.Remove(0, "<dir::".Length)
S = S.Remove(S.Length - 1, 1)
Dir += "\" + S
Directory.CreateDirectory(Dir)
N = N.Nodes.Add(GetDirName(S))
End If
If S.StartsWith("</dir>") Then
If Not W Is Nothing Then
W.Close()
End If
Dir = Dir.Remove(Dir.LastIndexOf("\"), Dir.Length - Dir.LastIndexOf("\"))
N = N.Parent
End If
Else
W.WriteLine(S)
End If
Index += S.Length
prgAll.Value = Index * 100 / Size
lblAll.Text = "Stock: " & CInt(Index * 100 / Size) & "%"
Application.DoEvents()
End While
prgAll.Value = 0
lblAll.Text = "Completed"
lblFile.Text = "Completed"
lstFiles.Nodes.Add(N)
End Sub
Public Sub AddNodeWithInfo(ByVal N As TreeNode, ByVal FileName As String)
Dim G As TreeNode = N.Nodes.Add(Path.GetFileName(FileName))
G.ImageIndex = 1
End Sub
Public Function GetDirSize(ByVal Dir As String) As Double
Dim Dirs() As String = Directory.GetDirectories(Dir)
Dim Files() As String = Directory.
GetFiles(Dir) Dim S As String
Dim Size As Double
lblStatus.Text = "Evaluating directory size..."
Size += FileLen(S)
Next
For Each S In Dirs
Size += GetDirSize(S)
Next
Return Size
End Function
Public Sub CopyDirectory(ByVal Dir As String, ByVal Destination As String)
Dim Dirs() As String = Directory.GetDirectories(Dir)
Dim Files() As String = Directory.
GetFiles(Dir) Dim S As String
Dim Size As Double = GetDirSize(Dir)
Dim Index As Double
lblStatus.Text = "Copying files..."
Try
MkDir(Destination)
Catch IOE As IOException
'MsgBox("Errore di accesso alla cartella: assicurarsi che non esista una cartella con lo stesso nome e di non " + _
'"stare modificando la suddetta mentre vengono eseguite le azioni di copia, quindi riprovare.", MsgBoxStyle.Exclamation)
MsgBox("An error has occurred while opening folder: make you sure that don't exist a folder with the same name and " + _
"that you aren't currently working on this folder while the operations are being executed. Try again after have done these controls.", MsgBoxStyle.Exclamation)
End Try
Application.DoEvents()
FileCopy(S, Destination + "\" + Path.GetFileName(S))
Index += FileLen(S)
lblAll.Text = "Copia dei file: " & CInt(Index * 100 / Size) & "%"
prgAll.Value = CInt(Index * 100 / Size)
Next
For Each S In Dirs
CopyDirectory(S, Destination + "\" + GetDirName(S))
Next
End Sub
Public Sub DeleteDirectory(ByVal Dir As String)
Dim Dirs() As String = Directory.GetDirectories(Dir)
Dim Files() As String = Directory.
GetFiles(Dir) Dim S As String
Dim Size As Double = GetDirSize(Dir)
Static Index As Double = 0
Try
Index += FileLen(S)
lblAll.Text = "Deleting files: " & CInt(Index * 100 / Size)
prgAll.Value = CInt(Index * 100 / Size)
Next
Catch IOE As Exception
MsgBox("An error has occurred while Arkiviation was deleting temporary files!", MsgBoxStyle.Exclamation)
End Try
For Each S In Dirs
DeleteDirectory(S)
Next
Directory.Delete(Dir)
End Sub
#End Region
Private Sub strAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAddFiles.Click, strAdd.ButtonClick
Dim FOpen As New Windows.Forms.OpenFileDialog
FOpen.Filter = "Text file|" + AllowedFiles
FOpen.Multiselect = True
If FOpen.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim S() As String = FOpen.FileNames
If lstFiles.SelectedNode Is Nothing Then
Dim N As TreeNode = lstFiles.Nodes.Add(GetDirName(Path.GetDirectoryName(S(0))))
Dim F As TreeNode
F
= N.
Nodes.
Add(Path.
GetFileName(File)) F.ImageIndex = 1
Next
Else
Dim N As TreeNode
N
= lstFiles.
SelectedNode.
Nodes.
Add(Path.
GetFileName(File)) N.ImageIndex = 1
Next
End If
NodeCount += S.Length
End If
strArk.Enabled = True
End Sub
Private Sub strRemove_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strRemoveSelected.Click, strRemove.ButtonClick
If lstFiles.SelectedNode Is Nothing Then
MsgBox("No element selected!", MsgBoxStyle.Exclamation)
Exit Sub
End If
If MsgBox("Are you sure you want to remove the selected element?", MsgBoxStyle.Question + vbYesNo) = MsgBoxResult.No Then
Exit Sub
End If
lstFiles.Nodes.Remove(lstFiles.SelectedNode)
End Sub
Private Sub strClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strClear.Click
If MsgBox("Are you sure you want to remove all list elements?", 36) = MsgBoxResult.No Then
Exit Sub
End If
lstFiles.Nodes.Clear()
NodeCount = 0
strExtract.Enabled = False
strArk.Enabled = False
strTools.Enabled = False
DeleteDirectory(Application.StartupPath + "\Temp")
strTools.Enabled = True
End Sub
Private Sub strArk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strArk.Click
Dim FSave As New Windows.Forms.SaveFileDialog
FSave.Filter = "Archive files|*.ark"
If FSave.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim N As TreeNode
strArk.Enabled = False
prgAll.Maximum = NodeCount
SaveFile = New StreamWriter(FSave.FileName)
For Each N In lstFiles.Nodes
Save(N)
Next
SaveFile.Close()
strArk.Enabled = True
prgFile.Value = 0
prgAll.Value = 0
lblStatus.Text = "Completed!"
lblFile.Text = "Progress: 0%"
lblAll.Text = "Total compression: 0%"
MsgBox("Completed!", MsgBoxStyle.Information)
End If
End Sub
Private Sub strAddDir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAddDir.Click
If lstFiles.SelectedNode Is Nothing Then
lstFiles.Nodes.Add(InputBox("Type the folder name:", "New folder")).ImageIndex = 0
Else
lstFiles.SelectedNode.Nodes.Add(InputBox("Type the folder name:", "New folder")).ImageIndex = 0
End If
strArk.Enabled = True
End Sub
Private Sub strAddRootDir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAddRootDir.Click
lstFiles.Nodes.Add(InputBox("Type the folder name:", "New folder"))
strArk.Enabled = True
End Sub
Private Sub strImportDir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strImportDir.Click
Dim F As New Windows.Forms.FolderBrowserDialog
F.Description = "Select the folder to import:"
If F.ShowDialog = Windows.Forms.DialogResult.OK Then
AddDirectory(F.SelectedPath, lstFiles.SelectedNode)
strArk.Enabled = True
End If
End Sub
Private Sub strOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strOpen.Click
Dim FOpen As New Windows.Forms.OpenFileDialog
FOpen.Filter = "Archive files|*.ark"
FOpen.FileName = "Archive"
If FOpen.ShowDialog = Windows.Forms.DialogResult.OK Then
OpenArk(FOpen.FileName)
End If
strExtract.Enabled = True
End Sub
Private Sub strExtract_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strExtract.Click
Dim F As New Windows.Forms.FolderBrowserDialog
F.Description = "Select the folder where to exctract files:"
If F.ShowDialog = Windows.Forms.DialogResult.OK Then
Try
CopyDirectory(Application.StartupPath + "\Temp", F.SelectedPath + "\" + Path.GetFileName(lstFiles.Nodes(0).Text))
MsgBox("Completed!", MsgBoxStyle.Information)
Catch IOE As IOException
'MsgBox("E' stato riscontrato un errore durante l'estrazione delle cartelle. Probabilmente si è aperta " + _
'"la cartella nella quale il file doveva essere estratto. Chiudere la cartella e riprovare.", MsgBoxStyle.Exclamation)
MsgBox("An error has occurred while exctracting files. Probably you opened the folder in which files should have been placed. Close folder and try again.", MsgBoxStyle.Exclamation)
Exit Sub
End Try
End If
lblStatus.Text = "Completed"
prgAll.Value = 0
End Sub
Private Sub strExtractSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EstraiElementoSelezionatoToolStripMenuItem.Click
If lstFiles.SelectedNode Is Nothing Then
MsgBox("No element selected!", MsgBoxStyle.Exclamation)
Exit Sub
End If
If lstFiles.SelectedNode.Nodes.Count = 0 And Path.HasExtension(lstFiles.SelectedNode.Tag) Then
Dim S As New Windows.Forms.SaveFileDialog
Dim N As TreeNode = lstFiles.SelectedNode
S.Filter = "File " + Path.GetExtension(N.Tag) + "|*" + Path.GetExtension(N.Tag)
If S.ShowDialog = Windows.Forms.DialogResult.OK Then
FileCopy(lstFiles.SelectedNode.Tag, S.FileName)
End If
Else
Dim F As New Windows.Forms.FolderBrowserDialog
Dim N As TreeNode = lstFiles.SelectedNode
If F.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim S As String
S = N.FullPath
S = S.Remove(0, S.IndexOf("\") + 1)
prgAll.Maximum = 100
CopyDirectory(Application.StartupPath + "\Temp\" + S, F.SelectedPath + "\" + N.Text)
End If
End If
lblAll.Text = "Completed"
lblStatus.Text = "Completed"
End Sub
Private Sub frmArk_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
strTools.Enabled = False
lblStatus.Text = "Deleting temporary files..."
If Directory.Exists(Application.StartupPath + "\Temp") Then
DeleteDirectory(Application.StartupPath + "\Temp")
End If
End Sub
Private Sub strBug_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strBug.Click
MsgBox("Contact nicolo1990@yahoo.it.", MsgBoxStyle.Information)
End Sub
Private Sub strAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAbout.Click, strHelp.ButtonClick
Dim Bas As New AboutBox1
Bas.ShowDialog()
End Sub
End Class
