Mensajes

Muchas gracias tincopasan, me ha funcionando perfectamente asi.  Gracias de nuevo.

Hola buenas,

Necesitaba hacer que este .vbs me creara el txt si preguntar, no tengo ni idea de .vbs. Intente modificar un par de cosas pero me da errores. El .vbs sirve para obtener el cd-key de windows.  Espero que me podais ayudar. Muchas gracias.

Código (vb) [Seleccionar] Expandir

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