RealBasic byte to string - realbasic

In RealBasic, is there a way to convert a byte to a string?

If you mean turn a Byte into a string representation of the byte in Binary (or hex or Octal), then:
Dim x As Byte = 24 //For example
Dim z, y, w As String
y = Bin(x) //Binary = "11000"
z = Hex(x) //Hexadecimal = "18"
w = Oct(x) //Octal = "30"

You could use MemoryBlock:
Dim m As MemoryBlock
m = NewMemoryBlock(1)
m.Byte(0) = 65
MsgBox(m.StringValue(0, 1)) // Displays "A"
Of course, Chr(65) does the same thing...

Related

Change authKey of a user

Using SNMP version 3, I am creating a user.
Right now, I have it set up where I clone a user and that works just fine. However, I need to change the new user's authKey. How can I do this? I know the oid for authKeyChange, however, I don't know how to generate the new key. How do I generate that key? Can it be done using SNMPSharpNet?
If there is an easier way to do this while I'm creating the user, I can do that as well. ANY way to change the authKey (and privKey, but one step at a time) is much appreciated. I'm using VB.net if it means anything.
So I've figured out how to do this. It's a bit of a complex process. I followed this document, which is rfc2574. Do a ctrl+F for "keyChange ::=" and you'll find the paragraph walking you through the algorithm to generate the keyChange value. The following code has worked reliably to generate the keyChange value. All you have to do from this point is push the keyChange value to the usmAuthKeyChange OID. If you are changing the privacy password, you push the keyChange value to the usmPrivKeyChange OID. I'm ashamed to say that due to the time crunch, I did not have time to make this work completely, so when using SHA, I had to code an entirely new method that did almost the exact same thing. Again, I'm ashamed to post it, but I know how much I was banging my head against a wall, and if someone comes here later and sees this, I would like them to know what to do without going through the struggle.
Here is all of the code you need using VB.Net and the SNMPSharpNet library:
Private Function GenerateKeyChange(ByVal newPass As String, ByVal oldPass As String, ByRef target As UdpTarget, ByRef param As SecureAgentParameters) As Byte()
Dim authProto As AuthenticationDigests = param.Authentication
Dim hash As IAuthenticationDigest = Authentication.GetInstance(authProto)
Dim L As Integer = hash.DigestLength
Dim oldKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(oldPass), param.EngineId)
Dim newKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(newPass), param.EngineId)
Dim random() As Byte = Encoding.UTF8.GetBytes(GenerateRandomString(L))
Dim temp() As Byte = oldKey
Dim delta(L - 1) As Byte
Dim iterations As Integer = ((newKey.Length - 1) / L) - 1
Dim k As Integer = 0
If newKey.Length > L Then
For k = 0 To iterations
'Append random to temp
Dim merged1(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged1, 0)
random.CopyTo(merged1, random.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged1, 0, merged1.Length)
'Generate the first 16 values of delta
For i = 0 To L - 1
delta(k * L + i) = temp(i) Xor newKey(k * L + i)
Next
Next
End If
'Append random to temp
Dim merged(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged, 0)
random.CopyTo(merged, temp.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged, 0, merged.Length)
'Generate the first 16 values of delta
For i = 0 To (newKey.Length - iterations * L) - 1
delta(iterations * L + i) = temp(i) Xor newKey(iterations * L + i)
Next
Dim keyChange(delta.Length + random.Length - 1) As Byte
random.CopyTo(keyChange, 0)
delta.CopyTo(keyChange, random.Length)
Return keyChange
End Function
Private Function GenerateKeyChangeShaSpecial(ByVal newPass As String, ByVal oldPass As String, ByRef target As UdpTarget, ByRef param As SecureAgentParameters) As Byte()
Dim authProto As AuthenticationDigests = param.Authentication
Dim hash As IAuthenticationDigest = Authentication.GetInstance(authProto)
Dim L As Integer = 16
Dim oldKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(oldPass), param.EngineId)
Dim newKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(newPass), param.EngineId)
Array.Resize(oldKey, L)
Array.Resize(newKey, L)
Dim random() As Byte = Encoding.UTF8.GetBytes(GenerateRandomString(L))
Dim temp() As Byte = oldKey
Dim delta(L - 1) As Byte
Dim iterations As Integer = ((newKey.Length - 1) / L) - 1
Dim k As Integer = 0
If newKey.Length > L Then
For k = 0 To iterations
'Append random to temp
Dim merged1(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged1, 0)
random.CopyTo(merged1, random.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged1, 0, merged1.Length)
Array.Resize(temp, L)
'Generate the first 16 values of delta
For i = 0 To L - 1
delta(k * L + i) = temp(i) Xor newKey(k * L + i)
Next
Next
End If
'Append random to temp
Dim merged(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged, 0)
random.CopyTo(merged, temp.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged, 0, merged.Length)
Array.Resize(temp, L)
'Generate the first 16 values of delta
For i = 0 To (newKey.Length - iterations * L) - 1
delta(iterations * L + i) = temp(i) Xor newKey(iterations * L + i)
Next
Dim keyChange(delta.Length + random.Length - 1) As Byte
random.CopyTo(keyChange, 0)
delta.CopyTo(keyChange, random.Length)
Return keyChange
End Function
Private Function GenerateRandomString(ByVal length As Integer) As String
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Dim r As New Random
Dim sb As New StringBuilder
For i As Integer = 1 To length
Dim idx As Integer = r.Next(0, 51)
sb.Append(s.Substring(idx, 1))
Next
Return sb.ToString()
End Function
Again, I am oh so well aware this code is hideous, but it works, and that is all I needed in the meantime. I understand this is technical debt and not the way I should code, but it's here and I hope you can get some use out of it.
If this doesn't work, don't forget to go to frc2574 and look at the algorithm.

How can I convert numbers to letters in VBS?

I want to take a number and convert it into lowercase a-z letters using VBScript.
For example:
1 converts to a
2 converts to b
27 converts to aa
28 converts to ab
and so on...
In particular I am having trouble converting numbers after 26 when converting to 2 letter cell names. (aa, ab, ac, etc.)
You should have a look at the Chr(n) function.
This would fit your needs from a to z:
wscript.echo Chr(number+96)
To represent multiple letters for numbers, (like excel would do it) you'll have to check your number for ranges and use the Mod operator for modulo.
EDIT:
There is a fast food Copy&Paste example on the web: How to convert Excel column numbers into alphabetical characters
Quoted example from microsoft:
For example: The column number is 30.
The column number is divided by 27: 30 / 27 = 1.1111, rounded down by the Int function to "1".
i = 1
Next Column number - (i * 26) = 30 -(1 * 26) = 30 - 26 = 4.
j = 4
Convert the values to alphabetical characters separately,
i = 1 = "A"
j = 4 = "D"
Combined together, they form the column designator "AD".
And its code:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Neither of the solutions above work for the full Excel range from A to XFD. The first example only works up to ZZ. The second example has boundry problems explained in the code comments below.
//
Function ColumnNumberToLetter(ColumnNumber As Integer) As String
' convert a column number to the Excel letter representation
Dim Div As Double
Dim iMostSignificant As Integer
Dim iLeastSignificant As Integer
Dim Base As Integer
Base = 26
' Column letters are base 26 starting at A=1 and ending at Z=26
' For base 26 math to work we need to adjust the input value to
' base 26 starting at 0
Div = (ColumnNumber - 1) / Base
iMostSignificant = Int(Div)
' The addition of 1 is needed to restore the 0 to 25 result value to
' align with A to Z
iLeastSignificant = 1 + (Div - iMostSignificant) * Base
' convert number to letter
ColumnNumberToLetter = Chr(64 + iLeastSignificant)
' if the input number is larger than the base then the conversion we
' just did is the least significant letter
' Call the function again with the remaining most significant letters
If ColumnNumber > Base Then
ColumnNumberToLetter = ColumnNumberToLetter(iMostSignificant) & ColumnNumberToLetter
End If
End Function
//
try this
function converts(n)
Dim i, c, m
i = n
c = ""
While i > 26
m = (i mod 26)
c = Chr(m+96) & c
i = (i - m) / 26
Wend
c = Chr(i+96) & c
converts = c
end function
WScript.Echo converts(1000)

Converting VERY large number to a hex string

Public Function MyMod(a As Double, b As Double) As Double
MyMod = a - Int(a / b) * b
End Function
This code doesn't work as it doesn't correctly show the remainder do be able to then calculate HEX.
Correct : 10009335357561071 / 16 = 62558345984756.69
VB6 MyMod returns 0 instead of a valid remainder.
I have been unable to figure out how to convert such a large value into a hex string?
I was able to code it myself. Because of the vb6 limitations of the size of a number, I had to go about it in different ways. I needed this to be able to covert VERY LARGE WHOLE numbers to Binary and Hexadecimal.
This this code, there are three functions you can use.
1) Decimal 2 Hex
2) Binary to Hex
3) Decimal 2 Binary
The code works and gives me CORRECT returns for the VERY large numbers.
Public Function Dec2Hex(Dec As String) As String
Dec2Hex = Binary2Hex(Dec2Bin(Dec))
End Function
Public Function Binary2Hex(Binary As String, Optional Pos As Long = 0) As String
Dim tic As Long
Dim Sz As Long
Dim x As Long
Dim z As Long
Dim AT As Long
Dim Hx As Long
Dim HxB As String
Dim xstart As Long
Dim xstop As Long
HxB = vbNullString
If InStrB(Binary, " ") <> 0 Then Binary = Replace(Binary, " ", "")
Sz = Len(Binary)
xstart = Sz
xstop = xstart - 3
Do
AT = 0
Hx = 0
If xstop < 1 Then xstop = 1
For x = xstart To xstop Step -1
AT = AT + 1
If AscB(Mid$(Binary, x, 1)) = 49 Then
Select Case AT
Case 1: Hx = Hx + 1
Case 2: Hx = Hx + 2
Case 3: Hx = Hx + 4
Case 4: Hx = Hx + 8
End Select
End If
Next x
HxB = Digit2Hex(CStr(Hx)) + HxB
If x <= 1 Then Exit Do
xstart = x
xstop = xstart - 3
Loop
Binary2Hex = HxB
End Function
Private Function Digit2Hex(digit As String) As String
Select Case digit
Case "0": Digit2Hex = "0"
Case "1": Digit2Hex = "1"
Case "2": Digit2Hex = "2"
Case "3": Digit2Hex = "3"
Case "4": Digit2Hex = "4"
Case "5": Digit2Hex = "5"
Case "6": Digit2Hex = "6"
Case "7": Digit2Hex = "7"
Case "8": Digit2Hex = "8"
Case "9": Digit2Hex = "9"
Case "10": Digit2Hex = "A"
Case "11": Digit2Hex = "B"
Case "12": Digit2Hex = "C"
Case "13": Digit2Hex = "D"
Case "14": Digit2Hex = "E"
Case "15": Digit2Hex = "F"
Case Else: Digit2Hex = vbNullString
End Select
End Function
Public Function Dec2Bin(Dec As String) As String
Dim Bin As String
Dim Var As Variant
Dim p As Long
Dim Tmp As String
Bin = vbNullString
Tmp = Dec
Do
Bin = IIf(isEven(Tmp), "0", "1") + Bin
Var = CDec(Tmp)
Var = Var / 2
Tmp = CStr(Var)
p = InStr(Tmp, ".")
If p > 0 Then Tmp = Mid(Tmp, 1, p - 1)
If Len(Tmp) = 1 Then
If CLng(Tmp) = 0 Then Exit Do
End If
Loop
Dec2Bin = Bin
End Function
Public Function isEven(Dec As String) As Boolean
Dim OE As Long
Dim myDec As Variant
OE = CLng(Right$(CStr(Dec), 1))
isEven = (OE = 0 Or OE = 2 Or OE = 4 Or OE = 6 Or OE = 8)
End Function
The only convenient data type in VB6 that can accurately represent 10009335357561071 is the Variant's Decimal subtype. Both Double and Currency native types lack the precision required.
There is also the matter of handling signed values and for that matter how many bytes of precision are desired, whether leading zeros should be suppressed, and probably others.
It is very hard to conceive of a need for this in a real application.
Even if we presume you are doing something "especially special" or if some instructor has given you this problem as an aid to general understanding...
... there just isn't much you can do with this without a BigNum library of some sort, or possibly using Decimal with some care though it only gains you a few more digits of precision.
Here is a working sample (using Fix), that is not mine, credit to http://visualbasic.ittoolbox.com/groups/technical-functional/visualbasic-l/vb60-hex-function-overflow-error-2744358.
Private Function MyHex(ByVal TempDec As Double) As String
Dim TNo As Integer
MyHex = ""
Do
TNo = TempDec - (Fix(TempDec / 16) * 16)
If TNo > 9 Then
MyHex = Chr(55 + TNo) & MyHex
Else
MyHex = TNo & MyHex
End If
TempDec = Fix(TempDec / 16)
Loop Until (TempDec = 0)
End Function
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Function Dec2Hex(ByVal strDec As Variant) As String
Dim mybyte(0 To 19) As Byte
Dim lp As Long
CopyMemory mybyte(0), ByVal VarPtr(CDec(strDec)), 16
' Quick reorganise so we can then just step through the entire thing in one loop
For lp = 7 To 4 Step -1
mybyte(12 + lp) = mybyte(lp)
Next
' Build the hex string
For lp = 19 To 8 Step -1
If (Not Len(Dec2Hex) And mybyte(lp) <> 0) Or Len(Dec2Hex) Then
'Dec2Hex = Dec2Hex & Format(hex(mybyte(lp)), IIf(Len(Dec2Hex), "00", "0"))
Dec2Hex = Dec2Hex & IIf(Len(Dec2Hex), Right$("0" & hex(mybyte(lp)), 2), hex(mybyte(lp)))
End If
Next
End Function

Convert Binary to String

I want to convert a password which is stored in binary to normal ASCII form so that i can read it. I need a VBscript for that and script should also return this de-crypted password
Eg: Encrypted Binary password: 00110001 00110010 00110011 00110100
De-crypted Original password : 1234
I Tried this
'Binary contains the binary password
dim S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
MSGBOX S
But the output is
0
How can achieve this. Please help!!
If you are dealing with a byte array, you must know the character encoding before you can convert it to string. Without that knowledge the bytes will be converted to the wrong characters.
The ADODB.Stream object can handle byte arrays. Here is a function that that does that:
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeReadWrite = 3
Function BytesToString(bytes, charset)
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write bytes
.Position = 0
.Type = adTypeText
.Charset = charset
BytesToString = .ReadText
End With
End Function
And here is how to use it:
MsgBox BytesToString(binary, "Windows-1252")
For the sake of completeness, this is the reverse operation:
Function StringToBytes(str, charset)
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = charset
.Open
.WriteText str
.Position = 0
.Type = adTypeBinary
StringToBytes = .Read
End With
End Function
Since your input seems to be a string like "00110001 00110010 00110011 00110100", here is a function to convert that to a byte array, which you can then use with BytesToString() shown above:
Function BinaryStringToBytes(binaryStr)
Dim b, n, i, l
l = GetLocale
SetLocale 1031
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Charset = "Windows-1252"
.Type = adTypeText
.Open
For Each b In Split(binaryStr, " ")
If Len(b) <> 8 Or Replace(Replace(b, "0", ""), "1", "") <> "" Then
' invalid procedure call or argument
Err.Raise 5, "BinaryStringToBytes", _
"Only stings of 8-blocks of 0s and 1s, " & _
"separated by a single space are accepted."
End If
n = 0
For i = 0 To 7
n = n + Mid(b, 8 - i, 1) * 2^i
Next
.WriteText Chr(n)
Next
.Position = 0
.Type = adTypeBinary
BinaryStringToBytes = .Read
End With
SetLocale l
End Function
Usage
Dim input, output
input = "00110001 00110010 00110011 00110100"
output = BytesToString(BinaryStringToBytes(input), "Windows-1252")
MsgBox output ' -> "1234"
And, more importantly, it can handle multi-byte encodings properly:
input = "00110001 00110010 00110011 00110100 11000011 10100100"
output = BytesToString(BinaryStringToBytes(input), "UTF-8")
MsgBox output ' -> "1234รค"
try this code ;)
the code :
function BinaryToString(bin)
dim next_char
dim result
dim i
dim ascii
For i = 1 To Len(bin) + 18 Step 8
next_char = Mid(bin, i, 8)
ascii = BinaryToLong(next_char)
result = result & Chr(ascii)
Next
BinaryToString=result
end function
Function BinaryToLong(binary_value)
Dim hex_result
Dim nibble_num
Dim nibble_value
Dim factor
Dim bit
binary_value = UCase(Trim(binary_value))
If Left(binary_value, 2) = "&B" Then
binary_value = Mid(binary_value, 3)
End If
binary_value = Replace(binary_value, " ", "")
binary_value = Right(String(32, "0") & binary_value, 32)
For nibble_num = 7 To 0 Step -1
factor = 1
nibble_value = 0
For bit = 3 To 0 Step -1
If Mid(binary_value,1 + nibble_num * 4 + bit, 1) = "1" Then
nibble_value = nibble_value + factor
End If
factor = factor * 2
Next 'bit
hex_result = Hex(nibble_value) & hex_result
Next 'nibble_num
BinaryToLong = CLng("&H" & hex_result)
End Function
usage:
response.Write(BinaryToString("00110001001100100011001100110100"))
don't forget to take off " " blank spaces from the binary string
If I'm right, all you're after is converting a binary number to decimal (eg 0100 -> 4)?
dim binary, n, s
binary= "00110001"
For s = 1 To Len(binary)
n = n + (Mid(binary, Len(binary) - s + 1, 1) * (2 ^ (s - 1)))
Next 's
WScript.Echo binary & " = " & n
outputs
00110001 = 49
Converted from here: http://www.vb-helper.com/howto_decimal_to_binary.html
There are so many ways.
If it's a binary reg value then from Help (you did read it, didn't you)
The RegRead method returns values of the following five types.
Type Description In the Form of
REG_SZ
A string
A string
REG_DWORD
A number
An integer
REG_BINARY
A binary value
A VBArray of integers
REG_EXPAND_SZ
An expandable string (e.g., "%windir%\\calc.exe")
A string
REG_MULTI_SZ
An array of strings
A VBArray of strings
If a string, split on space (gives you an array of strings). The least significant bit is 2^0, 2^1, ..., 2^7.
EDIT
The normal way, not the only way though, to store a password, is to dump it in the registry.
Reading it gives you an array, not a scalar variable. So ...
The second method, handles cases where it's stored in a file.

Make a *.bmp image from binary data

How would I make a *.bmp image using 1 bit per pixel using VB6? Does an example project exist for something like this?
'# # Image Data Info : #
'# # Each black dot are represented as binary 1(high)#
'# # and white are represented as binary 0(low) in #
'# # form of hexadecimal character. #
'# # Example : (for this example assume the image width is 8)#
'# # Data : 7E817E #
'# # Binary data : 7=0111, E=1110, 8=1000, 1=0001 #
'# # 7=0111, E=1110 #
'# # Image data : px1 px2 px3 px4 px5 px6 px7 px8 #
'# # px1 w b b b b b b w #
'# # px2 b w w w w w w b #
'# # px3 w b b b b b b w #
'# # #
'# # w = white, b = black, px = pixel #
Details:
You may use the following code, please note that:
the image width must be a multiple of 8;
the rows start from the bottom;
If the requirements are not good for you, the code can be fixed accordingly.
Option Explicit
Private Type BITMAPFILEHEADER
bfType As String * 2
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGBQUAD
End Type
Public Function strToBmp(str As String, w As Integer, h As Integer, filename As String) As Boolean
Dim bmfh As BITMAPFILEHEADER
Dim bmi As BITMAPINFO
Dim r As Boolean
Dim ff As Integer
Dim i As Integer
Dim x As Integer
Dim rl As Integer
Dim rw As Integer
Dim s As String
Dim b As Byte
rw = ((w + 31) \ 32 + 3) And &HFFFFFFFC
With bmfh
.bfType = "BM"
.bfSize = Len(bmfh) + Len(bmi) + rw * h
.bfOffBits = Len(bmfh) + Len(bmi)
End With
With bmi.bmiHeader
.biSize = Len(bmi.bmiHeader)
.biWidth = w
.biHeight = h
.biPlanes = 1
.biBitCount = 1
.biCompression = 0
.biSizeImage = rw * h
.biXPelsPerMeter = 72
.biYPelsPerMeter = 72
.biClrUsed = 0
.biClrImportant = 0
End With
With bmi.bmiColors(0)
.rgbRed = 255
.rgbGreen = 255
.rgbBlue = 255
End With
On Error Resume Next
Call Kill(filename)
On Error GoTo e2
ff = FreeFile()
Open filename For Binary Access Write As #ff
On Error GoTo e1
Put #ff, , bmfh
Put #ff, , bmi
For i = 1 To Len(str) Step 2
b = CByte("&H" & Mid(str, i, 2))
Put #ff, , b
rl = rl + 1
x = x + 8
If x = w Then
b = 0
Do While rl < rw
Put #ff, , b
rl = rl + 1
Loop
x = 0
rl = 0
End If
Next i
r = True
e1:
Close ff
e2:
strToBmp = r
End Function
Public Sub test()
Call strToBmp("7E817E", 8, 3, "out.bmp")
End Sub
This is the resulting image:
Please also note that Microsoft Paint seems to have a bug which affects monochromatic images resulting in the scrambling of some pixels.

Resources