Modulus In VB 6.0 - vb6

I want to ask about how modulus does not work for me.
For example:
Option Explicit
Private Function Modulus_Operator(Value1, Value2)
Modulus_Operator = Value1 - (Int(Value1 / Value2) * Value2)
End Function
Private Sub Form_Activate()
Dim A, B, BaseOut as double
A = 67^89
BaseOut = 35
text1.text = Modulus_Operator(A, BaseOut)
End Sub

Your function must return an integer. You mustn't to forget types:
Private Function Modulus_Operator(Value1 as integer, Value2 as integer) as integer
Modulus_Operator = Value1 - (Int(Value1 / Value2) * Value2)
End Function
Anyway... do you know about mod for modulus?

You try something 'impossible'. Do you know the range of values an integer can store? Your value 67^89 is far beyond this value, so you get an overflow.

You can use the following code:
Private Sub Form_Activate()
Dim A, B, BaseOut As Double
A = 67 ^ 89
BaseOut = 35
Text1.Text = Modulus_Operator(Val(A), Val(BaseOut))
End Sub
Private Function Modulus_Operator(Value1 As Double, Value2 As Double) As Double
Modulus_Operator = Value1 - (Int(Value1 / Value2) * Value2)
End Function

Related

How do I extract numbers from a string in VB6?

I have a string that looks something like 'NS-BATHROOMS 04288'
I only want the numbers.
I hve searched for answers, but none so far even get pst the compiler.
How can I do this?
without regex you can do it with: (altough VB6/VBA Code really isn`t nice to look at)
Public Function ReturnNonAlpha(ByVal sString As String) As String
Dim i As Integer
For i = 1 To Len(sString)
If Mid(sString, i, 1) Like "[0-9]" Then
ReturnNonAlpha = ReturnNonAlpha + Mid(sString, i, 1)
End If
Next i
End Function
I'd personally use regex. You can match given regex patterns to achieve what you need. This function matches only digits.
For VB6 you'd do something like:
Dim myRegExp, ResultString
Set myRegExp = New RegExp
myRegExp.Global = True
myRegExp.Pattern = "[\d]"
Then you'd go against your String.
https://support.microsoft.com/en-us/kb/818802
You can use this function for extract numerical chr as string value:
Public Function Str_To_Int(MyString As Variant) As Long
Dim i As Integer
Dim X As Variant
If IsNull(MyString) Or MyString = "" Then
Str_To_Int = 0
Exit Function
End If
For i = 1 To Len(MyString)
If IsNumeric(Mid(MyString, i, 1)) = True Then
X = Nz(X, "") & Mid(MyString, i, 1)
End If
Next i
Str_To_Int = Nz(X, 0)
End Function

VB ASCB in LotusScript?

Working on converting a Visual Basic SHA-256 encryption routine to work in LotusScript.
Is going well except for the VB's AscB command.
Found: "Use the AscB function to return the first byte of a string containing byte data."
Not finding way to do same in LotusScript.
See the LS CByte command comes close: "CByte returns an expression that has been converted to Byte."
Don't see way to have it return just the first Byte of the expression.
Any suggestions?
Derek
AscB is only appropriate for strings in single-byte character encoding. All LotusScript string data is Unicode represented in UTF16 double-byte encoding.
The LotusScript Uni() function returns a Long containing the integer value of the Unicode character. Since the input is a double byte character, the value returned by Uni() ranges from 0 to 65535. If you want to get the values of each of the two bytes, code like this will do the trick:
Dim ws As New NotesUIWorkspace
Dim s1 As String
Dim u1 As Long
Dim u2 As Long
Dim lowbyte As Integer
Dim highbyte As Integer
Dim b1 As Byte
Dim b2 as Byte
s1 = "Ʃ"
u1 = Uni(s1)
lowbyte = u1 Mod 256
highbyte = (u1 - lowbyte) / 256
b1 = Cbyte(lowbyte)
b2 = Cbyte(highbyte)
Call ws.Prompt(prompt_ok,"test",s1 + " " + Cstr(Cint(b1)) + " " + Cstr(Cint(b2)))
Would Asc, LeftB and RightB do what you need?
In my testing...
Lenb("A") = 2
Leftb("A", 1) = "A"
Asc(Leftb("A", 1)) = 65
Leftb("A", 2) = "A"
Asc(Leftb("A", 2)) = 65
Asc(Rightb(Leftb("A", 2), 1)) = 0

Using CryptHashData On Very Large Input

I am trying to MD5 hash user-supplied data (a file) using The Crypto functions in AdvApi32. All is well and good unless the file is very large (hundreds of MB. or larger) in which case I eventually get an OutOfMemory exception.
I figured that the solution would be to make repeated calls to CryptHashData using the same HashObject and processing only (for example) 4096 bytes at a time.
This appears to work, but the returned hash is incorrect.
Function HashFile(File As FolderItem) As String
Declare Function CryptAcquireContextW Lib "AdvApi32" (ByRef provider as Integer, container as Integer, providerName as WString, _
providerType as Integer, flags as Integer) as Boolean
Declare Sub CryptDestroyHash Lib "AdvApi32" (hashHandle as Integer )
Declare Function CryptCreateHash Lib "AdvApi32" (provider as Integer, algorithm as Integer, key as Integer, flags as Integer, _
ByRef hashHandle as Integer) as Boolean
Declare Function CryptHashData Lib "AdvApi32" (hashHandle as Integer, data as Ptr, length as Integer, flags as Integer) as Boolean
Declare Function CryptGetHashParam Lib "AdvApi32" (hashHandle as Integer, type as Integer, value as Ptr, ByRef length as Integer, _
flags as Integer) as Boolean
Const HP_HASHVAL = &h0002
Const HP_HASHSIZE = &h0004
Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Const PROV_RSA_FULL = 1
Const CRYPT_NEWKEYSET = &h00000008
Const CALG_MD5 = &h00008003
Dim provider As Integer
Dim hashHandle As Integer
If Not CryptAcquireContextW(provider, 0, MS_DEF_PROV, PROV_RSA_FULL, 0) Then
If Not CryptAcquireContextW(provider, 0, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET) Then
Raise New RuntimeException
End If
End If
If Not CryptCreateHash(provider, CALG_MD5, 0, 0, hashHandle) Then
Raise New RuntimeException
End If
Dim dataPtr As New MemoryBlock(4096)
Dim bs As BinaryStream
bs = bs.Open(File)
dataPtr.StringValue(0, 4096) = bs.Read(4096)
Do
If CryptHashData(hashHandle, dataPtr, dataPtr.Size, 0) Then
dataPtr = New MemoryBlock(4096)
dataPtr.StringValue(0, 4095) = bs.Read(4096)
End If
Loop Until bs.EOF
Dim size as Integer = 4
Dim toss As New MemoryBlock(4)
If Not CryptGetHashParam(hashHandle, HP_HASHSIZE, toss, size, 0) Then
Raise New RuntimeException
End If
size = toss.UInt32Value(0)
Dim hashValue As New MemoryBlock(size)
If Not CryptGetHashParam(hashHandle, HP_HASHVAL, hashValue, size, 0) Then
Raise New RuntimeException
End If
CryptDestroyHash(hashHandle)
//Convert binary to hex
Dim hexvalue As Integer
Dim hexedInt As String
Dim src As String = hashValue.StringValue(0, hashValue.Size)
For i As Integer = 1 To LenB(src)
hexvalue = AscB(MidB(src, i, 1))
hexedInt = hexedInt + RightB("00" + Hex(hexvalue), 2)
next
Return LeftB(hexedInt, LenB(hexedInt))
End Function
What am I doing wrong here? The output I get is consistent, but wrong.
Did you check that msdn example on C++ ?
Very similar answer to your question.
I think the problem is that since you read the data in blocks of 4096 bytes - when the data is not a multiple of 4096 you endup including unwanted trailing 0's or possibly garbage values. Try bs.Read(1) instead of bs.Read(4096) in the loop: Loop Until bs.EOF in-order to test if correct hash is being calculated now. If successful adjust your loop to tackle the remainder (%4096) bytes separately.

VB6: How to pass temporary to a function in Visual Basic 6

In C++ it is possible to pass a temporary object argument to a function:
struct Foo
{
Foo(int arg);
// ...
}
void PrintFoo(const Foo& f);
PrintFoo(Foo(10))
I am trying to implement something similar in Visual Basic 6:
'# Scroll bar params
Public Type ScrollParams
sbPos As Long
sbMin As Long
sbMax As Long
End Type
Public Function MakeScrollParams(pos As Long, min As Long, max As Long)
Dim params As ScrollParams
With params
.sbPos = pos
.sbMin = min
.sbMax = max
End With
Set MakeScrollParams = params
End Function
'# Set Scroll bar parameters
Public Sub SetScrollParams(sbType As Long, sbParams As ScrollParams)
Dim hWnd As Long
' ...
End Sub
However, Call SetScrollParams(sbHorizontal, MakeScrollParams(3, 0, 10)) raises an error: ByRef argument type mismatch. Why?
A couple of things need to change from your existing code:
You need to strongly-type the declaration of the MakeScrollParams function.
It returns an instance of the ScrollParams type, so you should specify that explicitly in the declaration. Like so:
Public Function MakeScrollParams(pos As Long, min As Long, max As Long) As ScrollParams
You need to remove the Set keyword from the last line in that function in order to avoid an "Object Required" compilation error. You can only use Set with objects, such as instances of classes. For regular value types, you omit it altogether:
MakeScrollParams = params
So the full function declaration would look like this:
Public Function MakeScrollParams(pos As Long, min As Long, max As Long) As ScrollParams
Dim params As ScrollParams
With params
.sbPos = pos
.sbMin = min
.sbMax = max
End With
MakeScrollParams = params
End Function
And calling it like this:
Call SetScrollParams(sbHorizontal, MakeScrollParams(3, 0, 10))
now works perfectly.
Maybe?
Public Function MakeScrollParams(pos As Long, min As Long, max As Long) As ScrollParams

how do you parse a string in vb6?

Some of us unfortunately are still supporting legacy app like VB6. I have forgotten how to parse a string.
Given a string:
Dim mystring As String = "1234567890"
How do you loop in VB6 through each character and do something like
for each character in mystring
debug.print character
next
In C# i would do something like
char[] myChars = mystring.ToCharArray();
foreach (char c in theChars)
{
//do something with c
}
Any ideas?
Thanks a lot
You can use the 'Mid' function to get at the individual characters:
Dim i As Integer
For i = 1 To Len(mystring)
Print Mid$(mystring, i, 1)
Next
Note this is untested.
There is no possibility to use foreach on strings.
Use
Dim i As Integer
For i = 1 To Len(YourString)
Result = Mid$(YourString, i, 1)
Next
note that the type of Result is a length-1 string, no char or byte type.
If performance is important, you'll have to convert the string to a bytearray fist (using StrConv) and then loop through it like this.
Dim i As Long
For i = 0 To UBound(Data)
Result = Data(i) ' Type is Byte '
Next
This is much more efficient.
The easiest way is to convert the string into an array of bytes and iterate over the byte array (converting each byte to a character).
Dim str As String
Dim bytArray() As Byte
Dim count As Integer
str = "This is a string."
bytArray = str
For count = 0 To UBound(bytArray)
Debug.Print Chr(bytArray(count))
Next
Don't loop; rather, set a reference to Microsoft VBScript Regular Expressions library and use regular expressions to achieve your 'do something' goal.

Resources