1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
|
Sub DocGetFileLocations(doc As NotesDocument, fileMap List As Variant)
'/**
' * Locates all file attachments in a document and returns the result in a hash table (list).
' * @param doc The document that contains the attachments.
' * @param fileList (Return) A hash table (list) used to store and return the results of this function.
' */
Dim allFiles As Variant ' all files embedded within the specified document regardless of which (if any) richtext field contains them.
Dim rtFiles As Variant ' files found embedded within any rich text field.
Erase fileMap ' clear the return param.
' Get all attachment names.
allFiles = ArrayTrimArray(Evaluate("@AttachmentNames", doc))
If (Isempty(allFiles)) Then Exit Sub
' Check all richtext items for embedded files.
Forall item In doc.Items
If (item.Type = RICHTEXT) Then
If (Not Isempty(item.EmbeddedObjects)) Then
Forall obj In item.EmbeddedObjects
fileMap(item.Name) = ArrayAdd(fileMap(item.Name), obj.Name)
rtFiles = ArrayAdd(rtFiles, obj.Name)
End Forall
End If
End If
End Forall
' Get the files that are not embedded within an item.
Forall file In allFiles
If (Not ArrayIsMember(rtFiles, file, False)) Then
fileMap("$DOCUMENT") = ArrayAdd(fileMap("$DOCUMENT"), file)
End If
End Forall
End Sub
Function ArrayAdd(source As Variant, values As Variant) As Variant
'/**
' * Appends one or more element to an array and returns the result as a third array.
' * Unlike ArrayAppend, this function supports scalar, null, and byte array arguments.
' * @param source The source array.
' * @param values The value or values to append to the array.
' * @return A new array containing all elements from source and values.
' */
Dim ta1 As Variant ' temp array
Dim ta2 As Variant ' temp array
' Check for empty arrays.
If (ArrayElements(values) = 0) Then
Redim ta1(0)
If (Isobject(source)) Then
Set ta1(0) = source
Elseif (Isarray(source)) Then
ta1 = source
Else
ta1(0) = source
End If
ArrayAdd = ta1
Exit Function
End If
If (ArrayElements(source) = 0) Then
Redim ta2(0)
If (Isobject(values)) Then
Set ta2(0) = values
Elseif (Isarray(values)) Then
ta2 = values
Else
ta2(0) = values
End If
ArrayAdd = ta2
Exit Function
End If
' Check for scalar values and objects.
If (Isarray(source)) Then
ta1 = source
Else
Dim td1 As Variant ' temp data
If (Isobject(source)) Then Set td1= source Else td1= source
Redim ta1(0)
If (Isobject(td1)) Then Set ta1(0) = td1 Else ta1(0) = td1
End If
If (Isarray(values)) Then
ta2 = values
Else
Dim td2 As Variant ' temp data
If (Isobject(values)) Then Set td2= values Else td2= values
Redim ta2(0)
If (Isobject(td2)) Then Set ta2(0) = td2 Else ta2(0) = td2
End If
' Check for byte arrays - Arrayappend throws Type Mismatch on Byte arrays in R7.
If ((Typename(ta1(0)) = "BYTE") Or (Typename(ta2(0)) = "BYTE")) Then
ArrayAdd = ArrayAppendEx(ta1, ta2)
Else
ArrayAdd = Arrayappend(ta1, ta2)
End If
End Function
Function ArrayAppendEx(a1 As Variant, a2 As Variant) As Variant
'/**
' * Appends one array to the end of another array and returns the result as a third array.
' * Unlike ArrayAppend, this function supports byte arrays.
' * @param a1 Any variant containing an array.
' * @param a2 Any variant containing an array.
' * @return A variant containing an array.
' */
Dim retval As Variant
Dim start As Long
Dim i As Long
retval = a1
start = Ubound(a1) + 1
Redim Preserve retval(start + Ubound(a2))
For i = 0 To Ubound(a2)
retval(start+i) = a2(i)
Next
ArrayAppendEx = retval
End Function
Function ArrayElements(source As Variant) As Long
'/**
' * Determines the number of elements in an array.
' * @param source The array to check.
' */
Select Case Datatype(source)
Case V_EMPTY, V_NULL
ArrayElements = 0
Exit Function
Case V_INTEGER, V_LONG, V_SINGLE, V_DOUBLE, V_CURRENCY, V_DATE, V_STRING, V_LSOBJ, V_PRODOBJ
ArrayElements = 1
Exit Function
Case V_BYTE, V_BOOLEAN
ArrayElements = 1
Exit Function
Case Else
If Isempty(source) Then
ArrayElements = 0
Exit Function
Else
ArrayElements = Ubound(source) - Lbound(source) + 1
End If
If (ArrayElements = 1) Then
Select Case Datatype(source(Lbound(source)))
Case V_EMPTY, V_NULL
ArrayElements = 0
Case V_LSOBJ, V_PRODOBJ
If (source(Lbound(source)) Is Nothing) Then ArrayElements = 0
End Select
End If
End Select
End Function
Function ArrayTrimArray(source As Variant) As Variant
'/**
' * Removes all empty elements from an array.
' * @param source The source array.
' * @return A new array that has all empty elements removed.
' */
Dim a As Variant
If (Not Isarray(source)) Then
ArrayTrimArray = source
Exit Function
End If
Forall value In source
If (Datatype(value) = V_STRING) Then
If (Trim(value) <> "") Then a = ArrayAdd(a, value)
Elseif (Not Isempty(value)) Then
a = ArrayAdd(a, value)
End If
End Forall
ArrayTrimArray = a
End Function
Function ArrayIsMember(source As Variant, values As Variant, Byval caseSensitive As Boolean) As Boolean
'/**
' * Searches an array for an exact value or values.
' * @param source The source array.
' * @param values The value(s) to search for. This can be a scalar, a string, or an array or values.
' * @param caseSensitive (Boolean) Indicates whether string matching should be case sensitive.
' * @return (Boolean) True if an exact value was found.
' */
Dim a1 As Variant
Dim a2 As Variant
Dim comp As Integer
ArrayIsMember = True
a1 = ArrayCreate(source)
a2 = ArrayCreate(values)
If (caseSensitive) Then comp = 0 Else comp = 1
' Search for any value in a2 that is present in a1.
Forall value1 In a1
Forall value2 In a2
If ((Datatype(value1) = V_STRING) And (Datatype(value2) = V_STRING)) Then
If (Strcompare(value1, value2, comp) = 0) Then Exit Function
Else
If (value1 = value2) Then Exit Function
End If
End Forall
End Forall
ArrayIsMember = False
End Function
Function ArrayCreate(source As Variant) As Variant
'/**
' * Creates an array from the source.
' * @param source An array or string containing a list of array elements separated by a comma.
' * @return A new array containing the elements found in the source.
' */
Dim result(0) As Variant
If (Isarray(source)) Then
ArrayCreate = source
Elseif (Isobject(source)) Then
Set result(0) = source
ArrayCreate = result
Elseif (Instr(1, source, ",", 0) <> 0) Then
ArrayCreate = Split(source, ",")
Else
result(0) = source
ArrayCreate = result
End If
End Function
|
