Imports System.IO
Imports TKageyu.Utils
Imports TKageyu.UI
Imports System.Text
Imports System.Globalization
Public Class Form3
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As IntPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As IntPtr
Dim convertx As ImageConverter = New ImageConverter
Dim Dossiers, Fichiers, Dossier
Dim ff, dd, tst_cp, F_Idx As Integer
Dim v, TailleTotale As Double
Dim Le_Chemin, Save_Noeud As String
Private Sub Form3_Load(sender As Object, e As EventArgs) Handles MyBase.Load
TreeView1.Nodes.Add("C:\")
Explor(TreeView1.Nodes.Item(0))
TreeView1.Nodes.Add("F:\")
Explor(TreeView1.Nodes.Item(1))
TreeView1.Nodes.Add("K:\")
Explor(TreeView1.Nodes.Item(2))
'TreeView1.SelectedNode.ImageIndex = 0
End Sub
Private Sub Explor(ByVal Node As TreeNode)
Try
Node.Nodes.Clear()
Dim s As String
For Each s In Directory.GetDirectories(Node.FullPath)
Node.Nodes.Add(Path.GetFileName(s))
Next s
Catch
End Try
End Sub
Private Sub TreeView1_AfterExpand(sender As Object, e As TreeViewEventArgs) Handles TreeView1.AfterExpand
Dim z As TreeNode
For Each z In e.Node.Nodes
Explor(z)
Next z
End Sub
Private Sub TreeView1_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles TreeView1.AfterSelect
Dim Cpt As Integer = -1
Dim Lng_File, Lng_Type, Lng_Cdate, Lng_Wdate, Lng_Size As Integer
Dim Txt, tt, La_Taille As String
Dim item As ListViewItem = Nothing
Dim subItems() As ListViewItem.ListViewSubItem
'Dim bidon As String
Lng_File = 0
Lng_Type = 0
Lng_Cdate = 0
Lng_Wdate = 0
Lng_Size = 0
ListView1.Items.Clear()
Try
Dim l = Directory.GetDirectories(e.Node.FullPath)
Catch ex As Exception
MsgBox(ex.Message, vbOKOnly, "Erreur")
Exit Sub
End Try
Le_Chemin = Replace(e.Node.FullPath, e.Node.FullPath & "\", "")
For Each filex In Directory.GetDirectories(e.Node.FullPath)
Cpt = Cpt + 1
Dim fileCreatedDate As DateTime = Directory.GetCreationTime(filex) '.ToShortDateString
Dim fileCreatedDatea As DateTime = Directory.GetLastWriteTime(filex) '.ToLongDateString
Dim C_create As String = Convert.ToDateTime(fileCreatedDate).ToString("dd/MM/yyyy HH:mm")
Dim C_write As String = Convert.ToDateTime(fileCreatedDatea).ToString("dd/MM/yyyy HH:mm")
If Len(e.Node.FullPath) > 3 Then
Txt = Replace(filex, e.Node.FullPath & "\", "")
v = 0
'If Txt = "debug" Then
' bidon = ""
'End If
'Calculer_LaTaille_du_répértoire(filex)
'tt = v
'La_Taille = Conv_Taille(tt, v)
La_Taille = ""
Else
Txt = Replace(filex, e.Node.FullPath, "")
La_Taille = ""
End If
If Len(Txt) > Lng_File Then Lng_File = Len(Txt)
If Len(La_Taille) > Lng_Size Then Lng_Size = Len(La_Taille)
If Len(C_create) > Lng_Cdate Then Lng_Cdate = Len(C_create)
If Len(C_write) > Lng_Wdate Then Lng_Wdate = Len(C_write)
item = New ListViewItem(Txt, 0)
subItems = New ListViewItem.ListViewSubItem() {New ListViewItem.ListViewSubItem(item, "Directory"),
New ListViewItem.ListViewSubItem(item, Trim(C_write)),
New ListViewItem.ListViewSubItem(item, Trim(La_Taille)),
New ListViewItem.ListViewSubItem(item, Trim(C_create))}
item.SubItems.AddRange(subItems)
ListView1.Items.Add(item)
Next
For Each filex In Directory.GetFiles(e.Node.FullPath)
Cpt = Cpt + 1
Dim fileCreatedDate As DateTime = File.GetCreationTime(filex) '.ToShortDateString
Dim fileCreatedDatea As DateTime = File.GetLastWriteTime(filex) '.ToLongDateString
Dim FichierInfo As System.IO.FileInfo = New System.IO.FileInfo(filex)
Dim C_create As String = Convert.ToDateTime(fileCreatedDate).ToString("dd/MM/yyyy HH:mm")
Dim C_write As String = Convert.ToDateTime(fileCreatedDatea).ToString("dd/MM/yyyy HH:mm")
Txt = Replace(filex, e.Node.FullPath & "\", "")
Txt = Replace(Txt, e.Node.FullPath, "")
'If Txt = "launcher.exe" Then
' bidon = ""
'End If
Dim TailleFichier As Double = FichierInfo.Length
tt = TailleFichier
La_Taille = Conv_Taille(tt, TailleFichier)
If Len(Txt) > Lng_File Then Lng_File = Len(Txt)
If Len(La_Taille) > Lng_Size Then Lng_Size = Len(La_Taille)
If Len(C_create) > Lng_Cdate Then Lng_Cdate = Len(C_create)
If Len(C_write) > Lng_Wdate Then Lng_Wdate = Len(C_write)
Dim F_Ext As String
Try
F_Ext = Txt.Substring(Txt.LastIndexOf("."))
Catch ex As Exception
End Try
F_Ext = Replace(F_Ext, ".", "")
Dim F_Type = Extr_Ext(F_Ext)
item = New ListViewItem(Txt, F_Idx)
subItems = New ListViewItem.ListViewSubItem() _
{New ListViewItem.ListViewSubItem(item, F_Type),
New ListViewItem.ListViewSubItem(item, Trim(C_write)),
New ListViewItem.ListViewSubItem(item, Trim(La_Taille)),
New ListViewItem.ListViewSubItem(item, Trim(C_create))}
item.SubItems.AddRange(subItems)
ListView1.Items.Add(item)
Next
ListView1.Columns(0).Width = Lng_File + 300
End Sub
Private Function Conv_Taille(ttx As String, vv As Double) As String
Dim qq As Double
Conv_Taille = ""
Select Case Len(ttx)
Case 2
qq = vv
Conv_Taille = Format(qq, "##,##0") & " Octets"
Case 3, 4, 5
qq = vv / 1024
Conv_Taille = Format(qq, "##,##0") & " K"
Case 6
qq = vv / 1024
Conv_Taille = Format(qq, "##,##00") & " K"
Case 7
qq = (vv / 1024) / 1024
Conv_Taille = Format(qq, "##,##0.00") & " M"
Case 8, 9
qq = (vv / 1024) / 1024
Conv_Taille = Format(qq, "##,##0") & " M"
Case 10
qq = (vv / 1048000000) '/ 1024
Conv_Taille = Format(qq, "##,##0.00") & " G"
Case 11
qq = (vv / 10480000000) '/ 1024
Conv_Taille = Format(qq, "##,##0.00") & " G"
End Select
Return Conv_Taille
End Function
Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click
Dim oo = SelectItemx(Save_Noeud, TreeView1.SelectedNode.Nodes)
End Sub
Sub Calculer_LaTaille_du_répértoire(ByVal MonChemin As String)
Try
Dim DossiersInfo As DirectoryInfo = My.Computer.FileSystem.GetDirectoryInfo(MonChemin)
Dossiers = DossiersInfo.GetDirectories
Fichiers = DossiersInfo.GetFiles
'Parcourir Les Fichiers
For Each Fichier As FileInfo In Fichiers
'lire la taille du fichier (fileinfo) et la placer dans la variable v
v += Fichier.Length
ff = ff + 1
Next
'Parcourir les sous-répertoires
For Each sousRepertoire As String In Directory.GetDirectories(MonChemin)
dd = dd + 1
'Appel de manière récursive 'Calculer_LaTaille_du_répértoire pour calculer la taille du contenu des sous répertoires.
Calculer_LaTaille_du_répértoire(sousRepertoire)
Next
Catch ex As Exception
End Try
End Sub
Private Sub ListView1_DoubleClick(sender As Object, e As EventArgs) Handles ListView1.DoubleClick
Dim Toto As New ListView
Dim x As Integer
Dim Tempo As String = ""
Dim Lng_File, Lng_Type, Lng_Cdate, Lng_Wdate, Lng_Size As Integer
Dim Cpt As Integer = -1
Dim item As ListViewItem = Nothing
Dim subItems() As ListViewItem.ListViewSubItem
Dim Txt, tt, La_Taille As String
' Extraction de la ligne sélectionnée
Label1.Text = TreeView1.SelectedNode.FullPath
label2.Text = TreeView1.SelectedNode.Text
Save_Noeud = TreeView1.SelectedNode.FullPath
Toto = CType(sender, ListView)
Dim Titi As ListView.SelectedIndexCollection = Toto.SelectedIndices
For Each x In Titi
Tempo = Toto.Items(x).Text
Next
TreeView1.SelectedNode.BackColor = Color.White
' Recherche dans le treeview de la ligne
Le_Chemin = Le_Chemin & "\" & Tempo
TreeView1.SelectedNode.Expand()
Dim oo = SelectItemx(Tempo, TreeView1.SelectedNode.Nodes)
Lng_File = 0
Lng_Type = 0
Lng_Cdate = 0
Lng_Wdate = 0
Lng_Size = 0
ListView1.Items.Clear()
Try
Dim l = Directory.GetDirectories(Le_Chemin)
Catch ex As Exception
MsgBox(ex.Message, vbOKOnly, "Erreur")
Exit Sub
End Try
For Each filex In Directory.GetDirectories(Le_Chemin)
Cpt = Cpt + 1
Dim fileCreatedDate As DateTime = Directory.GetCreationTime(filex) '.ToShortDateString
Dim fileCreatedDatea As DateTime = Directory.GetLastWriteTime(filex) '.ToLongDateString
Dim C_create As String = Convert.ToDateTime(fileCreatedDate).ToString("dd/MM/yyyy HH:mm")
Dim C_write As String = Convert.ToDateTime(fileCreatedDatea).ToString("dd/MM/yyyy HH:mm")
If Len(Le_Chemin) > 3 Then
Txt = Replace(filex, Le_Chemin & "\", "")
v = 0
'If Txt = "debug" Then
' bidon = ""
'End If
'Calculer_LaTaille_du_répértoire(filex)
'tt = v
'La_Taille = Conv_Taille(tt, v)
La_Taille = ""
Else
Txt = Replace(filex, Le_Chemin, "")
La_Taille = ""
End If
If Len(Txt) > Lng_File Then Lng_File = Len(Txt)
If Len(La_Taille) > Lng_Size Then Lng_Size = Len(La_Taille)
If Len(C_create) > Lng_Cdate Then Lng_Cdate = Len(C_create)
If Len(C_write) > Lng_Wdate Then Lng_Wdate = Len(C_write)
item = New ListViewItem(Txt, 0)
subItems = New ListViewItem.ListViewSubItem() {New ListViewItem.ListViewSubItem(item, "Directory"),
New ListViewItem.ListViewSubItem(item, Trim(C_write)),
New ListViewItem.ListViewSubItem(item, Trim(La_Taille)),
New ListViewItem.ListViewSubItem(item, Trim(C_create))}
item.SubItems.AddRange(subItems)
ListView1.Items.Add(item)
Next
For Each filex In Directory.GetFiles(Le_Chemin)
Cpt = Cpt + 1
Dim fileCreatedDate As DateTime = File.GetCreationTime(filex) '.ToShortDateString
Dim fileCreatedDatea As DateTime = File.GetLastWriteTime(filex) '.ToLongDateString
Dim FichierInfo As System.IO.FileInfo = New System.IO.FileInfo(filex)
Dim C_create As String = Convert.ToDateTime(fileCreatedDate).ToString("dd/MM/yyyy HH:mm")
Dim C_write As String = Convert.ToDateTime(fileCreatedDatea).ToString("dd/MM/yyyy HH:mm")
Txt = Replace(filex, Le_Chemin & "\", "")
'If Txt = "launcher.exe" Then
' bidon = ""
'End If
Dim TailleFichier As Double = FichierInfo.Length
tt = TailleFichier
La_Taille = Conv_Taille(tt, TailleFichier)
If Len(Txt) > Lng_File Then Lng_File = Len(Txt)
If Len(La_Taille) > Lng_Size Then Lng_Size = Len(La_Taille)
If Len(C_create) > Lng_Cdate Then Lng_Cdate = Len(C_create)
If Len(C_write) > Lng_Wdate Then Lng_Wdate = Len(C_write)
Dim F_Ext As String
Try
F_Ext = Txt.Substring(Txt.LastIndexOf("."))
Catch ex As Exception
End Try
F_Ext = Replace(F_Ext, ".", "")
Dim F_Type = Extr_Ext(F_Ext)
item = New ListViewItem(Txt, F_Idx)
subItems = New ListViewItem.ListViewSubItem() _
{New ListViewItem.ListViewSubItem(item, F_Type),
New ListViewItem.ListViewSubItem(item, Trim(C_write)),
New ListViewItem.ListViewSubItem(item, Trim(La_Taille)),
New ListViewItem.ListViewSubItem(item, Trim(C_create))}
item.SubItems.AddRange(subItems)
ListView1.Items.Add(item)
Next
ListView1.Columns(0).Width = Lng_File + 300
End Sub
Private Function SelectItemx(ByVal Item_ID As String, ByVal Noeuds As TreeNodeCollection) As Boolean
If IsNothing(TreeView1.Nodes) = True Then Return False
tst_cp = 0
Dim i As Integer = 0
Dim Trouver As Boolean = False
Do While Noeuds.Count - 1 >= i And Not Trouver
If Noeuds.Item(i).Text = Item_ID Then
Trouver = True
TreeView1.SelectedNode = Noeuds.Item(i)
TreeView1.SelectedNode.Expand()
TreeView1.SelectedNode.BackColor = Color.Aqua
tst_cp = i
Return Trouver
Else
tst_cp = i
Trouver = SelectItemx(Item_ID, Noeuds.Item(i).Nodes)
End If
i += 1
Loop
tst_cp = i
Return Trouver
End Function
Private Sub TreeView1_BeforeExpand(sender As Object, e As TreeViewCancelEventArgs) Handles TreeView1.BeforeExpand
Try
'Console.WriteLine("Before : ")
'Console.WriteLine(TreeView1.SelectedNode)
Label1.Text = TreeView1.SelectedNode.FullPath
label2.Text = TreeView1.SelectedNode.Text
Save_Noeud = TreeView1.SelectedNode.FullPath
TreeView1.SelectedNode.BackColor = Color.White
Catch ex As Exception
End Try
End Sub
Private Sub TreeView1_Click(sender As Object, e As EventArgs) Handles TreeView1.Click
Try
'Console.WriteLine("Click : ")
'Console.WriteLine(TreeView1.SelectedNode)
Label1.Text = TreeView1.SelectedNode.FullPath
label2.Text = TreeView1.SelectedNode.Text
Save_Noeud = TreeView1.SelectedNode.FullPath
TreeView1.SelectedNode.BackColor = Color.White
Catch ex As Exception
End Try
End Sub
Private Function Extr_Ext(ByVal Lst As String) As String
Select Case Lst
Case LCase("txt")
Extr_Ext = "Document texte"
F_Idx = 2
Case LCase("xml")
Extr_Ext = "Document XML"
F_Idx = 3
Case LCase("iso")
Extr_Ext = "Fichier ISO"
F_Idx = 4
Case LCase("exe")
Extr_Ext = "Application"
F_Idx = 5
Case LCase("ani"), LCase("cur")
If Lst = LCase("ani") Then Extr_Ext = "Curseur animé"
If Lst = LCase("cur") Then Extr_Ext = "Curseur"
F_Idx = 6
Case LCase("ico")
Extr_Ext = "Icône"
F_Idx = 7
Case LCase("ttf")
Extr_Ext = "Police de caractères"
F_Idx = 8
Case LCase("dll")
Extr_Ext = "Extension de l'application"
F_Idx = 9
Case LCase("mp3"), LCase("wav")
Extr_Ext = "Son au format " & UCase(Lst)
F_Idx = 10
Case LCase("jpg"), LCase("bmp"), LCase("png")
Extr_Ext = "Image au format " & UCase(Lst)
F_Idx = 11
Case LCase("rar")
Extr_Ext = "Archive Winrar"
F_Idx = 12
Case LCase("zip")
Extr_Ext = "Archive Winzip"
F_Idx = 13
Case Else
Extr_Ext = "Fichier " & UCase(Lst)
F_Idx = 1
End Select
End Function
Private Sub testtest(xxx As String)
On Error GoTo Err_Ext_Icl
Dim Icone As IntPtr
Icone = ExtractIcon(Me.Handle, xxx, -1)
If Icone.ToInt32 = 0 Then
'imageListLarge.Images.Add(My.Resources.Help_icon)
'imageListLarge.Images.SetKeyName(0, My.Resources.Help_icon.ToString)
Exit Sub
End If
Dim t As Integer
t = 0
'Try
If Icone.ToInt32 <> 0 Then
Using IE As IconExtractor = New IconExtractor(xxx)
Pb1.Image = convertx.ConvertFrom(IE.GetIcon(t))
IE.Dispose()
End Using
imageListLarge.Images.Add(Pb1.Image)
imageListLarge.Images.SetKeyName(0, Pb1.Image.ToString)
Else
'imageListLarge.Images.Add(My.Resources.Help_icon)
'imageListLarge.Images.SetKeyName(0, My.Resources.Help_icon.ToString)
End If
Exit Sub
Err_Ext_Icl:
'imageListLarge.Images.Add(My.Resources.Help_icon)
'imageListLarge.Images.SetKeyName(0, My.Resources.Help_icon.ToString)
End Sub
End Class