Untuk Membuat program pengunci windows, tidaklah perlu susah, Pada kesempatan ini saya
mencoba memberikan contoh program tersebut.
Di Sini saya menggunakan VB 6.
Yang di perlukan adalah :
1 buah form
2 buah label
1 text
2 timer
ketikan/copas kode di bawah ini ;
-------------code---------------------------
Option Explicit
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Dim hPos As Long
Dim ShowObj As Boolean
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
ShowObj = True
hPos = 0
End Sub
Private Sub Form_Load()
On Error Resume Next
EnumWindows AddressOf MinimizeAllWindows, ByVal 0&
SetCursorPos Text2.Left + 150, Text2.Top + 11
Me.Hide
ShowObj = True
tunggu 1
PrintScreen Me
tunggu 1
Me.Show
Timer1.Enabled = True
Timer2.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Button <> 0 Then
ShowObj = True
hPos = 0
'End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
If (Text2.Text = GlobalAdminPwd) Then
Timer1.Enabled = False
Timer2.Enabled = False
LetShowWindow
Unload Me
MsgBox "Windows Berhasil Di Buka", 64
Else
Text2.Text = ""
End If
KeyAscii = 0
End If
End Sub
Private Sub Timer1_Timer()
LetHideWindow Me.HWND
BringWindowToTop Me.HWND
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
If ShowObj Then
If Text2.Visible = False Then
Text2.Visible = True
Shape1.Visible = True
Shape2.Visible = True
Label1.Visible = True
Label2.Visible = True
Image1.Visible = True
SetCursorPos Text2.Left + 150, Text2.Top + 10
End If
Else
If Text2.Visible = True Then
Text2.Visible = False
Shape1.Visible = False
Shape2.Visible = False
Label1.Visible = False
Label2.Visible = False
Image1.Visible = False
End If
End If
If hPos < 10 Then
hPos = hPos + 1
Else
ShowObj = False
End If
End Sub
Sub tunggu(miliSecond As Single)
Dim pos As Single
Dim H
pos = 0.00001
H = miliSecond
While pos < H
DoEvents
If pos < H Then
pos = pos + 0.00001
End If
Wend
End Sub
dan untuk Modulenya adalah :
Option Explicit
Public Const GlobalAdminPwd = “X-Code Padang”
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As
OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As
Boolean
Declare Function IsWindowVisible Lib "user32" (ByVal HWND As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal HWND As Long, ByVal
lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal HWND As
Long) As Long
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As
Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal HWND As Long, ByVal nCmdShow As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal
lpWindowName As String) As Long
Declare Function BringWindowToTop Lib "user32" (ByVal HWND As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest
As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long,
ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal HWND As Long) As Long
Sub PrintScreen(picTmp As Object, Optional WidthDesk As Long = -1, Optional HeightDesk As Long = -
1)
On Error Resume Next
Dim hWndDesk As Long
Dim hDCDesk As Long
picTmp.Cls
If WidthDesk <= 0 Then WidthDesk = Screen.Width \ Screen.TwipsPerPixelX
If HeightDesk <= 0 Then HeightDesk = Screen.Height \ Screen.TwipsPerPixelY
hWndDesk = GetDesktopWindow()
hDCDesk = GetWindowDC(hWndDesk)
Dim H As Long, W As Long
H = HeightDesk / 2
W = WidthDesk / 2
Call BitBlt(picTmp.hDC, 0, 0, WidthDesk, HeightDesk, hDCDesk, 0, 0, vbSrcCopy)
picTmp.Picture = picTmp.Image
End Sub
Sub LetHideWindow(HWND As Long)
Dim H As Long
H = FindWindow("#32770", "Windows Task Manager")
If H Then ShowWindow H, 0
H = FindWindow("#32771", vbNullString)
If H Then ShowWindow H, 0
H = FindWindow("BaseBar", vbNullString)
If H Then ShowWindow H, 0
H = FindWindow("Shell_TrayWnd", vbNullString)
If H Then ShowWindow H, 0
If GetVersi = "W98" Then
SystemParametersInfo 97, 1&, 0&, 0
Else
End If
'If hWnd <> 0 Then BringWindowToTop hWnd
End Sub
Sub LetShowWindow()
Dim H As Long
H = FindWindow("Shell_TrayWnd", vbNullString)
If H Then ShowWindow H, 1
If GetVersi = "W98" Then
SystemParametersInfo 97, 0&, 0&, 0
Else
End If
End Sub
Public Function MinimizeAllWindows(ByVal HWND As Long, ByVal lParam As Long) As Boolean
On Error Resume Next
Dim sSave As String, Ret As Long
Ret = GetWindowTextLength(HWND)
sSave = Space(Ret)
GetWindowText HWND, sSave, Ret + 1
If sSave <> "" Then
If IsWindowVisible(HWND) Then
Select Case LCase(sSave)
Case "program manager", "reform client", LCase(App.Title), "reform system"
Case Else
ShowWindow HWND, 2
End Select
End If
End If
MinimizeAllWindows = True
End Function
Function GetVersi() As String
Dim OSInfo As OSVERSIONINFO, Ret&
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
Ret& = GetVersionEx(OSInfo)
If Ret& = 0 Then MsgBox "Error Getting Version Information", 16
Select Case OSInfo.dwPlatformId
Case 0
GetVersi = "W32"
Case 1
GetVersi = "W98"
Case 2
GetVersi = "W2K"
End Select
End Function
//sumber x-code//
-----------------end--------------------------------------
