by James Clay (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 26th October 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case, StripCrLf
API Declarations
Public Enum Trim_Type
LEADING
TRAILING
BOTH
End Enum
Public Enum YESNO
YES = 1
NO = 0
End Enum
VBcoders
'********************************************************************
'Trim: Replacement for built in Trim
'
'Input:
' vData - Input string
' TrimAction - (LEADING,TRAILING,BOTH)
' TrimChar - Char to trim *Optional Default is a Space
' CaseSensitive - YES/ON Case Trim *Optional Default is YES
'
'Result:
' Trim("009832326",LEADING,"0") Returns - 9832326
' Trim(" Hello",LEADING) Returns - "Hello"
' Trim(" Hello",LEADING,,NO) Returns - "hello"
' Trim(" Hello ",TRAILING) Returns - " Hello"
' Trim(" Hello ",BOTH) Returns - "Hello"
'********************************************************************
Dim pos As Long, Count As Long, bDoLeft As Boolean, rData As String
Dim bDoRight As Boolean
If Len(vData) = 0 Or Len(TrimChar) <> 1 Then TrimChar = "ERROR": Exit Function
If CaseSensitive = NO Then vData = LCase(vData): TrimChar = LCase(TrimChar)
DoAction:
Select Case TrimAction
Case LEADING
bDoLeft = False
Do While InStr(1, vData, TrimChar) = 1
vData = Mid(vData, 2)
Loop
Case TRAILING
bDoRight = False
Do While InStrRev(vData, TrimChar) = Len(vData)
vData = Mid(vData, 1, Len(vData) - 1)
Loop
Case BOTH
bDoLeft = True
bDoRight = True
End Select
' This is where both is really done
If bDoLeft = True Then
TrimAction = LEADING
GoTo DoAction
End If
If bDoRight = True Then
TrimAction = TRAILING
GoTo DoAction
End If
Trim = vData
End Function
Public Function ReplaceChars(vData As String, rmvChar As String, Optional rplChar As String = "") As String
'********************************************************************
'ReplaceChars
'
'Inputs:
' vData - String
' rmvChar - Char(s) to remove
' rplChar - Replace rmvChar with these *Optional
'
'Results:
' ReplaceChars("Hello Everyone","e") Returns - "Hllo Evryon"
' ReplaceChars("Hello Everyone","e","4") Returns - "H4llo Ev4ryon4"
'********************************************************************
Dim pos As Long, First As String, Last As String
Do While 1
pos = InStr(1, vData, rmvChar, vbTextCompare)
If pos = 0 Then Exit Do
First = Mid(vData, 1, pos - 1)
Last = Mid(vData, pos + Len(rmvChar))
vData = First & rplChar & Last
Loop
ReplaceChars = vData
End Function
Public Function BuildArray(vData As String, SectionDelimit As String, Optional FieldDelimit As String) As Variant
'**********************************************************************
' BuildArray:
' (REQUIRED) Part One
' vData is a delimited string
' SectionDelimit is the delimiting string
' Returns - An array of the delimited string.
' ret(0) is the total number of records.
'
' (Optional) Part Two
' FieldDelimit is a second delimiter for each record
' Returns - An array of the delimited string.
' ret(0,0) is the total number of records.
' ret(1,n) is Field name
' ret(2,n) is Parameter name
' Where 'n' is the record number.
'
' Example:
' Dim aCmd as Variant, STR as New cString, strCmd As String, SP as String
' SP = " "
' strCmd = "The Brown Fox Jumped Over The Lazy Dog."
' aCmd = STR.BuildArray(strCmd,SP)
' For i = 1 to aCmd(0) 'aCmd(0) = 8
' Debug.Print aCmd(i) 'Prints each word
' Next i
' set aCmd = nothing
'
'Example2:
' Dim aCmd As Variant, STR As New cString, strCmd As String, SP As String
' SP = " "
' strCmd = "FILE=readme.txt DebugFlags=Y RUN=notepad.exe"
' aCmd = STR.BuildArray(strCmd, SP, "=")
' For i = 1 To aCmd(0, 0) 'aCmd(0,0) = 3
' Debug.Print aCmd(1, i) 'File and DebugFlags and RUN
' Debug.Print aCmd(2, i) 'readme.txt and Y notepad.exe
' Next i
' Set aCmd = Nothing
'**********************************************************************
Dim ret() As Variant, Count As Long, pos As Long, Field As String, Param As String
Dim bFieldDel As Boolean
If Not FieldDelimit = "" Then
bFieldDel = True
ReDim ret(2, 0): ret(0, 0) = 0
Else
ReDim ret(0): ret(0) = 0
End If
If Len(vData) = 0 Then GoTo ReturnData
vData = Trim(vData, BOTH, , YES)
Do While Not vData = ""
Count = Count + 1
pos = InStr(1, vData, SectionDelimit)
If bFieldDel Then
ReDim Preserve ret(2, Count)
ret(0, 0) = Count
Else
ReDim Preserve ret(Count)
ret(0) = Count
End If
If pos = 0 Then
If bFieldDel Then
ret(0, Count) = vData
Else
ret(Count) = vData
End If
vData = ""
Else
If bFieldDel Then
ret(0, Count) = Mid(vData, 1, pos - 1)
Else
ret(Count) = Mid(vData, 1, pos - 1)
End If
vData = Mid(vData, pos + Len(SectionDelimit))
End If
Loop
ReturnData:
If bFieldDel Then
For i = 1 To ret(0, 0)
pos1 = InStr(1, ret(0, i), FieldDelimit)
If Not pos1 = 0 Then
Field = Mid(ret(0, i), 1, pos1 - 1)
Param = Mid(ret(0, i), pos1 + 1)
ret(1, i) = Field
ret(2, i) = Param
ret(0, i) = ""
End If
Next i
End If
BuildArray = ret()
End Function
Public Function ProperCase(vData As String) As String
'********************************************************************
'ProperCase
'
'Input:
' vData String
'
'Returns:
' ProperCase("hello world") Returns - "Hello World"
'********************************************************************
Dim ret() As Variant, retc As String
ret = BuildArray(vData, " ")
For i = 1 To ret(0)
If Not Left(ret(i), 1) = " " Then retc = retc & UCase(Left(ret(i), 1)) & Right(ret(i), Len(ret(i)) - 1) & " "
Next i
retc = Trim(retc, trRIGHT, " ", YES)
ProperCase = retc
End Function
Public Function StripCrLf(vData As String) As String
'********************************************************************
'StripCrLf:
'
'Inputs:
' vData String
'
'Results:
' StripCrLf("Hello" & vbCrlf) Returns - "HELLO"
'********************************************************************
vData = Trim(vData, TRAILING, vbLf, YES)
StripCrLf = Trim(vData, TRAILING, vbCr, YES)
End Function
No comments have been posted about Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case. Why not be the first to post a comment about Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case.
