Attribute VB_Name = "CommonPreparation" '/************************************************************************* ' * ' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. ' ' Copyright 2000, 2010 Oracle and/or its affiliates. ' ' OpenOffice.org - a multi-platform office productivity suite ' ' This file is part of OpenOffice.org. ' ' OpenOffice.org is free software: you can redistribute it and/or modify ' it under the terms of the GNU Lesser General Public License version 3 ' only, as published by the Free Software Foundation. ' ' OpenOffice.org is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU Lesser General Public License version 3 for more details ' (a copy is included in the LICENSE file that accompanied this code). ' ' You should have received a copy of the GNU Lesser General Public License ' version 3 along with OpenOffice.org. If not, see ' ' for a copy of the LGPLv3 License. ' ' ************************************************************************/ Option Explicit Private Declare Function CryptAcquireContext Lib "advapi32.dll" _ Alias "CryptAcquireContextA" (ByRef phProv As Long, _ ByVal pszContainer As String, ByVal pszProvider As String, _ ByVal dwProvType As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _ ByVal hProv As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _ ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, _ ByVal dwFlags As Long, ByRef phHash As Long) As Long Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, _ pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _ ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _ pdwDataLen As Long, ByVal dwFlags As Long) As Long Private Const ALG_CLASS_ANY As Long = 0 Private Const ALG_TYPE_ANY As Long = 0 Private Const ALG_CLASS_HASH As Long = 32768 Private Const ALG_SID_MD5 As Long = 3 ' Hash algorithms Private Const MD5_ALGORITHM As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5 ' CryptSetProvParam Private Const PROV_RSA_FULL As Long = 1 ' used when acquiring the provider Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000 ' Microsoft provider data Private Const MS_DEFAULT_PROVIDER As String = _ "Microsoft Base Cryptographic Provider v1.0" Function DoPreparation(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, preparationNote As String, _ var As Variant, currDoc As Object) As Boolean On Error GoTo HandleErrors Dim currentFunctionName As String currentFunctionName = "DoPreparation" DoPreparation = False 'Log as Preparable AddIssueDetailsNote myIssue, 0, preparationNote, RID_STR_COMMON_PREPARATION_NOTE myIssue.Preparable = True docAnalysis.PreparableIssuesCount = docAnalysis.PreparableIssuesCount + 1 If Not CheckDoPrepare Then Exit Function 'Do Prepare If myIssue.IssueTypeXML = CSTR_ISSUE_OBJECTS_GRAPHICS_AND_FRAMES And _ myIssue.SubTypeXML = CSTR_SUBISSUE_OBJECT_IN_HEADER_FOOTER Then DoPreparation = Prepare_HeaderFooter_GraphicFrames(docAnalysis, myIssue, var, currDoc) ElseIf myIssue.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES And _ myIssue.SubTypeXML = CSTR_SUBISSUE_OLD_WORKBOOK_VERSION Then DoPreparation = Prepare_WorkbookVersion() End If FinalExit: Exit Function HandleErrors: WriteDebug currentFunctionName & _ " : path " & docAnalysis.name & ": " & _ " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ Err.Number & " " & Err.Description & " " & Err.Source Resume FinalExit End Function Function InDocPreparation() As Boolean InDocPreparation = True End Function Function Prepare_DocumentCustomProperties(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, _ var As Variant, currDoc As Object) As Boolean On Error GoTo HandleErrors Dim currentFunctionName As String currentFunctionName = "Prepare_DocumentCustomProperties" Dim aProp As DocumentProperty Dim myCustomDocumentProperties As DocumentProperties Dim commentProp As DocumentProperty Prepare_DocumentCustomProperties = False Set myCustomDocumentProperties = getAppSpecificCustomDocProperties(currDoc) Set commentProp = getAppSpecificCommentBuiltInDocProperty(currDoc) Set aProp = var 'Safe as we know that a DocumentProperty is being passed in If commentProp.value <> "" Then commentProp.value = commentProp.value & vbLf commentProp.value = commentProp.value & _ RID_STR_COMMON_SUBISSUE_DOCUMENT_CUSTOM_PROPERTY & ": " & vbLf commentProp.value = commentProp.value & _ RID_STR_COMMON_ATTRIBUTE_NAME & " - " & aProp.name & ", " & _ RID_STR_COMMON_ATTRIBUTE_TYPE & " - " & getCustomDocPropTypeAsString(aProp.Type) & ", " & _ RID_STR_COMMON_ATTRIBUTE_VALUE & " - " & aProp.value myCustomDocumentProperties.item(aProp.name).Delete Prepare_DocumentCustomProperties = True FinalExit: Exit Function HandleErrors: WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source Resume FinalExit End Function Private Function GetProvider(hCtx As Long) As Boolean Const NTE_BAD_KEYSET = &H80090016 Const NTE_EXISTS = &H8009000F Const NTE_KEYSET_NOT_DEF = &H80090019 Dim currentFunctionName As String currentFunctionName = "GetProvider" Dim strTemp As String Dim strProvider As String Dim strErrorMsg As String Dim errStr As String GetProvider = False On Error Resume Next strTemp = vbNullChar strProvider = MS_DEFAULT_PROVIDER & vbNullChar If CBool(CryptAcquireContext(hCtx, ByVal strTemp, _ ByVal strProvider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) Then GetProvider = True Exit Function End If Select Case Err.LastDllError Case NTE_BAD_KEYSET errStr = "Key container does not exist or You do not have access to the key container." Case NTE_EXISTS errStr = "The key container already exists, but you are attempting to create it" Case NTE_KEYSET_NOT_DEF errStr = "The Crypto Service Provider (CSP) may not be set up correctly" End Select WriteDebug currentFunctionName & "Problems acquiring Crypto Provider: " & MS_DEFAULT_PROVIDER & ": " & errStr End Function Function MD5HashString(ByVal Str As String) As String Const HP_HASHVAL = 2 Const HP_HASHSIZE = 4 On Error GoTo HandleErrors Dim currentFunctionName As String currentFunctionName = "MD5HashString" Dim hCtx As Long Dim hHash As Long Dim ret As Long Dim lLen As Long Dim lIdx As Long Dim abData() As Byte If Not GetProvider(hCtx) Then Err.Raise Err.LastDllError ret = CryptCreateHash(hCtx, MD5_ALGORITHM, 0, 0, hHash) If ret = 0 Then Err.Raise Err.LastDllError ret = CryptHashData(hHash, ByVal Str, Len(Str), 0) If ret = 0 Then Err.Raise Err.LastDllError ret = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0) If ret = 0 Then Err.Raise Err.LastDllError ReDim abData(0 To lLen - 1) ret = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0) If ret = 0 Then Err.Raise Err.LastDllError For lIdx = 0 To UBound(abData) MD5HashString = MD5HashString & Right$("0" & Hex$(abData(lIdx)), 2) Next CryptDestroyHash hHash CryptReleaseContext hCtx, 0 FinalExit: Exit Function HandleErrors: MD5HashString = "" WriteDebug currentFunctionName & _ Err.Number & " " & Err.Description & " " & Err.Source Resume FinalExit End Function