About Me

Foto Saya
Affan's ErpEeL
Lihat profil lengkapku

SMS Gratis

Anda Pengunjung ke-

Free Counter
Free Counter Counter
Selasa, 12 Oktober 2010

Mengubah atribut file dengan Ms. VB 6.0


Kalo gak salah satu tahun 2006 yang lalu aku dapet komputer yang kena sebuah virus, aku gak tau apa namanya tapi aku dan teman-teman menyebutnya virus 463 karena besar file yang dihasilkan sebesar 463 Kb. Virus ini menghiden semua folder yang ada dan mengantinya dengan file bentukan yang baru namun berekstensi aplikasi atau (.exe). Si virus berhasil aku lumpuhkan dan file bentukannya sudah aku bersihkan, namun karena semua folder di hidden sama si virus mau gak mau aku harus mengembaliinnya seperti semula lagi. Aku coba klik kanan foldernya lalu propertis dengan harapan bisa aku hilangin centang pada hidden-nya, tapi ternyata si virus bukan cuma meng-hidden-nya tapi meng-superhidden atau hidden system. cara satu-satunya dengan cara menghilangkan attribut filenya melalui command promt dengan mengetikkan " attrib -S -H nama_file ", ko cuma satu file seh gak masalah, tapi klo semua folder tentu butuh waktu yang sangat lama dan capek banget.

Akhirnya aku mencoba membuat sebuah aplikasi untuk mengubah attribut filenya menggunakan microsoft visual basic 6.0 , dan berhasil. neh aku bagiin sebuah aplikasi sederhana untuk membuka file yang ke superhidden.

Tampilan aplikasinya sbb:


Berikut adalah coding buat modulnya :



Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const MAX_PATH = 260
Public Const MAXWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If

StripNulls = OriginalStr
End Function


Dan ini coding pada formnya :

Option Explicit

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)

Dim FileName As String
Dim DirName As String
Dim SearchPath As String, FindStr As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim x As Long
Dim xx As Long

If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)

If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont

DirName = StripNulls(WFD.cFileName)

If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) Or FILE_ATTRIBUTE_DIRECTORY Then

dirNames(nDir) = DirName
DirCount = DirCount + 1

nDir = nDir + 1
ReDim Preserve dirNames(nDir)

End If
End If
If (DirName <> ".") And (DirName <> "..") And (DirName <> "RECYCLER") And (DirName <> "System Volume Information") And (DirName <> "Thumbs.db") And (DirName <> "Desktop.ini") And (DirName <> "desktop.ini") Then
x = SetFileAttributes(path & DirName, FILE_ATTRIBUTE_NORMAL)
xx = CloseHandle(x)

List1.AddItem path & DirName
End If
Cont = FindNextFile(hSearch, WFD)

Loop
Cont = FindClose(hSearch)

End If


If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If

End Function

Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Dim msg

If Trim(UCase(Text1.Text)) = "C:\" Then
msg = MsgBox("Any Directories System will be show " & Chr(13) & " Are you sure to continue ?", vbQuestion + vbYesNo, ":: Confirmation ::")
If msg = vbYes Then
GoTo scan_acc
End If
Else
GoTo scan_acc
End If
Exit Sub

scan_acc:
Screen.MousePointer = vbHourglass
Command2.Enabled = False
Command1.Caption = "Please....wait"
List1.Clear
Label4.Caption = ""
SearchPath = Text1.Text
FindStr = Label1.Caption
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Label4.Caption = NumDirs & " Directories found in ' " & SearchPath & "'"
Screen.MousePointer = vbDefault
Command2.Enabled = True
Command1.Caption = "&Scan"
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Dir1_Change()
Text1.Text = Dir1.path
End Sub

Private Sub Drive1_Change()
On Error GoTo err
Dir1.path = Drive1.Drive
Exit Sub

err:
MsgBox "Device not ready", vbExclamation, ":: Device ::"
Drive1.Drive = "D:\"
Exit Sub
End Sub

Private Sub Form_Load()
Drive1.Drive = "D:\"
End Sub

Semoga aplikasi ini bisa membantu dan bisa memberikan ide baru buat kamu yang pengen belajar bareng aku.

0 komentar:

Posting Komentar

Blog Archive

Translate this page in

Powered by Translate