VBscript and InStr function - vbscript

I'm trying to retrieve the 5 characters before and after the string "Major-General" in the Pirate's of Penzance Major-General Song (found here: http://www.naic.edu/~gibson/poems/gilbert1.html ). I'm trying to find a better way to do this than what I have and also trying to figure out why it isn't looping. Any ideas would be greatly appreciated!
l1 =INSTR(l2, string, "Major-General")
l2 = 5
l3 = 1
vcount=0
if vcount <5 then
l1 =INSTR(l3, string, "Major-General")
vcount = vcount +1
word = mid(string, l1-5, l2 )
word1 = mid(string, l1+13, l2)
l3 = l3+l1
response.write "<br>" & "5 before: " & word & "<br>" & "5 after: " & word1
end if

It may be easier to do it like this:
Dim Poem,aStr,i,block,Left5,Right5
Poem = "The abc poem is abc in this abc string."
aStr = Split(Poem,"abc")
If uBound(aStr) = 0 Then Response.Write "String not found": Response.End
For i = 0 to uBound(aStr)
block = Trim(aStr(i))
Left5 = "": Right5 = ""
if cStr(i) <> cStr(uBound(aStr)) then Left5 = Right(block,5)
If cStr(i) <> cStr(0) then Right5 = Left(block,5)
Response.Write "The 5 characters to the left of abc:" & Left5
Response.Write "The 5 characters to the right of abc:" & Right5
Next
This will get the 5 characters to the left and right of the string, each time the string exists.
In this case, it will search the Poem string for abc and split the string into an array of each part where the string exists, then it can be processed further.

Related

How capitalize fullname in vb6

hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)

Remove duplicate values from a string in classic asp

I have below code in classic asp
str=Request.Form("txt_str")
"txt_str" is text box in a classic asp form page where I am entering below values:
000-00001
000-00001
000-00001
000-00002
response.write str
hence str will be 000-00001 000-00001 000-00001 000-00002
array = split(str,Chr(44))
if str <> "" then
x=empty
for i = 0 to ubound(array)
if array(i) <> "" then
array_2 = split(array(i),chr(13) & chr(10))
for j = 0 to ubound(array_2)
if array_2(j) <> "" then
if x=empty then
x= "'" & array_2(j) & "'"
else
x= x & ",'" & array_2(j) & "'"
end if
end if
next
end if
next
End if
response.write x
hence x will be returned as '000-00001','000-00001','000-00001','000-00002'
I want to remove duplicate values from x and display only it as:
x = '000-00001','000-00002'
How can i achieve this.Any help on this would be appreciated.
Thanks
To remove duplicates of string lists, the best option IMO is to use a Dictionary object. You can use this short function to do the task on a given string array:
Function getUniqueItems(arrItems)
Dim objDict, strItem
Set objDict = Server.CreateObject("Scripting.Dictionary")
For Each strItem in arrItems
objDict.Item(strItem) = 1
Next
getUniqueItems = objDict.Keys
End Function
A simple test:
' -- test output
Dim arrItems, strItem
arrItems = Array("a","b","b","c","c","c","d","e","e","e")
For Each strItem in getUniqueItems(arrItems)
Response.Write "<p>" & strItem & "</p>"
Next
This is a sample for your use case:
' -- sample for your use case
Dim strInput, x
strInput = Request.Form("txt_str")
x = "'" & join(getUniqueItems(split(str, Chr(44))), "','") & "'"
BTW, did you notice that Array and Str are VBScript Keywords, so you may run into issues with using such variable names. Therefore, I think it is common practice in VBScript to use prefixes for variable names.
If it's a ordered list, consider using a variable with last value:
lastval = ""
array = split(str,Chr(44))
if str <> "" then
x=empty
for i = 0 to ubound(array)
if array(i) <> "" then
array_2 = split(array(i),chr(13) & chr(10))
for j = 0 to ubound(array_2)
if array_2(j) <> "" then
if array_2(j) <> lastval then
lastval = array_2(j)
if x=empty then
x= "'" & array_2(j) & "'"
else
x= x & ",'" & array_2(j) & "'"
end if
end if
end if
next
end if
next
End if

Check if string is all capitals using classic asp

I need a function to check if a string is all (or mostly) capitals using classic asp. (I need to prevent users from inputting titles using all capitals.)
For example, if a string of 30 letters contains 20 or more that are capitalized, I'd need to flag it as "All capitals". So "The Count of Monte Cristo" would be fine, but "The COUNT of MONTE CRISTO" would not.
I was thinking about starting with a count of letters that match [^A-Z], but how do I do that?
This needs to be in Classic ASP and not VB.
Comparing against UCase(input) makes it an all or nothing check; I'd prefer to look at the UCase ratio:
Option Explicit
Function Ucasity(s)
If Len(s) Then
Dim r : Set r = New RegExp
r.Global = True
r.Pattern = "[A-Z]"
Dim m : Set m = r.Execute(s)
Ucasity = m.Count / Len(s)
Else
Ucasity = 0
End If
End Function
Function qq(s) : qq = """" & s & """" : End Function
Dim s
For Each s In Array( _
"UPPERCASE but not ALL OR NOTHING" _
, "UPPERCASE" _
, "pipapo" _
, "UPPERCASEuppercase" _
, "" _
)
WScript.Echo qq(s), CStr(s = UCase(s)), UCasity(s)
Next
output:
cscript 39261181.vbs
"UPPERCASE but not ALL OR NOTHING" False 0,65625
"UPPERCASE" True 1
"pipapo" False 0
"UPPERCASEuppercase" False 0,5
"" True 0
Simply use the UCase function
<%
dim a
a = "This is a test 1"
dim b
b = "THIS IS A TEST 2"
If a = ucase(a) then response.write(a & " is all upper")
If b = ucase(b) then response.write(b & " is all upper")
%>
Result
THIS IS A TEST 2 is all upper

How to display length of word count in vb?

So I've been trying for hours to figure out how to display the length of word count in vb.
For example, if I type in a sentence in a rich textbox and I click a button, I want a form to show up listing the number of one-letter words, two-letter words, three-letter words and so on within that sentence. The number of words of specific length will be outputted in labels, of course.
I found this short code online for word count:
dim wordcount as integer
dim a as string() = RichText.Text.Split(" ")
wordcount = a.length
However, I'm not sure if this code can be used to get the length of word count. Any ideas of how I can achieve outputting the number of words of a specific length in a label? Thank you.
What about something like:
Private Sub mnuCount_Click()
Const DELIMITERS As String = vbNewLine & " !"",.:;?"
Dim WordCounts(1 To 100) As Long
Dim Msg As String
Dim I As Integer
Dim WordCount As Long
With RTB
.Visible = False
.SelStart = 0
Do
.UpTo DELIMITERS, vNegate:=True
.Span DELIMITERS, vNegate:=True
If .SelLength > 0 Then
WordCounts(.SelLength) = WordCounts(.SelLength) + 1
.SelStart = .SelStart + .SelLength
Else
Exit Do
End If
Loop
.SelStart = 0
.Visible = True
End With
Msg = "Length" & vbTab & "Count"
For I = 1 To 100
If WordCounts(I) > 0 Then
Msg = Msg & vbNewLine _
& CStr(I) & vbTab & CStr(WordCounts(I))
WordCount = WordCount + WordCounts(I)
End If
Next
Msg = Msg & vbNewLine _
& "Grand total:" & vbNewLine _
& vbTab & CStr(WordCount)
MsgBox Msg
End Sub
Pradnya's code, translated to VB6:
Option Explicit
Private Sub Command1_Click()
Dim str As String
Dim splitStr() As String
Dim i As Integer
str = "ABC DEF GHIJ KLMNOPQ"
splitStr = Split(str, " ")
MsgBox "Number of words = " & UBound(splitStr) + 1 & vbCrLf & _
"Average Length = " & Len(Replace(str, " ", "")) / (UBound(splitStr) + 1)
End Sub
I made a few simplifications as well. There's no need to go through the loop to get the average. All you have to do to get the length of the whole is remove the spaces and divide by the number of elements in the array.
However, if you want to get a count of the number of words of each length, you'll have to loop through the array, getting the length of each word and storing those values one by one. Best way to do that is to set a reference to scrrun.dll (Windows Scripting Runtime) and use a Dictionary object to store the values.

vb6 split space delimited string at every nth space

I have a space delimited string variable. I would like to store the contents of the variable into an array. Using split, I can store every space delimited value in an array. I would prefer if I could separate the string variable at every 7th space. For example, the text could read:
"hello hello hello hello hello hello hello hi hi hi hi hi hi hi hey hey hey hey hey hey hey"
This isn't the actual content of the string, but a simpler version that is easier to read. I want to separate at the places where the words change, or every 7th space. Any help would be greatly appreciated. My current code looks like this, which splits at every space.
ReDim StatsArray(ArrInc)
StatsArray = Split(Stats)
For i = 0 To UBound(StatsArray())
If i > UBound(StatsArray()) Then
ReDim Preserve StatsArray(i + ArrInc)
End If
' MsgBox StatsArray(i) ' When not commented out, this help me check the array
Next
There isn't any built-in function that will do this for you. A couple of solutions come to mind: (1) Do your split, then iterate your array. Concatenate seven array elements in a string variable. Write the result to a new array. Rinse and repeat. (2) Create an Array. Iterate through the string character by character, pushing each character into a variable and keeping track of the spaces you encounter; when you reach the seventh space add an element to your array, copy the variable to it, and clear the variable. Rinse and repeat.
The first one strikes me as a bit faster, but I could be quite wrong about that.
If I understand what you're trying to do, a string of "1234 12345678 123" would get split into 1234, 1234567, 8, 123. Is this correct?
If so, then you can use Regular Expressions to do the split for you.
Function Split7(S As String)
Dim regex As New RegExp
regex.Pattern = "[^ ]{7}"
regex.Global = True
Split7 = Split(regex.Replace(S, "$& "), " ")
End Function
This will insert a space after every 7th character that is not a space. Then use the split function to get the whole thing into an array.
Another stab at it, though I'd probably optimize the ReDim Preserves, doing them in chunks:
Option Explicit
Private Function SplitN( _
ByRef Source As String, _
ByVal Delim As String, _
ByVal N As Long) As String()
'Delim can be multi-character.
'Always returns at least 1-element result,
'even if Source = "".
Dim SearchPos As Long
Dim PartPos As Long
Dim DelimPos As Long
Dim Parts() As String
Dim DelimCount As Long
Dim PartsCount As Long
SearchPos = 1
PartPos = SearchPos
Do
DelimPos = InStr(SearchPos, Source, Delim)
If DelimPos > 0 Then
DelimCount = DelimCount + 1
If DelimCount = N Then
DelimCount = 0
ReDim Preserve Parts(PartsCount)
Parts(PartsCount) = _
Mid$(Source, PartPos, DelimPos - PartPos)
PartsCount = PartsCount + 1
PartPos = DelimPos + Len(Delim)
End If
SearchPos = DelimPos + Len(Delim)
End If
Loop While DelimPos > 0
ReDim Preserve Parts(PartsCount)
Parts(PartsCount) = Mid$(Source, PartPos)
SplitN = Parts
End Function
Private Sub Form_Load()
Dim S As String
Dim Parts() As String
Dim P As Long
S = "hello hello hello hello hello hello hello " _
& "hi hi hi hi hi hi hi " _
& "hey hey hey hey hey hey hey"
Text1.SelStart = 0
Text1.SelText = S & vbNewLine & vbNewLine
Parts = SplitN(S, " ", 7)
Text1.SelText = "Ubound() = " & UBound(Parts) & vbNewLine
For P = 0 To UBound(Parts)
Text1.SelText = Parts(P) & vbNewLine
Next
End Sub

Resources