Berapa Lama Windows Telah Dijalankan

Option Explicit 
 
Private Declare Function GetTickCount Lib "Kernel32" () As Long 
 
Private Sub Timer1_Timer() 
    Text1.Text = Format(GetTickCount, "0") & " milisceconds" 
    Text2.Text = Format(GetTickCount / 60000, "0") & " minutes" 
End Sub 

READ MORE - Berapa Lama Windows Telah Dijalankan

Fungsi Shutdown, Restart, Log-Off Dan Sebagainya

Option Explicit 
 
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long 
Private Const ENDSESSION_LOGOFF As Long = &H80000000 
 
Public Enum EShutDownTypes 
    [_First] = 0 
    EWX_LOGOFF = 0 
    EWX_SHUTDOWN = 1& 
    EWX_REBOOT = 2& 
    EWX_FORCELOGOFF = 4& 
    EWX_FORCESHUTDOWN   = 5& 
    EWX_FORCEREBOOT = 6& 
    EWX_POWEROFF = 8& 
    EWX_FORCEIFHUNG = 10& ' NT5 only 
    [_Last] = &H20& - 1 
End Enum 
 
Public Enum EShutDownErrorBaseConstant 
    eeSSDErrorBase = vbObjectError Or (1048 + &H210) 
End Enum 
 
Private Type OSVERSIONINFO 
    dwOSVersionInfoSize As Long   
    dwMajorVersion As Long 
    dwMinorVersion As Long 
    dwBuildNumber As Long 
    dwPlatformId As Long 
    szCSDVersion As String * 128 
End Type 
 
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 
 
Private Const VER_PLATFORM_WIN32_NT = 2 
Private Const VER_PLATFORM_WIN32_WINDOWS = 1 
Private Const VER_PLATFORM_WIN32s = 0 
 
Private Const   FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000 
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800 
Private Const FORMAT_MESSAGE_FROM_STRING = &H400 
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200 
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF 
 
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _ 
ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long 
 
Private Type LARGE_INTEGER 
    LowPart As Long 
    HighPart As Long 
End Type 
 
Private Type LUID 
    LowPart As Long 
    HighPart As Long 
End Type 
 
Private Type LUID_AND_ATTRIBUTES 
    pLuid As LUID 
    Attributes As Long 
End Type 
 
Private Type TOKEN_PRIVILEGES 
    PrivilegeCount As Long 
    Privileges(0 To 0) As LUID_AND_ATTRIBUTES 
End Type 
 
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long 
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long   
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, TokenInformationClass As Integer, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long 
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long 
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias   "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long 
 
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege" 
Private Const SE_PRIVILEGE_ENABLED = &H2 
 
Private Const READ_CONTROL = &H20000 
Private Const STANDARD_RIGHTS_ALL = &H1F0000 
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL) 
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL) 
Private Const   STANDARD_RIGHTS_REQUIRED = &HF0000 
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) 
 
Private Const TOKEN_ASSIGN_PRIMARY = &H1 
Private Const TOKEN_DUPLICATE = (&H2) 
Private Const TOKEN_IMPERSONATE = (&H4) 
Private Const TOKEN_QUERY = (&H8) 
Private Const TOKEN_QUERY_SOURCE = (&H10) 
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20) 
Private Const TOKEN_ADJUST_GROUPS =   (&H40) 
Private Const TOKEN_ADJUST_DEFAULT = (&H80) 
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _ 
TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT) 
Private Const TOKEN_READ = (STANDARD_RIGHTS_READ Or TOKEN_QUERY) 
Private Const TOKEN_WRITE = (STANDARD_RIGHTS_WRITE Or   TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT) 
Private Const TOKEN_EXECUTE = (STANDARD_RIGHTS_EXECUTE) 
Private Const TokenImpersonationLevel = 9 
Private Const TokenOwner = 4 
Private Const TokenUser = 1 
Private Const TokenPrimaryGroup = 5 
Private Const TokenStatistics = 10 
Private Const TokenType = 8 
Private Const TokenPrivileges = 3 
Private Const TokenSource = 7 
Private Const TokenDefaultDacl = 6 
Private Const TokenGroups = 2 
 
Public Function WinError(ByVal lLastDLLError As Long) As String 
 
    Dim sBuff As String 
    Dim lCount As Long 
 
    sBuff = Space(255) 
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0) 
 
    If lCount Then 
       WinError = Left(sBuff, lCount) 
    End If 
 
End Function 
 
Public Function IsNT() As Boolean 
 
   Static bOnce As Boolean 
   Static bValue As Boolean 
 
   If Not (bOnce) Then 
       Dim tVI As OSVERSIONINFO 
 
       tVI.dwOSVersionInfoSize = Len(tVI) 
 
       If (GetVersionEx(tVI) <> 0) Then 
           bValue = (tVI.dwPlatformId = VER_PLATFORM_WIN32_NT) 
              bOnce = True 
       End If 
   End If 
 
   IsNT = bValue 
 
End Function 
 
Private Function NTEnableShutDown(ByRef sMsg As String) As Boolean 
 
    Dim tLUID As LUID 
    Dim hProcess As Long 
    Dim hToken As Long 
    Dim tTP As TOKEN_PRIVILEGES 
    Dim tTPOld As TOKEN_PRIVILEGES 
    Dim lTpOld As Long 
    Dim lR As Long 
 
   lR =   LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, tLUID) 
 
   If (lR <> 0) Then 
 
       hProcess = GetCurrentProcess() 
        If (hProcess <> 0) Then 
           lR = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) 
            If (lR <> 0) Then 
 
               With tTP 
                    .PrivilegeCount = 1 
                    With .Privileges(0) 
                        .Attributes =   SE_PRIVILEGE_ENABLED 
                        .pLuid.HighPart = tLUID.HighPart 
                        .pLuid.LowPart = tLUID.LowPart 
                    End With 
               End With 
 
               lR = AdjustTokenPrivileges(hToken, 0, tTP, Len(tTP), tTPOld, lTpOld) 
 
                If (lR <> 0) Then 
                   NTEnableShutDown = True 
                Else 
                   Err.Raise eeSSDErrorBase + 6, App.EXEName & ".mShutDown", "Can't enable shutdown: You do not have the privileges to " & "shutdown this system. ["   & WinError(Err.LastDllError) & "]" 
                End If 
 
               CloseHandle hToken 
            Else 
               Err.Raise eeSSDErrorBase + 6, App.EXEName & ".mShutDown", "Can't enable shutdown: You do not have the privileges to " & "shutdown this system. [" & WinError(Err.LastDllError) & "]" 
            End If 
       Else 
           Err.Raise eeSSDErrorBase + 5, App.EXEName & ".mShutDown", "Can't enable shutdown: Can't determine the current process. [" & WinError(Err.LastDllError) & "]" 
        End If 
   Else 
       Err.Raise eeSSDErrorBase +   4, App.EXEName & ".mShutDown", _ 
            "Can't enable shutdown: Can't find the SE_SHUTDOWN_NAME privilege value. [" & _ 
            WinError(Err.LastDllError) & "]" 
    End If 
 
End Function 
 
Public Function ShutdownSystem(Optional ByVal eType As EShutDownTypes = EWX_SHUTDOWN) As Boolean 
 
   Dim yesno As Integer 
 
   Dim lR As Long 
   Dim sMsg As String 
 
   If (eType < EShutDownTypes.[_First] And eType > EShutDownTypes.[_Last]) Then 
        Err.Raise   eeSSDErrorBase + 7, App.EXEName & ".mShutDown", "Invalid parameter to ShutdownSystem: " & eType, vbInformation 
        Exit Function 
   End If 
 
   If (IsNT) Then 
       If Not (NTEnableShutDown(sMsg)) Then 
           Exit Function 
       End If 
   End If 
 
   lR = ExitWindowsEx(eType, &HFFFFFFFF) 
 
    If (lR = 0) Then 
       Err.Raise eeSSDErrorBase + 3, App.EXEName & ".mShutDown", "ShutdownSystem failed: " & WinError(Err.LastDllError) 
    Else 
       ShutdownSystem = True 
    End If 
 
End Function 

Private Sub Command1_Click() 
    ShutdownSystem EWX_FORCESHUTDOWN 
End Sub 
 
Private Sub Command2_Click() 
    ShutdownSystem EWX_FORCEREBOOT 
End Sub 
 
Private Sub Command3_Click() 
    ShutdownSystem EWX_FORCELOGOFF 
End Sub 

READ MORE - Fungsi Shutdown, Restart, Log-Off Dan Sebagainya

Menghapus Isi TextBox Dengan Cepat Menggunakan For...Each

Option Explicit 
 
Public Sub ClearAllTextBoxes(frmClearMe As Form) 
    Dim txt As Control 
    For Each txt In frmClearMe 
        If TypeOf txt Is TextBox Then txt.Text = "" 
    Next 
End Sub 

Private Sub Command1_Click() 
    ClearAllTextBoxes Me 
End Sub 

READ MORE - Menghapus Isi TextBox Dengan Cepat Menggunakan For...Each

Fungsi VB6 - Untuk Memperoleh Time Out Screen Saver

Mengenai fungsi VB6 untuk memperoleh timeout screen saver - Bagaimanakah kita dapat memperoleh time out dari screen saver melalui kode VB6, berikut adalah jawabanya:

Option Explicit 
 
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 
Private Const SPI_GETSCREENSAVETIMEOUT = 14 
 
Function ScrTimeOut() As Integer 
    Dim intValue As Integer 
    Call SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, vbNull, intValue, 0) 
    ScrTimeOut = intValue 
End Function 

Cara menggunakan fungsi VB6 diatas:

Private Sub Command1_Click() 
    MsgBox ("Screen saver time-out value: " & ScrTimeOut & " seconds.") 
End Sub 

READ MORE - Fungsi VB6 - Untuk Memperoleh Time Out Screen Saver