'******************************************************************************
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
' ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED
' TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
'
' Copyright (C) 2001.  Microsoft Corporation.  All rights reserved.
' Modified by M. Gallant  09/18/2002 to generate pkcs #7 signatures with
' detached or attached content with data file read as either
' binary data, or as text (string) data.
'
' - Data read as text file reads and UNICODE-encodes bytes into string, signs
'   the data, and writes signature out to base64-encoded pkcs #7 signature file.
' - Data read as binary file reads bytes into byte-array, signs the exact 
'   byte array, and writes the signature out to binary pkcs #7 signature file.
'******************************************************************************
'
' SignAll.vbs
'
' This VBScript signs the content of a binary or text file, and then saves the
' signed pkcs#7 message to a specified file.
' For binary-mode usage, requires MDAC 2.5:
'  http://support.microsoft.com/default.aspx?scid=kb;EN-US;q231943
'
' This script runs from the command prompt and takes two, three or four arguments,
' 
' 1) filename of a binary file to be signed
' 2) filename to save the signed message
' 3) attached/detached switch
' 4) binary mode argument (any value)
'
' To create a signature, a time valid certificate with access to a private 
' key is required in the current user MY store. If there is more than one
' valid certificate, a certificate-selection dialog is displayed.
'
Option Explicit

Const Title = "SignAll"
Const ForReading = 1, ForWriting = 2
Const CAPICOM_ENCODE_BASE64 = 0
Const CAPICOM_ENCODE_BINARY = 1
Dim detached :	detached = TRUE		' FALSE = content attached
Dim detachedtxt:detachedtxt = "DETACHED"	' or "ATTACHED"
Dim binarymode: binarymode = FALSE	' Text mode is default
Dim fso, arg3, arg4

' Check syntax.
If Wscript.Arguments.Count < 2 OR  Wscript.Arguments.Count >4 Then
   Usage
End If


DoesFileExist(Wscript.Arguments(0))

If WScript.Arguments.Count > 2 Then
 arg3 = LCase(WScript.Arguments(2))
 If arg3="d"  OR arg3="de" Then
  detached = TRUE
  detachedtxt = "DETACHED"
 ElseIf arg3="a" OR arg3="at" OR arg3="i"  OR arg3="in" Then
  detached = FALSE
  detachedtxt = "ATTACHED"
 End If
End If

If WScript.Arguments.Count = 4 Then  'any 4th arg. indicates binary mode.
 binarymode = TRUE
End If

' Sign content as text input, or binary data input
If WScript.Arguments.Count = 2 OR NOT binarymode Then
  SignFile Wscript.Arguments(0), Wscript.Arguments(1), detached
 Else
  SignBinFile Wscript.Arguments(0), Wscript.Arguments(1), detached
End If


If binarymode Then
 MsgBox "The content of """ & Wscript.Arguments(0) & """ has been SUCCESSFULLY " & _
       "SIGNED as *binary* data." & vbCrLf & vbCrLf & _
	"The pkcs#7 signed message was saved to """ & _
        Wscript.Arguments(1) & """" & vbCrLf & " as a " & detachedtxt & _
	" signature in binary DER format.", vbInformation, Title
 Else
 MsgBox "The content of """ & Wscript.Arguments(0) & """ has been SUCCESSFULLY " & _
       "SIGNED as *string* data." & vbCrLf & vbCrLf & _
	"The pkcs#7 signed message was saved to """ & _
        Wscript.Arguments(1) & """" & vbCrLf & " as a " & detachedtxt & _
	" signature in BASE64-encoded DER format.", vbInformation, Title
End If

Wscript.Quit(0)


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' DoesFileExist
'
' Checks if content file to sign exists
'
Sub DoesFileExist(FileName)
 Set fso = CreateObject("Scripting.FileSystemObject")
 If Not fso.FileExists(FileName) Then
   MsgBox "Error: " & FileName & " file not found.", vbCritical, Title
   WScript.Quit(1)
 End If
 Set fso = nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' SignBinFile
'
' Sign content of InFile and save signed message to OutFile.
'
Sub SignBinFile (InFile, OutFile, detached)
  Dim SignedData, Utils
  Dim bContent, Content, Message

  Set SignedData = CreateObject("CAPICOM.SignedData")
  Set Utils = CreateObject("CAPICOM.Utilities")
  LoadBinFile InFile, bContent     'get content as byte array
  Content = Utils.ByteArrayToBinaryString(bContent) 'convert to binary string
  SignedData.Content = Content
  Message = SignedData.Sign(nothing, detached, CAPICOM_ENCODE_BINARY)
  'WScript.Echo Message
  SaveBinFile OutFile, Utils.BinaryStringToByteArray(Message) 'convert to byte array to write
  Set SignedData = nothing
  Set Utils = nothing
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' LoadBinFile
'
' Read content of FileName and return as byte array.
'
Sub LoadBinFile (FileName, bBuffer)   
  Const adReadAll = -1
  Dim oStream, bFileData
  Set oStream = WScript.CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1  ' adTypeBinary
  oStream.LoadFromFile FileName
  bBuffer = oStream.Read(adReadAll)
  oStream.Close
  Set oStream = nothing
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' SaveBinFile
'
' Save binary array to FileName.
'
Sub SaveBinFile (FileName, Binarray)
  Dim oStream
  Const adSaveCreateOverWrite = 2
  Const adTypeBinary = 1
  Const adModeReadWrite = 3 
  Set oStream = WScript.CreateObject("ADODB.Stream")
  oStream.type = adTypeBinary
  oStream.mode = adModeReadWrite
  oStream.Open
  oStream.write Binarray
  oStream.SaveToFile FileName, adSaveCreateOverWrite
  oStream.Close
  Set oStream = nothing
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' SignFile
'
' Sign content of InFile and save signed message to OutFile.
'
Sub SignFile (InFile, OutFile, detached)
    Dim SignedData
    Dim Content
    Dim Message

    Set SignedData = CreateObject("CAPICOM.SignedData")
    LoadFile InFile, Content
    SignedData.Content = Content
    Message = SignedData.Sign(Nothing, detached, CAPICOM_ENCODE_BASE64)
    SaveFile OutFile, Message
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' LoadFile
'
' Read content of FileName and assign to Buffer as string.
'
Sub LoadFile (FileName, Buffer)   
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FileExists(FileName) Then
        MsgBox "Error: " & FileName & " file not found."
        Exit Sub
    End If
   
    Dim ts
    Set ts = fso.OpenTextFile(FileName, ForReading)  
    Buffer = ts.ReadAll
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' SaveFile
'
' Save string Buffer to FileName.
'
Sub SaveFile (FileName, Buffer)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim ts
    Set ts = fso.OpenTextFile(FileName, ForWriting, True)
    ts.Write Buffer
End Sub


Sub Usage
    MsgBox "Usage: SignAll ContentFileName SignedFileName  [D | A]   [binarymode(anything)]  " _
	& vbCrLf & vbCrLf & "Examples: " & vbCrLf & _
	" SignAll.vbs  filetosign   output.p7s          (detached content, base64) " & vbCrLf & _
	" SignAll.vbs  filetosign   output.p7s A       (attached content, base64) " & vbCrLf & _
	" SignAll.vbs  filetosign   output.p7s A 1     (attached content, binary) " _
	,vbInformation, Title
    Wscript.Quit(1)
End Sub