Dim Ans As Long Dim tFsize As Long Dim dirNo As Long, fileNo As Long Dim fileNames() As String, fileNum As Long Dim dirName As String, orgPath As String Dim Dosyn As Long, Doexc As Long ' ³ÈÄ¥»Ò¤Ë¤è¤ë¥ê¥¹¥È¥¢¥Ã¥×¤Î½ü³°¡¦³ºÅö¥Õ¥é¥° Dim synExt() As String, excExt() As String ' ½ü³°¡¦³ºÅö¥Õ¥¡¥¤¥ë³ÈÄ¥»Ò¤Î¥ê¥¹¥È Dim Date1 As String, Date2 As String ' ½ü³°¤¹¤ë¥Õ¥¡¥¤¥ëºîÀ®ÆüÉÕ ' ºï½ü¥Ü¥¿¥ó¡§ Á´¤Æºï½ü¤µ¤ì¤ë¤Î¤ÇÃí°Õ Private Sub Command1_Click() Dim sFpath As String, soutFpath As String Dim sProp As Integer ' ºÆµ¢Åª¥Õ¥¡¥¤¥ë¸¡º÷¤Î½èÍý¥Ñ¥é¥á¡¼¥¿ 1: ¥Õ¥¡¥¤¥ë¥Ä¥ê¡¼ºîÀ® 2¡§»Ò¥Õ¥©¥ë¥À¤Þ¤ÇÁ´¤Æºï½ü Dim sTmp As String Dim j As Integer Ans = MsgBox("¤Þ¤º»ØÄꤵ¤ì¤¿¥Õ¥©¥ë¥À¤Î¥Õ¥¡¥¤¥ë¥Ä¥ê¡¼¤òºîÀ®¤·¤Þ¤¹¡£", vbOKCancel) If Ans = vbCancel Then Exit Sub sFpath = Text1.Text If Right(sFpath, 1) <> "\" Then sFpath = sFpath & "\" orgPath = sFpath dirNo = 0 tFsize = 0 fileNo = 0 soutFpath = orgPath & "FTree.txt" sTmp = "" fileNum = 0 ReDim fileNames(0) ' ÇÛÎó¤ò½é´ü²½ RecurseTree sFpath, 1 ' ¥Õ¥¡¥¤¥ë¥Ä¥ê¡¼¤ò¥Õ¥¡¥¤¥ë¤Ë½ñ¤­½Ð¤¹ Open soutFpath For Output As #1 Print #1, sTmp; " : Files ="; fileNum; " Total size ="; tFsize; "Bytes" For j = 0 To fileNum Print #1, Spc(4); fileNames(j) Next j fileNo = fileNo + fileNum dirNo = dirNo - 1 ' »ØÄꤵ¤ì¤¿¥Õ¥©¥ë¥À¤Ï¥«¥¦¥ó¥È¤·¤Ê¤¤ Print #1, "<"; String(50, "-"); ">" Print #1, "" Print #1, "" Close #1 Ans = MsgBox("»ØÄꤵ¤ì¤¿¥Õ¥©¥ë¥À¤Î²¼¤Ë¤Ï ¥Õ¥©¥ë¥À¡¼¡§ " & dirNo & " ¸Ä" & _ vbCrLf & "¥Õ¥¡¥¤¥ë¡§ " & fileNo & " ¸Ä¤¬¤¢¤ê¤Þ¤·¤¿¡£" & _ vbCrLf & "³¤±¤Æ¤³¤Î¥Ç¥£¥ì¥¯¥È¥ê¤ÎÃæ¿È¤Îºï½ü¤ò¹Ô¤¤¤Þ¤¹¤«¡©", vbOKCancel) If Ans = vbCancel Then Exit Sub Ans = MsgBox("·Ù¹ð¡§ »ØÄꤷ¤¿¥Õ¥©¥ë¥À°Ê²¼¤ÎÁ´¤Æ¤Î¥Õ¥¡¥¤¥ë¡¿¥Õ¥©¥ë¥À¤¬ºï½ü¤µ¤ì¤Þ¤¹ ¡ª¡ª¡ª", vbOKCancel) If Ans = vbCancel Then Exit Sub fileNum = 0 ReDim fileNames(0) ' ÇÛÎó¤ò½é´ü²½ RecurseTree sFpath, 2 ' ¥Õ¥¡¥¤¥ë¥Ä¥ê¡¼¤ÎºîÀ®¤È ºï½ü Âè2°ú¿ô¡á2 ¤Ïºï½ü¤Î»ØÄê MsgBox "»ØÄꤵ¤ì¤¿¥Õ¥©¥ë¥À°Ê²¼¤ÎÁ´¤Æ¤Î¥Õ¥©¥ë¥À¡¿¥Õ¥¡¥¤¥ë¤Ïºï½ü¤µ¤ì¤Þ¤·¤¿¡£" End Sub ' ½ªÎ»¥Ü¥¿¥ó Private Sub Command2_Click() Unload Me End Sub ' ¥Ç¥£¥ì¥¯¥È¥ê¡¿¥Õ¥¡¥¤¥ë¤ÎºÆµ¢Åª¸¡º÷ ' sProp=0:ÀäÂХѥ¹¡ÜFile̾ sProp=1:ÀäÂХѥ¹¡ÜFile̾¡ÜFile¥µ¥¤¥º¡ÜºÇ½ª¹¹¿·ÆüÉÕ ' sProp=2:¥Õ¥©¥ë¥À¡¼ÆâÁ´ºï½ü Sub RecurseTree(CurrentPath As String, sProp As Integer) Dim i As Integer, nI As Integer, nDirectory As Integer Dim sFileName As String, sDirectoryList() As String Dim sFilepath As String, fLen As Long Dim strtfNo As Long, endfNo As Long Dim sExt As String, subjP As Integer Dim j As Integer, sfDate As String Dim sSpace As String ' ­¡ ¤³¤Î¥Ç¥£¥ì¥¯¥È¥êÆâ¤Î¤¹¤Ù¤Æ¤Îɸ½à¥Õ¥¡¥¤¥ë¤òÎóµó¤¹¤ë CurrentPath = RTrim(CurrentPath) dirName = Right(CurrentPath, Len(CurrentPath) - Len(orgPath)) sFileName = Dir(CurrentPath, vbNormal + vbReadOnly) ' ɸ½à¥Õ¥¡¥¤¥ë¤È¥ê¡¼¥É¥ª¥ó¥ê¡¼¥Õ¥¡¥¤¥ë¤À¤±¤òÂоݤȤ¹¤ë dirNo = dirNo + 1 strtfNo = fileNum Do While sFileName <> "" sFilepath = CurrentPath & sFileName sExt = Right(sFilepath, Len(sFilepath) - InStr(sFilepath, ".")) sfDate = FileDateTime(sFilepath) If sProp = 2 Then ' ºï½ü¤Î¾ì¹ç½ü³°¾ò·ï¤Ï¤Ê¤· subjP = 1 Else If Dosyn = 1 Then ' Ʊ´ü¡¦½ü³°³ÈÄ¥»Ò¤Ë³ºÅö¤¹¤ë¤« j = 0 subjP = 0 Do While synExt(j) <> "" If sExt = synExt(j) Then subjP = 1 Exit Do Else j = j + 1 End If Loop ElseIf Doexc = 1 Then j = 0 subjP = 1 Do While excExt(j) <> "" If sExt = excExt(j) Then subjP = 0 Exit Do Else j = j + 1 End If Loop Else subjP = 1 End If ' ºîÀ®ÆüÉդϻØÄêÈÏ°ÏÆ⤫ If Date1 <> "" Then If DateDiff("s", sfDate, Date1) > 0 Then subjP = 0 ' ºîÀ®ÆüÉÕ¤¬Date1¤è¤êÁ°¤Î¾ì¹ç¤ÏƱ´ü¤·¤Ê¤¤ End If If Date2 <> "" Then If DateDiff("s", Date2, sfDate) > 0 Then subjP = 0 ' ºîÀ®ÆüÉÕ¤¬Date2¤è¤ê¸å¤Î¾ì¹ç¤ÏƱ´ü¤·¤Ê¤¤ End If End If If subjP = 1 Then ' Ʊ´ü¾ò·ï¤Ë°ìÃפ·¤¿¥Õ¥¡¥¤¥ë¤¬¤¢¤Ã¤¿ fLen = FileLen(sFilepath) tFsize = tFsize + fLen If sProp = 1 Then sSpace = String(48 - Len(dirName & sFileName) - Len(Str(fLen)), 32) ' ¾åµ­48¤Ï·å·¤¨¡§¥Õ¥©¥ë¥À̾¤È¿¼¤µ¤Ë¤è¤êÁý¸º¤µ¤»¤Ê¤¤¤È¥¨¥é¡¼¤Ë¤Ê¤ë fileNames(fileNum) = dirName & sFileName & "; " & sSpace & fLen & " Bytes; " & sfDate ElseIf sProp = 2 Then fileNames(fileNum) = orgPath & dirName & sFileName Else fileNames(fileNum) = dirName & sFileName End If fileNum = fileNum + 1 ReDim Preserve fileNames(fileNum) End If sFileName = Dir Loop endfNo = fileNum If sProp = 2 Then ' ¥Ç¥£¥ì¥¯¥È¥êÆâÁ´¥Õ¥¡¥¤¥ë¤Îºï½ü Do While endfNo > strtfNo Kill fileNames(endfNo - 1) endfNo = endfNo - 1 Loop DelFldr (CurrentPath) ' ¥Õ¥©¥ë¥À¤¬¶õ¤À¤Ã¤¿¤éºï½ü¤¹¤ë Sub Routin End If ' ­¢ ¼¡¤Ë¡¢¥µ¥Ö¥Ç¥£¥ì¥¯¥È¥ê¤Î°ì»þŪ¤Ê¥ê¥¹¥È¤òºî¤ë sFileName = Dir(CurrentPath, vbDirectory) Do While sFileName <> "" ' ¸½ºß¤Î¥Ç¥£¥ì¥¯¥È¥ê¤È¿Æ¥Ç¥£¥ì¥¯¥È¥ê¤ò̵»ë¤¹¤ë If sFileName <> "." And sFileName <> ".." Then ' ¥Ç¥£¥ì¥¯¥È¥ê°Ê³°¤ò̵»ë¤¹¤ë If GetAttr(CurrentPath & sFileName) _ And vbDirectory Then nDirectory = nDirectory + 1 ReDim Preserve sDirectoryList(nDirectory) sDirectoryList(nDirectory) = CurrentPath & sFileName End If End If sFileName = Dir ' ¾¤Î¥¤¥Ù¥ó¥È¤ò½èÍý¤¹¤ë DoEvents Loop ' ³Æ¥Ç¥£¥ì¥¯¥È¥ê¤òºÆµ¢Åª¤Ë½èÍý¤¹¤ë For nI = 1 To nDirectory RecurseTree sDirectoryList(nI) & "\", sProp Next nI End Sub ' ¥Õ¥©¥ë¥À¤¬¶õ¤À¤Ã¤¿¤éºï½ü¤¹¤ë Sub Routin Sub DelFldr(CurrentPath) Dim sDirName As String, sParentD As String Dim empDir As Integer, sIrgF As String sIrgF = Dir(CurrentPath, vbHidden + vbNormal + vbReadOnly + vbSystem) If sIrgF <> "" Then Ans = MsgBox("¥Õ¥©¥ë¥À¤òºï½ü¤·¤è¤¦¤È¤·¤Þ¤·¤¿¤¬¡¢¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥©¥ë¥À¤ËÉÔÀµ¤Ê¥Õ¥¡¥¤¥ë¤¬»Ä¤Ã¤Æ¤¤¤Þ¤¹¡£" & _ "< " & CurrentPath & "\" & sIrgF & " >" & vbCrLf & _ vbCrLf & "¥Õ¥©¥ë¥À¤Îºï½ü¤Ï´°Á´¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£" & vbCrLf & _ "ɬÍפ˱þ¤¸ºï½ü¤·¤Æ¤¯¤À¤µ¤¤¡£", vbOKOnly, "Caution !") Else sDirName = Dir(CurrentPath, vbDirectory) ' Ãí°Õ¡§CurrentPath̾¤ÏºÇ¸å¤¬ "\"¤Ç½ª¤ï¤Ã¤Æ¤¤¤Ê¤¤¤È¼«¿È¤¬¥Õ¥©¥ë¥À̾¤Çµ¢¤µ¤ì¤ë ' ¡Ê¡¥¤Ç¤Ï¤Ê¤¯¡Ë ¤Î¤ÇÃí°Õ¤¬É¬Í× Do While sDirName <> "" If sDirName <> "." And sDirName <> ".." Then ' ¥ë¡¼¥È¥Ç¥£¥ì¥¯¥È¥ê¤È¿Æ¥Ç¥£¥ì¥¯¥È¥ê°Ê³°¤¬¤¢¤Ã¤¿ empDir = 1 Exit Do End If sDirName = Dir Loop If empDir = 0 Then ' ¥Õ¥©¥ë¥À¤¬¶õ¤Î¾ì¹ç¤Ï¡¢¼«¿È¤òºï½ü¤·¹¹¤Ë ¿Æ¤Î¥Ç¥£¥ì¥¯¥È¥ê¤Î¥Á¥§¥Ã¥¯¤Èºï½ü¤ò¤¹¤ë sParentD = Left(CurrentPath, InStrRev(CurrentPath, "\", Len(CurrentPath) - 1)) If CurrentPath <> orgPath Then RmDir (CurrentPath) If sParentD <> orgPath Then DelFldr (sParentD) ' ¿Æ¥Ç¥£¥ì¥¯¥È¥ê¤¬¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥©¥ë¥À¤Ç¤Ê¤¤¾ì¹ç¤ÏºÆµ¢Åª¤Ëºï½ü End If End If End If End Sub