How to extract a given string out of another? - vbscript

I would like to extract a given string out of another one.
The sample strings shall be:
V_DDRF_2J_WTF
V_ASDF_8J_TLDR
V_LULZ_1337_3J
(Hint: The letter after the integer is ALWAYS a J.)
Now I only want to extract the integer of the bold part of the string. How do I achieve that?
xJ will only appear in the middle or the end of the string.

Use a RegExp searching for "", a (sequence of) number(s), and an optional "" - as in:
Option Explicit
Function qq(s) : qq = """" & s & """" : End Function
Dim aTests : aTests = Array( _
"V_DDRF_2J_WTF" , "_2J_" _
, "V_ASDF_8J_TLDR", "_8J_" _
, "V_LULZ_1337_3J", "_3J" _
)
Dim r : Set r = New RegExp
'r.Pattern = "_\d+J(?:_|$)"
r.Pattern = "_\d+J_?"
Dim i, s
For i = 0 To UBound(aTests) Step 2
s = r.Execute(aTests(i + 0))(0).Value
WScript.Echo qq(aTests(i + 0)) _
, qq(s) _
, CStr(aTests(i + 1) = s)
Next
output:
cscript 28561918.vbs
"V_DDRF_2J_WTF" "_2J_" True
"V_ASDF_8J_TLDR" "_8J_" True
"V_LULZ_1337_3J" "_3J" True
You may have to tinker with the pattern, depending on your input data; code to deal with non-matches should be added.

You can use regex and use this pattern \d+J or \d+\w
You can test patterns here

Related

Count Items in file using VB

Kind of new to VBS. I'm trying to count the fields in the file and have this code.
Col()
Function Col()
Const FSpec = "C:\test.txt"
Const del = ","
dim fs : Set fs = CreateObject("Scripting.FileSystemObject")
dim f : Set f = fs.OpenTextFile(FSpec, 1)
Dim L, C
Do Until f.AtEndOfStream
L = f.ReadLine()
C = UBound(Split(L, del))
C = C +1
WScript.Echo "Items:", C
Loop
f.Close
End Function
It works however, I don't want to count the delim inside " ".
Here's file content:
1,"2,999",3
So basically, I'm getting 4 items for now but I wanted to get 3. Kind of stuck here.
For an example of my second suggestion, a very simple example could be something like this. Not saying it is perfect, but it illustrates the idea:
Dim WeAreInsideQuotes 'global flag
Function RemoveQuotedCommas(ByVal line)
Dim i
Dim result
Dim current
For i = 1 To Len(line)
current = Mid(line, i, 1) 'examine character
'check if we encountered a quote
If current = Chr(34) Then
WeAreInsideQuotes = Not WeAreInsideQuotes 'toggle flag
End If
'process the character
If Not (current = Chr(44) And WeAreInsideQuotes) Then 'skip if comma and insode quotes
result = result & current
End If
Next
RemoveQuotedCommas = result
End Function

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

Splitting the Name and Changing the First Letter to Upper Case

How can I write my full name where the first letter is in upper-case and the rest is lower-case for example:
Michael Jonson Bech
I have this so fair:
option Explicit
Dim Name,fName
Name = Split(InputBox("what is your name"))
Dim var
For Each var In Name
'var=UCase(Left(var,1))
LCase(var)
UCase (Left(var,1))
Next
fName = Join(Name)
WScript.Echo("you name is : " & fName )
String functions like UCase do not modify the operand, but return a modified copy. For Each v gives you copies of the array's elements named v.
So you need something like this:
Option Explicit
Dim a : a = Split("mIchael jOnson bEch")
WScript.Echo Join(a)
Dim i
For i = 0 To UBound(a)
a(i) = UCase(Left(a(i), 1)) & LCase(Mid(a(i), 2))
Next
WScript.Echo Join(a)
output:
cscript 34629546.vbs
mIchael jOnson bEch
Michael Jonson Bech
This looks like VB6, in which case something like :
Dim Name as string
Name = InputBox("what is your name")
Name = StrConv(Name, vbProperCase)

Convert a value with a regex to a real value

I have a huge file containing values with a regex in it, like this:
LGP0041_\d{4}\.dta
objd135a_\S{3}.txt
Now I need to convert these to a valid example value, like this:
LGP0041_1234.dta
objd135a_abc.txt
I know of the RegExp object to check if there is a match, but is there also a way to create valid values?
A regular grammar can be used to recognize or produce words of its language, but the VBScript regexp engine does not implement producing. So you have to roll your own.
Your sample does not contain contain regular patterns. \S can't mean 'non-whitespace' because you won't like characters illegal in a file name and a representative sample of file names should contain elements with spaces. The fact that the first sample escapes the extension dot and the second one doesn't makes me think that your syntax specs aren't really thought out. If you come up with a (regular) grammar of your inputs, I'm willing to give your problem further thought.
Some code to base the thinking on:
Option Explicit
Function rndInt(lowerbound, upperbound)
rndInt = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function
Sub shuffleAD(aX)
' Durstenfeld's Permutation Algorithm
Dim J, K, Temp
For J = UBound(aX) To 1 Step -1
K = Int((J + 1) * Rnd) ' random number 0 - J
Temp = aX(J)
aX(J) = aX(K)
aX(K) = Temp
Next
End Sub ' shuffleAD
Class cRGen
Private m_
Public Function init(s)
Set init = Me
ReDim m_(Len(s) - 1)
Dim i
For i = 0 To UBound(m_)
m_(i) = Mid(s, i + 1, 1)
Next
End Function
Public Function getNext(mi, ma)
shuffleAD m_
getNext = Mid(Join(m_, ""), 1, rndInt(mi, ma))
End Function
End Class
Dim goRpl : Set goRpl = Nothing
Function magic(m, w, mi, ma, p, src)
If IsEmpty(ma) Then ma = mi
magic = goRpl.m_dicGens(w).getNext(mi, ma)
End Function
Class cRpl
Private m_fRpl
Private m_r
Public m_dicGens
Private Sub Class_Initialize()
Set m_fRpl = GetRef("magic")
Set m_r = New RegExp
m_r.Pattern = "\\(\w){(\d+)(?:,(\d+))?}"
Set m_dicGens = CreateObject("Scripting.Dictionary")
Set m_dicGens("d") = New cRGen.init("0123456789")
Set m_dicGens("S") = New cRGen.init("abcdefghij")
End Sub
Public Function rpl(s)
Set goRpl = me
rpl = m_r.Replace(s, m_fRpl)
End Function
End Class
Randomize
Dim aTests : aTests = Array( _
"LGP0041_\d{4}.dta" _
, "objd135a_\S{3}.txt" _
, "x_\S{3,8}.txt" _
)
Dim oRpl : Set oRpl = New cRpl
Dim sTest
For Each sTest In aTests
WScript.Echo sTest, "=>", oRpl.rpl(sTest)
Next
output:
cscript 28936688.vbs
LGP0041_\d{4}.dta => LGP0041_4317.dta
objd135a_\S{3}.txt => objd135a_cea.txt
x_\S{3,8}.txt => x_jgcfidh.txt
cscript 28936688.vbs
LGP0041_\d{4}.dta => LGP0041_8054.dta
objd135a_\S{3}.txt => objd135a_eci.txt
x_\S{3,8}.txt => x_ahfgd.txt
This should at least identify the needed components:
generators that deliver strings of specific character sets
a (sorry: global) replace function that maps 'type letters' to generators, handles 'width specs', and build the output
a regular pattern to parse the specs from your inputs

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.

Resources