Version 20180904
This commit is contained in:
396
DPMLizenzmanagement/SHUKeyGen/StrFunc.vb
Normal file
396
DPMLizenzmanagement/SHUKeyGen/StrFunc.vb
Normal file
@@ -0,0 +1,396 @@
|
||||
Module StrFunc
|
||||
'Attribute VB_Name = "StrFuncs"
|
||||
' *
|
||||
' * StrFuncs Module
|
||||
' * Copyright (C) 2007 John Mazza.
|
||||
' *
|
||||
' * Written by John Mazza <maz@mgcworks.com>
|
||||
' *
|
||||
' * This library is free software; you can redistribute it and/or
|
||||
' * modify it under the terms of the GNU Lesser General Public
|
||||
' * License Version 2.1 as published by the Free Software Foundation.
|
||||
' *
|
||||
' * This library is distributed in the hope that it will be useful,
|
||||
' * but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
' * Lesser General Public License for more details.
|
||||
' *
|
||||
' * You should have received a copy of the GNU Lesser General Public
|
||||
' * License along with this library; if not, write to the Free Software
|
||||
' * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
' ****************************************************************************
|
||||
'
|
||||
' PURPOSE
|
||||
' String manipulation routines
|
||||
'
|
||||
' LANGUAGE
|
||||
' Visual Basic 6.0 or VBA6
|
||||
' Should work in VB.NET as well
|
||||
'
|
||||
' DEPENDENCIES:
|
||||
' None known
|
||||
'
|
||||
|
||||
|
||||
' Helper for Base32 numbers
|
||||
Const B32Map = "0123456789ABCDEFGHJKLMNPRSTVWXYZ"
|
||||
|
||||
|
||||
' General String Functions
|
||||
|
||||
' RemoveDashes() - Trivial function to delete "-" character from a string
|
||||
|
||||
Public Function RemoveDashes(ByVal StrIn As String) As String
|
||||
RemoveDashes = Replace(StrIn, "-", "")
|
||||
End Function
|
||||
|
||||
|
||||
' ShiftStrLeft() - Shift a string left by a number of bits
|
||||
|
||||
Public Function ShiftStrLeft(ByVal StrIn As String, ByVal Bits As Long) As String
|
||||
Dim CurPos As Long
|
||||
Dim WorkStr As String
|
||||
Dim RetStr As String
|
||||
Dim CurByteVal As Byte
|
||||
Dim BitMask As Byte
|
||||
Dim InvMask As Byte
|
||||
Dim ShiftBits As Byte
|
||||
Dim WholeBytes As Long
|
||||
Dim LeftPart As Byte
|
||||
Dim RightPart As Byte
|
||||
Dim Carry As Byte
|
||||
Dim PrevChar As Byte
|
||||
Dim TrimMask As Byte
|
||||
|
||||
Dim StrLen As Integer
|
||||
Dim StrBits As Integer
|
||||
|
||||
' Figure out some metrics on our input string
|
||||
|
||||
WholeBytes = Int(Bits / 8)
|
||||
ShiftBits = Bits Mod 8
|
||||
|
||||
BitMask = 255 - (2 ^ (8 - ShiftBits) - 1)
|
||||
InvMask = Not (BitMask)
|
||||
TrimMask = (2 ^ ShiftBits) - 1
|
||||
|
||||
CurPos = 1
|
||||
StrLen = Len(StrIn)
|
||||
StrBits = StrLen * 8
|
||||
WorkStr = StrIn
|
||||
|
||||
' Check we're not trying to shift more bits than
|
||||
' we have in the string.
|
||||
|
||||
If (StrBits > Bits) Then
|
||||
' First, shift string by whole bytes
|
||||
If (WholeBytes > 0) Then
|
||||
WorkStr = Right(WorkStr, StrLen - WholeBytes)
|
||||
|
||||
' Pad zero bytes to end of WorkStr to make length match
|
||||
|
||||
For CurPos = 1 To WholeBytes
|
||||
WorkStr = WorkStr & Chr(0)
|
||||
Next CurPos
|
||||
|
||||
' Ensure RetStr contains shifted string in case no other
|
||||
' bitwise shifting is performed later
|
||||
|
||||
RetStr = WorkStr
|
||||
End If
|
||||
|
||||
' Now handle the bitwise shift
|
||||
If (ShiftBits > 0) Then
|
||||
|
||||
For CurPos = 1 To Len(WorkStr)
|
||||
' Read next character of input and mask it appropriately
|
||||
CurByteVal = Asc(Mid(WorkStr, CurPos, 1))
|
||||
LeftPart = (CurByteVal And BitMask) And &HFF
|
||||
RightPart = (CurByteVal And InvMask) And &HFF
|
||||
|
||||
' Shift the masked portions
|
||||
LeftPart = Int(LeftPart / (2 ^ (8 - ShiftBits)))
|
||||
RightPart = (RightPart * (2 ^ ShiftBits))
|
||||
|
||||
If CurPos = 1 Then
|
||||
' Put the non-discarded part into PrevChar for later use
|
||||
PrevChar = (RightPart)
|
||||
RetStr = ""
|
||||
Else
|
||||
' Put carryover part into PrevChar and combine
|
||||
' the other bits with the carry from previous step
|
||||
PrevChar = PrevChar Or LeftPart
|
||||
RetStr = RetStr & Chr(PrevChar)
|
||||
PrevChar = RightPart
|
||||
End If
|
||||
|
||||
Next CurPos
|
||||
|
||||
' Combine our final carry with last char of string and mask off
|
||||
PrevChar = (PrevChar Or (LeftPart And Not (TrimMask)))
|
||||
RetStr = RetStr & Chr(PrevChar)
|
||||
|
||||
End If
|
||||
|
||||
Else
|
||||
' If we're trying to shift by more bits than
|
||||
' input string, return an equal length string
|
||||
' full of zeroes (null characters).
|
||||
|
||||
For CurPos = 1 To StrLen
|
||||
RetStr = RetStr & Chr(0)
|
||||
Next CurPos
|
||||
End If
|
||||
|
||||
ShiftStrLeft = RetStr
|
||||
|
||||
End Function
|
||||
|
||||
' ShiftStringRight() - Shift a string right a number of bits
|
||||
|
||||
Public Function ShiftStrRight(ByVal StrIn As String, ByVal Bits As Long) As String
|
||||
Dim CurPos As Long
|
||||
Dim WorkStr As String
|
||||
Dim RetStr As String
|
||||
Dim CurByteVal As Byte
|
||||
Dim BitMask As Byte
|
||||
Dim InvMask As Byte
|
||||
Dim ShiftBits As Byte
|
||||
Dim WholeBytes As Long
|
||||
Dim LeftPart As Byte
|
||||
Dim RightPart As Byte
|
||||
Dim Carry As Byte
|
||||
Dim PrevChar As Byte
|
||||
Dim TrimMask As Byte
|
||||
|
||||
Dim StrLen As Integer
|
||||
Dim StrBits As Integer
|
||||
' Calculate metrics on input
|
||||
|
||||
WholeBytes = Int(Bits / 8)
|
||||
ShiftBits = Bits Mod 8
|
||||
|
||||
BitMask = 255 - ((2 ^ ShiftBits) - 1)
|
||||
InvMask = Not (BitMask)
|
||||
TrimMask = (2 ^ ShiftBits) - 1
|
||||
|
||||
CurPos = 1
|
||||
StrLen = Len(StrIn)
|
||||
StrBits = StrLen * 8
|
||||
|
||||
' Check we're not trying to shift more bits than
|
||||
' we have in the string.
|
||||
WorkStr = StrIn
|
||||
|
||||
If (StrBits > Bits) Then
|
||||
|
||||
' First, shift string by whole bytes
|
||||
|
||||
If (WholeBytes > 0) Then
|
||||
WorkStr = Left(WorkStr, StrLen - WholeBytes)
|
||||
|
||||
' Pad zero bytes to end of WorkStr
|
||||
|
||||
For CurPos = 1 To WholeBytes
|
||||
WorkStr = Chr(0) & WorkStr
|
||||
Next CurPos
|
||||
|
||||
' Ensure RetStr contains shifted string in case no other
|
||||
' bitwise shifting later
|
||||
|
||||
RetStr = WorkStr
|
||||
End If
|
||||
|
||||
' Now handle the bitwise shift
|
||||
If (ShiftBits > 0) Then
|
||||
|
||||
RetStr = ""
|
||||
|
||||
For CurPos = Len(WorkStr) To 1 Step -1
|
||||
|
||||
CurByteVal = Asc(Mid(WorkStr, CurPos, 1))
|
||||
|
||||
LeftPart = CurByteVal And BitMask
|
||||
LeftPart = LeftPart / (2 ^ ShiftBits)
|
||||
|
||||
RightPart = CurByteVal And InvMask
|
||||
RightPart = RightPart * (2 ^ (8 - ShiftBits))
|
||||
|
||||
If CurPos = Len(WorkStr) Then
|
||||
Carry = LeftPart
|
||||
Else
|
||||
CurByteVal = RightPart Or Carry
|
||||
Carry = LeftPart
|
||||
RetStr = Chr(CurByteVal) & RetStr
|
||||
End If
|
||||
|
||||
Next CurPos
|
||||
|
||||
RetStr = Chr(Carry) & RetStr
|
||||
|
||||
End If
|
||||
|
||||
Else
|
||||
' If we're trying to shift by more bits than
|
||||
' input string, return an equal length string
|
||||
' full of zeroes.
|
||||
|
||||
For CurPos = 1 To StrLen
|
||||
RetStr = RetStr & Chr(0)
|
||||
Next CurPos
|
||||
End If
|
||||
|
||||
ShiftStrRight = RetStr
|
||||
|
||||
End Function
|
||||
|
||||
' Base32Enc() - Takes a "binary" string and represents as a Base32 number
|
||||
' Net result is an encoding where each "character" represents 5 bits
|
||||
|
||||
Public Function Base32Enc(ByVal StrIn As String) As String
|
||||
Dim CurBit As Long
|
||||
Dim Mask32 As Byte
|
||||
Dim CurPos As Long
|
||||
Dim CurVal As Byte
|
||||
Dim StrBits As Long
|
||||
Dim BitsProc As Long
|
||||
Dim WorkStr As String
|
||||
Dim RetStr As String
|
||||
Dim CurConv As String
|
||||
|
||||
Dim StrGroups As Integer
|
||||
Dim StrChar As Integer
|
||||
|
||||
RetStr = ""
|
||||
WorkStr = StrIn
|
||||
StrBits = Len(StrIn) * 8
|
||||
StrGroups = Int(StrBits / 5)
|
||||
|
||||
If (StrBits Mod 5) <> 0 Then StrGroups = StrGroups + 1
|
||||
|
||||
StrChar = Len(StrIn)
|
||||
BitsProc = 0
|
||||
Mask32 = &H1F
|
||||
|
||||
' Work from back of string to front.
|
||||
' and output the character representing each 5-bit group
|
||||
|
||||
For CurPos = 1 To StrGroups
|
||||
CurVal = Asc(Mid(WorkStr, Len(WorkStr), 1))
|
||||
CurVal = (CurVal And Mask32) + 1
|
||||
CurConv = Mid(B32Map, CurVal, 1)
|
||||
WorkStr = ShiftStrRight(WorkStr, 5)
|
||||
RetStr = CurConv & RetStr
|
||||
Next CurPos
|
||||
|
||||
Base32Enc = RetStr
|
||||
|
||||
End Function
|
||||
|
||||
' Base32Dec() - Takes a string encoded with Base32Enc() and returns the
|
||||
' original "binary" string it represents.
|
||||
|
||||
Public Function Base32Dec(ByVal StrIn As String) As String
|
||||
Dim CurPos As Long
|
||||
Dim CurVal As Byte
|
||||
Dim CurChr As String
|
||||
Dim RetStr As String
|
||||
Dim WorkStr As String
|
||||
Dim Carry As Byte
|
||||
Dim CarryMask As Byte
|
||||
Dim CurMask As Byte
|
||||
Dim ThisVal As Byte
|
||||
Dim ThisChar As String
|
||||
Dim ShiftBits As Long
|
||||
Dim OutBytes As Long
|
||||
Dim InBits As Long
|
||||
|
||||
' Calculate metrics
|
||||
Dim BitsProc As Integer
|
||||
Dim BaseMask As Object
|
||||
|
||||
BitsProc = 0
|
||||
BaseMask = &H1F
|
||||
Carry = 0
|
||||
WorkStr = StrIn
|
||||
|
||||
InBits = Len(StrIn) * 5
|
||||
OutBytes = Int(InBits / 8)
|
||||
|
||||
' Setup a string of zero bytes to push values into later
|
||||
|
||||
For CurPos = 1 To OutBytes
|
||||
RetStr = RetStr & Chr(0)
|
||||
Next CurPos
|
||||
|
||||
' Convert input string into binary representation
|
||||
|
||||
For CurPos = 1 To Len(StrIn)
|
||||
|
||||
' Derive 5-bit value of current char in StrIn
|
||||
CurChr = Mid(WorkStr, CurPos, 1)
|
||||
CurVal = InStr(1, B32Map, CurChr)
|
||||
CurVal = CurVal - 1
|
||||
|
||||
' Now, shift RetStr left 5 bits and pop last char off
|
||||
RetStr = ShiftStrLeft(RetStr, 5)
|
||||
ThisChar = Mid(RetStr, Len(RetStr), 1)
|
||||
RetStr = Left(RetStr, Len(RetStr) - 1)
|
||||
|
||||
' Now, OR our CurChr with the popped value
|
||||
' and push result back to end of string
|
||||
ThisVal = Asc(ThisChar)
|
||||
ThisVal = ThisVal Or CurVal
|
||||
ThisChar = Chr(ThisVal)
|
||||
RetStr = RetStr & ThisChar
|
||||
Next CurPos
|
||||
|
||||
Base32Dec = RetStr
|
||||
|
||||
End Function
|
||||
|
||||
' HexStrToBinStr() - Convert a hexadecimal string into a binary representation
|
||||
|
||||
Public Function HexStrToBinStr(ByVal StrIn As String) As String
|
||||
Dim StrOut As String
|
||||
Dim Ch As Long
|
||||
Dim HexByte As String
|
||||
Dim ByteVal As Long
|
||||
Dim ByteCh As String
|
||||
|
||||
StrOut = ""
|
||||
|
||||
For Ch = 1 To Len(StrIn) Step 2
|
||||
HexByte = Mid(StrIn, Ch, 2)
|
||||
ByteVal = Val("&H" & HexByte)
|
||||
ByteCh = Chr(ByteVal)
|
||||
StrOut = StrOut & ByteCh
|
||||
Next Ch
|
||||
|
||||
HexStrToBinStr = StrOut
|
||||
|
||||
End Function
|
||||
|
||||
' BinStrToHexStr() - Convert a binary string to a hexadecimal representation
|
||||
|
||||
Public Function BinStrToHexStr(ByVal StrIn As String) As String
|
||||
Dim StrOut As String
|
||||
Dim Ch As Long
|
||||
Dim HexByte As String
|
||||
Dim HexChr As String
|
||||
|
||||
StrOut = ""
|
||||
|
||||
For Ch = 1 To Len(StrIn)
|
||||
HexByte = Mid(StrIn, Ch, 1)
|
||||
HexChr = Hex$(Asc(HexByte))
|
||||
If Len(HexChr) = 1 Then HexChr = "0" & HexChr
|
||||
StrOut = StrOut & HexChr
|
||||
Next Ch
|
||||
|
||||
BinStrToHexStr = StrOut
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
End Module
|
||||
Reference in New Issue
Block a user