vba - 启用 vbscript 在命令行和双击中运行

Question

我有以下 vbscript，在命令行中运行时运行得非常好。希望在双击鼠标时将其合并到 Windows GUI 中。

当前设置

这是执行 vbscript 的当前命令 - 需要两个参数

1. 文件名
2. 密码

cscript fix.vbs file.ext 密码

这是我的代码(fix.vbs):

Dim Arg, pfxFileName, keyFileName, cerFileName, cabFileName, keyPassword
Set Arg = WScript.Arguments

pfxFileName = Arg(0)
keyPassword = Arg(1)
keyFileName = "key.tmp"
cerFileName = "cer.tmp"
cabFileName = "cabundle.tmp"

Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
return = oShell.run("cmd /C openssl pkcs12 -in " & pfxFileName & " -nocerts -out " & keyFileName & " -passin pass:" & keyPassword & " -passout pass:" & keyPassword & " | openssl pkcs12 -in " & pfxFileName & " -clcerts -nokeys -out " & cerFileName & " -passin pass:" & keyPassword & " | openssl pkcs12 -in " & pfxFileName & " -cacerts -nokeys -out " & cabFileName & " -passin pass:" & keyPassword, 0, true)

' strip all ca's except for the last block
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim reCut : Set reCut = New RegExp
reCut.Global = True
reCut.Pattern = "-----BEGIN CERTIFICATE-----[\s\S]+?-----END CERTIFICATE-----"
Dim oMTS : Set oMTS = reCut.Execute(goFS.OpenTextFile(cabFileName).ReadAll())
Dim sBlock : sBlock = oMTS(oMTS.Count - 1).Value
' WScript.Echo sBlock

Sub SaveStringToFile(filename, text)
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(filename, 2)
    f.Write text
    f.Close
End Sub

SaveStringToFile cabFileName, sBlock

' build pfx file
return = oShell.run("cmd /C openssl pkcs12 -export -in " & cerFileName & " -inkey " & keyFileName & " -certfile " & cabFileName & " -out NEW-" & pfxFileName & " -password pass:" & keyPassword & " -passin pass:" & keyPassword, 0, true)

Dim WshShell, strCurDir
Set WshShell = CreateObject("WScript.Shell")
strCurDir    = WshShell.CurrentDirectory
WScript.Echo vbNewLine & ">>> Thew NEW PFX file is located in " & strCurDir & "\" & "NEW-" & pfxFileName

Set oShell = Nothing

' remove files
Set obj = CreateObject("Scripting.FileSystemObject")
obj.DeleteFile(cerFileName)
obj.DeleteFile(keyFileName)
obj.DeleteFile(cabFileName)

必需的补充

1. 使上述代码在双击时兼容工作 在 Windows GUI 中。
2. 提示用户输入两个参数(浏览到文件)&(文件 密码)

Answer 1

使用以下代码创建一个 .vbs 文件并将其放置在桌面上。双击它。

    PerformAction

Private Sub PerformAction()

  pfxFileName = Trim(InputBox("Enter Filename:", "My VB Script"))
  If pfxFileName = vbNullString Then
    Exit Sub
  End If

  keyPassword = Trim(InputBox("Enter Password:", "My VB Script"))
  If keyPassword = vbNullString Then
    Exit Sub
  End If

  ProcessCertificate pfxFileName, keyPassword

End Sub

Private Sub ProcessCertificate(ByVal pfxFileName, ByVal keyPassword)
  Dim keyFileName, cerFileName, cabFileName
  keyFileName = "key.tmp"
  cerFileName = "cer.tmp"
  cabFileName = "cabundle.tmp"

  Dim oShell
  Set oShell = WScript.CreateObject("WScript.Shell")
  return = oShell.run("cmd /C openssl pkcs12 -in " & pfxFileName & " -nocerts -out " & keyFileName & " -passin pass:" & keyPassword & " -passout pass:" & keyPassword & " | openssl pkcs12 -in " & pfxFileName & " -clcerts -nokeys -out " & cerFileName & " -passin pass:" & keyPassword & " | openssl pkcs12 -in " & pfxFileName & " -cacerts -nokeys -out " & cabFileName & " -passin pass:" & keyPassword, 0, true)

  ' strip all ca's except for the last block
  Dim goFS: Set goFS = CreateObject("Scripting.FileSystemObject")
  Dim reCut: Set reCut = New RegExp
  reCut.Global = True
  reCut.Pattern = "-----BEGIN CERTIFICATE-----[\s\S]+?-----END CERTIFICATE-----"
  Dim oMTS: Set oMTS = reCut.Execute(goFS.OpenTextFile(cabFileName).ReadAll())
  Dim sBlock: sBlock = oMTS(oMTS.Count - 1).Value
  ' WScript.Echo sBlock

  SaveStringToFile cabFileName, sBlock

  ' build pfx file
  return = oShell.run("cmd /C openssl pkcs12 -export -in " & cerFileName & " -inkey " & keyFileName & " -certfile " & cabFileName & " -out NEW-" & pfxFileName & " -password pass:" & keyPassword & " -passin pass:" & keyPassword, 0, true)

  Dim WshShell, strCurDir
  Set WshShell = CreateObject("WScript.Shell")
  strCurDir = WshShell.CurrentDirectory
  WScript.Echo vbNewLine & ">>> Thew NEW PFX file is located in " & strCurDir & "\" & "NEW-" & pfxFileName

  Set oShell = Nothing

  ' remove files
  Set obj = CreateObject("Scripting.FileSystemObject")
  obj.DeleteFile (cerFileName)
  obj.DeleteFile (keyFileName)
  obj.DeleteFile (cabFileName)
End Sub

  Sub SaveStringToFile(filename, text)
      Dim fso, f
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set f = fso.OpenTextFile(filename, 2)
      f.Write text
      f.Close
  End Sub