-
Notifications
You must be signed in to change notification settings - Fork 3
/
M_omStringFunctions.def
323 lines (282 loc) · 12 KB
/
M_omStringFunctions.def
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
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
Option Compare Database
Option Explicit
Public Enum StringPaddingMode
PadLeft = 1
PadRight = 2
End Enum
' Last Updated by Raoul Jacobs on 20130617_1305
'Public Function Nz(Value As Variant, Optional valueifnull = "")
' Nz = IIf(IsNull(Value), valueifnull, Value)
'End Function
Public Function CleanString(Value As Variant) As String
CleanString = Trim(Nz(Value, ""))
End Function
Public Function IsNullOrEmpty(Value As Variant) As Boolean
IsNullOrEmpty = (Len(CleanString(Value)) = 0)
End Function
Public Function IsNullOrEmptyOrZero(Value As Variant) As Boolean
IsNullOrEmptyOrZero = IsNullOrEmpty(Value)
If Not IsNullOrEmptyOrZero Then
IsNullOrEmptyOrZero = (Value = 0)
If Not IsNullOrEmptyOrZero And IsDate(Value) Then
IsNullOrEmptyOrZero = (CDbl(CDate(Value)) = 0)
End If
End If
End Function
Public Function NotIsNullOrEmptyOrZero(Value As Variant) As Boolean
NotIsNullOrEmptyOrZero = Not IsNullOrEmptyOrZero(Value)
End Function
Public Function NotIsNullOrEmpty(Value As Variant) As Boolean
NotIsNullOrEmpty = Not IsNullOrEmpty(Value)
End Function
Public Function ParseValue(arguments As Variant, valueName As String, Optional assignChar = "=", Optional splitchar = ",", Optional notFoundValue As Variant = Null) As Variant
Dim lPos As Long
Dim lPosTerminator
Dim lPosEqual As Long
ParseValue = notFoundValue
If IsNullOrEmpty(arguments) Then
Exit Function
End If
lPos = InStr(1, Nz(arguments, ""), valueName & assignChar)
If lPos <> 0 Then
lPosEqual = InStr(lPos, arguments, assignChar)
If lPosEqual <> 0 Then
lPosTerminator = InStr(lPosEqual, arguments, splitchar)
ParseValue = Mid(arguments, lPosEqual + 1, IIf(lPosTerminator = 0, Len(arguments), lPosTerminator - 1) - lPosEqual)
End If
End If
End Function
Public Function StringSplit(Value As String, splitchar As String, Optional removeEmptyValues As Boolean = True) As String()
Dim startPos As Long
Dim endPos As Long
Dim result() As String
Dim Length As Long
Dim tempValue As String
If Len(Value) > 0 Then
omArrayFunctions.StringArrayClear result
startPos = 1
While startPos <> 0
endPos = InStr(startPos, Value, splitchar)
Length = IIf(endPos = 0, Len(Value) + 1, endPos) - startPos
If (removeEmptyValues = False) Or (removeEmptyValues And Length > 0) Then
tempValue = Mid(Value, startPos, Length)
omArrayFunctions.StringArrayAdd result, tempValue
End If
startPos = IIf(endPos <> 0, endPos + 1, 0)
Wend
End If
StringSplit = result
End Function
Public Function StringSplitGetByIndex(Value As String, splitchar As String, index As Long) As Variant
StringSplitGetByIndex = Split(Value, splitchar)(index)
End Function
Public Function IsIdNullOrZero(Value As Variant) As Boolean
IsIdNullOrZero = (Nz(Value, 0) = 0)
End Function
Public Function NotIsIdNullOrZero(Value As Variant) As Boolean
NotIsIdNullOrZero = Not IsIdNullOrZero(Value)
End Function
Public Function IsIdNullOrEmptyOrZero(Value As Variant) As Boolean
If IsNullOrEmpty(Value) Then
Value = 0
End If
IsIdNullOrEmptyOrZero = (Nz(Value, 0) = 0)
End Function
Public Function NotIsIdNullOrEmptyOrZero(Value As Variant) As Boolean
NotIsIdNullOrEmptyOrZero = Not IsIdNullOrEmptyOrZero(Value)
End Function
Public Function AreIdsEqual(id1 As Variant, id2 As Variant) As Boolean
If omStringFunctions.IsIdNullOrZero(id1) And omStringFunctions.IsIdNullOrZero(id2) Then AreIdsEqual = True
AreIdsEqual = Nz((id1 = id2), False)
End Function
Public Function AreStringsEqual(string1 As Variant, string2 As Variant) As Boolean
If omStringFunctions.IsNullOrEmpty(string1) And omStringFunctions.IsNullOrEmpty(string2) Then AreStringsEqual = True
AreStringsEqual = Nz((string1 = string2), False)
End Function
Public Function StringFormat(source As String, replace0 As String, Optional replace1 As Variant = Null, Optional replace2 As Variant = Null, Optional replace3 As Variant = Null, Optional replace4 As Variant = Null, Optional replace5 As Variant = Null, Optional replace6 As Variant = Null, Optional replace7 As Variant = Null, Optional replace8 As Variant = Null, Optional replace9 As Variant = Null, Optional replace10 As Variant = Null, Optional replace11 As Variant = Null, Optional replace12 As Variant = Null) As String
StringFormat = Replace(source, "{0}", replace0)
StringFormat = Replace(StringFormat, "{1}", Nz(replace1, ""))
StringFormat = Replace(StringFormat, "{2}", Nz(replace2, ""))
StringFormat = Replace(StringFormat, "{3}", Nz(replace3, ""))
StringFormat = Replace(StringFormat, "{4}", Nz(replace4, ""))
StringFormat = Replace(StringFormat, "{5}", Nz(replace5, ""))
StringFormat = Replace(StringFormat, "{6}", Nz(replace6, ""))
StringFormat = Replace(StringFormat, "{7}", Nz(replace7, ""))
StringFormat = Replace(StringFormat, "{8}", Nz(replace8, ""))
StringFormat = Replace(StringFormat, "{9}", Nz(replace9, ""))
StringFormat = Replace(StringFormat, "{10}", Nz(replace10, ""))
StringFormat = Replace(StringFormat, "{11}", Nz(replace11, ""))
StringFormat = Replace(StringFormat, "{12}", Nz(replace12, ""))
End Function
Public Function RemoveChars(source As Variant, findPattern As String, replaceString As String)
Dim returnString As String
Dim i As Long
returnString = Nz(source, "")
For i = 1 To Len(findPattern)
returnString = Replace(returnString, Mid(findPattern, i, 1), replaceString)
Next i
RemoveChars = returnString
End Function
Public Function KeepChars(source As Variant, keepPattern As String, replaceString As String)
Dim returnString As String
Dim i As Long
Dim currentChar As String
returnString = Nz(source, "")
i = 1
While i <= Len(returnString)
currentChar = Mid(returnString, i, 1)
If InStr(1, keepPattern, currentChar) = 0 Then
returnString = Replace(returnString, currentChar, replaceString)
Else
i = i + 1
End If
Wend
KeepChars = returnString
End Function
Public Function ContainsString(source As Variant, containString As String, Optional useDelimiter As String = "") As Long
ContainsString = InStr(1, useDelimiter & source & useDelimiter, useDelimiter & containString & useDelimiter)
End Function
Public Function GetEnglishPlural(Value As String) As String
If Right(Value, 1) = "y" Then
GetEnglishPlural = Left(Value, Len(Value) - 1) & "ies"
ElseIf Right(Value, 1) = "s" Then
GetEnglishPlural = Value & "es"
Else
GetEnglishPlural = Value & "s"
End If
End Function
Public Function ReplaceCharPattern(source As Variant, findPattern As String, Replacement As String) As Variant
Dim returnString As String
Dim i As Long
If IsNullOrEmpty(source) Then
ReplaceCharPattern = Null
Else
returnString = source
For i = 1 To Len(findPattern)
returnString = replaceString(returnString, Mid(findPattern, i, 1), Replacement)
Next i
ReplaceCharPattern = returnString
End If
End Function
Public Function CleanCommunication(Value As Variant) As Variant
If IsNullOrEmpty(Value) Then
CleanCommunication = Null
Else
CleanCommunication = replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(replaceString(Value, " ", ""), "+", ""), ".", ""), ",", ""), "-", ""), "@", ""), ";", ""), "*", ""), "/", ""), "(", ""), ")", "")
End If
End Function
Public Function ReverseCommunication(Value As Variant) As Variant
Value = CleanCommunication(Value)
If IsNullOrEmpty(Value) Then
ReverseCommunication = Null
Else
ReverseCommunication = StrReverse(Value)
End If
End Function
Function Proper(var As Variant) As Variant
' Purpose: Convert the case of var so that the first letter of each word capitalized.
Dim strV As String, intChar As Integer, i As Integer
Dim fWasSpace As Integer 'Flag: was previous char a space?
If IsNull(var) Then Exit Function
strV = var
fWasSpace = True 'Initialize to capitalize first letter.
For i = 1 To Len(strV)
intChar = Asc(Mid$(strV, i, 1))
Select Case intChar
Case 65 To 90 ' A to Z
If Not fWasSpace Then Mid$(strV, i, 1) = Chr$(intChar Or &H20)
Case 97 To 122 ' a to z
If fWasSpace Then Mid$(strV, i, 1) = Chr$(intChar And &HDF)
End Select
fWasSpace = (intChar = 32)
Next
Proper = strV
End Function
Public Function replaceString(ByVal Value As String, oldString As String, newString As String) As String
While InStr(1, Value, oldString) > 0
Value = Replace(Value, oldString, newString)
Wend
replaceString = Value
End Function
Public Function GetvbCrLf() As String
GetvbCrLf = vbCrLf
End Function
Public Function GetDelimitedValue(Value As String, Optional Position As Long = 0, Optional delimiter As String = ";", Optional EmbraceChar As String)
Dim strings() As String
strings = omStringFunctions.StringSplit(Value, delimiter & EmbraceChar, False)
GetDelimitedValue = Replace(strings(Position), EmbraceChar, "")
End Function
Public Function GetScrambleNumbers(Length As Long) As String
Dim strTemp As String
Dim i As Long
Randomize
For i = 1 To Length
strTemp = strTemp & CInt(Rnd(1) * 9)
Next i
GetScrambleNumbers = strTemp
End Function
Public Function IsStringInPattern(Value As String, pattern As String) As Boolean
IsStringInPattern = (InStr(1, pattern, Value) > 0)
End Function
Public Function CleanStringUsingPattern(ByVal Value As Variant, Optional findPattern As String = vbCrLf & vbTab, Optional replaceString As String = " ", Optional replaceDoubleBlanks As Boolean = True, Optional trimResult As Boolean = True) As String
If IsNull(Value) Then
CleanStringUsingPattern = ""
Exit Function
End If
Value = ReplaceCharPattern(Value, findPattern, replaceString)
If replaceDoubleBlanks Then
While InStr(1, Value, " ") > 0
Value = Replace(Value, " ", " ")
Wend
End If
If trimResult Then
CleanStringUsingPattern = CleanString(Value)
Else
CleanStringUsingPattern = Value
End If
End Function
Public Function StringPadLeft(S As String, totalLength As Long, paddingChar As String) As String
StringPadLeft = StringPad(S, totalLength, paddingChar, PadLeft)
End Function
Public Function StringPadRight(S As String, totalLength As Long, paddingChar As String) As String
StringPadRight = StringPad(S, totalLength, paddingChar, PadRight)
End Function
Public Function StringPad(S As String, totalLength As Long, paddingChar As String, paddingMode As StringPaddingMode) As String
Dim result As String
result = strings.String(totalLength, paddingChar)
If paddingMode = StringPaddingMode.PadLeft Then
result = result & Nz(S, "")
result = Right(result, totalLength)
Else
result = Nz(S, "") & result
result = Left(result, totalLength)
End If
StringPad = result
End Function
Public Function ContainsCharFromPattern(S As String, pattern As String) As Boolean
Dim c As String
Dim i As Long
For i = 1 To Len(pattern)
c = Mid(pattern, i, 1)
If InStr(1, S, c) > 0 Then
ContainsCharFromPattern = True
Exit Function
End If
Next i
End Function
Public Function ExtractLong(text As Variant, findtext As String) As Long
Dim pos As Long
Dim posStart As Long
text = Nz(text, "")
While InStr(1, text, " ") > 0
text = Replace(text, " ", " ")
Wend
pos = InStr(1, text, " " & findtext)
If pos = 0 Then
pos = InStr(1, text, findtext)
End If
If pos <> 0 Then
posStart = InStrRev(text, " ", pos - 1) + 1
'ExtractLong = CLng(Replace(Replace(Trim(Mid(text, posStart, pos - posStart)), ".", ""), ",", ""))
End If
End Function