How to parse a time (month/date/year) in Microsoft QBasic, needed for testing.
s = 'PT1H28M26S'
I would like to get:
num_mins = 88
You can parse such a time string with the code below, but the real question is:
Who still uses QBasic in 2015!?
CLS
s$ = "PT1H28M26S"
' find the key characters in string
posP = INSTR(s$, "PT")
posH = INSTR(s$, "H")
posM = INSTR(s$, "M")
posS = INSTR(s$, "S")
' if one of values is zero, multiplying all will be zero
IF ((posP * posH * posM * posS) = 0) THEN
' one or more key characters are missing
nummins = -1
numsecs = -1
ELSE
' get values as string
sHour$ = MID$(s$, posP + 2, (posH - posP - 2))
sMin$ = MID$(s$, posH + 1, (posM - posH - 1))
sSec$ = MID$(s$, posM + 1, (posS - posM - 1))
' string to integer, so we can calculate
iHour = VAL(sHour$)
iMin = VAL(sMin$)
iSec = VAL(sSec$)
' calculate totals
nummins = (iHour * 60) + iMin
numsecs = (iHour * 60 * 60) + (iMin * 60) + iSec
END IF
' display results
PRINT "Number of minutes: "; nummins
PRINT "Number of seconds: "; numsecs
PRINT "QBasic in 2015! w00t?!"
Simpler way to grab minutes from string in qbasic
REM Simpler way to grab minutes from string in qbasic
S$ = "PT1H28M26S"
S$ = MID$(S$, 3) ' 1H28M26S
V = INSTR(S$, "H") ' position
H = VAL(LEFT$(S$, V - 1)) ' hours
S$ = MID$(S$, V + 1) ' 28M26S
V = INSTR(S$, "M") ' position
M = VAL(LEFT$(S$, V - 1)) ' minutes
PRINT "num_mins ="; H * 60 + M
Related
We have some code that checks each incoming file against 3 different criteria before processing (Not a weekend, not after 6pm, not a holiday). This being said, I need to figure out how to have it check for a half hour now (bolded part). I have tried adding a + mRelease > 30 as well as AND mRelease > 30 and both have failed. I have been altering this line
Do While (WeekDay(dRelease) = 1) OR (WeekDay(dRelease) = 7) OR (UBound(fHoliday) > -1) OR (tRelease >17)
Here is the code currently in place:
result = ""
dRelease = Now
tRelease = CStr(Hour(Now))
mRelease = CStr(Minute(Now))
aHoliday = Array("01/02/2017","01/16/2017","05/29/2017","07/04/2017","09/04/2017","10/09/2017","11/23/2017","11/24/2017","12/25/2017","12/26/2017")
dNow = CStr(DatePart("m",Date)) + "/" + CStr(DatePart("d",Date)) + "/" + CStr(DatePart("yyyy",Date))
dMonth = "0" + CStr(Month(dRelease))
dDay = "0" + CStr(Day(dRelease))
dYear = CStr(Year(dRelease))
fHoliday = Filter(aHoliday,Right(dMonth,2) + "/" + Right(dDay,2) + "/" + dYear)
'fHoliday = Filter(aHoliday,dNow)
'result = UBound(fHoliday)
'result = Left(dRelease,10)
'result = CStr(DatePart("m",Date)) + "/" + CStr(DatePart("d",Date)) + "/" + CStr(DatePart("yyyy",Date))
'While release date is a weekend, or release date is a holiday
Do While (WeekDay(dRelease) = 1) OR (WeekDay(dRelease) = 7) OR (UBound(fHoliday) > -1) OR (tRelease >17)
'increase release date by 1
dRelease = dRelease + 1
'result = dRelease
'check for holiday
dMonth = "0" + CStr(Month(dRelease))
dDay = "0" + CStr(Day(dRelease))
dYear = CStr(Year(dRelease))
'fHoliday = Filter(aHoliday,Left(dRelease,10))
fHoliday = Filter(aHoliday,Right(dMonth,2) + "/" + Right(dDay,2) + "/" + dYear)
tRelease = 00
Loop
'Format the release date to the Esker deferred date/time standard.
dMonth = "0" + CStr(Month(dRelease))
dDay = "0" + CStr(Day(dRelease))
dYear = CStr(Year(dRelease))
dtCurrent = Right(dMonth,2) + "/" + Right(dDay,2) + "/" + dYear
If dRelease > Now Then
tRelease = "00:" + mRelease
Else
tRelease = CStr(Hour(Now)) + ":" + CStr(Minute(Now))
End If
result = dtCurrent + " " + tRelease
Change this:
Do While (WeekDay(dRelease) = 1) OR (WeekDay(dRelease) = 7) OR (UBound(fHoliday) > -1) OR (tRelease >17)
...
Loop
into this:
If (WeekDay(dRelease) = 1) Or (WeekDay(dRelease) = 7) Or (UBound(fHoliday) > -1) Or (Time > CDate("16:30")) Then
...
End If
I have this string:
0|1|2|3|4|5|6|7|8|9
I need to return the text after the 6th occurence of | and before the 7th. In this example, it would be 6.
Can his be achieved using the simple String functions (Mid, Left, Right, InStr)?
In addition, you could use a RegExp to look for the possibly empty sequence of non-| before a | and after 6 such sequences:
>> Set r = New RegExp
>> r.Pattern = "^(?:[^\|]*\|){6}([^\|]*)\|"
>> WScript.Echo r.Execute("0|1|2|3|4|5|6|7|8|9")(0).SubMatches(0)
>>
6
For production code, you'd need a check against non-confirming data.
s = "0|1|2|3|4|5|6|7|8|9"
For i = 1 To 6
intPos1 = InStr(intPos1 + 1, s, "|")
If intPos1 = 0 Then Exit For
Next
If intPos1 > 0 Then
intPos2 = InStr(intPos1 + 1, s, "|")
If intPos2 > intPos1 Then MsgBox Mid(s, intPos1 + 1, intPos2 - intPos1 - 1)
End If
Or, like #Filburt said, it could be a one-liner with Split():
MsgBox Split(s, "|")(6)
Dim s, c, n, i, p, e, r
s = "0|1|2|3|4|5|6|7|8|9" ' examined string
c = "|" ' split char
n = 6 ' occurance to start from
i = 0
p = 0
r = ""
Do
p = InStr(p + 1, s, c)
If p = 0 Then Exit Do
i = i + 1
If i = n Then
e = InStr(p + 1, s, c)
If e > 0 Then r = Mid(s, p + 1, e - p - 1)
Exit Do
End If
Loop
MsgBox r
I have a script that outputs a .bmp captcha image.
The image is built in hexadecimal, and converted to binary and sent to the browser via response.binaryWrite chrB(CByte(myHexImage)) (as an image mime type = bmp)
I want the option to move away from that (changing mime type, etc) and toward just sending something to the output like this:
data:image/jpeg;base64,/9j/4AAQSkZJRgABAQAAAQABAAD/2 ...
(except that my images are BMP)
Is there a quick and easy way to convert that hex or binary to base64 in vbscript? Here is a snippet of what I have implmented now as described above.
how can I change this so I output, to the screen, valid hex format (which i can then easily convert to base64) or base64 directly?
Dim sBmpEndLine, sBmpInfoHeader, sBmpHeader, sTmpHex
If (m_iBmpWidth Mod 4) <> 0 Then
sBmpEndLine = string((4 - (m_iBmpWidth Mod 4)) * 2, "0")
Else
sBmpEndLine = vbNullString
End If
sBmpInfoHeader = array("28000000", "00000000", "00000000", "0100", "0800", "00000000", "00000000", "120B0000", "120B0000", "00000000", "00000000")
sBmpInfoHeader(1) = formatHex(hex(m_iBmpWidth), 4, 0, True)
sBmpInfoHeader(2) = formatHex(hex(m_iBmpHeight), 4, 0, True)
sBmpInfoHeader(6) = formatHex(hex((m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
sBmpInfoHeader(9) = formatHex(hex(len(m_sBmpColorMap) / 8), 4, 0, True)
sBmpInfoHeader(10) = sBmpInfoHeader(9)
sBmpHeader = array("424D", "00000000", "0000", "0000", "00000000")
sBmpHeader(1) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2) + (m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
sBmpHeader(4) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2)), 4, 0, True)
sendHex(join(sBmpHeader, ""))
sendHex(join(sBmpInfoHeader, ""))
sendHex(m_sBmpColorMap)
For y = m_iBmpHeight To 1 Step -1
For x = 1 To m_iBmpWidth
sTmpHex = m_aBitmap(y, x)
If sTmpHex = vbNullString Then
sendHex(m_sBgColor)
Else
sendHex(sTmpHex)
End If
Next
sendHex(sBmpEndLine)
Next
Response.Flush
And here is the sendHex() function:
Private Sub sendHex(valHex)
Dim iCntHex
For iCntHex = 1 To len(valHex) Step 2
'Response.BinaryWrite chrB(CByte("&H" & mid(valHex, iCntHex, 2)))
response.Write "&H" & mid(valHex, iCntHex, 2)
Next
End Sub
The Microsoft.XMLDOM has built in converters for bin.base64 and bin.hex. I wrote functions that demonstrate how to use this:
Function TextToBinary(text, dataType)
Dim dom
Set dom = CreateObject("Microsoft.XMLDOM")
dom.loadXML("<HELLO/>")
dom.documentElement.nodeTypedValue = text
dom.documentElement.dataType = dataType
TextToBinary = dom.documentElement.nodeTypedValue
End Function
Function BinaryToText(binary, dataType)
Dim dom
Set dom = CreateObject("Microsoft.XMLDOM")
dom.loadXML("<HELLO/>")
dom.documentElement.dataType = dataType
dom.documentElement.nodeTypedValue = binary
dom.documentElement.removeAttribute("dt:dt")
BinaryToText = dom.documentElement.nodeTypedValue
End Function
Function HexToBase64(strHex)
HexToBase64 = BinaryToText(TextToBinary(strHex, "bin.hex"), "bin.base64")
End Function
Function Base64ToHex(strBase64)
Base64ToHex = BinaryToText(TextToBinary(strBase64, "bin.base64"), "bin.hex")
End Function
Here's an example of their usage:
MsgBox HexToBase64("41")
MsgBox Base64ToHex("QQ==")
Also look at the ADODB.Stream as a means of working with binary files. It'll work with these routines.
I was able to get this working. Here is how.
In sendHex, I removed the &H portion, and wrapped my string in hex():
Private Sub sendHex(valHex)
Dim iCntHex
For iCntHex = 1 To len(valHex) Step 2
If len( mid(valHex, iCntHex, 2)) = 1 Then
response.write "0"
end if
response.write mid(valHex, iCntHex, 2)
Next
End Sub
This results in a string output like this (in byte strings of 2 hexidecimal chars):
424d1e050000000000003e00000028000000340000001800000001000
I can then dump that proper hex string into a HEX to base64 function as follows (not written by me, but rather, by Richard Mueller - http://www.rlmueller.net/Base64.htm)
Function HexToBase64(strHex)
' Function to convert a hex string into a base64 encoded string.
' Constant B64 has global scope.
Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm
intLen = Len(strHex)
' Pad with zeros to multiple of 3 bytes.
intTerm = intLen Mod 6
If (intTerm = 4) Then
strHex = strHex & "00"
intLen = intLen + 2
End If
If (intTerm = 2) Then
strHex = strHex & "0000"
intLen = intLen + 4
End If
' Parse into groups of 3 hex bytes.
j = 0
strWord = ""
HexToBase64 = ""
For k = 1 To intLen Step 2
j = j + 1
strWord = strWord & Mid(strHex, k, 2)
If (j = 3) Then
' Convert 3 8-bit bytes into 4 6-bit characters.
lngValue = CCur("&H" & strWord)
lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1)
lngValue = lngTemp
lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1) & str64
lngValue = lngTemp
lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1) & str64
str64 = Mid(B64, lngTemp + 1, 1) & str64
HexToBase64 = HexToBase64 & str64
j = 0
strWord = ""
End If
Next
' Account for padding.
If (intTerm = 4) Then
HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 1) & "="
End If
If (intTerm = 2) Then
HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
End If
End Function
This converts the above to base64, and I can use the output like this (e.g. in a browser url bar) to view it as an image:
data:image/bmp;base64,Qk0eBQAAAAAAAD4AAAAo...
I want to write a program to convert from decimal to negabinary.
I cannot figure out how to convert from decimal to negabinary.
I have no idea about how to find the rule and how it works.
Example: 7(base10)-->11011(base-2)
I just know it is 7 = (-2)^0*1 + (-2)^1*1 + (-2)^2*0 + (-2)^3*1 + (-2)^4*1.
The algorithm is described in http://en.wikipedia.org/wiki/Negative_base#Calculation. Basically, you just pick the remainder as the positive base case and make sure the remainder is nonnegative and minimal.
7 = -3*-2 + 1 (least significant digit)
-3 = 2*-2 + 1
2 = -1*-2 + 0
-1 = 1*-2 + 1
1 = 0*-2 + 1 (most significant digit)
def neg2dec(arr):
n = 0
for i, num in enumerate(arr[::-1]):
n+= ((-2)**i)*num
return n
def dec2neg(num):
if num == 0:
digits = ['0']
else:
digits = []
while num != 0:
num, remainder = divmod(num, -2)
if remainder < 0:
num, remainder = num + 1, remainder + 2
digits.append(str(remainder))
return ''.join(digits[::-1])
Just my two cents (C#):
public static int[] negaBynary(int value)
{
List<int> result = new List<int> ();
while (value != 0)
{
int remainder = value % -2;
value = value / -2;
if (remainder < 0)
{
remainder += 2;
value += 1;
}
Console.WriteLine (remainder);
result.Add(remainder);
}
return result.ToArray();
}
There is a method (attributed to Librik/Szudzik/Schröppel) that is much more efficient:
uint64_t negabinary(int64_t num) {
const uint64_t mask = 0xAAAAAAAAAAAAAAAA;
return (mask + num) ^ mask;
}
The conversion method and its reverse are described in more detail in this answer.
Here is some code that solves it and display the math behind it.
Some code taken from "Birender Singh"
#https://onlinegdb.com/xR1E5Cj7L
def neg2dec(arr):
n = 0
for i, num in enumerate(arr[::-1]):
n+= ((-2)**i)*num
return n
def dec2neg(num):
oldNum = num
if num == 0:
digits = ['0']
else:
digits = []
while num != 0:
num, remainder = divmod(num, -10)
if remainder < 0:
num, remainder = num + 1, remainder + 10
print(str(oldNum) + " = " + str(num) + " * -10 + " + str(remainder))
oldNum = num
digits.append(str(remainder))
return ''.join(digits[::-1])
print(dec2neg(-8374932))
Output:
-8374932 = 837494 * -10 + 8
837494 = -83749 * -10 + 4
-83749 = 8375 * -10 + 1
8375 = -837 * -10 + 5
-837 = 84 * -10 + 3
84 = -8 * -10 + 4
-8 = 1 * -10 + 2
1 = 0 * -10 + 1
12435148
I want a function to calculate numerology.For example if i enter "XYZ" then my output should be 3 .
Here is how it became 3:
X = 24
Y = 25
Z = 26
on adding it becomes 75 which again adds up to 12 (7+5) which again adds up to 3(1+2) . Similarly whatever names i should pass,my output should be a single digit score.
Here you are:
Function Numerology(Str)
Dim sum, i, char
' Convert the string to upper case, so that 'X' = 'x'
Str = UCase(Str)
sum = 0
' For each character, ...
For i = 1 To Len(Str)
' Check if it's a letter and raise an exception otherwise
char = Mid(Str, i , 1)
If char < "A" Or char > "Z" Then Err.Raise 5 ' Invalid procedure call or argument
' Add the letter's index number to the sum
sum = sum + Asc(char) - 64
Next
' Calculate the result using the digital root formula (http://en.wikipedia.org/wiki/Digital_root)
Numerology = 1 + (sum - 1) Mod 9
End Function
In vbscript:
Function numerology(literal)
result = 0
for i = 1 to Len(literal)
'' // for each letter, take its ASCII value and substract 64,
'' so "A" becomes 1 and "Z" becomes 26
result = result + Asc(Mid(literal, i, 1)) - 64
next
'' // while result is bigger than 10, let's sum it's digits
while(result > 10)
partial = 0
for i = 1 to Len(CStr(result))
partial = partial + CInt(Mid(CStr(result), i, 1))
next
result = partial
wend
numerology = result
End Function
I have no idea what this could possible be used for but it was fun to write anyway.
Private Function CalcStupidNumber(ByVal s As String) As Integer
s = s.ToLower
If (s.Length = 1) Then 'End condition
Try
Return Integer.Parse(s)
Catch ex As Exception
Return 0
End Try
End If
'cover to Values
Dim x As Int32
Dim tot As Int32 = 0
For x = 0 To s.Length - 1 Step 1
Dim Val As Integer = ConvertToVal(s(x))
tot += Val
Next
Return CalcStupidNumber(tot.ToString())
End Function
Private Function ConvertToVal(ByVal c As Char) As Integer
If (Char.IsDigit(c)) Then
Return Integer.Parse(c)
End If
Return System.Convert.ToInt32(c) - 96 ' offest of a
End Function