Convert Double to LARGE_INTEGER

[arthur2]

Это не наше дело. Наше дело — бысть настолько прозрачными, насколько это возможно.

Так и тут я согласен! Я ж говорю - мой код нисколько не мешает такому мазохизму. Вот если бы мой подход не позволял бы выразить 10 терабайт в байтах - то это бы и была "непрозрачность", и я бы первым от такого подхода отказался. Но ведь в том-то и дело, что он позволяет

Безосновательные страхи.

В кирпичах очень долго - несколько лет - лежал код очень хорошего программиста. Код должен был делать вполне стандартную операцию, просто не стандартную для бейсика. И код был, в общем-то, довольно элементарный. И тем не менее в этом коде обнаружился вполне себе критический косяк. И даже не один!

Зачем множить сущности? Арифметика в бейсике уже есть. Стандартные действия над большими числами бейсик совершает без проблем. Ты предлагаешь написать собственную арифметику для LARGE_INTEGER. Я предлагаю пользоваться тем типом, с которым бейсик умеет работать без танцев с бубном, и в который LARGE_INTEGER легко помещается. И только когда нужен именно LARGE_INTEGER - можно в него преобразовывать.

А можно, кстати, даже и не преобразовывать. Просто в переменной типа Decimal считать восемь байт, начиная с восьмого, за LARGE_INTEGER. Жаль, конечно, что в бейсике нет юнионов, но это можно же как-то обойти. Надо будет подумать :о)

[Хакер]

В кирпичах очень долго - несколько лет - лежалкод очень хорошего программиста. Код должен был делать вполне стандартную операцию, просто не стандартную для бейсика. И код был, в общем-то, довольно элементарный. И тем не менее в этом коде обнаружился вполне себе критический косяк. И даже не один!

Вот это я и называю «вставать в позу». Если кто-то накосячил — это проблемы отдельно взятого человека и его кода. Просто не надо косячить. И то, что кто-то накосячил, не означает, что всем следует избегать той области, в которой кто-то накосячил, потому что и остальные автоматически накосячат.

Зачем множить сущности?

Никто не множит. 64-битной арифметики нет. Её нужно сделать.

А можно, кстати, даже и не преобразовывать. Просто в переменной типа Decimal считать восемь байт, начиная с восьмого, за LARGE_INTEGER. Жаль, конечно, что в бейсике нет юнионов, но это можно же как-то обойти. Надо будет подумать :о)

Это уже грязный трюк. Единственное чистое решение: это преобразовывать Variant(Decimal) обратно в строку, а потом из строки собирать LARGE_INTEGER. Ну и зачем тогда вообще Variant(Decimal)?

[Хакер]

Я вообще даже близко понять не могу, почему этот топик есть, почему этот разговор ведётся. Написать конвертор [строчка→LARGE_INTEGER] — дело 8—10 минут. Тут разговор ни о чём ведётся уже несколько дней.

[arthur2]

если кто-то накосячил — это проблемы отдельно взятого человека и его кода. Просто не надо косячить.

Если писать арифметику для LARGE_INTEGER - накосячить очень легко. Причем, природа косяков будет очень даже вероятно схожа с природой косяков в коде GSerg-a. Просто LARGE_INTEGER - беззнаковый, а в бесике, получается, состоит из двух знаковых полей - очень легко запутаться. Я бы наверняка запутался. Мне вполне хватило, что я написал функцию сравнения двух ладжинтеджеров. В си ещё можно было бы попробовать писать арифметику для
LARGE_INTEGER, но здесь - увольте.

Это уже грязный трюк.

Так ведь почти все твои революционные находки и фишки строятся на подобных трюках.

Написать конвертор [строчка→LARGE_INTEGER] — дело 8—10 минут. Тут разговор ни о чём ведётся уже несколько дней.

Вот это я и называю «вставать в позу». Добро бы просто - в число... нет, обязательно в LARGE_INTEGER.

Разговор действительно ни о чем - предлагаю закругляться.

[Хакер]

Если писать арифметику для LARGE_INTEGER - накосячить очень легко.

Нет. Это катастрофически субъективное утверждение. Ты боишься написать эту арифметику, потому что не дружишь с битами. Но объективно накосячить вероятность не больше, чем при написании обработчика, я не знаю, кликов по меню.

Причем, природа косяков будет очень даже вероятно схожа с природой косяков в коде GSerg-a.

Ты меня просто пугаешь своей какой-то суеверностью что-ли. У тебя механизм мышления такой: ты увидел, как кто-то шёл по тротуару, оступился и упал. Всё — теперь ты сам обходишь это место стороной и агитируешь своих знакомых не ходить туда. Это бред. Одна мелкая ошибка по неосторожности, допущенная GSerg-ом — это ни на граммулечку, ни на миллисекунду не повод как-то плохо думать о реализации арифметики вручную.

Просто LARGE_INTEGER - беззнаковый, а в бесике, получается, состоит из двух знаковых полей - очень легко запутаться.

Аргхх!! Кто тебе мешает объявить его как 8 беззнаковых байтов?

Разговор действительно ни о чем - предлагаю закругляться.

Как хочешь. И да, дизреспект тебе за твои взгляды.

[Хакер]

По крайней мере, если при написании конвертора «строка → LARGE_INTEGER» можно ошибиться, а можно и не ошибиться, то в CDec уже ошиблись. Это уже кривая бажная функция с ошибкой, и с этим ничего не поделать.

[arthur2]

Кто тебе мешает объявить его как 8 беззнаковых байтов?

Хм, действительно Инерция мышления

то в CDec уже ошиблись. Это уже кривая бажная функция с ошибкой, и с этим ничего не поделать

А вот это уже убедительный аргумент! А по-подробнее?

[ark]

Вдруг кому пригодится:

Код: Выделить всё

Option Explicit

Private Type tagDECIMAL
  wReserved                 As Integer
  scale                     As Byte
  sign                      As Byte
  Hi32                      As Long ' unsigned
  Lo32                      As Long ' unsigned
  Mid32                     As Long ' unsigned
End Type

Private Const VT_DECIMAL = 14
Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
Private Const OFFSET_2 = 65536
Private Const MAXINT_2 = 32767

Public Function ByteToSByte(ByVal b As Byte) As Integer
    If b < 128 Then
       ByteToSByte = b
    Else
       ByteToSByte = b - &H100
    End If
End Function

Public Function LoWord(ByVal dw As Long) As Integer
    If dw And &H8000& Then
        LoWord = dw Or &HFFFF0000
    Else
        LoWord = dw And &HFFFF&
    End If
End Function

Public Function HiWord(ByVal dw As Long) As Integer
    HiWord = (dw And &HFFFF0000) \ 65536
End Function

Public Function MAKEWORD(ByVal bLo As Byte, ByVal bHi As Byte) As Integer
    If bHi And &H80 Then
        MAKEWORD = (((bHi And &H7F) * 256) + bLo) Or &H8000
    Else
        MAKEWORD = (bHi * 256) + bLo
    End If
End Function

Public Function MakeDWord(ByVal wLo As Integer, ByVal wHi As Integer) As Long
    MakeDWord = (wHi * 65536) + (wLo And &HFFFF&)
End Function

Public Function LongToUShort(ULong As Long) As Integer
   If ULong > &H7FFF Then
      LongToUShort = CInt(ULong - &H10000)
   Else
      LongToUShort = CInt(ULong)
   End If
End Function

Public Function vbIntToUShort(vbInt As Integer) As Long
   If vbInt < 0 Then
      vbIntToUShort = vbInt + &H10000
   Else
      vbIntToUShort = CLng(vbInt)
   End If
End Function

Public Function UnsignedToLong(Value As Double) As Long
    If Value < 0 Or Value >= OFFSET_4 Then Error 6 ' Overflow
    If Value <= MAXINT_4 Then
        UnsignedToLong = Value
    Else
        UnsignedToLong = Value - OFFSET_4
    End If
End Function

Public Function LongToUnsigned(Value As Long) As Double
    If Value < 0 Then
        LongToUnsigned = Value + OFFSET_4
    Else
        LongToUnsigned = Value
    End If
End Function

Public Function UnsignedToInteger(Value As Long) As Integer
    If Value < 0 Or Value >= OFFSET_2 Then Error 6 ' Overflow
    If Value <= MAXINT_2 Then
        UnsignedToInteger = Value
    Else
        UnsignedToInteger = Value - OFFSET_2
    End If
End Function

Public Function IntegerToUnsigned(Value As Integer) As Long
    If Value < 0 Then
        IntegerToUnsigned = Value + OFFSET_2
    Else
        IntegerToUnsigned = Value
    End If
End Function

Public Function MakeDecimal( _
   ByVal HighDword As Long, _
   ByVal LowDword As Long, _
   Optional ByVal HighestDWord As Long, _
   Optional ByVal DecimalPlaces As Byte, _
   Optional ByVal Signed As Boolean) As Variant

   Const DECIMAL_NEG = &H80&
   Dim dec As tagDECIMAL
   With dec
     .wReserved = VT_DECIMAL
     .Lo32 = LowDword
     .Mid32 = HighDword
     .Hi32 = HighestDWord
     Select Case DecimalPlaces
        Case 0 To 28
          .scale = DecimalPlaces
        Case Else
          Err.Raise 5
     End Select
   
     If Signed Then .sign = DECIMAL_NEG
   End With
   CopyMemory ByVal VarPtr(MakeDecimal), ByVal VarPtr(dec.wReserved), LenB(dec)
End Function

Public Function HiDWord(ByVal vDecimal As Variant) As Long
   Dim dec As tagDECIMAL
   Select Case VarType(vDecimal)
     Case vbDecimal
     Case vbCurrency, vbLong, vbInteger
        vDecimal = CDec(vDecimal)
     Case Else
        Err.Raise 5
   End Select
   CopyMemory ByVal VarPtr(dec.wReserved), ByVal VarPtr(vDecimal), LenB(dec)
   HiDWord = dec.Mid32
End Function

Public Function LoDWord(ByVal vDecimal As Variant) As Long
   Dim dec As tagDECIMAL
   Select Case VarType(vDecimal)
      Case vbDecimal
      Case vbCurrency, vbLong, vbInteger
          vDecimal = CDec(vDecimal)
      Case Else
          Err.Raise 5
   End Select

   CopyMemory ByVal VarPtr(dec.wReserved), ByVal VarPtr(vDecimal), LenB(dec)
   LoDWord = dec.Lo32
End Function

Public Function HighestDWord(ByVal vDecimal As Variant) As Long
   Dim dec As tagDECIMAL
   Select Case VarType(vDecimal)
      Case vbDecimal
      Case vbCurrency, vbLong, vbInteger
         vDecimal = CDec(vDecimal)
      Case Else
         Err.Raise 5
   End Select
   CopyMemory ByVal VarPtr(dec.wReserved), ByVal VarPtr(vDecimal), LenB(dec)
   HighestDWord = dec.Hi32
End Function

Public Sub SplitDecimal( _
   ByVal vDecimal As Variant, _
   ByRef LowDword As Long, _
   ByRef HighDword As Long, _
   Optional ByRef HighestDWord As Long)

   Dim dec As tagDECIMAL
   Select Case VarType(vDecimal)
       Case vbDecimal
       Case vbCurrency, vbLong, vbInteger
           vDecimal = CDec(vDecimal)
       Case Else
           Err.Raise 5
   End Select
   CopyMemory ByVal VarPtr(dec.wReserved), ByVal VarPtr(vDecimal), LenB(dec)
   LowDword = dec.Lo32
   HighDword = dec.Mid32
   HighestDWord = dec.Hi32
End Sub


[Xiaofang]

Подобие 64-битовой арифметики в VB6 есть. Это тип Currency - 8-байтовое целое число, поэтому при работе с ним не будет потери данных, как это бывает при работе с double и float. Здесь ([Хакер] :: ссылка вырезана.) можно посмотреть, как я реализовал получение размеров больших файлов (более 2-х гигабайт).

[ark]

8-байтовое целое число

Ну, не совсем целое, а немножко отмасштабированное (1:10 000), или fixed-point.

поэтому при работе с ним не будет потери данных, как это бывает при работе с double и float

С точностью до наоборот:

Код: Выделить всё


   Dim dblNum      As Double
   Dim curNum      As Currency
   Dim i    As Long
   For i = 1 To 10000
      dblNum = dblNum + 0.0001
      curNum = curNum + 0.0001
   Next
   Debug.Print "Result using Double: " & dblNum
   Debug.Print "Result using Currency: " & curNum


[Rody66]

А что насчет LARGE_INTEGER 2 VBType ?
Если я пишу высокоточный таймер, можно ли делать так:

Код: Выделить всё

Function GetTick() As Currency
    Dim c As LARGE_INTEGER
    QueryPerformanceCounter c
    CopyMemory GetTick, c, 8
End Function

[Mikle]

А не уйдёт ф-ция в бесконечную рекурсию на этой строке:

Код: Выделить всё

CopyMemory GetTick, c, 8

Я не проверял, но если это работает корректно, то почему QueryPerformanceCounter сразу не задекларировать с параметром типа Currency?

[Rody66]

не уйдёт ф-ция в бесконечную рекурсию

Не уходит. Мне, как человеку не сильно сведущему, кажется, что это работает. Чем дальше замер - тем больше число. А что еще надо? Но я могу не знать о граблях, которые могут возникнуть в будущем при использовании данного метода.

[The trick]

Заинтересовался темой, т.к. делал подобное на AVR, сделал функции для перевода беззнакового десятичного целого неограниченной размерности в строку и обратно используя сдвиги и арифметику. Может кому будет интересно. Работает достаточно быстро.

Код: Выделить всё

Option Explicit

Private Declare Function GetMem2 Lib "msvbvm60" (Src As Any, Dst As Any) As Long

Private Sub Form_Load()
    Dim Value() As Byte, Res As String
   
    StrToUI "1234567891011121314151617181920", Value
   
    Res = UIToStr(Value)
   
End Sub
' Перевод беззнакового целого числа из байтового представления в строку
Private Function UIToStr(bValue() As Byte) As String
    Dim i As Long, f As Boolean, loc() As Byte
    loc = bValue
    Do
        i = Div10UI(loc)
        UIToStr = CStr(i) & UIToStr
        f = False
        For i = UBound(loc) To 0 Step -1
            If loc(i) Then f = True: Exit For
        Next
    Loop While f
End Function
' Перевод беззнакового целого числа из строкового представления в массив байт
Private Sub StrToUI(sValue As String, Out() As Byte)
    Dim i As Long, lpStr As Long, v As Integer, b(0) As Byte
    ReDim Out(0)
    If Len(sValue) Then
        lpStr = StrPtr(sValue)
        For i = 0 To Len(sValue) - 1
            GetMem2 ByVal lpStr, v
            v = v - &H30
            If v < 0 Or v > 9 Then Err.Raise 13: Exit Sub
            b(0) = v
            If i Then Mul10UI Out
            AddUI Out, b()
            lpStr = lpStr + 2
        Next
    Else: Err.Raise 5
    End If
End Sub
Private Sub AddUI(Op1() As Byte, Op2() As Byte)
    Dim i As Long, p As Long, o As Long, q As Long
    If UBound(Op1) < UBound(Op2) Then ReDim Preserve Op1(UBound(Op2))
    Do
        If i <= UBound(Op2) Then o = Op2(i) Else o = 0
        q = CLng(Op1(i)) + o + p
        p = (q And &H100&) \ &H100
        Op1(i) = q And &HFF
        i = i + 1
    Loop While CBool(o Or p) And i <= UBound(Op1)
    If p Then ReDim Preserve Op1(i): Op1(i) = p
End Sub
Private Function Div10UI(Value() As Byte) As Long
    Dim i1 As Long, i2 As Long, acc() As Byte, loc() As Byte, q As Long, p As Long
    For i1 = 0 To (UBound(Value) + 1) * 8
        Div10UI = (Div10UI * 2) Or p
        If Div10UI < 10 Then p = 0 Else p = 1: Div10UI = Div10UI - 10
        For i2 = 0 To UBound(Value)
            q = (CLng(Value(i2)) * 2) Or p
            p = (q And &H100) \ &H100
            Value(i2) = q And &HFF&
        Next
    Next
End Function
Private Sub Mul10UI(Value() As Byte)
    Dim i As Long, p As Long, q As Long
    For i = 0 To UBound(Value)
        q = (CLng(Value(i)) * 4 + Value(i)) * 2 + p
        p = (q And &HFF00&) \ &H100
        Value(i) = q And &HFF
    Next
    If p Then ReDim Preserve Value(i): Value(i) = p
End Sub

[sosed213]

The trick, спасибо за твой код.

Использую его для себя, и немного дополнил, перевод текстового представления десятичного числа в LARGE_INTEGER и наоборот.

Код выше дополнил этим:

Код: Выделить всё

Private Type LARGE_INTEGER
   LowPart  As Long
   HighPart As Long
End Type

Private Declare Function GetMem2 Lib "msvbvm60" (src As Any, Dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, Dst As Any) As Long
Private Declare Function GetMem8 Lib "msvbvm60" (src As Any, Dst As Any) As Long

Private Declare Function GetMem4Array Lib "msvbvm60" Alias "GetMem4" (src() As Any, Dst As Any) As Long


Private Sub Form_Load()
' Код для проверки
    Dim s As String
    s = "18446744073709551615"
    Debug.Print s
    Debug.Print LIToStr(StrToLI(s))
End Sub

' Перевод LARGE_INTEGER в текстовое представление десятичного числа
Private Function LIToStr(liValue As LARGE_INTEGER) As String
    Dim n_LI As LARGE_INTEGER
    Dim n_buf1(7) As Byte
   
    n_LI = liValue

    GetMem8 ByVal VarPtr(n_LI), ByVal VarPtr(n_buf1(0))
    LIToStr = UIToStr(n_buf1)
End Function



' Перевод текстового представления десятичного числа в LARGE_INTEGER
Private Function StrToLI(sValue As String) As LARGE_INTEGER
    Dim n_buf0() As Byte
    Dim n_buf1(7) As Byte
    Dim i As Long
    Dim n_LI As LARGE_INTEGER

    StrToUI sValue, n_buf0
   
    ' Проверка, не пустой ли массив
    Dim initArray As Long
    GetMem4Array n_buf0, initArray
    If Not (initArray > 0) Then Exit Function
   
    If UBound(n_buf0) > 7 Then Exit Function 'Переполнение
       
    For i = 0 To UBound(n_buf0)
        n_buf1(i) = n_buf0(i)
    Next i
   
    GetMem8 ByVal VarPtr(n_buf1(0)), ByVal VarPtr(n_LI)
   
    StrToLI = n_LI

End Function


[The trick]

Кстати для некоторых случаев можно использовать VarBstrFromUI8, StrToInt64ExW и аналогичные. Также можно использовать snprintf/scanf и др.

[sosed213]

По итогу. Для перевода LARGE_INTEGER в Decimal, я пользуюсь этим способом. (За основу взят код arthur2).
Возможно это не правильный код, но он работает.

Код: Выделить всё

Public Type LARGE_INTEGER
   LowPart  As Long
   HighPart As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)

' Перевод LARGE_INTEGER в Decimal
Public Function ValLargeInteger(L As LARGE_INTEGER) As Variant
    ValLargeInteger = CDec(0)
    'CopyMemory n, 14, 1    'первый байт 14  ( вариант предложенный arthur2, в скомпилированном виде почти не работает)
    CopyMemory ByVal VarPtr(ValLargeInteger) + 8, ByVal VarPtr(L), 8&
End Function

' Перевод Variant в LARGE_INTEGER
Public Function getLargeInteger(ByVal ValLargeInteger As Variant) As LARGE_INTEGER
  ValLargeInteger = CDec(ValLargeInteger)

  If ValLargeInteger > CDec("18446744073709551615") Then Err.Raise 6
  If ValLargeInteger < 0 Then Err.Raise 6

  CopyMemory getLargeInteger, ByVal VarPtr(ValLargeInteger) + 8, 8&
End Function

[Хакер]

Возможно это не правильный код, но он работает.

Код либо правильный и всегда работает, либо работает через раз, потому что неправильный.

Конкретно этот код неправилен тем, что он не декларирует себя ни как код, работающий со знаковыми 64-битными числами, ни как код, работающий с беззнаковыми.

Если он работает с беззнаковыми, то он условно правильный, потому что делает предположение, что CDec устанавливает поле, хранящее положение плавающей точки в числе в ноль для входящего нулевого значения. По факту именно так и происходит, но кто сказал, что это всегда так? Если кто-нибудь хакнет поведение CDecl для каких-то целей, то внезапно этот код перестанет работать должным образом.

Если же он работает со знаковыми 64-битными числами, то он неправильный, потому что он неправильно обращается со знаковым битом в исходном 64-битном и результирующем Decimal-числе: из отрицательных значений на входе он будет делать положительные и неправильные значения на выходе.

Вообщем, в OLEAUT32.DLL уже есть VarDecFromI8 и VarDecFromUI8, но им нужен прединициализированный Variant.

[sosed213]

Тогда для полной картины потребуются 4 функции:
VarI8FromDec (const DECIMAL *pdecIn, LONG64 *pi64Out)
VarUI8FromDec (const DECIMAL *pdecIn, ULONG64 *pi64Out)
VarDecFromI8 (LONG64 i64In, DECIMAL *pdecOut)
VarDecFromUI8 (ULONG64 ui64In, DECIMAL *pdecOut)

Вопрос:
LONG64 = INT64 ?
ULONG64 = UINT64 ?

И можно ли их объявить как структуру LARGE_INTEGER ?

Код: Выделить всё

Public Type LARGE_INTEGER
   LowPart  As Long
   HighPart As Long
End Type

Судя по описанию (с сайта microsoft), в ULONG64 MSB не используется, а в LONG64 (если он же INT64) как раз используется для знака.

[sosed213]

Реализовал работу с этими функциями (VarI8FromDec, VarUI8FromDec, VarDecFromI8, VarDecFromUI8) и пример как я использую GetTickCount64.

Код: Выделить всё

Const S_OK = &H0
'Success.
'Успех

Const DISP_E_BADVARTYPE = &H80020008
'The input parameter is not a valid type of variant.
'Входной параметр не является допустимым типом варианта.

Const DISP_E_OVERFLOW = &H8002000A
'The data pointed to by the output parameter does not fit in the destination type.
'Данные, на которые указывает выходной параметр, не подходят для целевого типа.

Const DISP_E_TYPEMISMATCH = &H80020005
'The argument could not be coerced to the specified type.
'Аргумент не может быть приведен к указанному типу.

Const E_INVALIDARG = &H80070057
'One of the arguments is not valid.
'Один из аргументов неверен.

Const E_OUTOFMEMORY = &H8007000E
'Insufficient memory to complete the operation.
'Недостаточно памяти для завершения операции.

Private Declare Function VarI8FromDec Lib "oleaut32" (ByVal pdecIn As Long, ByVal pi64Out As Long) As Long
Private Declare Function VarUI8FromDec Lib "oleaut32" (ByVal pdecIn As Long, ByVal pi64Out As Long) As Long

Private Declare Function VarDecFromI8 Lib "oleaut32" (ByVal i64In_lp As Long, ByVal i64In_hp As Long, ByVal pDecOut As Long) As Long
Private Declare Function VarDecFromUI8 Lib "oleaut32" (ByVal i64In_lp As Long, ByVal i64In_hp As Long, ByVal pDecOut As Long) As Long


Private Declare Function GetTickCount64 Lib "kernel32" () As LARGE_INTEGER


Public Function DecimalToLargeInteger(ByVal VarDec As Variant) As LARGE_INTEGER
    Dim nRet As Long
    nRet = VarI8FromDec(ByVal VarPtr(VarDec), ByVal VarPtr(DecimalToLargeInteger))
   
    Select Case nRet
        Case S_OK
            'Success.
        Case DISP_E_BADVARTYPE
            Err.Raise DISP_E_BADVARTYPE, , "The input parameter is not a valid type of variant."
        Case DISP_E_OVERFLOW
            Err.Raise DISP_E_OVERFLOW, , "The data pointed to by the output parameter does not fit in the destination type."
        Case DISP_E_TYPEMISMATCH
            Err.Raise DISP_E_TYPEMISMATCH, , "The argument could not be coerced to the specified type."
        Case E_INVALIDARG
            Err.Raise E_INVALIDARG, , "One of the arguments is not valid."
        Case E_OUTOFMEMORY
            Err.Raise E_OUTOFMEMORY, , "Insufficient memory to complete the operation."
    End Select
End Function

Public Function UnsignedDecimalToLargeInteger(ByVal VarDec As Variant) As LARGE_INTEGER
    Dim nRet As Long
    nRet = VarUI8FromDec(ByVal VarPtr(VarDec), ByVal VarPtr(UnsignedDecimalToLargeInteger))
   
    Select Case nRet
        Case S_OK
            'Success.
        Case DISP_E_BADVARTYPE
            Err.Raise DISP_E_BADVARTYPE, , "The input parameter is not a valid type of variant."
        Case DISP_E_OVERFLOW
            Err.Raise DISP_E_OVERFLOW, , "The data pointed to by the output parameter does not fit in the destination type."
        Case DISP_E_TYPEMISMATCH
            Err.Raise DISP_E_TYPEMISMATCH, , "The argument could not be coerced to the specified type."
        Case E_INVALIDARG
            Err.Raise E_INVALIDARG, , "One of the arguments is not valid."
        Case E_OUTOFMEMORY
            Err.Raise E_OUTOFMEMORY, , "Insufficient memory to complete the operation."
    End Select
End Function

Public Function LargeIntegerToDecimal(VarLI As LARGE_INTEGER) As Variant
    LargeIntegerToDecimal = CDec(0)

    Dim nRet As Long
    nRet = VarDecFromI8(VarLI.LowPart, VarLI.HighPart, ByVal VarPtr(LargeIntegerToDecimal))

    Select Case nRet
        Case S_OK
            'Success.
        Case DISP_E_BADVARTYPE
            Err.Raise DISP_E_BADVARTYPE, , "The input parameter is not a valid type of variant."
        Case DISP_E_OVERFLOW
            Err.Raise DISP_E_OVERFLOW, , "The data pointed to by the output parameter does not fit in the destination type."
        Case DISP_E_TYPEMISMATCH
            Err.Raise DISP_E_TYPEMISMATCH, , "The argument could not be coerced to the specified type."
        Case E_INVALIDARG
            Err.Raise E_INVALIDARG, , "One of the arguments is not valid."
        Case E_OUTOFMEMORY
            Err.Raise E_OUTOFMEMORY, , "Insufficient memory to complete the operation."
    End Select
End Function

Public Function LargeIntegerToUnsignedDecimal(VarLI As LARGE_INTEGER) As Variant
    LargeIntegerToUnsignedDecimal = CDec(0)

    Dim nRet As Long
    nRet = VarDecFromUI8(VarLI.LowPart, VarLI.HighPart, ByVal VarPtr(LargeIntegerToUnsignedDecimal))
   
    Select Case nRet
        Case S_OK
            'Success.
        Case DISP_E_BADVARTYPE
            Err.Raise DISP_E_BADVARTYPE, , "The input parameter is not a valid type of variant."
        Case DISP_E_OVERFLOW
            Err.Raise DISP_E_OVERFLOW, , "The data pointed to by the output parameter does not fit in the destination type."
        Case DISP_E_TYPEMISMATCH
            Err.Raise DISP_E_TYPEMISMATCH, , "The argument could not be coerced to the specified type."
        Case E_INVALIDARG
            Err.Raise E_INVALIDARG, , "One of the arguments is not valid."
        Case E_OUTOFMEMORY
            Err.Raise E_OUTOFMEMORY, , "Insufficient memory to complete the operation."
    End Select
End Function







Public Sub Test()
    Debug.Print TimeToString(LargeIntegerToUnsignedDecimal(GetTickCount64), 0)
End Sub



Public Function TimeToString(ByVal Milliseconds As Variant, Optional PrintMillisecondsIF As Long = -1, Optional ExcludeZero As Boolean = True) As String
    ' PrintMillisecondsIF - отображать милисекунды или нет.
    ' -1 - никогда
    ' 0 - всегда
    ' 1 - если в результате один разряд (секунды)
    ' 2 - если в результате два разряда (секунды и минуты), и т.д.
   
    TimeToString = ""
   
    On Error GoTo err1
   
    Dim st As String
    Dim Z(6) As Variant
    Dim Zs(6) As String
    Dim i As Integer
    Dim j As Integer
   
    Zs(0) = "мс."
    Zs(1) = "с."
    Zs(2) = "м."
    Zs(3) = "ч."
    Zs(4) = "Д."
    Zs(5) = "М."
    Zs(6) = "Г."
   
    Z(0) = CDec(0)
    Z(1) = 0&
    Z(2) = 0&
    Z(3) = 0&
    Z(4) = 0&
    Z(5) = 0&
    Z(6) = 0&
   
   ' 1 секунда = 1000 милисекунд
   ' 1 минута = 60000  милисекунд
    Z(0) = Milliseconds
   
    i = 0
    If Milliseconds >= 1000 Then
        ' Вычисляем секунды и милесикунды
        i = 1
        Z(1) = Fix(Milliseconds / 1000)
        Z(0) = MyMod(Milliseconds, 1000)
        If Z(1) >= 60 Then
            ' Вычисляем минуты и секунды
            i = 2
            Z(2) = Fix(Z(1) / 60)   ' Минуты
            Z(1) = MyMod(Z(1), 60)       ' Секунды
            If Z(2) >= 60 Then
                ' Вычисляем часы и минуты
                i = 3
                Z(3) = Fix(Z(2) / 60)  ' Часы
                Z(2) = MyMod(Z(2), 60)     ' Минуты
                If Z(3) >= 24 Then
                    ' Вычисляем дни и часы
                    i = 4
                    Z(4) = Fix(Z(3) / 24)  ' Дни
                    Z(3) = MyMod(Z(3), 24)     ' Часы
                    If Z(4) >= 30 Then
                        ' Вычисляем месяцы и дни
                        i = 5
                        Z(5) = Fix(Z(4) / 30)  ' месяцы
                        Z(4) = MyMod(Z(4), 30)    ' дни
                        If Z(5) >= 12 Then
                            ' Вычисляем годы и месяцы
                            i = 6
                            Z(6) = Fix(Z(5) / 12)  ' годы
                            Z(5) = MyMod(Z(5), 12)    ' месяцы
                        End If
                    End If
                End If
            End If
        End If
    Else
        Z(0) = Milliseconds
    End If
   
   
    Dim nStart As Long
    nStart = IIf((Not (PrintMillisecondsIF = 0)) And (PrintMillisecondsIF <= i), 1, 0)
   
   
   
    If nStart > i Then nStart = i
   
   
    For j = nStart To i
        If Z(j) = 0 Then
            nStart = nStart + 1
        Else
            Exit For
        End If
    Next j
   
    If nStart > i Then nStart = i
   
    st = ""
    For j = i To nStart Step -1
       
        If Not ((Z(j) = 0) And (ExcludeZero = True)) Then
            st = st & Z(j) & Zs(j) & " "
        End If
    Next j

    TimeToString = st
   
    Erase Z()
   
    Exit Function
   
err1:
    If MsgBox("err: " & Err.Number & vbNewLine & Err.Description & vbNewLine & "Exit App?", vbExclamation + vbYesNo) = vbYes Then
        End
    End If
   

   
End Function


Public Function MyMod(x As Variant, y As Variant) As Variant
    MyMod = Round(((x / y) - Int(x / y)) * y)
End Function