Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function LockWorkStation Lib "user32.dll" () As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) 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 Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const SE_PRIVILEGE_ENABLED As Long = &H2

Private Const EWX_LOGOFF As Long = &H0
Private Const EWX_SHUTDOWN As Long = &H1
Private Const EWX_REBOOT As Long = &H2
Private Const EWX_FORCE As Long = &H4
Private Const EWX_POWEROFF As Long = &H8
Private Const EWX_FORCEIFHUNG As Long = &H10 '2000/XP only

Private Const VER_PLATFORM_WIN32_NT As Long = 2

Private Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

Private Type LUID
   dwLowPart As Long
   dwHighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
   udtLUID As LUID
   dwAttributes As Long
End Type

Private Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   laa As LUID_AND_ATTRIBUTES
End Type

Private Const MF_BYPOSITION = &H400&

Dim Basla As Date, Simdi As Date, Zaman As Date, Ara As Date
Dim Arabasla As Date, Sifirlandi As Boolean, Durduruldu As Boolean

Private Sub RemoveMenus(ByVal frm As Form, _
    ByVal remove_restore As Boolean, _
    ByVal remove_move As Boolean, _
    ByVal remove_size As Boolean, _
    ByVal remove_minimize As Boolean, _
    ByVal remove_maximize As Boolean, _
    ByVal remove_seperator As Boolean, _
    ByVal remove_close As Boolean)
    
    Dim hMenu As Long
    hMenu = GetSystemMenu(frm.hWnd, False)
    If remove_close Then DeleteMenu hMenu, 6, MF_BYPOSITION
    If remove_seperator Then DeleteMenu hMenu, 5, MF_BYPOSITION
    If remove_maximize Then DeleteMenu hMenu, 4, MF_BYPOSITION
    If remove_minimize Then DeleteMenu hMenu, 3, MF_BYPOSITION
    If remove_size Then DeleteMenu hMenu, 2, MF_BYPOSITION
    If remove_move Then DeleteMenu hMenu, 1, MF_BYPOSITION
    If remove_restore Then DeleteMenu hMenu, 0, MF_BYPOSITION
End Sub

Private Function IsWinNTPlus() As Boolean
   #If Win32 Then
      Dim OSV As OSVERSIONINFO
      OSV.OSVSize = Len(OSV)
      If GetVersionEx(OSV) = 1 Then
         IsWinNTPlus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And (OSV.dwVerMajor >= 4)
      End If
   #End If
End Function


Private Function EnableShutdownPrivledges() As Boolean
   Dim hProcessHandle As Long
   Dim hTokenHandle As Long
   Dim lpv_la As LUID
   Dim token As TOKEN_PRIVILEGES
   
   hProcessHandle = GetCurrentProcess()
   If hProcessHandle <> 0 Then
   
      If OpenProcessToken(hProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hTokenHandle) <> 0 Then
         If LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", lpv_la) <> 0 Then
            With token
               .PrivilegeCount = 1
               .laa.udtLUID = lpv_la
               .laa.dwAttributes = SE_PRIVILEGE_ENABLED
            End With
   
            If AdjustTokenPrivileges(hTokenHandle, False, token, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then

               EnableShutdownPrivledges = True
            End If  'AdjustTokenPrivileges
         End If  'LookupPrivilegeValue
      End If  'OpenProcessToken
   End If  'hProcessHandle
End Function

Private Sub Baslat_Click()
    If Durduruldu = True Then Ara = Time - Arabasla: Basla = Basla + Ara
    If CDbl(Basla) = 0 Then Basla = Time
    If Timer1.Enabled = False Then Timer1.Enabled = True: Timer1.Interval = 5
    Baslat.Enabled = False
    If Baslat.Caption <> "Başlat" Then Baslat.Caption = "Başlat"
    Durdur.Enabled = True
    Sifirla.Enabled = False
    Sifirlandi = False
    Durduruldu = False
    Frame1.Enabled = False
End Sub

Private Sub Command1_Click()
    If Text2.Text = Text1.Text Then
    Unload Me
    Else: Label5.Caption = "Doğru Şifre girmediniz."
    Label5.ForeColor = vbRed
    End If
End Sub

Private Sub Durdur_Click()
    If Text2.Text <> Text1.Text Then
        Label5.Caption = "Doğru Şifre girmediniz."
        Label5.ForeColor = vbRed
    Exit Sub
    End If
    Durduruldu = True
    Arabasla = Time
    Timer1.Enabled = False
    Baslat.Enabled = True
    Sifirla.Enabled = True
    Baslat.Caption = "Devam"
    Durdur.Enabled = False
    Frame1.Enabled = True
End Sub

Private Sub Form_Load()
    RemoveMenus Me, False, False, False, False, False, True, True
    Sifirlandi = True
    Durdur.Enabled = False
    Sifirla.Enabled = False
    Durduruldu = False
    Timer1.Enabled = False
    Text2.Enabled = False
    Text2.Text = Empty
    Text2.Visible = False
    Label5.Caption = "Şifre belirleyin ve bu kutuya girin"
    Label5.ForeColor = vbRed
End Sub

Private Sub Sifirla_Click()
    If Text2.Text <> Text1.Text Then
        Label5.Caption = "Doğru Şifre girmediniz."
        Label5.ForeColor = vbRed
    Exit Sub
    End If
    Sifirlandi = True
    Durduruldu = False
    Zaman = Empty
    Basla = Empty
    Ara = Empty
    Arabasla = Empty
    Baslat.Enabled = True
    Sifirla.Enabled = False
    If Timer1.Enabled = False Then Timer1.Enabled = True: Timer1.Interval = 1
End Sub


Private Sub Text1_Change()
    Label5.Caption = "Şifre kutusu:"
    Label5.ForeColor = Label3.ForeColor
End Sub

Private Sub Text1_LostFocus()
    If Text2 = Empty Then Text2.Text = Text1.Text: Text1 = Empty
End Sub

Private Sub Timer1_Timer()
    Simdi = Time
    If Sifirlandi = True Then
        Zaman = Format(TimeSerial(DTPicker1.Hour, DTPicker1.Minute, DTPicker1.Second))
    Else: Zaman = Format(TimeSerial(DTPicker1.Hour, DTPicker1.Minute, DTPicker1.Second) - (Simdi - Basla), "hh:mm:ss")
    End If
    Label2.Caption = Zaman
    If CDbl(Zaman) = 0 Then Timer1.Enabled = False: Call Islem_Yap
End Sub

Private Sub Timer2_Timer()
    Label1.Caption = Format(Now, "dddd dd.mm.yyyy hh:mm:ss")
End Sub

Private Sub Islem_Yap()
    Dim Deger As Long, success As Long
    With Me
        Select Case True
        Case OptionKapat
            SetTimer hWnd, NV_CLOSEMSGBOX, 5000&, AddressOf TimerProc
            Call MessageBox(hWnd, "Bilgisayar kapanacak", "UYARI", vbInformation)
            If IsWinNTPlus() Then
               success = EnableShutdownPrivledges()
               If success Then Call ExitWindowsEx(EWX_SHUTDOWN, 0&)
            Else
                Call ExitWindowsEx(EWX_SHUTDOWN, 0&)
            End If
        Case OptionRestart
            SetTimer hWnd, NV_CLOSEMSGBOX, 5000&, AddressOf TimerProc
            Call MessageBox(hWnd, "Bilgisayar kapanıp yeniden açılacak", "UYARI", vbInformation)
            If IsWinNTPlus() Then
               success = EnableShutdownPrivledges()
               If success Then Call ExitWindowsEx(EWX_REBOOT, 0&)
            Else
                Call ExitWindowsEx(EWX_REBOOT, 0&)
            End If
        Case OptionLogoff
            SetTimer hWnd, NV_CLOSEMSGBOX, 5000&, AddressOf TimerProc
            Call MessageBox(hWnd, "Bu oturum kapanacak", "UYARI", vbInformation)
            If IsWinNTPlus() Then
               success = EnableShutdownPrivledges()
               If success Then Call ExitWindowsEx(EWX_LOGOFF, 0&)
            Else
                Call ExitWindowsEx(EWX_LOGOFF, 0&)
            End If
        Case OptionLock
            LockWorkStation
            SetTimer hWnd, NV_CLOSEMSGBOX, 5000&, AddressOf TimerProc
            Call MessageBox(hWnd, "Ekran kitlenecek", "UYARI", vbInformation)
        End Select
    End With
End Sub

Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Const API_FALSE As Long = 0&



Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    KillTimer hWnd, idEvent
    Dim hMessageBox As Long
    hMessageBox = FindWindow("#32770", "UYARI")
    If hMessageBox Then
        Call SetForegroundWindow(hMessageBox)
        SendKeys "{enter}"
    End If
    Call LockWindowUpdate(API_FALSE)
End Sub