Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Class CompareTool
- Dim TypeNameDict
- Dim MyType_Simple
- Dim MyType_Date
- Dim MyType_String
- Dim MyType_Wierd
- Dim MyType_Error
- Dim MyType_Empty
- Dim MyType_Null
- Dim MyType_Object
- Dim MyType_Unknown
- Dim MyType_Nothing
- Private Sub Class_Initialize()
- Set TypeNameDict = CreateObject("Scripting.Dictionary")
- MyType_Simple = 1
- MyType_Date = 2
- MyType_String = 3
- MyType_Wierd = 4
- MyType_Error = 5
- MyType_Empty = 6
- MyType_Null = 7
- MyType_Object = 8
- MyType_Unknown = 9
- MyType_Nothing = 10
- TypeNameDict("Byte") = MyType_Simple
- TypeNameDict("Integer") = MyType_Simple
- TypeNameDict("Long") = MyType_Simple
- TypeNameDict("Single") = MyType_Simple
- TypeNameDict("Double") = MyType_Simple
- TypeNameDict("Currency") = MyType_Simple
- TypeNameDict("Decimal") = MyType_Simple
- TypeNameDict("Date") = MyType_Date
- TypeNameDict("Boolean") = MyType_Simple
- TypeNameDict("String") = MyType_String
- TypeNameDict("Error") = MyType_Error
- TypeNameDict("Empty") = MyType_Empty
- TypeNameDict("Null") = MyType_Null
- TypeNameDict("Object") = MyType_Object
- TypeNameDict("Unknown") = MyType_Unknown
- TypeNameDict("Nothing") = MyType_Nothing
- End Sub ' Class_Initialize
- Private Sub Class_Terminate()
- Set TypeNameDict = Nothing
- End Sub ' Class_Terminate
- Private Function StdCompare(Var1, Var2)
- If Var1 > Var2 Then
- StdCompare = 1
- ElseIf Var1 < Var2 Then
- StdCompare = -1
- Else
- StdCompare = 0
- End If
- End Function ' StdCompare
- ' Compare two Variants that they are not an arrays or objects.
- Public Function CompareVariants(Var1, Var2) ' CompareVariants(Variant, Variant) As Long
- Dim T1, T2
- Dim D1, D2
- ' Examine
- On Error Resume Next
- T1 = TypeName(Var1)
- If Err.Number <> 0 Then
- Err.Clear
- CompareVariants = -1
- End If
- T2 = TypeName(Var2)
- If Err.Number <> 0 Then
- Err.Clear
- CompareVariants = 1
- End If
- D1 = TypeNameDict(T1)
- If Err.Number <> 0 Then
- Err.Clear
- CompareVariants = -1
- End If
- D2 = TypeNameDict(T2)
- If Err.Number <> 0 Then
- Err.Clear
- CompareVariants = 1
- End If
- On Error Goto 0
- ' Compare
- If D1 >= MyType_Wierd Or D2 >= MyType_Wierd Then
- ' Sort weird type in one pile and normal types in another.
- If D1 < MyType_Wierd Then
- CompareVariants = 1
- ElseIf D2 < MyType_Wierd Then
- CompareVariants = -1
- Else
- ' Sort weird types by typename instead of by value.
- CompareVariants = StrComp(T1, T2, 1)
- End If
- ElseIf D1 = MyType_Date Or D2 = MyType_Date Then
- If D1 = MyType_String Then
- CompareVariants = StdCompare(DateValue(Var1), Var2)
- ElseIf D2 = MyType_String Then
- CompareVariants = StdCompare(DateValue(Var2), Var1)
- Else
- CompareVariants = StdCompare(Var1, Var2)
- End If
- ElseIf D1 = MyType_String Or D2 = MyType_String Then
- CompareVariants = StrComp(Var1, Var2, 1)
- Else
- CompareVariants = StdCompare(Var1, Var2)
- End If
- End Function ' CompareVariants
- Public Sub DebugCompare(Var1, Var2)
- WScript.Echo "Compare(" & Var1 & ", " & Var2 & ") == " & CompareVariants(Var1, Var2)
- End Sub ' DebugCompare
- End Class ' CompareTool
- Sub TestMe()
- Dim tool, mydate
- mydate = Now
- set tool = new CompareTool
- WScript.Echo "-- numbers"
- tool.DebugCompare 42, 42
- tool.DebugCompare 1, 2
- tool.DebugCompare 2, 1
- tool.DebugCompare 2.22, 1.11
- tool.DebugCompare 1.11, 2.22
- WScript.Echo "-- date vs string"
- tool.DebugCompare mydate, "2021-01-02"
- tool.DebugCompare mydate, "2019-01-02"
- tool.DebugCompare "2021-01-02", mydate
- tool.DebugCompare "2019-01-02", mydate
- WScript.Echo "-- dates"
- tool.DebugCompare mydate, mydate
- tool.DebugCompare mydate, DateValue("2021-01-02")
- tool.DebugCompare mydate, DateValue("2019-01-02")
- tool.DebugCompare DateValue("2021-01-02"), mydate
- tool.DebugCompare DateValue("2019-01-02"), mydate
- WScript.Echo "-- strings"
- tool.DebugCompare "Bob", "Bob"
- tool.DebugCompare "Bob", "Alice"
- tool.DebugCompare "Alice", "Bob"
- tool.DebugCompare "Alice", "Carl"
- tool.DebugCompare "Carl", "Alice"
- tool.DebugCompare "Alice", "#Carl"
- tool.DebugCompare "#Carl", "Alice"
- WScript.Echo "-- misc"
- tool.DebugCompare "Carl", Empty
- tool.DebugCompare Empty, "Carl"
- End Sub ' TestMe
- TestMe
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement