usefuls.bas

Rjindeal加密算法

Dim lPos As Long
Dim lNewString As String

    ' if it contains a quote, we need to substitute this with ""
    If Len(pString) = 0 Then
        ConvertStringToValidCSVFormat = ""
        Exit Function
    End If
    If Len(pString) = 1 Then
        If pString = Chr(34) Then
            ConvertStringToValidCSVFormat = Chr(34) & Chr(34) & Chr(34) & Chr(34)
            Exit Function
        End If
    End If
    lNewString = Chr(34)
    For lPos = 1 To Len(pString)
        If Mid(pString, lPos, 1) = Chr(34) Then
            lNewString = lNewString & Chr(34)
        End If
        lNewString = lNewString & Mid(pString, lPos, 1)
    Next
    lNewString = lNewString & Chr(34)
    ConvertStringToValidCSVFormat = lNewString
End Function

' Useful when retrieving rows from database
Public Function GRON(Var As Variant) As String
    If IsNull(Var) Then
        GRON = ""
    Else
        GRON = Var
    End If
End Function

' Search and Replace
Public Function QSAR(ByVal pString As String, ByVal pSearch As String, Optional ByVal pReplace As String = "", Optional pCompare As Long = vbBinaryCompare, Optional GlobalReplace As Boolean = True) As String
Dim lLen1 As Long
Dim lLen2 As Long
Dim lStartFind As Long
Dim lFoundLoc As Long
Dim ltmpString As String

    lLen1 = Len(pString)
    lLen2 = Len(pSearch)
    lStartFind = 1
    ltmpString = ""
    Do
        lFoundLoc = InStr(lStartFind, pString, pSearch, pCompare)
        If lFoundLoc = 0 Then
            Exit Do
        End If
        ltmpString = ltmpString & Mid(pString, lStartFind, lFoundLoc - lStartFind) & pReplace
        If lStartFind = 1 And GlobalReplace = False Then
            lStartFind = lFoundLoc + lLen2
            Exit Do
        End If
        lStartFind = lFoundLoc + lLen2
    Loop
    ltmpString = ltmpString & Mid(pString, lStartFind, lLen1 - lStartFind + 1)
    QSAR = ltmpString
End Function

' Note that this ONLY supports the formats %s, \n and \t
Public Function PrintF(FormatString As String, ParamArray PA() As Variant)
Dim Param As Variant
Dim OutputString As String
    OutputString = FormatString
    For Each Param In PA
        OutputString = QSAR(OutputString, "%s", Param, , False)
    Next
    OutputString = QSAR(OutputString, "\n", vbCrLf, , True)
    OutputString = QSAR(OutputString, "\t", vbTab, , True)
    Debug.Print OutputString
End Function

' Note that this ONLY supports the formats %s, \n and \t
Public Function FPrintF(FileNumber As Long, FormatString As String, ParamArray PA() As Variant)
Dim Param As Variant
Static OutputString As String
    OutputString = OutputString & FormatString
    For Each Param In PA
        OutputString = QSAR(OutputString, "%s", Param, , False)
    Next
    OutputString = QSAR(OutputString, "\n", vbCrLf, , True)
    OutputString = QSAR(OutputString, "\t", vbTab, , True)
    If Right(OutputString, 2) = vbCrLf Then
        Print #FileNumber, Mid(OutputString, 1, Len(OutputString) - 2)
        OutputString = ""
    End If
End Function

'-------------------------------------------
' Conversion functions
'-------------------------------------------
Public Function LengthUnitConvert(InitialValue As Double, InitialUnit As LengthUnits, FinalUnit As LengthUnits) As Double
Dim Mili As Double
    Select Case InitialUnit
        ' Metric
        Case Micrometres
            Mili = InitialValue * 0.001
        Case Milimetres
            Mili = InitialValue
        Case Centimetres
            Mili = InitialValue * 10
        Case Metres
            Mili = InitialValue * 1000
        Case Kilometres
            Mili = InitialValue * 1000000
        ' Common Imperial
        Case Inches
            Mili = InitialValue * 25.4
        Case Feet
            Mili = InitialValue * 25.4 * 12
        Case Yards
            Mili = InitialValue * 25.4 * 36
        Case Miles
            Mili = InitialValue * 25.4 * 36 * 1760
        ' Nautical and horse racing
        Case NauticalMiles
            Mili = InitialValue * 25.4 * 36 * 6080
        Case CableLengths
            Mili = InitialValue * 25.4 * 12 * 600
        Case Chains
            Mili = InitialValue * 25.4 * 12 * 66
        Case Fathoms
            Mili = InitialValue * 25.4 * 12 * 6
        Case Furlongs
            Mili = InitialValue * 25.4 * 12 * 660
        Case Hands
            Mili = InitialValue * 25.4 * 4
        Case Degrees
            Mili = InitialValue * 25.4 * 36 * 6080 * 60
        Case Minutes
            Mili = InitialValue * 25.4 * 36 * 6080 ' yes, same as nautical mile
        Case Seconds
            Mili = InitialValue * 25.4 * 36 * (6080 / 60)
        ' Computer
        Case Dots
            Mili = InitialValue * 25.4 / 300
        Case Points
            Mili = InitialValue * 25.4 / 72
        Case RadixDots
            Mili = InitialValue * 25.4 / 1200
        Case Twips
            Mili = InitialValue * 25.4 / 1440
        Case PlotterUnits
            Mili = InitialValue * 25.4 / 1016
        ' Scientific
'        Case Angstroms
'            Mili = InitialValue * 1 / 10000000000#
        Case LightYears
            Mili = InitialValue * 1000 * 9.4 * 10 ^ 15
        ' Old and Biblical
        Case Cubits
            Mili = InitialValue * 25.4 * 18
        Case RoyalEgyptianCubits
            Mili = InitialValue * 25.4 * 21
        Case Ells
            Mili = InitialValue * 25.4 * 45
        Case Palms
            Mili = InitialValue * 127
        Case Reeds
            Mili = InitialValue * 1520
        Case Span
            Mili = InitialValue * 25.4 * 9
    End Select
    Select Case FinalUnit
        ' Metric
        Case Micrometres
            LengthUnitConvert = Mili / 0.001
        Case Milimetres
            LengthUnitConvert = Mili
        Case Centimetres
            LengthUnitConvert = Mili / 10
        Case Metres
            LengthUnitConvert = Mili / 1000
        Case Kilometres
            LengthUnitConvert = Mili / 1000000
        ' Common Imperial
        Case Inches
            LengthUnitConvert = Mili / 25.4
        Case Feet
            LengthUnitConvert = Mili / (25.4 * 12)
        Case Yards
            LengthUnitConvert = Mili / (25.4 * 36)
        Case Miles
            LengthUnitConvert = Mili / (25.4 * 36 * 1760)
        ' Nautical and horse racing
        Case NauticalMiles
            LengthUnitConvert = Mili / (25.4 * 36 * 6080)
        Case CableLengths
            LengthUnitConvert = Mili / (25.4 * 12 * 600)
        Case Chains
            LengthUnitConvert = Mili / (25.4 * 12 * 66)
        Case Fathoms
            LengthUnitConvert = Mili / (25.4 * 12 * 6)
        Case Furlongs
            LengthUnitConvert = Mili / (25.4 * 12 * 660)
        Case Hands
            LengthUnitConvert = Mili / (25.4 * 4)
        Case Degrees
            LengthUnitConvert = Mili / (25.4 * 36 * 6080 * 60)
        Case Minutes
            LengthUnitConvert = Mili / (25.4 * 36 * 6080)  ' yes, same as nautical mile
        Case Seconds
            LengthUnitConvert = Mili / (25.4 * 36 * (6080 / 60))
        ' Computer
        Case Dots
            LengthUnitConvert = Mili / (25.4 / 300)
        Case Points
            LengthUnitConvert = Mili / (25.4 / 72)
        Case RadixDots
            LengthUnitConvert = Mili / (25.4 / 1200)
        Case Twips
            LengthUnitConvert = Mili / (25.4 / 1440)
        Case PlotterUnits
            LengthUnitConvert = Mili / (25.4 / 1016)
        ' Scientific
'        Case Angstroms
'            LengthUnitConvert = Mili / (1 / 10000000000#)
        Case LightYears
            LengthUnitConvert = Mili / (1000 * 9.4 * 10 ^ 15)
        ' Old and Biblical
        Case Cubits
            LengthUnitConvert = Mili / (25.4 * 18)
        Case RoyalEgyptianCubits
            LengthUnitConvert = Mili / (25.4 * 21)
        Case Ells
            LengthUnitConvert = Mili / (25.4 * 45)
        Case Palms
            LengthUnitConvert = Mili / 127
        Case Reeds
            LengthUnitConvert = Mili / 1520
        Case Span
            LengthUnitConvert = Mili / (25.4 * 9)
    End Select
End Function

'-------------------------------------------
' Timing functions
'-------------------------------------------
' Function can time accurately to microseconds (1/1000000th of a second)
' Tis slow though.  Have to convert 64bit unsigned integer to Decimal within Variant. Yuk
' When VB7 arrives, with it's 64bit long variable, I'll be able to write this to be a tad quicker(!)
Public Function TimerElapsed(Optional 礢 As Long = 0, Optional UsePerformanceTimer As Boolean = True) As Boolean
Static StartTime As Variant ' Decimal
Static PerformanceFrequency As LongLong
Static EndTime As Variant ' Decimal
Dim CurrentTime As LongLong
Dim Dec As Variant

    If 礢 > 0 Then
        ' Initialize
        If UsePerformanceTimer = True Then
            If QueryPerformanceFrequency(PerformanceFrequency) Then
                ' Performance Timer available
                If QueryPerformanceCounter(CurrentTime) Then
                Else
                    ' Performance timer is available, but is not responding
                    CurrentTime.HighPart = 0
                    CurrentTime.LowPart = timeGetTime
                    PerformanceFrequency.HighPart = 0
                    PerformanceFrequency.LowPart = 1000
                End If
            Else
                ' Performance timer is not available.
                CurrentTime.HighPart = 0
                CurrentTime.LowPart = timeGetTime
                PerformanceFrequency.HighPart = 0
                PerformanceFrequency.LowPart = 1000
            End If
        Else
                ' Do not need to use performance timer
                CurrentTime.HighPart = 0
                CurrentTime.LowPart = timeGetTime
                PerformanceFrequency.HighPart = 0
                PerformanceFrequency.LowPart = 1000
        End If
        ' Work out start time...
        ' Convert to DECIMAL
        Dec = CDec(CurrentTime.LowPart)
        ' make this UNSIGNED
        If Dec < 0 Then
            Dec = CDec(Dec + (2147483648# * 2))
        End If
        ' Add higher value
        StartTime = CDec(Dec + (CurrentTime.HighPart * 2147483648# * 2))
        
        ' Put performance frequency into Dec variable
        Dec = CDec(PerformanceFrequency.LowPart)
        ' Convert to unsigned
        If Dec < 0 Then
            Dec = CDec(Dec + (2147483648# * 2))
        End If
        ' Add higher value
        Dec = CDec(Dec + (PerformanceFrequency.HighPart * 2147483648# * 2))
        
        ' Work out end time from this
        EndTime = CDec(StartTime + 礢 * Dec / 1000000)