Advertisement
mabu

Преобразование числа в строку без RTL

Oct 7th, 2014
323
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' Возвращает количество цифр в числе с учётом знака
  2. Public Function GetDigitCount(ByVal Number As Integer) As Integer
  3.     Dim Count As Integer
  4.     If Number < 0 Then
  5.         Number *= -1
  6.         Count = 1
  7.     End If
  8.     Do
  9.         Number = Number \ 10
  10.         Count += 1
  11.     Loop While Number
  12.     Return Count
  13. End Function
  14.  
  15. ' Преобразует число в строку
  16. ' Number — число
  17. ' DigitCount — количество цифр в числе
  18. ' Buffer — буфер для заполнения строкой
  19. ' Границы буфера не проверяются, прожет произойти переполнение
  20. Public Sub ToWString(ByVal Number As Integer, ByVal DigitCount As Integer, ByVal Buffer As Byte Ptr)
  21.     ' Флаг знака
  22.     Dim flag As Integer
  23.     If Number < 0 Then
  24.         Number *= -1
  25.         flag = 1
  26.         ' Поставить минус
  27.         Buffer[0] = 45
  28.     End If
  29.     For i As Integer = DigitCount - 1 - flag To 0 Step -1
  30.         Buffer[(i + flag) * SizeOf(WString)] = Number Mod 10 + 48 ' символ нуля в кодовой таблице
  31.         Number = Number \ 10
  32.     Next i
  33. End Sub
  34.  
  35. ' Очистка буфера
  36. Public Sub ZeroBuffer(ByVal Buffer As Byte Ptr, ByVal BufferLength As Integer)
  37.     For i As Integer = 0 To Length - 1
  38.         Buffer[i] = 0
  39.     Next
  40. End Sub
  41.  
  42.  
  43. ' Точка входа в программу
  44. Public Sub Main Alias "Main"()
  45.     Const Number As Integer = -324
  46.     Dim ReturnCode As Integer
  47.     'Dim InHandle As HANDLE = GetStdHandle(STD_INPUT_HANDLE)
  48.     Dim OutHandle As HANDLE = GetStdHandle(STD_OUTPUT_HANDLE)
  49.     ' Куча по умолчанию
  50.     Dim hDefaultProcessHeap As Integer Ptr = GetProcessHeap()
  51.     If hDefaultProcessHeap Then
  52.         ' Выделить память из кучи
  53.         ' Количество символов для строки
  54.         Dim Count As Integer = GetDigitCount(Number)
  55.         ' Количество байт под строку
  56.         ' Плюс пара символов на перенос каретки
  57.         Dim BytesCount As Integer = (Count + 2 + 1) * SizeOf(WString)
  58.         ' Выделение памяти
  59.         Dim aHeaps As Byte Ptr = HeapAlloc(hDefaultProcessHeap, 0, BytesCount)
  60.         If aHeaps Then
  61.             ' Обнуление буфера
  62.             ZeroBuffer(aHeaps, BytesCount)
  63.             ' Строка в текст
  64.             ToWString(Number, Count, aHeaps)
  65.             ' Добавить перенос строки
  66.             aHeaps[Count * SizeOf(WString)] = 13
  67.             aHeaps[Count * SizeOf(WString) + SizeOf(WString)] = 10
  68.             ' Печать на сонсоль
  69.             WriteConsole(OutHandle, aHeaps, Count+2, 0, 0)
  70.             ' Очистка
  71.             HeapFree(hDefaultProcessHeap, 0, aHeaps)
  72.             'SleepEx(INFINITE, 0)
  73.         Else
  74.             ReturnCode = 1
  75.         End If
  76.     Else
  77.         ReturnCode = 1
  78.     End If
  79.     ExitProcess(ReturnCode)
  80. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement