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