lists.openwall.net   lists  /  announce  owl-users  owl-dev  john-users  john-dev  passwdqc-users  yescrypt  popa3d-users  /  oss-security  kernel-hardening  musl  sabotage  tlsify  passwords  /  crypt-dev  xvendor  /  Bugtraq  Full-Disclosure  linux-kernel  linux-netdev  linux-ext4  linux-hardening  linux-cve-announce  PHC 
Open Source and information security mailing list archives
 
Hash Suite: Windows password security audit tool. GUI, reports in PDF.
[<prev] [next>] [day] [month] [year] [list]
From: lhand at co.la.ca.us (Larry Hand)
Subject: b62.inc

To use the base 62 routines:
...
<!-- #include file ="includes/b62.inc" -->
...
Dim b62         ' base 62 conversion object
...
'Create the b62 object
Set b62 = New B62Conversion
...
s19_digit_number = b62.b62toUID(s10_digit_id) ' Convert to user readable form
...
s10_digit_id = b62.UIDtoB62(s19_digit_number) ' Convert to database format
...

Hope this helps.
-------------- next part --------------
<%  
' Base 62 functions 
 ' Coversion from internal CWS/CMS ids to 
 ' the 'human-readable' versions the workers see.
 '
 ' The internal code consists of two base 62 numbers
 ' concatenated together as follows:
 '
 '	digits 1-7 (len 7) is a date/time stamp
 '	digits 8-10 (len 3) is a staff person ID
 '
 ' These expand into base 10 numbers the workers see
 ' (with dashes inserted) as follows:
 '
 '	digits 1-13 (len 13)(not counting dashes) is a date/time stamp
 '	digits 14-19 (len 6)(not counting dashes) is a staff persion ID
 '
 ' The dashes are inserted as follows:
 '
 '	1234-5678-9012-3456789
 '
 ' The base 62 is encoded in ASCII as the sequence 0-9A-Za-z.

Class B62Conversion  
	' Public interface variables:
	' - none

	' Private internal variables:
	Private DontDoItRight	' set to true (-1) to match the erronious IBM DLL behaviour. See B62toDate.

'---------------------------------------
' Properties

Property Let MatchDLL( bMatch )
	DontDoItRight = (bMatch = true)
End Property

'---------------------------------------
' The public conversion functions: 
 
Public Function B62toUId(Code) 
' build the identification string (GetUIIdentifierFromKey) 
Dim UIIdent, r
  ' put together the string
  r = B62toDec(Mid(Code, 1, 7))
  if r = -1 then
  	B62toUId = -1
  	exit function
  end if
  UIIdent = zfill(r, 13)  ' the date/time part 
  
  r = B62toStaffPersionID(Code) 
  if r = -1 then
  	B62toUId = -1
  	exit function
  end if
  UIIdent = UIIdent & r	' add the StaffPersionID part 

  ' put in the '-'s 
  B62toUId = Mid(UIIdent, 1, 4) & "-" & _ 
             Mid(UIIdent, 5, 4) & "-" & _ 
             Mid(UIIdent, 9, 4) & "-" & _ 
             Mid(UIIdent, 13) 
End Function 

Public Function UIdtoB62(UIIdent) 
' Convert a "human-readable" string into the internal CWS/CMS base 62 key
' returns blank if any problems/errors
Dim sUId, Code, r

	' It must be 22 chars long
	if len(UIIdent) <> 22 then
		UIdtoB62 = ""
		exit function
	end if

	' take out the hyphens (making it 19 digits long)
  sUId = Mid(UIIdent,1,4) & Mid(UIIdent,6,4) & Mid(UIIdent,11,4) & Mid(UIIdent,16)
	r = DectoB62(Mid(sUId,1,13))
	if r = "" then
  	UIdtoB62 = ""
  	exit function
  end if
  Code = zfill(r,7)  ' the date/time part 

	r = DectoB62(Mid(sUId,14))
	if r = "" then
  	UIdtoB62 = ""
  	exit function
  end if
  UIdtoB62 = Code & zfill(r,3) ' add the StaffPersionID part
End Function
 
Public Function B62toStaffPersionID(Code) 	
' extract the Staff Persion ID 
Dim r
	r = B62toDec(Mid(Code, 8, 3))
  if r = -1 then
  	B62toStaffPersionID = -1
  	exit function
  end if
  B62toStaffPersionID = zfill(r, 6) 
End Function 
 
Public Function B62toDate(Code) 
' convert the string to a date (GetUITimestampFromKey) 
' Note that some code values do not convert to valid dates. 
 
Dim CodeVal, tmp      ' must use currency type to allow for all the digits 
Dim DT, TM            ' date and time parts 
Dim yy, mm, dd       ' year, month, day 
Dim hh, mn, ss, fs  ' hour, minute, second, fractional second 
 
  CodeVal = B62toDec(Mid(Code, 1, 7))  ' convert the string to a number 
   
  ' Convert the value into two longs. The Date part consists of the last 17 bits. 
  ' The rest is the time. 
  tmp = Int(CodeVal / &H20000)  ' drop 17 bits 
  DT = CodeVal - tmp * &H20000 ' get just the date part 
  TM = tmp                      ' put time part in a long for later calculations 
   
  yy = CStr(1900 + (DT And &HFF)) ' years start at 1900 (1900-2155) 
   
  DT = Int(DT / &H100)  ' must truncate so it won't round value 
  mm = zfill((DT And &HF) + 1, 2) ' months start at 1 (1-16) 
 
  DT = Int(DT / &H10) 
  dd = zfill(DT, 2) ' (0-31) 
 
  ' now calculate the time portion 
  hh = zfill(TM And &H1F, 2) 
  TM = Int(TM / &H20) 
 
  mn = zfill(TM And &H3F, 2) 
  TM = Int(TM / &H40) 
 
  ss = zfill(TM And &H3F, 2) 
  TM = Int(TM / &H40) 
 
	If DontDoItRight Then 
		' The DLL supplied does not correctly return the fractions of a second on the date 
		' function. If you want to match that functionality, use this: 
		fs = zfill(TM, 2) 
	Else 
		' What the DLL was supposed to do. Note the extra digit zero filling the value: 
		fs = zfill(TM, 3) 
	End If 
	fs = fs & "0000"   ' just tack on the zeros. We really don't keep it 
                       ' to the tenth of a microsecond 
  ' and put in the dashes and dots 
  B62toDate = yy & "-" & mm & "-" & dd & "-" & hh & "." & mn & "." & ss & "." & fs 
              ' yyyy-mm-dd-hh.mn.ss.fffffff 
              ' 123456789012345678901234567 
End Function 
 
Public Function DatetoB62(FormattedDate) 
' Date MUST be in the format yyyy-mm-dd-hh.mm.ss.fffffff 
' Year must not be less than 1900 nor greater than 2155 
' If anything seems funny, it will return an empty string. 
Dim yy, mm, dd         ' Date parts 
Dim hh, mn, ss, fs    ' Time parts 
Dim ymd, hms            ' Combined date and times 
 
  ' parse out the values from the formatted date 
  yy = CInt(Mid(FormattedDate, 1, 4)) 
  mm = CInt(Mid(FormattedDate, 6, 2)) 
  dd = CInt(Mid(FormattedDate, 9, 2)) 
  hh = CInt(Mid(FormattedDate, 12, 2)) 
  mn = CInt(Mid(FormattedDate, 15, 2)) 
  ss = CInt(Mid(FormattedDate, 18, 2)) 
	If DontDoItRight Then 
		' The DLL supplied does not correctly return the fractions of a second on the date 
		' function. If you want to match that functionality, use this: 
		fs = CInt(Mid(FormattedDate, 21, 2))  ' note we don't use the last four digits of the fractional seconds 
	Else 
		' What the DLL was supposed to do. Note the extra digit zero filling the value: 
		fs = CInt(Mid(FormattedDate, 21, 3))  ' note we don't use the last four digits of the fractional seconds 
	End If 
 
  ' Now start packing the data into a data and a time variable 
  ' Date first 
  ymd = (CCur(dd) * &H1000) + (CCur(mm - 1) * &H100) + (yy - 1900) 
  ' and time 
  hms = (CCur(fs) * &H20000) + (CCur(ss) * &H800) + (mn * &H20) + hh 
  DatetoB62 = zfill(DectoB62(hms * &H20000 + ymd), 7) ' make it seven digits long 
 
DateToB62Exit: 
End Function 
 
'----------- Private routines from here on --------  

Private Sub Class_Initialize()
	'	Set default values as needed
	DontDoItRight = -1 ' match the DLL
End Sub

'Private Sub Class_Terminate()   
'	'	We don't have to do any termination stuff  
'End Sub  

Private Function B62toDec(Code) 
' Convert the base 62 code to decimal.
' return -1 if any errors
Dim i, r, digit 
  For i = 1 To Len(Code) 
    digit = InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", Mid(Code, i, 1)) - 1 
    r = (r * 62) + digit 
    If digit = -1 Then 
    ' invalid digits make the whole result bad 
      r = -1
      Exit For 
    End If 
  Next
  B62toDec = r
End Function 
 
Private Function DectoB62(DecNumber) 
' Convert a decimal number to base 62 code.
Dim i, j, r, digit 
  r = ""

	if not isNumeric(DecNumber) then
  	DectoB62 = ""
  	Exit Function
  End if

  i = DecNumber 
  Do While i > 0 
    j = Int(i / 62) ' a "\" caused an overflow, weird. 
    digit = i - j * 62 
    i = j 
    r = Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", digit + 1, 1) & r 
  Loop 
  DectoB62 = r 
End Function 
 
Private Function zfill(Value, Leng) 
' zero fill numerics 
  zfill = Right(String(Leng, "0") & CStr(Value), Leng) 
End Function
End Class
%> 

Powered by blists - more mailing lists

Powered by Openwall GNU/*/Linux Powered by OpenVZ