[<prev] [next>] [day] [month] [year] [list]
Message-ID: <200309120942890.SM00250@there>
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