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