1. Buka Run, [Caranya : Klik menu Start -- Run /  Tekan tombol Windows dan R secara bersamaan]
2. Tulis regedit pada kotak dialog Run.
3. Kemudian buka folder My Computer\HEY_CURRENT_USER\Software\Yahoo\pager\Test, pada Regedit Explorer.
4. Tambahkan file DWORD, berinama Plural dan beri nilai 1.
5. Beresdeh, silahkan buka Yahoo Messanger lebih dari 1.

Selamat mencoba…

USE msdb
GO
DECLARE @DaysToKeepHistory DATETIME
SET @DaysToKeepHistory = CONVERT(VARCHAR(10), DATEADD(dd, -30, GETDATE()), 101)

EXEC sp_delete_backuphistory @DaysToKeepHistory
GO

Dalam tutorial ini kita akan membuat file .Pfd dengan menggunakan Visual Basic 6 dan tanpa menggunakan OCX. Silahkan mencoba, Trimakasih…

Download

Cara penggunaannya, download file mouse whell di bawah ini, kemudian extrak file tersebut.

Cara pertama, Copykan file yang bernama MouseWheel.dll kedalam directory C:\Windows\System32\MouseWhell.dll kemudian jalankan Run, copykan kode “Regsvr32.exe /s %systemroot%\system32\MouseWheel.dll” lalu tekan tombol Enter.

Cara Kedua, Langsung Double Klik File Install.bat.

Beikut file Download-nya :

Download

Option Explicit

Public Declare Function WritePrivateProfileString Lib "Kernel32" Alias _
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _
    lpKeyName As Any, ByVal lpstring As Any, ByVal lpfilename As String) As Long

Public Declare Function GetPrivateProfileString Lib "Kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _
    lpKeyName As Any, ByVal lpdefault As String, ByVal lpreturnedstring As Any, _
    ByVal nsize As Long, ByVal lpfilename As String) As Long

Public Function ReadValue(Key As String, Optional Default As String,
    Optional Section As String, Optional File)
    ' Read from INI file
    Dim sReturn As String
    If IsMissing(File) Then File = FullPath(App.Path, "\config\config.ini")
    sReturn = String(255, Chr(0))
    ReadValue = Left(sReturn, GetPrivateProfileString(Section, Key, Default, sReturn, Len(sReturn), File))
    'ReadValue("CSound02", sValue, "CSOUND")
End Function

Public Sub SaveValue(Key As String, Value As String,
    Optional Section As String = "WonderHTML", Optional File)
    ' Write to INI file
    If IsMissing(File) Then File = FullPath(App.Path, "\config\config.ini")
    WritePrivateProfileString Section, Key, Value, File
End Sub

Function FullPath(lpPath As String, lpFile As String) As String
    If Right(lpPath, 1)  "\" Then lpPath = lpPath & "\"
    FullPath = lpPath & lpFile
    'fullpath, after resolving the "\" problems
End Function

Public Function CBinary(Expression As Boolean) As Integer
    'Useful for converting BOOLs to 0 or 1. CByte() would
    'return 255 for true, which wont be useful for setting the
    'values of, for instance, a checkbox; as it uses 0 and 1.
    If Expression = False Then CBinary = 0 Else CBinary = 1
End Function

Cara penggunaannya :

    'Untuk Membaca File Ini
    ReadValue(SaveValue Key, Value, Section)

    'Untuk Menulis ke File Ini
    SaveValue(Key, Value, Section)

Silahkan mencoba, Trimakasih…

Dim A(20), num, i, j, max As Integer

Private Sub Form_Load()
    'Input nilai
    num = InputBox("Inisialisasi array : ")
    For i = 0 To num - 1
        A(i) = InputBox("Masukkan jumlah array : ")
    Next i

    'Cari Nilai Max
    max = A(0)
    For i = 0 To num - 1
        If max < A(i) Then
            max = A(i)
        End If
    Next

    'Tampilkan nilai max
    Print "Jumlah Array : "
    For i = 0 To num - 1
        Print A(i)
    Next i

    Print "Value; Tertinggi = "; max; ""
End Sub

Silahkan mencoba, Trimakasih…

Option Explicit

Const MAX_PATH& = 260
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF

Declare Function TerminateProcess _
    Lib "kernel32" (ByVal ApphProcess As Long, _
    ByVal uExitCode As Long) As Long

Declare Function OpenProcess Lib _
    "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal blnheritHandle As Long, _
    ByVal dwAppProcessId As Long) As Long

Declare Function ProcessFirst _
    Lib "kernel32" Alias "Process32First" _
    (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long

Declare Function ProcessNext _
    Lib "kernel32" Alias "Process32Next" _
    (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long

Declare Function CreateToolhelpSnapshot _
    Lib "kernel32" Alias "CreateToolhelp32Snapshot" _
    (ByVal lFlags As Long, _
    lProcessID As Long) As Long

Declare Function CloseHandle _
    Lib "kernel32" (ByVal hObject As Long) As Long

Private Type LUID
    lowpart As Long
    highpart As Long
    End Type
    Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    LuidUDT As LUID
    Attributes As Long
End Type

Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess _
    Lib "kernel32" () As Long

Private Declare Function OpenProcessToken _
    Lib "advapi32" (ByVal ProcessHandle As Long, _
    ByVal DesiredAccess As Long, _
    TokenHandle As Long) As Long

Private Declare Function LookupPrivilegeValue _
    Lib "advapi32" Alias "LookupPrivilegeValueA" _
    (ByVal lpSystemName As String, _
    ByVal lpName As String, _
    lpLuid As LUID) As Long

Private Declare Function AdjustTokenPrivileges _
    Lib "advapi32" (ByVal TokenHandle As Long, _
    ByVal DisableAllPrivileges As Long, _
    NewState As TOKEN_PRIVILEGES, _
    ByVal BufferLength As Long, _
    PreviousState As Any, _
    ReturnLength As Any) As Long

Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * MAX_PATH
End Type

Public Function KillApp(myName As String) As Boolean
    Const TH32CS_SNAPPROCESS As Long = 2&
    Const PROCESS_ALL_ACCESS = 0
    Dim uProcess As PROCESSENTRY32
    Dim rProcessFound As Long
    Dim hSnapshot As Long
    Dim szExename As String
    Dim exitCode As Long
    Dim myProcess As Long
    Dim AppKill As Boolean
    Dim appCount As Integer
    Dim i As Integer
    On Local Error GoTo Finish
    appCount = 0

    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)
    Do While rProcessFound
        i = InStr(1, uProcess.szexeFile, Chr(0))
        szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
        If Right$(szExename, Len(myName)) = LCase$(myName) Then
            KillApp = True
            appCount = appCount + 1
            myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, _
            uProcess.th32ProcessID)
            If KillProcess(uProcess.th32ProcessID, 0) Then
            'Tidak ada process yang di stop
            End If
        End If
        rProcessFound = ProcessNext(hSnapshot, uProcess)
    Loop
    Call CloseHandle(hSnapshot)
    Exit Function
Finish:
    MsgBox "Error!"
End Function

Function KillProcess(ByVal hProcessID As Long, Optional ByVal _
exitCode As Long) As Boolean
Dim hToken As Long
Dim hProcess As Long
Dim tp As TOKEN_PRIVILEGES

    If GetVersion() >= 0 Then
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
            TOKEN_QUERY, hToken) = 0 Then
            GoTo CleanUp
        End If
        If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
            GoTo CleanUp
        End If
        tp.PrivilegeCount = 1
        tp.Attributes = SE_PRIVILEGE_ENABLED
        If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
            ByVal 0&) = 0 Then
            GoTo CleanUp
        End If
    End If
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
    If hProcess Then
        KillProcess = (TerminateProcess(hProcess, exitCode)  0)
        CloseHandle hProcess
    End If

    If GetVersion() >= 0 Then
        tp.Attributes = 0
        AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&

CleanUp:
        If hToken Then CloseHandle hToken
    End If
End Function

Cara penggunaannya sebagai berikut :

Private Sub Form_Load()
    Call KillApp("explorer.exe")
End Sub

Silahkan mencoba, trimakasih…

Function KiosProjectShellTrayWnd() As Long
Dim KiosProject(1 To 2) As Long
    '/Cari class Shell_TrayWnd
    KiosProject(1) = FindWindow("Shell_TrayWnd", vbNullString)
    '/Cari Start Button Pada Class Shell_TrayWnd
    KiosProject(2) = FindWindowEx(KiosProject(1), ByVal 0&, "Button", vbNullString)
    KiosProjectShellTrayWnd = KiosProject(2)
End Function

Private Sub Form_Load()
    Timer1.Interval = 200
End Sub

Private Sub Timer1_Timer()
    Dim hText As String, btnHwnd As Long
    Static pos As Integer

    '/Set animasi Text
    hText = " Programming Community (Kios Project)"

    '/Masukan Hwnd Tombol Start
    btnHwnd = KiosProjectShellTrayWnd
    If btnHwnd > 0 Then
        If pos < Len(hText) Then
            pos = pos + 1
        Else
            pos = 1
        End If

        '/Rubah Text Baru
        SetWindowText KiosProjectShellTrayWnd, Mid(hText, pos, 4)
        '/Tampilkan perubahan text baru
        RedrawWindow KiosProjectShellTrayWnd, ByVal 0&, ByVal 0&, &H1
    End If
End Sub

Coba jalankan kode program tersebut, kemudian perhatikan tombol start dalam windows, jika nama text Start-nya berubah menjadi “Programming Community (Kios Project)” dan bergerak, maka berhasil. Silahkan mencoba…

Trimakasih…

Nah gimana cara-nya mengetahui keberadaan sebuah file tersebut, sederhananya seperti contoh kode program di bawah ini :

Function FileExists(strPath As String) As Boolean
Dim lngRetVal As Long
On Error Resume Next
lngRetVal = Len(Dir$(strPath, vbReadOnly Or _
                            vbSystem Or _
                            vbHidden Or _
                            vbArchive Or _
                            vbNormal))
  If Err Or lngRetVal = 0 Then
    FileExists = False
  Else
    FileExists = True
  End If
End Function

Private Sub Form_Load()
   MsgBox FileExists(”C:\boot.ini”)
End Sub

Terimakasih…