|
Attribute VB_Name = "String"
OPTION Explicit
'Collected and created by Win Swarr [[Email Removed]]
Public FUNCTION reversestring(revstr AS STRING) AS STRING
' revstr: String to reverse
' Returns: The reverse string
DIM doreverse AS LONG
reversestring = ""
FOR doreverse = LEN(revstr) TO 1 STEP -1
reversestring = reversestring & MID$(revstr, doreverse, 1)
NEXT
END FUNCTION
Public FUNCTION FindDelimitor(SearchString AS STRING, _
Optional TokenList AS STRING = " " & vbTab) AS INTEGER
'Find the position of the first token delimitor character in a string.
'This function takes the following arguments:
'1 - The string to be searched
'2 - A list of token delimitors.
' If this string is ommited the delimitors are set to " " and vbTab
'The function returns the position of the found character or
'zero if the character was not found
DIM StringLength AS INTEGER
DIM Counter AS INTEGER
StringLength = LEN(SearchString)
FOR Counter = 1 TO StringLength
IF INSTR(TokenList, MID$(SearchString, Counter, 1)) > 0 THEN
FindDelimitor = Counter
EXIT FUNCTION
END IF
NEXT
FindDelimitor = 0
END FUNCTION
'Find the position of the first character, which is NOT a token delimitor character, in a string.
'This function takes the following arguments:
'1 - The string to be searched
'2 - A list of token delimitors.
' If this string is ommited the delimitors are set to " " and vbTab
'The function returns the position of the found character or
'zero if the character was not found
Public FUNCTION skipDelimitor(SearchString AS STRING, _
Optional TokenList AS STRING = " " & vbTab) AS INTEGER
DIM StringLength AS INTEGER
DIM Counter AS INTEGER
StringLength = LEN(SearchString)
FOR Counter = 1 TO StringLength
IF INSTR(TokenList, MID$(SearchString, Counter, 1)) = 0 THEN
skipDelimitor = Counter
EXIT FUNCTION
END IF
NEXT
skipDelimitor = 0
END FUNCTION
FUNCTION FormatStringForSQLInsertStatment(ByRef szLine AS STRING, szTarget AS STRING, _
szReplacement AS STRING, szNumberColumns AS STRING) AS STRING
DIM i AS INTEGER
DIM j AS INTEGER
DIM k AS INTEGER
DIM c AS STRING
DIM N AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
ON ERROR RESUME NEXT
szResult = szLine
i = k = 2
szResult = ReplaceEachStringWithString(szResult, szTarget, szReplacement)
i = LEN(szNumberColumns) + 1
j = i
k = 1
DO WHILE i >= 0
'Get Number before first comma
i = i - 1
szTemp = Trim(Mid(szNumberColumns, (i), 1))
IF szTemp = Trim(",") OR i = 0 THEN
c = Trim(Mid(szNumberColumns, (i + 1), (k - 1)))
N = (VAL(c))
szResult = ReplaceNthStringWithString(szResult, ",'", ",", (N - 1))
szResult = ReplaceNthStringWithString(szResult, "',", ",", N)
j = i - 1
k = 0
END IF
k = k + 1
LOOP
'Check for quote on left most portion of string
IF Trim(Left(szNumberColumns, 1)) = "1" THEN
IF Trim(Left(szResult, 2)) = ",'" OR Trim(Left(szResult, 2)) = "'," THEN
szResult = Right(szResult, LEN(Trim(szResult)) - 2)
ELSEIF Trim(Left(szResult, 1)) = "," OR Trim(Left(szResult, 1)) = "'" THEN
szResult = Right(szResult, LEN(Trim(szResult)) - 1)
END IF
ELSE
IF Trim(Left(szResult, 2)) = ",'" OR Trim(Left(szResult, 2)) = "'," THEN
szResult = "'" + Right(szResult, LEN(Trim(szResult)) - 2)
ELSEIF Trim(Left(szResult, 1)) <> "'" THEN
szResult = "'" + szResult
END IF
END IF
szLine = szResult
END FUNCTION
FUNCTION REMoveNthOccurenceOfString(ByRef szOriginal As String, szTarget As String, _
N AS INTEGER) AS INTEGER
'This function will remove the Nth occurence only of the target string
'within the original
DIM i AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
DIM j AS INTEGER
DIM k AS INTEGER
i = j = k = 0
szTemp = szOriginal
i = INSTR(1, szTemp, szTarget)
DO WHILE k < N AND i > 0
IF Mid(szOriginal, i, LEN(szTarget)) = szTarget THEN
k = k + 1
j = i
i = INSTR(i, szTemp, szTarget)
i = (i + LEN(szTarget))
ELSE
i = i + 1
END IF
LOOP
i = j
IF (i > 0) AND (k = N) THEN
j = (i - 1)
k = (i - 2)
szTemp = Left(szTemp, j) + Right(szTemp, (LEN(szTemp) - (k + LEN(szTarget))) - 1)
REMoveNthOccurenceOfString = i
ELSE
REMoveNthOccurenceOfString = 0
END IF
szOriginal = szTemp
END FUNCTION
FUNCTION REMoveString(ByRef szOriginal As String, szTarget As String) As Integer
'This function will remove the first occurence of the target string from
'the original, concatenating the string at the the leading and following
'characters
DIM i AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
DIM j AS INTEGER
DIM k AS INTEGER
i = j = k = 0
szTemp = szOriginal
i = INSTR(1, szTemp, szTarget)
IF i > 0 THEN
j = (i - 1)
k = (i - 2)
szTemp = Left(szTemp, j) + Right(szTemp, (LEN(szTemp) - (k + LEN(szTarget))) - 1)
REMoveString = i
ELSE
REMoveString = 0
END IF
szOriginal = szTemp
END FUNCTION
FUNCTION ReplaceNthStringWithString(szOriginal AS STRING, szTarget AS STRING, _
szReplacement AS STRING, N AS INTEGER) AS STRING
'This function replaces the Nth instance only of a given string within
'the original with the replacement string.
DIM i AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
DIM j AS INTEGER
DIM k AS INTEGER
i = j = k = 0
szResult = ""
szTemp = szOriginal
IF N > 0 THEN
i = REMoveNthOccurenceOfString(szTemp, szTarget, N)
szTemp = InsertString(szTemp, szReplacement, i)
END IF
ReplaceNthStringWithString = szTemp
END FUNCTION
FUNCTION ReplaceEachStringWithString(szOriginal AS STRING, szTarget AS STRING, szReplacement AS STRING) AS STRING
'This function replaces each instance of a given string within the
'original with the replacement string.
DIM i AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
DIM j AS INTEGER
i = j = 0
szResult = ""
szTemp = szOriginal
i = REMoveString(szTemp, szTarget)
DO WHILE i > 0
szTemp = InsertString(szTemp, szReplacement, i)
i = REMoveString(szTemp, szTarget)
LOOP
ReplaceEachStringWithString = szTemp
END FUNCTION
FUNCTION InsertString(szSource AS STRING, szNew AS STRING, index) AS STRING
'This function will insert szNew before the character at index in the
'Source string
DIM szResult AS STRING
ON ERROR RESUME NEXT
szResult = ""
IF index > (LEN(szSource) + 1) THEN
InsertString = szSource + Space(index - LEN(szSource)) + szNew
EXIT FUNCTION
END IF
IF index = 0 THEN index = 1
szResult = Left(szSource, (index - 1)) + szNew + Right(szSource, (LEN(szSource) - index) + 1)
InsertString = szResult
END FUNCTION
FUNCTION ReplaceEachInstanceOfCharacter(szOriginal AS STRING, oldcharacter AS STRING, newcharacter AS STRING) AS STRING
'This function will replace any instance of a given character within the original string
DIM i AS INTEGER
DIM szTemp AS STRING
DIM szResult AS STRING
DIM j AS INTEGER
DIM k AS INTEGER
i = j = k = 0
ON ERROR RESUME NEXT
szResult = ""
DO WHILE i < LEN(szOriginal)
i = i + 1
szTemp = Trim(Mid(szOriginal, (i), 1))
IF szTemp = Trim(oldcharacter) AND i <= LEN(szOriginal) THEN
k = k + 1
Mid(szOriginal, i, 1) = newcharacter
j = i + 1
END IF
LOOP
ReplaceEachInstanceOfCharacter = szOriginal
END FUNCTION
FUNCTION ScrambleString(szRaw AS STRING, szKey AS STRING) AS STRING
DIM nDigitSum AS INTEGER
DIM i AS INTEGER
DIM szCooked AS STRING
DIM nRawLength AS INTEGER
DIM szMask AS STRING
DIM nDigit AS INTEGER
DIM nDigitMask AS INTEGER
nDigitSum = 0
FOR i = 1 TO LEN(szKey)
nDigitSum = nDigitSum + ASC(MID$(szKey, i, 1))
NEXT
nDigitSum = nDigitSum MOD 128
szCooked = ""
nRawLength = LEN(szRaw)
szMask = szKey
DO WHILE LEN(szMask) < nRawLength
szMask = szMask + szKey
LOOP
FOR i = 1 TO LEN(szRaw)
' To scramble = digit + digitsum of key XOR character of key
nDigit = ASC(MID$(szRaw, i, 1)) + nDigitSum
nDigitMask = ASC(MID$(szMask, i, 1))
nDigit = nDigit XOR nDigitMask
szCooked = szCooked + CHR$(nDigit)
NEXT
'MsgBox "Raw = '" + szRaw + "' Cooked='" + szCooked + "'"
ScrambleString = szCooked
END FUNCTION
FUNCTION UnscrambleString(szCooked AS STRING, szKey AS STRING) AS STRING
DIM nDigitSum AS INTEGER
DIM i AS INTEGER
DIM szRaw AS STRING
DIM nCookedLength AS INTEGER
DIM szMask AS STRING
DIM nDigit AS INTEGER
DIM nDigitMask AS INTEGER
szRaw = ""
nDigitSum = 0
FOR i = 1 TO LEN(szKey)
nDigitSum = nDigitSum + ASC(MID$(szKey, i, 1))
NEXT
nDigitSum = nDigitSum MOD 128
nCookedLength = LEN(szCooked)
szMask = szKey
DO WHILE LEN(szMask) < nCookedLength
szMask = szMask + szKey
LOOP
FOR i = 1 TO LEN(szCooked)
' To unscramble = digitsum of key XOR character of key - digit
nDigit = ASC(MID$(szCooked, i, 1))
nDigitMask = ASC(MID$(szMask, i, 1))
nDigit = nDigit XOR nDigitMask
nDigit = nDigit - nDigitSum
szRaw = szRaw + CHR$(nDigit)
NEXT
'MsgBox "Cooked = '" + szCooked + "' Raw='" + szRaw + "'"
UnscrambleString = szRaw
END FUNCTION
|
