| Autor |
Beitrag |
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: So 11.10.15 20:01
Es gibt auch ein VBS-File:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
| Set WshShell = CreateObject("WScript.Shell")
Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")
ProductName = "Product Name: " & WshShell.RegRead(Key & "ProductName") & vbNewLine
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey
If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
Save ProductID
End if
Function ConvertToKey(Key)
Const KeyOffset = 52
isWin8 = (Key(66) \ 6) And 1
Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
i = 24
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
X = 14
Do
Cur = Cur * 256
Cur = Key(X + KeyOffset) + Cur
Key(X + KeyOffset) = (Cur \ 24)
Cur = Cur Mod 24
X = X -1
Loop While X >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
Last = Cur
Loop While i >= 0
If (isWin8 = 1) Then
keypart1 = Mid(KeyOutput, 2, Last)
insert = "N"
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
End If
a = Mid(KeyOutput, 1, 5)
b = Mid(KeyOutput, 6, 5)
c = Mid(KeyOutput, 11, 5)
d = Mid(KeyOutput, 16, 5)
e = Mid(KeyOutput, 21, 5)
ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
Function Save(Data)
Const ForWRITING = 2
Const asASCII = 0
Dim fso, f, fName, ts
fName = "Windows Key.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile fName
Set f = fso.GetFile(fName)
Set f = f.OpenAsTextStream(ForWRITING, asASCII)
f.Writeline Data
f.Close
End Function |
Einloggen, um Attachments anzusehen!
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: So 11.10.15 20:25
Noch 2 VBS-Lösungen für WIN8 und für ältere WIN-Versionen:
Anleitung für Newbies:
Einen Source-Teil in Notepad kopieren, abspeichern unter WINKEY7.vbs oder WINKEY8.vbs
Doppelklick auf das File zeigt den Key.
Vor WIN8.0
  Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
| Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
Function ConvertToKey(Key)
Const KeyOffset = 52
i = 28
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
Do
Cur = Cur * 256
Cur = Key(x + KeyOffset) + Cur
Key(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x -1
Loop While x >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i -1
KeyOutput = "-" & KeyOutput
End If
Loop While i >= 0
ConvertToKey = KeyOutput
End Function |
Ab WIN8.0
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
| Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
Function ConvertToKey(Key)
Const KeyOffset = 52
isWin8 = (Key(66) \ 6) And 1
Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
i = 24
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
X = 14
Do
Cur = Cur * 256
Cur = Key(X + KeyOffset) + Cur
Key(X + KeyOffset) = (Cur \ 24)
Cur = Cur Mod 24
X = X -1
Loop While X >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
Last = Cur
Loop While i >= 0
If (isWin8 = 1) Then
keypart1 = Mid(KeyOutput, 2, Last)
insert = "N"
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
End If
a = Mid(KeyOutput, 1, 5)
b = Mid(KeyOutput, 6, 5)
c = Mid(KeyOutput, 11, 5)
d = Mid(KeyOutput, 16, 5)
e = Mid(KeyOutput, 21, 5)
ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function |
Einloggen, um Attachments anzusehen!
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: So 11.10.15 22:31
 Roy hat folgendes geschrieben  : | Nichts zu machen, Funktioniert nicht unter Delphi7 und auch nicht unter Embarcadero XE7
|
Das liegt am Decoder - der funktioniert offensichtlich erst ab WIN8.0.
|
|
Roy
 
Beiträge: 184
Windows7 Ultimate
Delphi 2007, NET, Embarcadero
|
Verfasst: Di 13.10.15 14:38
| hathor hat folgendes geschrieben : | Es gibt auch ein VBS-File:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
| Set WshShell = CreateObject("WScript.Shell")
Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")
ProductName = "Product Name: " & WshShell.RegRead(Key & "ProductName") & vbNewLine
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey
If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
Save ProductID
End if
Function ConvertToKey(Key)
Const KeyOffset = 52
isWin8 = (Key(66) \ 6) And 1
Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
i = 24
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
X = 14
Do
Cur = Cur * 256
Cur = Key(X + KeyOffset) + Cur
Key(X + KeyOffset) = (Cur \ 24)
Cur = Cur Mod 24
X = X -1
Loop While X >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
Last = Cur
Loop While i >= 0
If (isWin8 = 1) Then
keypart1 = Mid(KeyOutput, 2, Last)
insert = "N"
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
End If
a = Mid(KeyOutput, 1, 5)
b = Mid(KeyOutput, 6, 5)
c = Mid(KeyOutput, 11, 5)
d = Mid(KeyOutput, 16, 5)
e = Mid(KeyOutput, 21, 5)
ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
Function Save(Data)
Const ForWRITING = 2
Const asASCII = 0
Dim fso, f, fName, ts
fName = "Windows Key.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile fName
Set f = fso.GetFile(fName)
Set f = f.OpenAsTextStream(ForWRITING, asASCII)
f.Writeline Data
f.Close
End Function | |
Ich möchte das gerne auf meiner TForm in einem Memo aufrufen. Bekomme nur Fehler beim Compleiren
|
|
Narses
Beiträge: 10181
Erhaltene Danke: 1254
W10ent
TP3 .. D7pro .. D10.2CE
|
Verfasst: Di 13.10.15 14:56
Moin!
So, das wird mir jetzt doch zu komisch hier.  Du zeigst keinerlei erkennbare Eigeninitiative, zitierst sinnlos meterweise Code/Beiträge, lieferst keine brauchbaren Informationen und wünschst c&p-ready Code. Das entspricht zum einen nicht unseren Forenregeln, zum anderen ist es reichlich unverschämt. 
Konkret zu deinem letzten Beitrag: Du hast den VBS-Code in dein Delphi-Projekt übernommen, aber komischerweise kann man das nicht kompilieren.  Tja, ich schlage vor, du lieferst erstmal eine Erklärung, was denn die Ursache sein könnte. Dann schauen wir mal weiter.
Alternativ mache ich den Thread hier zu.
cu
Narses _________________ There are 10 types of people - those who understand binary and those who don´t.
|
|
Roy
Beiträge: 184
Windows7 Ultimate
Delphi 2007, NET, Embarcadero
|
Verfasst: Di 13.10.15 15:07
Hallo Narses,
den Code zietiere ich nur das derjenige weis welchen Code ich meine. Habe gemerkt das hier alle durcheinander posten, jeder mit einem anderen Code.
Meine Frage bleibt immer noch die Gleiche.
Ich möchte mir den Produktkey auf meinem Formular in einem Memo ausgeben lassen.
In allen Code die ihr gepostet habt, die auch alle bei mir funktionieren, habe ich aber Probleme sowie ich es in mein Project einbinden möchte und in einem Memo anzeigen will.
Zur Ursache kann ich nichts sagen.
Kann mit WshShell nichts anfangen
Danke
Roy
|
|
Narses
Beiträge: 10181
Erhaltene Danke: 1254
W10ent
TP3 .. D7pro .. D10.2CE
|
Verfasst: Di 13.10.15 17:02
Moin!
| Roy hat folgendes geschrieben : | | den Code zietiere ich nur das derjenige weis welchen Code ich meine. Habe gemerkt das hier alle durcheinander posten, jeder mit einem anderen Code. |
Ja, zugegebenermaßen läuft das hier manchmal etwas... übereilt. OK, soll nicht dein Problem sein. 
| Roy hat folgendes geschrieben : | Meine Frage bleibt immer noch die Gleiche.
Ich möchte mir den Produktkey auf meinem Formular in einem Memo ausgeben lassen. |
Das ist keine Frage, das ist ein Wunsch.  Konkret: DEIN Wunsch! Dann tu auch was dafür und lass dir nicht alles vorbeten.
| Roy hat folgendes geschrieben : | | In allen Code die ihr gepostet habt, die auch alle bei mir funktionieren, habe ich aber Probleme sowie ich es in mein Project einbinden möchte und in einem Memo anzeigen will. |
Und diese Probleme sind uns hier natürlich alle schon klar, wir sind nur so gemein, sie dir nicht von den Augen abzulesen und einfach nur den "richtigen" Code hinzuschreiben... ist schon klar. 
Ist dir schonmal der Gedanke gekommen, dass wir nicht wissen können, was auf deinem Monitor so alles zu sehen ist und was genau du da tust? 
| Roy hat folgendes geschrieben : | Zur Ursache kann ich nichts sagen.
Kann mit WshShell nichts anfangen |
Aber mit Google kannst du schon umgehen? Dann such doch bitte mal nach dem Stichwort "VBS"  was ist denn das für eine Programmiersprache, mach dich mal schlau.  
cu
Narses _________________ There are 10 types of people - those who understand binary and those who don´t.
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Di 13.10.15 19:20
| Roy hat folgendes geschrieben : | | Ich möchte das gerne auf meiner TForm in einem Memo aufrufen. Bekomme nur Fehler beim Compleiren |
Warum schreibst Du das nicht gleich?!
Hast Du mittlerweile begriffen, dass der GLEICHE CODE NICHT unter WIN7 UND unter WIN8 funktioniert?
Zwischen DELPHI 7 und DELPHI XE7 ist auch ein grosser Unterschied!
Entscheide Dich mal, was Du eigentlich willst!
Ich habe jetzt KEINE Lust, 4 verschiedene DELPHI-Versionen zu posten...
.
Albert Einstein lebte KURZ in der Schweiz.
Es kam ihm aber SEHR LANGE vor.
Da entdeckte er die Relativitätstheorie.
|
|
|
