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
Related
What is the quickest and easiest way (in Classic ASP) to check if a string has some string (that has a length greater than 0) i.e. NOT "Null", "Nothing", "Empty", or '' empty string
To make sure that the Variant you deal with is of sub-type "string", you need the VarType or TypeName function. To rule out zero length strings, you need Len(). To guard against strings of space, you could throw in a Trim().
Code to illustrate/experiment with:
Option Explicit
Function qq(s) : qq = """" & s & """" : End Function
Function toLiteral(x)
Select Case VarType(x)
Case vbEmpty
toLiteral = "<Empty>"
Case vbNull
toLiteral = "<Null>"
Case vbObject
toLiteral = "<" & TypeName(x) & " object>"
Case vbString
toLiteral = qq(x)
Case Else
toLiteral = CStr(x)
End Select
End Function
Function isGoodStr(x)
isGoodStr = False
If vbString = VarType(x) Then
If 0 < Len(x) Then
isGoodStr = True
End If
End If
End Function
Dim x
For Each x In Array("ok", "", " ", 1, 1.1, True, Null, Empty, New RegExp)
WScript.Echo toLiteral(x), CStr(isGoodStr(x))
Next
output:
cscript 26107006.vbs
"ok" True
"" False
" " True
1 False
1.1 False
True False
<Null> False
<Empty> False
<IRegExp2 object> False
Here's a one-liner that dodges all the trouble with Null by concatenating the value with an empty string. It works for Null, Empty, "", and, of course, strings with actual length! The only one it doesn't (nor shouldn't) work for is Nothing, because that's for object variables, of which a string is not.
isNullOrEmpty = (Len("" & myString) = 0)
You could try having something like this:
Function nz(valToCheck, valIfNull)
If IsNull(valToCheck) then
nz = valIfNull
Else
nz = valToCheck
End if
End function
and then you would use it like this:
if nz(var,"") <> "" then
'--string has something in it
else
'--string is null or empty
end is
You can use the VarType() function to check if it is a string, then you can check if the string is not empty. This statement will only pass through a string that isn't empty.
If VarType(MyString) = 8 Then
If MyString <> "" Then
'String is Not Null And Not Empty, code goes here
End If
End If
This worked for me:
if mystring = "" then wscript.echo "Empty string"
else wscript.echo "String is not empty"
<%
Dim x,y
x = "abcdefg"
'counting length of string
y = Len(x)
Response.Write (y)
'checking string is empty or not
If Len(x) = 0 then
Response.Write ("<p>String is empty</p>")
Else
Response.Write ("<p>String is not empty</p>")
End If
%>
Hope this is helpful.
Okay, I am trying to convert the user given decimal number to binary but Internet Explorer gives me this error:
Isn't that how you send a dynamic array as function argument in VBScript?
VBScript code:
Function toBinary(number, binary)
Dim remainder : remainder = 0
Dim index : index = 0
While (number <> 0)
remainder = number Mod 2
number = number \ 2
ReDim binary(index)
binary(index) = remainder
index = index + 1
Wend
toBinary = binary
End Function
Dim number
Dim response : response = vbYes
Dim binary()
While (response = vbYes)
number = InputBox("Enter A Decimal Number: ")
If (Not IsNumeric(number)) Then
response = MsgBox("Wrong Input, Wanna Try Again? ", vbYesNo)
Else
MsgBox (number & " is equal to " & toBinary(number, binary) & " in Binary")
response = vbNo
End If
Wend
In the line msgbox ( number & " is equal to " & toBinary(number, binary) & " in Binary"), the function toBinary(...) returns an array.
An array cannot be converted to a string in vbscript, so when you concatenate it to display it, you get an error.
In your example, I would suggest that you build a string instead of an array and return that string :
Function toBinary(value)
dim result : result = ""
dim remainder : remainder = 0
If value = 0 Then
result = "0"
Else
While (value <> 0)
remainder = value Mod 2
result = remainder & result
value = value \ 2
Wend
End If
toBinary = result
End Function
dim number
dim response : response = vbYes
dim binary()
while ( response = vbYes )
number = inputbox("Enter A Decimal Number: ")
if ( Not IsNumeric(number)) then
response = msgbox("Wrong Input, Wanna Try Again ? ", vbYesNo)
else
msgbox ( number & " is equal to " & toBinary(number) & " in Binary")
response = vbNo
end if
wend
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
I'm making form where i need to enter the time's for each period like.
Start time - End time
Start time - End time
Start time - End time
Those record's could be saved in listbox as in my example. On another form i have 3 labels
CurrentTime, TimePassed, TimeLeft, and a Timer which ticks in interval 1second. So the time in timepassed ticking up, time left ticking down, and current time show correct time while application is opened.
In final it looks like this
Private Sub cmdAdd_Click()
Call addp
End Sub
Function addp(Optional ByVal t As String)
Dim s As String, e As String
If t = "" Then s = Trim(InputBox("Start time (hh:mm AM/PM):")) Else: s = Trim(Split(t, "-")(0))
If s = "" Or InStr(1, s, " AM") = 0 And InStr(1, s, " PM") = 0 Then Exit Function
If chk(s) = False Then Exit Function
If t = "" Then e = Trim(InputBox(s & "-?" & vbCrLf & "End time:")) Else: e = Trim(Split(t, "-")(1))
If e = "" Or InStr(1, e, " AM") = 0 And InStr(1, e, " PM") = 0 Then Exit Function
If e = s Then Exit Function
If chk(e) = False Then Exit Function
If Format$(Split(s, "-")(0), "hh:mm AM/PM") > Format$(Split(e, "-")(0), "hh:mm AM/PM") Then Exit Function
If lstPeriods.List(0) <> "" Then
If Format$(Split(lstPeriods.List(lstPeriods.ListCount - 1), "-")(1), "hh:mm AM/PM") > Format$(Split(s, "-")(0), "hh:mm AM/PM") Then Exit Function
End If
lstPeriods.AddItem lstPeriods.ListCount + 1 & ". " & s & "-" & e
If frmMain.lblPeriod.Caption = "" Then Call snd(s & "-" & e, lstPeriods.ListCount)
End Function
For check
Function chk(ByVal st As String) As Boolean
st = Replace$(Replace$(st, " AM", ""), " PM", "")
If UBound(Split(st, ":")) <> 1 Then Exit Function
For i = 0 To 1
If IsNumeric(Split(st, ":")(i)) = False Then Exit Function
If Len(Split(st, ":")(i)) <> 2 Then Exit Function
If Split(st, ":")(i) < 0 Then Exit Function
Next
If Split(st, ":")(0) > 12 Then Exit Function
If Split(st, ":")(1) > 59 Then Exit Function
chk = True
End Function
The solution i gave is the only solution which beginner as i I had. And i know it's confusing and very slow. There is no way this can be finished by using trim/split/format because it require for a lot of modification.
Searching for easier solution.
Sp i need to compare the current time on computer with the time person enetered in textbox/listbox how can i do that .
To Run this code you need to add 5 Controls to the Form1
lblSystemTime = Label Control
lblTimeLeft = Label Control
lblTimePassed = Label Control
lblPeriod = Label Control
tmrSystemTime = Timer Control
Dim Periods()
Private Sub Form_Load()
Periods = Array( _
"06:00 PM-07:00PM", _
"07:01 PM-08:00PM", _
"09:00 PM-10:00PM", _
"1AM-2AM" _
)
End Sub
Private Sub tmrSystemTime_Timer()
lblSystemTime.Caption = FormatDateTime(Now, vbLongTime)
Dim OnPeriod As Integer
OnPeriod = GetPeriod()
If OnPeriod < 0 Then
lblTimeLeft.Caption = vbNullString
lblTimePassed.Caption = vbNullString
lblPeriod.Caption = "Unknown Period"
Else
lblPeriod = CStr(OnPeriod + 1) & ". period"
lblTimeLeft.Caption = "Time Left: " & Format( _
DateAdd("s", _
DateDiff("s", _
CDate(lblSystemTime.Caption), _
CDate(Split(Periods(OnPeriod), "-")(1))), _
CDate("0") _
), _
"nn:ss" _
)
lblTimePassed.Caption = "Time Passed: " & Format( _
DateAdd("s", _
DateDiff("s", _
CDate(Split(Periods(OnPeriod), "-")(1)), _
CDate(lblSystemTime.Caption)), _
CDate("0") _
), _
"nn:ss" _
)
End If
End Sub
Private Function GetPeriod() As Integer
Dim ICount As Integer
For Each Pr In Periods
If CDate(Split(Pr, "-")(0)) <= CDate(lblSystemTime.Caption) And _
CDate(Split(Pr, "-")(1)) >= CDate(lblSystemTime.Caption) Then
GetPeriod = ICount
Exit Function
End If
ICount = ICount + 1
Next
GetPeriod = -1
End Function
Here is something which may help:
Private Sub TimeCheck(byval int_TimeNow as Integer)
dim intTimeThen as string 'set a variable to compare for the THEN time
dim intTimeNow as string 'set a variable to compare for the NOW time
dim intDiff as string ' set a variable for the difference in time
intTimeNow = int_TimeNow 'just to ensure we don't mess with any data
intTimeThen = val(txtTimeThen.text) 'get the numeric value of the time, the system will
'convert it from a string to the value here.
intDiff = intTimeThen - intTimeNow 'Do the math
lstTimeEvents.additem timevalue(intDiff) 'write it to a listbox
End Sub
I realize this is not the coding convention you are using, but it should demonstrate what you are looking for to some degree.
I have written a little sub to filter approx. 56.000 items in an Excel List.
It works as expected, but it gets really slower and slower after like 30.000 Iterations. After 100.000 Iterations it's really slow...
The Sub checks each row, if it contains any of the defined words (KeyWords Array). If true, it checks if it is a false positive and afterwards deletes it.
What am I missing here? Why does it get so slow?
Thanks...
Private Sub removeAllOthers()
'
' removes all Rows where Name does not contain
' LTG, Leitung...
'
Application.ScreenUpdating = False
Dim TotalRows As Long
TotalRows = Cells(rows.Count, 4).End(xlUp).row
' Define all words with meaning "Leitung"
KeyWords = Array("LTG", "LEITUNG", "LETG", "LEITG", "MASSE")
' Define all words which are false positives"
BadWords = Array("DUMMY", "BEF", "HALTER", "VORSCHALTGERAET", _
"VORLAUFLEITUNG", "ANLEITUNG", "ABSCHIRMUNG", _
"AUSGLEICHSLEITUNG", "ABDECKUNG", "KAELTEMITTELLEITUNG", _
"LOESCHMITTELLEITUNG", "ROHRLEITUNG", "VERKLEIDUNG", _
"UNTERDRUCK", "ENTLUEFTUNGSLEITUNG", "KRAFTSTOFFLEITUNG", _
"KST", "AUSPUFF", "BREMSLEITUNG", "HYDRAULIKLEITUNG", _
"KUEHLLEITUNG", "LUFTLEITUNG", "DRUCKLEITUNG", "HEIZUNGSLEITUNG", _
"OELLEITUNG", "RUECKLAUFLEITUNG", "HALTESCHIENE", _
"SCHLAUCHLEITUNG", "LUFTMASSE", "KLEBEMASSE", "DICHTUNGSMASSE")
For i = TotalRows To MIN_ROW Step -1
Dim nmbr As Long
nmbr = TotalRows - i
If nmbr Mod 20 = 0 Then
Application.StatusBar = "Progress: " & nmbr & " of " & TotalRows - MIN_ROW & ": " & Format(nmbr / (TotalRows - MIN_ROW), "Percent")
End If
Set C = Range(NAME_COLUMN & i)
Dim Val As Variant
Val = C.Value
Dim found As Boolean
For Each keyw In KeyWords
found = InStr(1, Val, keyw) <> 0
If (found) Then
Exit For
End If
Next
' Check if LTG contains Bad Word
Dim badWord As Boolean
If found Then
'Necessary because SCHALTER contains HALTER
If InStr(1, Val, "SCHALTER") = 0 Then
'Bad Word filter
For Each badw In BadWords
badWord = InStr(1, Val, badw) <> 0
If badWord Then
Exit For
End If
Next
End If
End If
If found = False Or badWord = True Then
C.EntireRow.Delete
End If
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Typically, performing read from / write to operations on ranges in long loops are slow, compared to loops that are performed in memory.
A more performant approach would be to load the range into memory, perform the operations in memory (on array level), clear the contents of the entire range and display the new result (after operations on the array) at once in the sheet (no constant Read / Write but only Read and Write a single time).
Below you find a test with 200 000 rows that illustrates what I aim at, I suggest you check it out.
If it is not a hundred percent what you were looking for, you can finetune it in any way you wish.
I noticed that the screen becomes blank at a certain point; don't do anything, the code is still running but you may be temporarily blocked out of the Excel application.
However you'll notice that it is faster.
Sub Test()
Dim BadWords As Variant
Dim Keywords As Variant
Dim oRange As Range
Dim iRange_Col As Integer
Dim lRange_Row As Long
Dim vArray As Variant
Dim lCnt As Long
Dim lCnt_Final As Long
Dim keyw As Variant
Dim badw As Variant
Dim val As String
Dim found As Boolean
Dim badWord As Boolean
Dim vArray_Final() As Variant
Keywords = Array("LTG", "LEITUNG", "LETG", "LEITG", "MASSE")
BadWords = Array("DUMMY", "BEF", "HALTER", "VORSCHALTGERAET", _
"VORLAUFLEITUNG", "ANLEITUNG", "ABSCHIRMUNG", _
"AUSGLEICHSLEITUNG", "ABDECKUNG", "KAELTEMITTELLEITUNG", _
"LOESCHMITTELLEITUNG", "ROHRLEITUNG", "VERKLEIDUNG", _
"UNTERDRUCK", "ENTLUEFTUNGSLEITUNG", "KRAFTSTOFFLEITUNG", _
"KST", "AUSPUFF", "BREMSLEITUNG", "HYDRAULIKLEITUNG", _
"KUEHLLEITUNG", "LUFTLEITUNG", "DRUCKLEITUNG", "HEIZUNGSLEITUNG", _
"OELLEITUNG", "RUECKLAUFLEITUNG", "HALTESCHIENE", _
"SCHLAUCHLEITUNG", "LUFTMASSE", "KLEBEMASSE", "DICHTUNGSMASSE")
Set oRange = ThisWorkbook.Sheets(1).Range("A1:A200000")
iRange_Col = oRange.Columns.Count
lRange_Row = oRange.Rows.Count
ReDim vArray(1 To lRange_Row, 1 To iRange_Col)
vArray = oRange
For lCnt = 1 To lRange_Row
Application.StatusBar = lCnt
val = vArray(lCnt, 1)
For Each keyw In Keywords
found = InStr(1, val, keyw) <> 0
If (found) Then
Exit For
End If
Next
If found Then
'Necessary because SCHALTER contains HALTER
If InStr(1, val, "SCHALTER") = 0 Then
'Bad Word filter
For Each badw In BadWords
badWord = InStr(1, val, badw) <> 0
If badWord Then
Exit For
End If
Next
End If
End If
If found = False Or badWord = True Then
Else
'Load values into a new array
lCnt_Final = lCnt_Final + 1
ReDim Preserve vArray_Final(1 To lCnt_Final)
vArray_Final(lCnt_Final) = vArray(lCnt, 1)
End If
Next lCnt
oRange.ClearContents
set oRange = nothing
If lCnt_Final <> 0 Then
Set oRange = ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(lCnt_Final, 1))
oRange = vArray_Final
End If
End Sub