Introduction


This VBS code was written when I needed to decrypt PGP-encrypted files on Windows. The otherwise nice package Gpg4win failed to work on a Japanese language Windows system. The commercial PGP software would have been overkill, and the GnuPG software for Windows could not be given to end-users because of their cryptic commandline operation. Therefore, the VBS program below was written as a front-end to GnuPG for Windows. It expects GnuPG to be installed, and the necessary PGP keys imported.

Code


'////////////////////////////////////////////////////////////////////
'File:    DecryptFile.vbs
'Purpose: Prompts for a PGP encrypted input file and decrypts it using GPG
'         This program serves as a alternative to the Gpg4win package,
'         Gpg4win fails to work on Japanese Windows desktops. 
'Author:  Oct 2010, Frank Migge
'
'Requires: Local installation of GnuPG for Windows
'////////////////////////////////////////////////////////////////////
Option Explicit

Dim ObjFSO, InitFSO
Dim decryptedFilename
Dim gpgBinary
gpgBinary = "C:\Program Files\GNU\GnuPG\gpg2.exe"
Dim message
message ="PGP Decryption: Main Parameters" & vbNewLine

' Check Prerequisites
' -------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(gpgBinary) Then
  message = message & "GPG program: " & gpgBinary & " OK" & vbNewLine
Else
  Wscript.Echo "PGP Decryption: GPG program could not be found."
  Wscript.Quit
End If

Set ObjFSO = CreateObject("UserAccounts.CommonDialog")
ObjFSO.Filter = "PGP encrypted Files|*.pgp|All Files|*.*"
ObjFSO.FilterIndex = 1
ObjFSO.InitialDir = "%USERPROFILE%\Desktop"

InitFSO = ObjFSO.ShowOpen
If InitFSO = False Then
  Wscript.Echo "PGP Decryption: No PGP file selected, click 'OK' to close."
  Wscript.Quit
Else
  'newLines(2)="Encrypted File: " + ObjFSO.FileName + "\tOK\n"
End If

decryptedFilename = Left(ObjFSO.FileName, (InStr(1,ObjFSO.FileName,".pgp",1) -1))
'newLines(3)="Output File: " + decryptedFilename + "\tOK\n"

'newLines(4)="Enter passphrase\n"

MsgBox(message)

Dim bWaitOnReturn: bWaitOnReturn = True
Dim iWindowStyle: iWindowStyle = 7 'Minimized; active window stays active
Dim sPassphrase: sPassphrase = InputBox("Please type the passphrase below:",
                                        "Passphrase")

Dim sFileName_Input: sFileName_Input = ObjFSO.FileName
Dim sFileName_Output: sFileName_Output = decryptedFilename


Dim sCommand_Text: sCommand_Text = Chr(34) 
                   & gpgBinary & Chr(34) & "--passphrase " 
                   & Chr(34) & sPassphrase & Chr(34) & " -o " & Chr(34) 
                   & sFileName_Output & Chr(34) & " -d " & Chr(34) 
                   & sFileName_Input & Chr(34)

Dim oWiSH_Shell: Set oWiSH_Shell = CreateObject("WScript.Shell")
oWiSH_Shell.Run sCommand_Text, iWindowStyle, bWaitOnReturn

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(decryptedFilename) Then
Wscript.Echo "PGP Decryption: File has been successfully decrypted."
Else
Wscript.Echo "PGP Decryption: File could not be decrypted."
End If

Set oWiSH_Shell = Nothing
WScript.Quit

Source: