Mengganti Wallpaper dan Mengosongkan Recyle Bin dari Visual Basic 6.0

Berikut aplikasi untuk mengganti Wallpaper dan Mengosongkan isi Recyle Bin dari aplikasi Visual Basic 6.0. Langsung saja buat project baru dari Visual Basic 6 dan atur tampilan formnya seperti di bawah ini.

Isikan perintah berikut pada area '(General)'

Option Explicit

Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_SENDWININICHANGE = &H2

Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum

Private Declare Function RegCreateKey Lib _
"advapi32.dll" Alias "RegCreateKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal Hkey As Long) As Long

Private Declare Function RegSetValueEx Lib _
"advapi32.dll" Alias "RegSetValueExA" _
(ByVal Hkey As Long, ByVal _
lpValueName As String, ByVal _
Reserved As Long, ByVal dwType _
As Long, lpData As Any, ByVal _
cbData As Long) As Long

Private Const REG_SZ = 1

'Recyle Bin
Const SHERB_NOCONFIRMATION = &H1
Const SHERB_NOPROGRESSUI = &H2
Const SHERB_NOSOUND = &H4
Private Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Type SHQUERYRBINFO
cbSize As Long
i64Size As ULARGE_INTEGER
i64NumItems As ULARGE_INTEGER
End Type
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Declare Function SHQueryRecycleBin Lib "shell32.dll" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHQUERYRBINFO) As Long

Public Function ChangeWallPaper(ImageFile As String, Tile As Boolean)
Dim lRet As Long
On Error Resume Next

If Tile Then WriteStringToRegistry HKEY_CURRENT_USER, _
"Control Panel\desktop", "TileWallpaper", "1"

lRet = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ImageFile, _
SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
ChangeWallPaper = lRet <> 0 And Err.LastDllError = 0
End Function

Private Function WriteStringToRegistry(Hkey As _
REG_TOPLEVEL_KEYS, strPath As String, strValue As String, _
strdata As String) As Boolean


Dim bAns As Boolean

On Error GoTo ErrorHandler
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
If r = 0 Then
r = RegSetValueEx(keyhand, strValue, 0, _
REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End If

WriteStringToRegistry = (r = 0)

Exit Function

ErrorHandler:
WriteStringToRegistry = False
Exit Function

End Function

Perintah Pada Tombol 'Ganti Wallpaper'

Private Sub Command1_Click()
Dim s
CommonDialog1.Filter = "Bitmap(*.bmp)|*.bmp"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
s = ChangeWallPaper(CommonDialog1.FileName, False)
End If
End Sub

Perintah Pada tombol 'Kosongkan Recyle Bin'

Private Sub Command2_Click()
Dim RBinInfo As SHQUERYRBINFO, Msg As VbMsgBoxResult
RBinInfo.cbSize = Len(RBinInfo)
SHQueryRecycleBin vbNullString, RBinInfo
If (RBinInfo.i64Size.LowPart And &H80000000) = &H80000000 Or RBinInfo.i64Size.HighPart > 0 Then
Msg = MsgBox("Recycle Bin anda terisi lebih dari 2 gigabytes sekarang." + vbCrLf + "Apakah Anda ingin Mengosongkannya ?", vbYesNo + vbQuestion)
Else
Msg = MsgBox("Recycle Bin anda terisi " + Str$(RBinInfo.i64Size.LowPart) + " bytes sekarang." + vbCrLf + "Apakah Anda ingin Mengosongkannya ?", vbYesNo + vbQuestion)
End If
If Msg = vbYes Then
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
SHUpdateRecycleBinIcon
End If
End Sub

Perintah Pada tombol 'Tutup'

Private Sub Command3_Click()
End
End Sub

Jalankan Aplikasi dengan cara tekan tombol F5

Source code program dapat diambil di http://www.ziddu.com/download/15683391/VB6ChangeWallpaper.rar.html. Selamat Mencoba