'******************************************************************************
' 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  06/27/2002 to generate *detached* signature
'  for data file read as binary data, or as text (string) data.
'******************************************************************************
'
' SignDetBinary.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 or three arguments,
' 
' 1) filename of a binary file to be signed
' 2) filename to save the signed message
' 3) 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 raised.
'
Option Explicit

Const Title = "SignDetBinary"
Const ForReading = 1, ForWriting = 2
Const CAPICOM_ENCODE_BASE64 = 0
Const CAPICOM_ENCODE_BINARY = 1
Const detached = TRUE		' FALSE = content included
Dim fso

' Check syntax.
If Wscript.Arguments.Count < 2 OR  Wscript.Arguments.Count >3 Then
    MsgBox "Usage: SignDetBinary ContentFileName SignedFileName [SignMode]  ", _
	vbInformation, Title
    Wscript.Quit(1)
End If


DoesFileExist(Wscript.Arguments(0))

' Sign content.
If WScript.Arguments.Count = 2 Then
  SignFile Wscript.Arguments(0), Wscript.Arguments(1)
 Else
  SignBinFile Wscript.Arguments(0), Wscript.Arguments(1)
End If


If WScript.Arguments.Count = 2 Then
 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) & """ in BASE64-encoded DER format.", vbInformation, Title
Else
 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) & """ in binary 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)
  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) ' detached binary string
  '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)
    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)  'Detached Signature
    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