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