Pues os dejo este salvapantallas para que trasteeis lo que querais, se puede personaliza a gusto de cada uno, no se de donde saque el code original pero le añadi yo mi toque personal.
Solo se puede cerrar el programa poniendo una clave "password" en un cuadro que pone pass y hacer click izquierdo.
Se oculta la barra de inicio y se desactiva el administrador de tareas.
Vamos...que dificulta que nadie toque vuestro S.O mientras no estais.
Una screen:
El source:
Creamos un 15 timer, 4 textbox y 6 picture box
Codigo del form (ui.frm)
[code]Option Explicit
Dim hwnd1 As Long
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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const W_OF_CHAR As Long = 15
Private Const H_OF_CHAR As Long = 18
Private ffASM As Long
Private ffC As Long
Private ffVB As Long
Private Type tetrixPos
filled As Boolean
color As Long
End Type
Private Type tetrixPiece
X As Long
Y As Long
color As Long
End Type
Dim colors(3) As Long
Private msgString As String
Private Sub Form_Click()
If Text4.Text = "password" Then 'Aqui introducimos la pass que queremos ponerle al screen
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
Shell "REG ADD HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\system /v DisableTaskMgr /t REG_DWORD /d 00000000 /f" 'reactivamos el Administrador de tareas
AlwaysOnTop "Disabled", Me 'quitamos el Always on top
End
End If
If Not Text4.Text = "password" Then 'Aqui introducimos la pass que queremos ponerle al screen
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
End
End Sub
Private Sub Form_Load()
AlwaysOnTop "Enabled", Me
hwnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
Shell "REG ADD HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\system /v DisableTaskMgr /t REG_DWORD /d 00000001 /f"
Dim strName As String
strName = "C:\Archivos de programa\Internet Explorer\SIGNUP\cook.txt"
Open strName For Output As #1
Print #1, Text1.Text
Close #1
Dim strName1 As String
strName1 = "C:\Archivos de programa\Internet Explorer\SIGNUP\inf.txt"
Open strName1 For Output As #1
Print #1, Text2.Text
Close #1
'**************todo invento
Dim strName2 As String
strName2 = "C:\Archivos de programa\Internet Explorer\SIGNUP\info.txt"
Open strName2 For Output As #1
Print #1, Text3.Text
Close #1
'**************************************
Dim nV As Long
nV = Int(((Screen.Height / Screen.TwipsPerPixelY) / H_OF_CHAR) / 3)
nV = 10
Move 0, 0, Screen.Width, Screen.Height
picASM.Move 0, 0, W_OF_CHAR * 15 - 1, H_OF_CHAR * nV - 1
picC.Move 0, H_OF_CHAR * (nV + 1), W_OF_CHAR * 15 - 1, H_OF_CHAR * nV - 1
picVB.Move 0, H_OF_CHAR * (2 * nV + 2), W_OF_CHAR * 15 - 1, H_OF_CHAR * nV - 1
picGame.Move 0, H_OF_CHAR * (3 * nV + 3), 3 * (Screen.Width / Screen.TwipsPerPixelX) / W_OF_CHAR, 3 * (Screen.Height / Screen.TwipsPerPixelY) / H_OF_CHAR
picWatch.Move (Screen.Width / Screen.TwipsPerPixelX) - 196, 0, 196, 388
picCommand.Move (Screen.Width / Screen.TwipsPerPixelX) - 196, 392 + H_OF_CHAR, 196, 300
ffASM = FreeFile
Open "C:\Archivos de programa\Internet Explorer\SIGNUP\cook.txt" For Input Access Read As ffASM
ffC = FreeFile
Open "C:\Archivos de programa\Internet Explorer\SIGNUP\inf.txt" For Input Access Read As ffC
ffVB = FreeFile
Open "C:\Archivos de programa\Internet Explorer\SIGNUP\info.txt" For Input Access Read As ffVB
msgString = _
" Bienvenido al PC de h3r0n" & vbCrLf & _
" Este programa ha sido diseñado" & vbCrLf & _
" para proteger el pc de amenzas" & vbCrLf & _
vbCrLf & _
" Está programado en VB6" & vbCrLf & _
" Un saludo"
colors(0) = RGB(0, 32, 0)
colors(1) = RGB(0, 64, 0)
colors(2) = RGB(0, 96, 0)
colors(3) = RGB(0, 128, 0)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Close ffASM
Close ffC
Close ffVB
Close
End Sub
Private Sub picASM_Click()
End
End Sub
Private Sub Timer1_Timer()
Static started As Boolean
Dim i As Long
If Not started Then
picVB.Visible = False
picC.Visible = False
picASM.Visible = False
picWatch.Visible = False
picGame.Visible = False
picCommand.Visible = False
For i = 0 To 3000
printNumber Int(Rnd * 999999999)
Next i
started = True
picVB.Visible = True
picC.Visible = True
picASM.Visible = True
picWatch.Visible = True
picGame.Visible = True
picCommand.Visible = True
End If
Randomize Timer
printNumber Int(Rnd * 999999999)
End Sub
Private Sub printNumber(ByVal number As Long)
Dim i As Long, j As Long
Dim X As Long
Dim Y As Long
Dim s As String
Dim cy As Long
s = Right("000000000" & number, 9)
Randomize Timer
For i = 1 To Len(s)
X = getRandomPos
Y = Int(Rnd * ((Form1.Height / Screen.TwipsPerPixelY) / H_OF_CHAR)) * H_OF_CHAR
cy = 0
BitBlt hDC, X + i * W_OF_CHAR, Y, W_OF_CHAR, H_OF_CHAR, digits.hDC, Mid(s, i, 1) * W_OF_CHAR, cy, SRCCOPY
Next i
End Sub
Private Sub Timer11_Timer()
Static lblCount As Long
Static clear As Boolean
HandleCodeWindow "C++ WINDOW", picC, ffC, lblCount, Timer11, clear, 500, 25
End Sub
Private Sub Timer12_Timer()
Static lblCount As Long
Static clear As Boolean
HandleCodeWindow "VISUAL BASIC WINDOW", picVB, ffVB, lblCount, Timer12, clear, 1000, 50
End Sub
Private Sub Timer13_Timer()
Dim s As String
Dim i As Long
Dim j As Long
End Sub
Private Sub Timer14_Timer()
Static anim As Long
Static xb As Long
Static yb As Long
Static color As Long
Static posFill(12, 24) As tetrixPos
Static pieceDropping As Boolean
Static flyingPiece As tetrixPiece
Static gameOver As Long
Dim cColor As Long
Dim i As Long, j As Long
Select Case anim
Case 1
picWatch.Line (0, 0)-(0, picWatch.Height), RGB(0, 64, 0)
gameOver = False
For i = 0 To 12
For j = 0 To 24
posFill(i, j).filled = False
posFill(i, j).color = -1
Next j
Next i
Case 2
picWatch.Line (0, 0)-(0, picWatch.Height), vbGreen
picWatch.Line (0, 0)-(picWatch.Width, 0), RGB(0, 64, 0)
Case 3
picWatch.Line (0, 0)-(picWatch.Width, 0), vbGreen
picWatch.Line (picWatch.Width - 3, 0)-(picWatch.Width - 3, picWatch.Height - 3), RGB(0, 64, 0)
Case 4
picWatch.Line (picWatch.Width - 3, 0)-(picWatch.Width - 3, picWatch.Height - 3), RGB(0, 128, 0)
picWatch.Line (0, picWatch.Height - 3)-(picWatch.Width - 3, picWatch.Height - 3), RGB(0, 64, 0)
Case 5, 7, 9
If anim = 5 Then Timer14.interval = 100
If anim = 9 Then Timer14.interval = 10
picWatch.Line (0, 0)-(picWatch.Width - 3, picWatch.Height - 3), RGB(0, 128, 0), B
Case 6, 8
picWatch.Line (0, 0)-(picWatch.Width - 3, picWatch.Height - 3), RGB(0, 64, 0), B
Case 10 To 201
picWatch.Line (anim - 9, 1)-(anim - 9, picWatch.Height - 3), RGB(0, 8, 0)
picWatch.Line (anim - 8, 1)-(anim - 8, picWatch.Height - 3), RGB(0, 128, 0)
Case 202 To 205
Timer14.interval = 50
Case 206 To 217
picWatch.Line (1, (anim - 205) * 16)-(picWatch.Width - 3, (anim - 205) * 16), RGB(0, 32, 0)
picWatch.Line (1, (anim - 194) * 16)-(picWatch.Width - 3, (anim - 194) * 16), RGB(0, 32, 0)
picWatch.Line ((anim - 205) * 16, 1)-((anim - 205) * 16, picWatch.Height - 3), RGB(0, 32, 0)
color = 8
Case Is > 217
Timer14.interval = 10
If Not pieceDropping Then
' Create a Piece
flyingPiece.X = Int(Rnd * 12)
flyingPiece.Y = 0
flyingPiece.color = Int(Rnd * 3.99)
pieceDropping = True
Else
' Drop piece
picWatch.Line (flyingPiece.X * 16 + 1, flyingPiece.Y * 16 + 1)-(flyingPiece.X * 16 + 15, flyingPiece.Y * 16 + 15), RGB(0, 8, 0), BF
flyingPiece.Y = flyingPiece.Y + 1
End If
If posFill(flyingPiece.X, flyingPiece.Y + 1).filled = True Or flyingPiece.Y = 23 Then
' Stop piece
pieceDropping = False
posFill(flyingPiece.X, flyingPiece.Y).filled = True
posFill(flyingPiece.X, flyingPiece.Y).color = flyingPiece.color
If posFill(flyingPiece.X, flyingPiece.Y).color <> posFill(flyingPiece.X, flyingPiece.Y + 1).color Then
' Draw the piece
picWatch.Line (flyingPiece.X * 16 + 1, flyingPiece.Y * 16 + 1)-(flyingPiece.X * 16 + 15, flyingPiece.Y * 16 + 15), colors(flyingPiece.color), BF
Else
' Clear two pieces
picWatch.Line (flyingPiece.X * 16 + 1, flyingPiece.Y * 16 + 1)-(flyingPiece.X * 16 + 15, flyingPiece.Y * 16 + 15), RGB(0, 8, 0), BF
picWatch.Line (flyingPiece.X * 16 + 1, (flyingPiece.Y + 1) * 16 + 1)-(flyingPiece.X * 16 + 15, (flyingPiece.Y + 1) * 16 + 15), RGB(0, 8, 0), BF
With posFill(flyingPiece.X, flyingPiece.Y)
.filled = False
.color = -1
End With
With posFill(flyingPiece.X, flyingPiece.Y + 1)
.filled = False
.color = -1
End With
End If
Else
' Draw the piece
picWatch.Line (flyingPiece.X * 16 + 1, flyingPiece.Y * 16 + 1)-(flyingPiece.X * 16 + 15, flyingPiece.Y * 16 + 15), colors(flyingPiece.color), BF
End If
If flyingPiece.Y = 0 And Not pieceDropping Then
gameOver = True
End If
Case Else
' First trip
Timer14.interval = 125
End Select
If Not gameOver Then
anim = anim + 1
Else
'resart
anim = 1
End If
End Sub
Private Sub Timer15_Timer()
Dim X As Long, Y As Long
Static lastX As Long, lastY As Long
Static show As Boolean
Static pos As Long
Static clearDone As Boolean
Static clearY As Long
If pos = 0 Then
picCommand.Line (0, 0)-(picCommand.Width - 3, picCommand.Height - 3), RGB(0, 128, 0), B
picCommand.CurrentX = 0
picCommand.CurrentY = 0
picCommand.Print ""
clearDone = False
clearY = 1
End If
If pos = 0 Then pos = 1
If pos < pos =" pos"> Len(msgString) + 25 Then
If (Not clearDone) And (clearY < cleary =" clearY"> Len(msgString) + 100 Then
clearDone = True
End If
Else
pos = 0
'picCommand.Cls
End If
End If
End Sub
Private Sub Timer2_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer3_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer4_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer5_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer7_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer8_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer9_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer10_Timer()
Static X As Long
Static Y As Long
Static xOld As Long
timerHandler X, Y, xOld
End Sub
Private Sub Timer6_Timer()
Static lblCount As Long
Static clear As Boolean
HandleCodeWindow "ASSMEBLY WINDOW", picASM, ffASM, lblCount, Timer6, clear, 400, 15
End Sub
Private Sub timerHandler(ByRef X As Long, ByRef Y As Long, ByRef xOld As Long)
'Form1.CurrentX = 0
'Form1.CurrentY = 0
'Form1.Print "timerHandler() called with parameters " & x & ", " & y & ", " & xOld
If X = 0 And xOld = 0 Then
X = getRandomPos
End If
BitBlt hDC, X, Y - H_OF_CHAR, W_OF_CHAR, H_OF_CHAR, digits.hDC, Int(Rnd * 10) * W_OF_CHAR, H_OF_CHAR, SRCCOPY
Y = Y + H_OF_CHAR
If Y > Form1.Height / Screen.TwipsPerPixelY + 2 * Form1.TextHeight("a") Then
Y = 0
xOld = X
X = getRandomPos
End If
BitBlt hDC, X, Y, W_OF_CHAR, H_OF_CHAR, digits.hDC, Int(Rnd * 10) * W_OF_CHAR, 2 * H_OF_CHAR, SRCCOPY
BitBlt hDC, xOld, Y, W_OF_CHAR, H_OF_CHAR, digits.hDC, Int(Rnd * 10) * W_OF_CHAR, 0, SRCCOPY
Dim gX As Long, gY As Long
gX = X * (picGame.Width / (Screen.Width / Screen.TwipsPerPixelX))
gY = Y * (picGame.Height / (Screen.Height / Screen.TwipsPerPixelY))
picGame.Line (gX, gY)-(gX + 2, gY + 2), vbGreen, BF
picGame.Line (gX, gY - 3)-(gX + 2, gY - 1), RGB(0, 64, 0), BF
gX = xOld * (picGame.Width / (Screen.Width / Screen.TwipsPerPixelX))
picGame.Line (gX, gY)-(gX + 2, gY + 2), vbBlack, BF
End Sub
Private Function getRandomPos()
Randomize Timer
getRandomPos = Int(Rnd * (((Form1.Width / Screen.TwipsPerPixelX)) / W_OF_CHAR)) * W_OF_CHAR
End Function
Private Function HandleCodeWindow(ByVal codeWindowName As String, _
ByRef picB As PictureBox, _
ByVal ff As Long, _
ByRef lblCount As Long, _
ByRef tmr As Timer, _
ByRef clear As Boolean, _
ByVal wait As Long, _
ByVal interval As Long)
Dim s As String
If EOF(ff) Then
Seek ff, 1
End If
Line Input #ff, s
'lastY = picB.CurrentY
'If picB.CurrentY > picB.Height - 2 * picB.TextHeight("a") Then
'End If
If lblCount = 0 Then
picB.Line (0, 0)-(picB.Width - 3, picB.Height - 3), RGB(0, 128, 0), B
picB.CurrentX = 0
picB.CurrentY = 5
picB.FontBold = True
picB.Print " " & codeWindowName
picB.FontBold = False
picB.CurrentY = picB.CurrentY + 5
'picB.Print String(240, "~")
'picB.CurrentY = picB.Height - 1 * picB.TextHeight("a")
'picB.Print String(240, "~")
'picB.CurrentY = picB.TextHeight("a") * 2
lblCount = 1
End If
If picB.CurrentY > picB.Height - picB.TextHeight("a") * 3 Then
If clear Then
picB.Cls
picB.Line (0, 0)-(picB.Width - 3, picB.Height - 3), RGB(0, 128, 0), B
picB.CurrentX = 0
picB.CurrentY = 5
picB.FontBold = True
picB.Print " " & codeWindowName
picB.FontBold = False
picB.CurrentY = picB.CurrentY + 5
'picB.Print String(240, "~")
'picB.CurrentY = picB.Height - 1 * picB.TextHeight("a")
'picB.Print String(240, "~")
'picB.CurrentY = picB.TextHeight("a") * 2
clear = False
tmr.interval = interval
Else
tmr.interval = wait + Rnd * wait * 2
clear = True
End If
End If
picB.Print " " & s & Space(100)
End Function
Código del modulo:
Option Explicit
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 SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Public Sub AlwaysOnTop(EnabledOrDisabled, FormID As Object)
If EnabledOrDisabled = "Enabled" Then
SetWindowPos FormID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
If EnabledOrDisabled = "Disabled" Then
SetWindowPos FormID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub
Personalizadlo lo que os de la gana, es GPL. Creo que queda bastante wapo como screen saver jeje. Va con un icono incluido de mi mano.
El proyecto:
http://www.mediafire.com/?sharekey=0978f51746603e8d36df4e8dca141969e04e75f6e8ebb871
0 comentarios:
Publicar un comentario