1*b1cdbd2cSJim JagielskiAttribute VB_Name = "CommonPreparation" 2*b1cdbd2cSJim Jagielski'************************************************************************* 3*b1cdbd2cSJim Jagielski' 4*b1cdbd2cSJim Jagielski' Licensed to the Apache Software Foundation (ASF) under one 5*b1cdbd2cSJim Jagielski' or more contributor license agreements. See the NOTICE file 6*b1cdbd2cSJim Jagielski' distributed with this work for additional information 7*b1cdbd2cSJim Jagielski' regarding copyright ownership. The ASF licenses this file 8*b1cdbd2cSJim Jagielski' to you under the Apache License, Version 2.0 (the 9*b1cdbd2cSJim Jagielski' "License"); you may not use this file except in compliance 10*b1cdbd2cSJim Jagielski' with the License. You may obtain a copy of the License at 11*b1cdbd2cSJim Jagielski' 12*b1cdbd2cSJim Jagielski' http://www.apache.org/licenses/LICENSE-2.0 13*b1cdbd2cSJim Jagielski' 14*b1cdbd2cSJim Jagielski' Unless required by applicable law or agreed to in writing, 15*b1cdbd2cSJim Jagielski' software distributed under the License is distributed on an 16*b1cdbd2cSJim Jagielski' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17*b1cdbd2cSJim Jagielski' KIND, either express or implied. See the License for the 18*b1cdbd2cSJim Jagielski' specific language governing permissions and limitations 19*b1cdbd2cSJim Jagielski' under the License. 20*b1cdbd2cSJim Jagielski' 21*b1cdbd2cSJim Jagielski'************************************************************************* 22*b1cdbd2cSJim JagielskiOption Explicit 23*b1cdbd2cSJim JagielskiPrivate Declare Function CryptAcquireContext Lib "advapi32.dll" _ 24*b1cdbd2cSJim Jagielski Alias "CryptAcquireContextA" (ByRef phProv As Long, _ 25*b1cdbd2cSJim Jagielski ByVal pszContainer As String, ByVal pszProvider As String, _ 26*b1cdbd2cSJim Jagielski ByVal dwProvType As Long, ByVal dwFlags As Long) As Long 27*b1cdbd2cSJim Jagielski 28*b1cdbd2cSJim JagielskiPrivate Declare Function CryptReleaseContext Lib "advapi32.dll" ( _ 29*b1cdbd2cSJim Jagielski ByVal hProv As Long, ByVal dwFlags As Long) As Long 30*b1cdbd2cSJim Jagielski 31*b1cdbd2cSJim JagielskiPrivate Declare Function CryptCreateHash Lib "advapi32.dll" ( _ 32*b1cdbd2cSJim Jagielski ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, _ 33*b1cdbd2cSJim Jagielski ByVal dwFlags As Long, ByRef phHash As Long) As Long 34*b1cdbd2cSJim Jagielski 35*b1cdbd2cSJim JagielskiPrivate Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long 36*b1cdbd2cSJim Jagielski 37*b1cdbd2cSJim JagielskiPrivate Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, _ 38*b1cdbd2cSJim Jagielski pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long 39*b1cdbd2cSJim Jagielski 40*b1cdbd2cSJim JagielskiPrivate Declare Function CryptGetHashParam Lib "advapi32.dll" ( _ 41*b1cdbd2cSJim Jagielski ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _ 42*b1cdbd2cSJim Jagielski pdwDataLen As Long, ByVal dwFlags As Long) As Long 43*b1cdbd2cSJim Jagielski 44*b1cdbd2cSJim JagielskiPrivate Const ALG_CLASS_ANY As Long = 0 45*b1cdbd2cSJim JagielskiPrivate Const ALG_TYPE_ANY As Long = 0 46*b1cdbd2cSJim JagielskiPrivate Const ALG_CLASS_HASH As Long = 32768 47*b1cdbd2cSJim JagielskiPrivate Const ALG_SID_MD5 As Long = 3 48*b1cdbd2cSJim Jagielski' Hash algorithms 49*b1cdbd2cSJim JagielskiPrivate Const MD5_ALGORITHM As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5 50*b1cdbd2cSJim Jagielski' CryptSetProvParam 51*b1cdbd2cSJim JagielskiPrivate Const PROV_RSA_FULL As Long = 1 52*b1cdbd2cSJim Jagielski' used when acquiring the provider 53*b1cdbd2cSJim JagielskiPrivate Const CRYPT_VERIFYCONTEXT As Long = &HF0000000 54*b1cdbd2cSJim Jagielski' Microsoft provider data 55*b1cdbd2cSJim JagielskiPrivate Const MS_DEFAULT_PROVIDER As String = _ 56*b1cdbd2cSJim Jagielski "Microsoft Base Cryptographic Provider v1.0" 57*b1cdbd2cSJim Jagielski 58*b1cdbd2cSJim JagielskiFunction DoPreparation(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, preparationNote As String, _ 59*b1cdbd2cSJim Jagielski var As Variant, currDoc As Object) As Boolean 60*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 61*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 62*b1cdbd2cSJim Jagielski currentFunctionName = "DoPreparation" 63*b1cdbd2cSJim Jagielski 64*b1cdbd2cSJim Jagielski DoPreparation = False 65*b1cdbd2cSJim Jagielski 66*b1cdbd2cSJim Jagielski 'Log as Preparable 67*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, preparationNote, RID_STR_COMMON_PREPARATION_NOTE 68*b1cdbd2cSJim Jagielski myIssue.Preparable = True 69*b1cdbd2cSJim Jagielski docAnalysis.PreparableIssuesCount = docAnalysis.PreparableIssuesCount + 1 70*b1cdbd2cSJim Jagielski 71*b1cdbd2cSJim Jagielski If Not CheckDoPrepare Then Exit Function 72*b1cdbd2cSJim Jagielski 73*b1cdbd2cSJim Jagielski 'Do Prepare 74*b1cdbd2cSJim Jagielski 75*b1cdbd2cSJim Jagielski If myIssue.IssueTypeXML = CSTR_ISSUE_OBJECTS_GRAPHICS_AND_FRAMES And _ 76*b1cdbd2cSJim Jagielski myIssue.SubTypeXML = CSTR_SUBISSUE_OBJECT_IN_HEADER_FOOTER Then 77*b1cdbd2cSJim Jagielski DoPreparation = Prepare_HeaderFooter_GraphicFrames(docAnalysis, myIssue, var, currDoc) 78*b1cdbd2cSJim Jagielski 79*b1cdbd2cSJim Jagielski ElseIf myIssue.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES And _ 80*b1cdbd2cSJim Jagielski myIssue.SubTypeXML = CSTR_SUBISSUE_OLD_WORKBOOK_VERSION Then 81*b1cdbd2cSJim Jagielski DoPreparation = Prepare_WorkbookVersion() 82*b1cdbd2cSJim Jagielski 83*b1cdbd2cSJim Jagielski End If 84*b1cdbd2cSJim Jagielski 85*b1cdbd2cSJim JagielskiFinalExit: 86*b1cdbd2cSJim Jagielski Exit Function 87*b1cdbd2cSJim Jagielski 88*b1cdbd2cSJim JagielskiHandleErrors: 89*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & _ 90*b1cdbd2cSJim Jagielski " : path " & docAnalysis.name & ": " & _ 91*b1cdbd2cSJim Jagielski " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ 92*b1cdbd2cSJim Jagielski Err.Number & " " & Err.Description & " " & Err.Source 93*b1cdbd2cSJim Jagielski Resume FinalExit 94*b1cdbd2cSJim JagielskiEnd Function 95*b1cdbd2cSJim Jagielski 96*b1cdbd2cSJim JagielskiFunction InDocPreparation() As Boolean 97*b1cdbd2cSJim Jagielski InDocPreparation = True 98*b1cdbd2cSJim JagielskiEnd Function 99*b1cdbd2cSJim Jagielski 100*b1cdbd2cSJim JagielskiFunction Prepare_DocumentCustomProperties(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, _ 101*b1cdbd2cSJim Jagielski var As Variant, currDoc As Object) As Boolean 102*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 103*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 104*b1cdbd2cSJim Jagielski currentFunctionName = "Prepare_DocumentCustomProperties" 105*b1cdbd2cSJim Jagielski 106*b1cdbd2cSJim Jagielski Dim aProp As DocumentProperty 107*b1cdbd2cSJim Jagielski Dim myCustomDocumentProperties As DocumentProperties 108*b1cdbd2cSJim Jagielski Dim commentProp As DocumentProperty 109*b1cdbd2cSJim Jagielski Prepare_DocumentCustomProperties = False 110*b1cdbd2cSJim Jagielski 111*b1cdbd2cSJim Jagielski Set myCustomDocumentProperties = getAppSpecificCustomDocProperties(currDoc) 112*b1cdbd2cSJim Jagielski Set commentProp = getAppSpecificCommentBuiltInDocProperty(currDoc) 113*b1cdbd2cSJim Jagielski Set aProp = var 'Safe as we know that a DocumentProperty is being passed in 114*b1cdbd2cSJim Jagielski 115*b1cdbd2cSJim Jagielski If commentProp.value <> "" Then commentProp.value = commentProp.value & vbLf 116*b1cdbd2cSJim Jagielski 117*b1cdbd2cSJim Jagielski commentProp.value = commentProp.value & _ 118*b1cdbd2cSJim Jagielski RID_STR_COMMON_SUBISSUE_DOCUMENT_CUSTOM_PROPERTY & ": " & vbLf 119*b1cdbd2cSJim Jagielski 120*b1cdbd2cSJim Jagielski commentProp.value = commentProp.value & _ 121*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_NAME & " - " & aProp.name & ", " & _ 122*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_TYPE & " - " & getCustomDocPropTypeAsString(aProp.Type) & ", " & _ 123*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_VALUE & " - " & aProp.value 124*b1cdbd2cSJim Jagielski 125*b1cdbd2cSJim Jagielski myCustomDocumentProperties.item(aProp.name).Delete 126*b1cdbd2cSJim Jagielski 127*b1cdbd2cSJim Jagielski Prepare_DocumentCustomProperties = True 128*b1cdbd2cSJim Jagielski 129*b1cdbd2cSJim JagielskiFinalExit: 130*b1cdbd2cSJim Jagielski Exit Function 131*b1cdbd2cSJim Jagielski 132*b1cdbd2cSJim JagielskiHandleErrors: 133*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 134*b1cdbd2cSJim Jagielski Resume FinalExit 135*b1cdbd2cSJim JagielskiEnd Function 136*b1cdbd2cSJim Jagielski 137*b1cdbd2cSJim JagielskiPrivate Function GetProvider(hCtx As Long) As Boolean 138*b1cdbd2cSJim Jagielski Const NTE_BAD_KEYSET = &H80090016 139*b1cdbd2cSJim Jagielski Const NTE_EXISTS = &H8009000F 140*b1cdbd2cSJim Jagielski Const NTE_KEYSET_NOT_DEF = &H80090019 141*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 142*b1cdbd2cSJim Jagielski currentFunctionName = "GetProvider" 143*b1cdbd2cSJim Jagielski 144*b1cdbd2cSJim Jagielski Dim strTemp As String 145*b1cdbd2cSJim Jagielski Dim strProvider As String 146*b1cdbd2cSJim Jagielski Dim strErrorMsg As String 147*b1cdbd2cSJim Jagielski Dim errStr As String 148*b1cdbd2cSJim Jagielski 149*b1cdbd2cSJim Jagielski GetProvider = False 150*b1cdbd2cSJim Jagielski 151*b1cdbd2cSJim Jagielski On Error Resume Next 152*b1cdbd2cSJim Jagielski strTemp = vbNullChar 153*b1cdbd2cSJim Jagielski strProvider = MS_DEFAULT_PROVIDER & vbNullChar 154*b1cdbd2cSJim Jagielski If CBool(CryptAcquireContext(hCtx, ByVal strTemp, _ 155*b1cdbd2cSJim Jagielski ByVal strProvider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) Then 156*b1cdbd2cSJim Jagielski GetProvider = True 157*b1cdbd2cSJim Jagielski Exit Function 158*b1cdbd2cSJim Jagielski End If 159*b1cdbd2cSJim Jagielski 160*b1cdbd2cSJim Jagielski Select Case Err.LastDllError 161*b1cdbd2cSJim Jagielski Case NTE_BAD_KEYSET 162*b1cdbd2cSJim Jagielski errStr = "Key container does not exist or You do not have access to the key container." 163*b1cdbd2cSJim Jagielski Case NTE_EXISTS 164*b1cdbd2cSJim Jagielski errStr = "The key container already exists, but you are attempting to create it" 165*b1cdbd2cSJim Jagielski Case NTE_KEYSET_NOT_DEF 166*b1cdbd2cSJim Jagielski errStr = "The Crypto Service Provider (CSP) may not be set up correctly" 167*b1cdbd2cSJim Jagielski End Select 168*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & "Problems acquiring Crypto Provider: " & MS_DEFAULT_PROVIDER & ": " & errStr 169*b1cdbd2cSJim JagielskiEnd Function 170*b1cdbd2cSJim Jagielski 171*b1cdbd2cSJim Jagielski 172*b1cdbd2cSJim Jagielski 173*b1cdbd2cSJim JagielskiFunction MD5HashString(ByVal Str As String) As String 174*b1cdbd2cSJim Jagielski Const HP_HASHVAL = 2 175*b1cdbd2cSJim Jagielski Const HP_HASHSIZE = 4 176*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 177*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 178*b1cdbd2cSJim Jagielski currentFunctionName = "MD5HashString" 179*b1cdbd2cSJim Jagielski 180*b1cdbd2cSJim Jagielski Dim hCtx As Long 181*b1cdbd2cSJim Jagielski Dim hHash As Long 182*b1cdbd2cSJim Jagielski Dim ret As Long 183*b1cdbd2cSJim Jagielski Dim lLen As Long 184*b1cdbd2cSJim Jagielski Dim lIdx As Long 185*b1cdbd2cSJim Jagielski Dim abData() As Byte 186*b1cdbd2cSJim Jagielski 187*b1cdbd2cSJim Jagielski If Not GetProvider(hCtx) Then Err.Raise Err.LastDllError 188*b1cdbd2cSJim Jagielski 189*b1cdbd2cSJim Jagielski ret = CryptCreateHash(hCtx, MD5_ALGORITHM, 0, 0, hHash) 190*b1cdbd2cSJim Jagielski If ret = 0 Then Err.Raise Err.LastDllError 191*b1cdbd2cSJim Jagielski 192*b1cdbd2cSJim Jagielski ret = CryptHashData(hHash, ByVal Str, Len(Str), 0) 193*b1cdbd2cSJim Jagielski If ret = 0 Then Err.Raise Err.LastDllError 194*b1cdbd2cSJim Jagielski 195*b1cdbd2cSJim Jagielski ret = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0) 196*b1cdbd2cSJim Jagielski If ret = 0 Then Err.Raise Err.LastDllError 197*b1cdbd2cSJim Jagielski 198*b1cdbd2cSJim Jagielski 199*b1cdbd2cSJim Jagielski ReDim abData(0 To lLen - 1) 200*b1cdbd2cSJim Jagielski ret = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0) 201*b1cdbd2cSJim Jagielski If ret = 0 Then Err.Raise Err.LastDllError 202*b1cdbd2cSJim Jagielski 203*b1cdbd2cSJim Jagielski For lIdx = 0 To UBound(abData) 204*b1cdbd2cSJim Jagielski MD5HashString = MD5HashString & Right$("0" & Hex$(abData(lIdx)), 2) 205*b1cdbd2cSJim Jagielski Next 206*b1cdbd2cSJim Jagielski CryptDestroyHash hHash 207*b1cdbd2cSJim Jagielski 208*b1cdbd2cSJim Jagielski CryptReleaseContext hCtx, 0 209*b1cdbd2cSJim Jagielski 210*b1cdbd2cSJim JagielskiFinalExit: 211*b1cdbd2cSJim Jagielski Exit Function 212*b1cdbd2cSJim Jagielski 213*b1cdbd2cSJim JagielskiHandleErrors: 214*b1cdbd2cSJim Jagielski MD5HashString = "" 215*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & _ 216*b1cdbd2cSJim Jagielski Err.Number & " " & Err.Description & " " & Err.Source 217*b1cdbd2cSJim Jagielski Resume FinalExit 218*b1cdbd2cSJim JagielskiEnd Function 219*b1cdbd2cSJim Jagielski 220