(27/05/2011, 18:49)siyahcin yazdı: maytas bunu hangi programla yazdığını söylermisin birde kodlarını veririsen sevinirim şimdiden teşekkürler
Bu soruyu yeni gördüm.
Program VB6'da hazırlanmıştır.
Kodlar ne kadar işinize yarar bilmem, ama yine de altta veriyorum.
Form kodları:
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
Module kodları:
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
