Langsung aja ya proejct terdiri dari 1 form dan 1 module. silahkan lanjutkan membacanya
Ini source code untuk form1
'File Remover 1.0.0.1
'if u like this software, Mail me at : subhendra_barik@yahoo.co.in
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FO_DELETE = &H3
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Dim st, ct, tt As Variant
Private Sub Check1_Click()
Check2.Value = 0
End Sub
Private Sub Check2_Click()
Check1.Value = 0
End Sub
Private Sub Cmd_Click(Index As Integer)
Select Case Index
Case 0
cmd.Item(Index).Enabled = False
Timer1.Enabled = True
st = Time
On Error GoTo Stop1
Drive1.Refresh
TxtDel.Text = ""
List2.Clear
File1.Refresh
File1.Pattern = "*." & CmbExten.Text
If Option1.Item(0).Value = True Then
Drive1.Drive = LblFol.Caption
Dir1.path = Trim(LblFol.Caption) & "\"
ElseIf Option1.Item(1).Value = True Then
Drive1.Drive = CmbDrive.Text
Dir1.path = CmbDrive.Text & "\"
End If
File1.path = Dir1.path
For i = 0 To File1.ListCount - 1
TotFil.Caption = List2.ListCount
List2.AddItem File1.List(i)
LblFile.Caption = File1.path
TxtDel.Text = TxtDel.Text & File1.path
DeleteFile (File1.path & "\" & File1.List(i))
Next i
err:
If flag = 1 Then GoTo Stop1
Dir1.path = List1.Text
LblFile.Caption = File1.path & "\" & File1.List(i)
List2.Refresh
For i = 0 To Dir1.ListCount - 1
List1.AddItem Dir1.List(i)
File1.path = Dir1.List(i)
For j = 0 To File1.ListCount - 1
TotFil.Caption = List2.ListCount
List2.AddItem File1.List(j)
LblFile.Caption = File1.path
TxtDel.Text = TxtDel.Text & File1.path & "\" & File1.List(j) & vbNewLine
DeleteFile (File1.path & "\" & File1.List(j))
Next j
DoEvents
LblTime = Format(Time - st, "HH:MM:SS")
Next i
List1.ListIndex = List1.ListIndex + 1
GoTo err
Case 1
MsgBox "Thank You For Using This Software." & vbNewLine & "If you have any Suggestion , Please mail me at:" & vbNewLine & "subhendra_barik@yahoo.co.in"
End
End Select
Stop1:
TotFil.Caption = List2.ListCount
Timer1.Enabled = False
Image1.Width = 100
MsgBox "Total " & List2.ListCount & " Files Deleted", vbOKOnly, "File Remover Ver-1.0.0.1"
LblTime = Format(Time - st, "HH:MM:SS")
End Sub
Private Sub CmdBrow_Click()
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim POS As Integer
bi.hOwner = Me.hwnd
bi.pidlRoot = 0&
bi.lpszTitle = "Select original database directory."
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
POS = InStr(path, Chr$(0))
If Len(Left(path, POS - 1)) = 3 Then
LblFol.Caption = Mid(Left(path, POS - 1), 1, 2)
Else
LblFol.Caption = Left(path, POS - 1)
End If
End If
End Sub
Private Sub Dir1_Change()
File1.path = Dir1.path
Dir1.Refresh
File1.Refresh
End Sub
Private Sub Form_Load()
Image1.Width = 100
CmbExten.Clear
Dim ext As String
Open App.path & "\ext.txt" For Input As #1
Do While Not EOF(1)
ext = ""
n = ""
Line Input #1, temp
length = Len(CStr(temp))
For i = 1 To length
n = Mid(temp, i, 1)
If n = "=" Then
For j = 1 To i - 2
ext = ext + Mid(temp, j + 1, 1)
Next j
End If
Next i
CmbExten.AddItem StrConv(ext, vbUpperCase)
Loop
Close #1
End Sub
Private Sub LblFol_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblFol.ToolTipText = LblFol.Caption
End Sub
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
CmbDrive.Enabled = False
CmdBrow.Enabled = True
Case 1
LblFol.Caption = ""
CmdBrow.Enabled = False
CmbDrive.Enabled = True
End Select
End Sub
Private Sub Timer1_Timer()
Image1.Width = Image1.Width + 20
If Image1.Width = 6820 Then Image1.Width = 100
End Sub
dan ini source code untuk modulenya
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 260
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
biar ga bingung ni aku kasih tampilannya
Posting Komentar