Source code ini aslinya dulu saya dapat dari vb-bego.com, siapa yang menciptakannya saya tidak tahu.
ini screenshot program aslinya:
dan ini screenshot hasil modifikasi saya:
saya bukan programer dan tidak pernah belajar pemograman silahkan sobat blogger sederhanakan code functionnya remTeks dengan menggunakan select case
berikut code yang ada di formnya:
Option Explicit
Dim sAkhiran As String
Dim indek As Byte
Const wireles = ".{1fa9085f-25a2-489b-85d4-86326eedcd87}" 'CLSID wireles
Const Recycle = ".{645FF040-5081-101B-9F08-00AA002F954E}" 'CLSID Recycle Bin
Const network = ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" 'CLCID My nETWORK pLACE
Const MyComp = ".{20D04FE0-3AEA-1069-A2D8-08002B30309D}" 'CLSID my computer
Const firewal = ".{4026492F-2F69-46B8-B9BF-5654FC07E423}" 'CLSID firewall
Const performance = ".{78F3955E-3B90-4184-BD14-5397C15F1EFC}" 'CLSID performance
Const power = ".{025A5937-A6BE-4686-A844-36FE4BEC8B6D}" 'CLSID power
Const notif = ".{05d7b0f4-2121-4eff-bf6b-ed3f69b894d9}" 'CLSID notif
Const printer = ".{2227A280-3AEA-1069-A2DE-08002B30309D}" 'CLSID printer
Const credit = ".{1206F5F1-0569-412C-8FEC-3204630DFB70}" 'CLSID credit
Const godm = ".{ED7BA470-8E54-465E-825C-99712043E01C}" 'CLSID godm
Function remTeks12(sTm As String)
remTeks12 = Replace(sTm, wireles, "")
End Function
Function remTeks1(sTm As String)
remTeks1 = Replace(sTm, Recycle, "")
End Function
Function remTeks2(sTm As String)
remTeks2 = Replace(sTm, network, "")
End Function
Function remTeks3(sTm As String)
remTeks3 = Replace(sTm, MyComp, "")
End Function
Function remTeks4(sTm As String)
remTeks4 = Replace(sTm, firewal, "")
End Function
Function remTeks5(sTm As String)
remTeks5 = Replace(sTm, performance, "")
End Function
Function remTeks6(sTm As String)
remTeks6 = Replace(sTm, power, "")
End Function
Function remTeks7(sTm As String)
remTeks7 = Replace(sTm, notif, "")
End Function
Function remTeks8(sTm As String)
remTeks8 = Replace(sTm, printer, "")
End Function
Function remTeks9(sTm As String)
remTeks9 = Replace(sTm, credit, "")
End Function
Function remTeks10(sTm As String)
remTeks10 = Replace(sTm, godm, "")
End Function
Sub cekAktif()
If Right(Txtlokasi.Text, Len(wireles)) = wireles Or Right(Txtlokasi.Text, Len(Recycle)) = Recycle Or Right(Txtlokasi.Text, Len(network)) = network Or Right(Txtlokasi.Text, Len(MyComp)) = MyComp _
Or Right(Txtlokasi.Text, Len(firewal)) = firewal Or Right(Txtlokasi.Text, Len(performance)) = performance Or Right(Txtlokasi.Text, Len(power)) = power _
Or Right(Txtlokasi.Text, Len(notif)) = notif Or Right(Txtlokasi.Text, Len(printer)) = printer _
Or Right(Txtlokasi.Text, Len(credit)) = credit Or Right(Txtlokasi.Text, Len(godm)) = godm Then
cmdnormal.Enabled = True
cmdrename.Enabled = False
Option1.Enabled = False
Option2.Enabled = False
Option3.Enabled = False
Option4.Enabled = False
Option5.Enabled = False
Option6.Enabled = False
Option7.Enabled = False
Option8.Enabled = False
Option9.Enabled = False
Option10.Enabled = False
Option11.Enabled = False
ElseIf Right(Txtlokasi.Text, Len(wireles)) <> wireles Or Right(Txtlokasi.Text, Len(Recycle)) <> Recycle Or Right(Txtlokasi.Text, Len(network)) <> network Or Right(Txtlokasi.Text, Len(MyComp)) <> MyComp _
Or Right(Txtlokasi.Text, Len(firewal)) <> firewal Or Right(Txtlokasi.Text, Len(performance)) <> performance Or Right(Txtlokasi.Text, Len(power)) <> power _
Or Right(Txtlokasi.Text, Len(notif)) <> notif Or Right(Txtlokasi.Text, Len(printer)) <> printer _
Or Right(Txtlokasi.Text, Len(credit)) <> credit Or Right(Txtlokasi.Text, Len(godm)) <> godm Then
cmdnormal.Enabled = False
If Option1.Value = True Or Option2.Value = True Or Option3.Value = True Or Option4.Value = True Or Option5.Value = True _
Or Option6.Value = True Or Option7.Value = True Or Option8.Value = True Or Option9.Value = True _
Or Option10.Value = True Or Option11.Value = True Then cmdrename.Enabled = True
End If
If Txtlokasi.Text = "" Then
Exit Sub
End If
End Sub
Private Sub cmdBrowse_Click()
On Error GoTo salah
Dim sTemp As String
sTemp = BrowseFolder(Me.hwnd, "-----Tentukan lokasi folder yang akan di samarkan oleh anda, by Dendrif Deo ------------------------")
If sTemp = "" Then Exit Sub
If Len(sTemp) = 3 Then Exit Sub
If (GetAttr(sTemp) And vbDirectory) = 0 Then
Exit Sub
Else
Txtlokasi.Text = sTemp
If Option1.Value = True Or Option2.Value = True Or Option3.Value = True Or Option4.Value = True Or Option5.Value = True Or Option6.Value = True _
Or Option7.Value = True Or Option8.Value = True Or Option9.Value = True Or Option10.Value = True Or Option11.Value = True Then cmdrename.Enabled = True
cekAktif
End If
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdNormal_Click()
On Error GoTo salah
If Right(Txtlokasi.Text, Len(wireles)) = wireles Then
Name (Txtlokasi.Text) As remTeks12(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(Recycle)) = Recycle Then
Name (Txtlokasi.Text) As remTeks1(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(network)) = network Then
Name (Txtlokasi.Text) As remTeks2(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(MyComp)) = MyComp Then
Name (Txtlokasi.Text) As remTeks3(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(firewal)) = firewal Then
Name (Txtlokasi.Text) As remTeks4(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(performance)) = performance Then
Name (Txtlokasi.Text) As remTeks5(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(power)) = power Then
Name (Txtlokasi.Text) As remTeks6(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(notif)) = notif Then
Name (Txtlokasi.Text) As remTeks7(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(printer)) = printer Then
Name (Txtlokasi.Text) As remTeks8(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(credit)) = credit Then
Name (Txtlokasi.Text) As remTeks9(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(godm)) = godm Then
Name (Txtlokasi.Text) As remTeks10(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
Txtlokasi.Text = " "
Me.Hide
MsgBox "Folder telah di normalkan." + vbCrLf + "UNTUK MENYAMARKAN FOLDER" + vbCrLf + "tutup aplikasi dan jalankan kembali..!", vbInformation, "Yeeess..!"
Me.Show
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Private Sub cmdRename_Click()
On Error GoTo salah
If sAkhiran = "" Then Exit Sub
Name (Txtlokasi.Text) As Txtlokasi.Text & sAkhiran
cmdrename.Enabled = False
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system" + vbCrLf + "folder yang telah DISAMARKAN" + vbCrLf + "tidak dapat DISAMARKAN dengan yang lain" + vbCrLf + "NORMALKAN dahulu..!", vbCritical, "Error BooZz..."
End Sub
Private Sub option1_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = False
cekAktif
sAkhiran = wireles
Option2.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option10_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = credit
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option11_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = godm
Option1.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option2.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option2_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = Recycle
Option1.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option3_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = network
Option2.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option4_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = MyComp
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option5_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = firewal
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option6_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = performance
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option7_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = power
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option8_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = notif
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option9_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = printer
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Timer1_Timer()
Label3.Caption = Time
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
If Label2.Visible = True Then
Label2.Visible = False
ElseIf Label2.Visible = False Then
Label2.Visible = True
End If
End Sub
Private Sub Timer3_Timer()
Me.Width = Me.Width + 100
tengah
If Me.Width >= 8130 Then
Timer3.Enabled = False
tengah
End If
End Sub
Private Sub txtLokasi_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo salah
If (GetAttr(Data.Files(1)) And vbDirectory) = 0 Then
Exit Sub
Else
Txtlokasi.Text = Data.Files(1)
Effect = 0
cekAktif
End If
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Public Sub tengah()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
End Sub
Private Sub Form_Load()
Me.Width = 2
Timer2.Enabled = True
Dim hari(7) As String
Dim bulan(12) As String
Dim har As Integer
Dim tgl As Integer
Dim bul As Integer
Dim thn As Integer
hari(1) = " Minggu "
hari(2) = " Senin "
hari(3) = " Selasa "
hari(4) = " Rabu "
hari(5) = " Kamis "
hari(6) = " Jum'at "
hari(7) = " Sabtu "
bulan(1) = " Januari "
bulan(2) = " Februari "
bulan(3) = " Maret "
bulan(4) = " April "
bulan(5) = " M e i "
bulan(6) = " Juni "
bulan(7) = " Juli "
bulan(8) = " Agustus "
bulan(9) = " September "
bulan(10) = " Oktober "
bulan(11) = " Nopember "
bulan(12) = " Desember "
har = Weekday(Date)
tgl = Day(Date)
bul = Month(Date)
thn = Str(Year(Date))
Label4.Caption = hari(har) & ", " & Str(tgl) & " " & bulan(bul) & " " & thn
cmdnormal.Enabled = False
cmdrename.Enabled = False
Option1.Value = False
Option2.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option10.Value = False
Option11.Value = False
End Sub
=======================================================================
ini source code modulnya:
Option Explicit
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function BrowseFolder(hwnd As Long, sTitle As String) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = hwnd
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = BIF_BROWSEINCLUDEFILES
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseFolder = sBuffer
End If
End Function
=======================================================================
bila sobat blogger ingin mencobanya silahkan download disini
semoga bermanfaat...... :D
ini screenshot program aslinya:
berikut code yang ada di formnya:
Option Explicit
Dim sAkhiran As String
Dim indek As Byte
Const wireles = ".{1fa9085f-25a2-489b-85d4-86326eedcd87}" 'CLSID wireles
Const Recycle = ".{645FF040-5081-101B-9F08-00AA002F954E}" 'CLSID Recycle Bin
Const network = ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" 'CLCID My nETWORK pLACE
Const MyComp = ".{20D04FE0-3AEA-1069-A2D8-08002B30309D}" 'CLSID my computer
Const firewal = ".{4026492F-2F69-46B8-B9BF-5654FC07E423}" 'CLSID firewall
Const performance = ".{78F3955E-3B90-4184-BD14-5397C15F1EFC}" 'CLSID performance
Const power = ".{025A5937-A6BE-4686-A844-36FE4BEC8B6D}" 'CLSID power
Const notif = ".{05d7b0f4-2121-4eff-bf6b-ed3f69b894d9}" 'CLSID notif
Const printer = ".{2227A280-3AEA-1069-A2DE-08002B30309D}" 'CLSID printer
Const credit = ".{1206F5F1-0569-412C-8FEC-3204630DFB70}" 'CLSID credit
Const godm = ".{ED7BA470-8E54-465E-825C-99712043E01C}" 'CLSID godm
Function remTeks12(sTm As String)
remTeks12 = Replace(sTm, wireles, "")
End Function
Function remTeks1(sTm As String)
remTeks1 = Replace(sTm, Recycle, "")
End Function
Function remTeks2(sTm As String)
remTeks2 = Replace(sTm, network, "")
End Function
Function remTeks3(sTm As String)
remTeks3 = Replace(sTm, MyComp, "")
End Function
Function remTeks4(sTm As String)
remTeks4 = Replace(sTm, firewal, "")
End Function
Function remTeks5(sTm As String)
remTeks5 = Replace(sTm, performance, "")
End Function
Function remTeks6(sTm As String)
remTeks6 = Replace(sTm, power, "")
End Function
Function remTeks7(sTm As String)
remTeks7 = Replace(sTm, notif, "")
End Function
Function remTeks8(sTm As String)
remTeks8 = Replace(sTm, printer, "")
End Function
Function remTeks9(sTm As String)
remTeks9 = Replace(sTm, credit, "")
End Function
Function remTeks10(sTm As String)
remTeks10 = Replace(sTm, godm, "")
End Function
Sub cekAktif()
If Right(Txtlokasi.Text, Len(wireles)) = wireles Or Right(Txtlokasi.Text, Len(Recycle)) = Recycle Or Right(Txtlokasi.Text, Len(network)) = network Or Right(Txtlokasi.Text, Len(MyComp)) = MyComp _
Or Right(Txtlokasi.Text, Len(firewal)) = firewal Or Right(Txtlokasi.Text, Len(performance)) = performance Or Right(Txtlokasi.Text, Len(power)) = power _
Or Right(Txtlokasi.Text, Len(notif)) = notif Or Right(Txtlokasi.Text, Len(printer)) = printer _
Or Right(Txtlokasi.Text, Len(credit)) = credit Or Right(Txtlokasi.Text, Len(godm)) = godm Then
cmdnormal.Enabled = True
cmdrename.Enabled = False
Option1.Enabled = False
Option2.Enabled = False
Option3.Enabled = False
Option4.Enabled = False
Option5.Enabled = False
Option6.Enabled = False
Option7.Enabled = False
Option8.Enabled = False
Option9.Enabled = False
Option10.Enabled = False
Option11.Enabled = False
ElseIf Right(Txtlokasi.Text, Len(wireles)) <> wireles Or Right(Txtlokasi.Text, Len(Recycle)) <> Recycle Or Right(Txtlokasi.Text, Len(network)) <> network Or Right(Txtlokasi.Text, Len(MyComp)) <> MyComp _
Or Right(Txtlokasi.Text, Len(firewal)) <> firewal Or Right(Txtlokasi.Text, Len(performance)) <> performance Or Right(Txtlokasi.Text, Len(power)) <> power _
Or Right(Txtlokasi.Text, Len(notif)) <> notif Or Right(Txtlokasi.Text, Len(printer)) <> printer _
Or Right(Txtlokasi.Text, Len(credit)) <> credit Or Right(Txtlokasi.Text, Len(godm)) <> godm Then
cmdnormal.Enabled = False
If Option1.Value = True Or Option2.Value = True Or Option3.Value = True Or Option4.Value = True Or Option5.Value = True _
Or Option6.Value = True Or Option7.Value = True Or Option8.Value = True Or Option9.Value = True _
Or Option10.Value = True Or Option11.Value = True Then cmdrename.Enabled = True
End If
If Txtlokasi.Text = "" Then
Exit Sub
End If
End Sub
Private Sub cmdBrowse_Click()
On Error GoTo salah
Dim sTemp As String
sTemp = BrowseFolder(Me.hwnd, "-----Tentukan lokasi folder yang akan di samarkan oleh anda, by Dendrif Deo ------------------------")
If sTemp = "" Then Exit Sub
If Len(sTemp) = 3 Then Exit Sub
If (GetAttr(sTemp) And vbDirectory) = 0 Then
Exit Sub
Else
Txtlokasi.Text = sTemp
If Option1.Value = True Or Option2.Value = True Or Option3.Value = True Or Option4.Value = True Or Option5.Value = True Or Option6.Value = True _
Or Option7.Value = True Or Option8.Value = True Or Option9.Value = True Or Option10.Value = True Or Option11.Value = True Then cmdrename.Enabled = True
cekAktif
End If
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdNormal_Click()
On Error GoTo salah
If Right(Txtlokasi.Text, Len(wireles)) = wireles Then
Name (Txtlokasi.Text) As remTeks12(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(Recycle)) = Recycle Then
Name (Txtlokasi.Text) As remTeks1(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(network)) = network Then
Name (Txtlokasi.Text) As remTeks2(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(MyComp)) = MyComp Then
Name (Txtlokasi.Text) As remTeks3(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(firewal)) = firewal Then
Name (Txtlokasi.Text) As remTeks4(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(performance)) = performance Then
Name (Txtlokasi.Text) As remTeks5(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(power)) = power Then
Name (Txtlokasi.Text) As remTeks6(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(notif)) = notif Then
Name (Txtlokasi.Text) As remTeks7(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(printer)) = printer Then
Name (Txtlokasi.Text) As remTeks8(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(credit)) = credit Then
Name (Txtlokasi.Text) As remTeks9(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
If Right(Txtlokasi.Text, Len(godm)) = godm Then
Name (Txtlokasi.Text) As remTeks10(Txtlokasi.Text)
cmdnormal.Enabled = False
End If
Txtlokasi.Text = " "
Me.Hide
MsgBox "Folder telah di normalkan." + vbCrLf + "UNTUK MENYAMARKAN FOLDER" + vbCrLf + "tutup aplikasi dan jalankan kembali..!", vbInformation, "Yeeess..!"
Me.Show
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Private Sub cmdRename_Click()
On Error GoTo salah
If sAkhiran = "" Then Exit Sub
Name (Txtlokasi.Text) As Txtlokasi.Text & sAkhiran
cmdrename.Enabled = False
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system" + vbCrLf + "folder yang telah DISAMARKAN" + vbCrLf + "tidak dapat DISAMARKAN dengan yang lain" + vbCrLf + "NORMALKAN dahulu..!", vbCritical, "Error BooZz..."
End Sub
Private Sub option1_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = False
cekAktif
sAkhiran = wireles
Option2.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option10_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = credit
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option11_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = godm
Option1.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option2.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option2_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = Recycle
Option1.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option3_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = network
Option2.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub option4_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = MyComp
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option5_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = firewal
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option6_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = performance
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option7.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option7_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = power
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option8.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option8_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = notif
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option9.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Option9_Click()
If Txtlokasi.Text <> "" Then cmdrename.Enabled = True
cekAktif
sAkhiran = printer
Option2.Value = False
Option3.Value = False
Option1.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option10.Value = False
Option11.Value = False
If Txtlokasi.Text = "" Then
cmdrename.Enabled = False
End If
End Sub
Private Sub Timer1_Timer()
Label3.Caption = Time
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
If Label2.Visible = True Then
Label2.Visible = False
ElseIf Label2.Visible = False Then
Label2.Visible = True
End If
End Sub
Private Sub Timer3_Timer()
Me.Width = Me.Width + 100
tengah
If Me.Width >= 8130 Then
Timer3.Enabled = False
tengah
End If
End Sub
Private Sub txtLokasi_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo salah
If (GetAttr(Data.Files(1)) And vbDirectory) = 0 Then
Exit Sub
Else
Txtlokasi.Text = Data.Files(1)
Effect = 0
cekAktif
End If
On Error GoTo 0
Exit Sub
salah:
MsgBox "maaf telah terjadi kesalahan system", vbCritical, "Error BooZ..."
End Sub
Public Sub tengah()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
End Sub
Private Sub Form_Load()
Me.Width = 2
Timer2.Enabled = True
Dim hari(7) As String
Dim bulan(12) As String
Dim har As Integer
Dim tgl As Integer
Dim bul As Integer
Dim thn As Integer
hari(1) = " Minggu "
hari(2) = " Senin "
hari(3) = " Selasa "
hari(4) = " Rabu "
hari(5) = " Kamis "
hari(6) = " Jum'at "
hari(7) = " Sabtu "
bulan(1) = " Januari "
bulan(2) = " Februari "
bulan(3) = " Maret "
bulan(4) = " April "
bulan(5) = " M e i "
bulan(6) = " Juni "
bulan(7) = " Juli "
bulan(8) = " Agustus "
bulan(9) = " September "
bulan(10) = " Oktober "
bulan(11) = " Nopember "
bulan(12) = " Desember "
har = Weekday(Date)
tgl = Day(Date)
bul = Month(Date)
thn = Str(Year(Date))
Label4.Caption = hari(har) & ", " & Str(tgl) & " " & bulan(bul) & " " & thn
cmdnormal.Enabled = False
cmdrename.Enabled = False
Option1.Value = False
Option2.Value = False
Option3.Value = False
Option4.Value = False
Option5.Value = False
Option6.Value = False
Option7.Value = False
Option8.Value = False
Option10.Value = False
Option11.Value = False
End Sub
=======================================================================
ini source code modulnya:
Option Explicit
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function BrowseFolder(hwnd As Long, sTitle As String) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.hWndOwner = hwnd
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = BIF_BROWSEINCLUDEFILES
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseFolder = sBuffer
End If
End Function
=======================================================================
bila sobat blogger ingin mencobanya silahkan download disini
semoga bermanfaat...... :D
Tidak ada komentar:
Posting Komentar