Új hozzászólás Aktív témák

• #3710 SharpSA veterán Torry #3708

  Új Válasz 2014-12-10 21:50:41 #3710

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  SharpSA

  veterán

  válasz Torry #3708 üzenetére

  Hozz létre egy fájlt cdkey.vbs névvel és ez legyen benne:

  DIM fso, WriteFile
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set WriteFile = fso.CreateTextFile("CDKEY.txt", True)
  Set WshShell = CreateObject("wscript.Shell")
  Set WshNetwork = WScript.CreateObject("WScript.Network")
  Set env = WshShell.environment("Process")
  strComputer = env.Item("Computername")
  Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const UnInstPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
  ".\root\default:StdRegProv")
  strDigitalProductId="HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
  strxpKey=GetKey(WshShell.RegRead(strDigitalProductId))
  Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
  For Each objItem in colItems
  report = report & " ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" & vbCrLf
  report = report & " Microsoft Windows CD Key Finder (v1.0-Beta)" & vbCrLf
  report = report & " ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" & vbCrLf
  report = report & "- Edition: " & objItem.Name & vbCrLf
  report = report & "- Build Number: " & objItem.Version & vbCrLf
  report = report & "- Product/CD Key: "& strXPKey & vbCrLf
  report = report & "- Product ID: "& objItem.SerialNumber & vbCrLf
  WriteFile.WriteLine("Edition:" & objItem.Name)
  WriteFile.WriteLine("Build Number:" & objItem.Version)
  WriteFile.WriteLine("Product/CD Key:" & strXPKey)
  WriteFile.WriteLine("Product ID:" & objItem.SerialNumber)
  WriteFile.Close
  Next
  MsgBox report
  Function GetKey(rpk)
  
  Const rpkOffset=52:i=28
  szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
  
  Do 'Rep1
  dwAccumulator=0 : j=14
  Do
  dwAccumulator=dwAccumulator*256
  dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
  rpk(j+rpkOffset)=(dwAccumulator\24) and 255
  dwAccumulator=dwAccumulator Mod 24
  j=j-1
  Loop While j>=0
  i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
  if (((29-i) Mod 6)=0) and (i<>-1) then
  i=i-1 : szProductKey="-"&szProductKey
  End If
  Loop While i>=0 'Goto Rep1
  
  GetKey=szProductKey
  End Function

  Ha ezt elindítod, akkor kapsz egy cdkey.txt fájlt, amiben benne lesz a kulcs.

Új hozzászólás Aktív témák