Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Как десятичные числа с плавающей точкой перевести в байтовый вид и наоборот?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Помогите конвертировать число с десятичной точкой в байтовый вид длиной 8 байтов и наоборот.
Нужен сам алгоритм. Чтобы сначала было число а потом байтовый вид этого числа.
Type double
Double precision values with double type have 8 bytes. The format is similar to the float format except that it has an 11-bit excess-1023 exponent and a 52-bit mantissa, plus the implied high-order 1 bit. This format gives a range of approximately 1.7E?308 to 1.7E+308 for type double.
Microsoft Specific ?>
The double type contains 64 bits: 1 for sign, 11 for the exponent, and 52 for the mantissa. Its range is +/?1.7E308 with at least 15 digits of precision.
END Microsoft Specific
алгоритм может быть типа (для 1 байта пример)
1 2 4 8 16 32 64 128
1- смотрим знак
2 - вычитаем 128-если был перенос знака - такого бита нет, если переноса знака не было- пишем 1 в позицию бита
3 - вычитаем 64 - если был перенос знака - такого бита нет, если переноса знака не было- пишем 1 в позицию бита
и т.д.
обратное преобразование - берем биты и суммируем соответствующие им весовые коэффициенты - 1 2 4 8 16 32 64 128
для 64 байтного числа надо бы таблицу коэффициентов составить
Как осуществить преобразование между десятичными, шестнадцатиричными и двоичными значениями
Dim lDec As Long, aHex As String, aBin As String
lDec = 121
aHex = Hex$(lDec) ' Десятичное в шестнадцатиричное
lDec = Val("&H" & aHex) ' Шестнадцатиричное в десятичное
' Обратите внимание, что несоставляет труда преобразовать шестнадцатиричное значение в
' двоичное, поэтому, чтобы преобразовать из десятичного в шестнадцатиричное, удобней сперва преобразовать десятичное в двоичное. Наиболее быстрый способ двоичного преобразования, это
' использовать специальную таблицу преобразования.
Dim vBinTable As Variant
vBinTable = Array("0000", "0001", "0010", "0011", _
"0100", "0101", "0110", "0111", _
"1000", "1001", "1010", "1011", _
"1100", "1101", "1110", "1111")
Dim i As Integer, k As Long
For k = 1 To Len(aHex)
' Шестнадцатиричное в двоичное
i = Val("&H" & Mid$(aHex, k, 1))
aBin = aBin & vBinTable(i)
Next
' Так же несложно сделать преобразование из двоичного значения вдесятичное. Однако,
' это не всегда выполнимо, так как шестнадцатиричные и двоичные значения в VB могут
' представлять из себя намного большие размеры чем десятичное значение. Таким образом
' для преобразование из двоичного в шестнадцатиричное опять прибегнем к таблице
' преобразования, только другого типа.
Dim aBinTable As String, aHexTable As String
aBinTable = " 0000 0001 0010 0011 0100 0101 0110 0111" & _
" 1000 1001 1010 1011 1100 1101 1110 1111 "
aHexTable = "0123456789ABCDEF"
If Len(aBin) Mod 4 Then
' Делаем длину чётной 4
aBin = String$(Len(aBin) Mod 4, "0") & aBin
End If
aHex = ""
For k = 1 To Len(aBin) Step 4
i = InStr(aBinTable, " " & Mid$(aBin, k, 4))
aHex = aHex & Mid$(aHexTable, (i - 1) \ 5 + 1, 1)
NextСпасибо большое! У меня проблема вот в чём: Создан файл в бинарном виде и я пытаюсь прочитать из него информацию. Для начала пытаюсь прочить первый байт этого файла и его численное значение вывести на экран с помощью функции:
msgbox InputB(1, #1)
Но функция выводит на экран непонятный символ в виде квадратика или вообще ничего не выводит
Функция MsgBox CStr(InputB(1, #1)) выдаёт ошибку.
С помощью какой функции VBA можно прочитать численое значение байта из бинарного файла?
Дело в том, что файлы можно открывать двумя видами:
1) Как текстовый
2) Как бинарный
Вы, видимо просто открываете как текстовый.
Сделайте 2-й вариант.
Выдержка из MSDN:
Opening a File for Binary Access
To open a file for binary access, use the following syntax for the
Open pathname For Binary As filenumber
> Миша
эта функция отдает численное значение байта
Asc Function
Returns an Integer representing the character code corresponding to the first letter in a string.
Syntax
Asc(string)
The required string argument is any valid string expression. If the string contains no characters, a run-time error occurs.
Remarks
The range for returns is 0 ? 255 on non-DBCS systems, but ?32768 ? 32767 on DBCS systems.
Asc Function Example
This example uses the Asc function to return a character code corresponding to the first letter in the string.
Dim MyNumber
MyNumber = Asc("A") ' Returns 65.
MyNumber = Asc("a") ' Returns 97.
MyNumber = Asc("Apple") ' Returns 65.
файл откройте как поток, это позволяет экономить ресурсы компа. А численное значение можно прочитать как
MsgBox CStr(Asc(..............
Насчет открытия файлов - очень просто с помощью скриптов это делается. Это стандартный пример, как с помощью скриптов иметь файлы
Scripting Runtime Library
FileSystemObject Sample Code
The sample code described in this section provides a real-world example that demonstrates many of the features available in the FileSystemObject object model. This code shows how all the features of the object model work together, and how to use those features effectively in your own code.
Notice that since this code is fairly generic, some additional code and a little tweaking are needed to make this code actually run on your machine. These changes are necessary because of the different ways input and output to the user is handled between Active Server Pages and the Windows Scripting Host.
To run this code on an Active Server Page, use the following steps:
Create a standard web page with an .asp extension.
Copy the following sample code into that file between the <BODY>...</BODY> tags.
Enclose all the code within <%...%> tags.
Move the Option Explicit statement from its current position in the code to the very top of your HTML page, positioning it even before the opening <HTML> tag.
Place <%...%> tags around the Option Explicit statement to ensure that it's run on the server side.
Add the following code to the end of the sample code:
Sub Print(x)
Response.Write "<PRE><FONT FACE=""Courier New"" SIZE=""1"">"
Response.Write x
Response.Write "</FONT></PRE>"
End Sub
Main
The previous code adds a print procedure that will run on the server side, but display results on the client side. To run this code on the Windows Scripting Host, add the following code to the end of the sample code:
Sub Print(x)
WScript.Echo x
End Sub
Main
The code is contained in the following section:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FileSystemObject Sample Code
' Copyright 1998 Microsoft Corporation. All Rights Reserved.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Regarding code quality:
' 1) The following code does a lot of string manipulation by
' concatenating short strings together with the "&" operator.
' Since string concatenation is expensive, this is a very
' inefficient way to write code. However, it is a very
' maintainable way to write code, and is used here because this
' program performs extensive disk operations, and because the
' disk is much slower than the memory operations required to
' concatenate the strings. Keep in mind that this is demonstration
' code, not production code.
'
' 2) "Option Explicit" is used, because declared variable access is
' slightly faster than undeclared variable access. It also prevents
' bugs from creeping into your code, such as when you misspell
' DriveTypeCDROM as DriveTypeCDORM.
'
' 3) Error handling is absent from this code, to make the code more
' readable. Although precautions have been taken to ensure that the
' code will not error in common cases, file systems can be
' unpredictable. In production code, use On Error Resume Next and
' the Err object to trap possible errors.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Some handy global variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TabStop
Dim NewLine
Const TestDrive = "C"
Const TestFilePath = "C:\Test"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants returned by Drive.DriveType
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const DriveTypeRemovable = 1
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4
Const DriveTypeRAMDisk = 5
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants returned by File.Attributes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const FileAttrNormal = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32
Const FileAttrAlias = 64
Const FileAttrCompressed = 128
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants for opening files
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowDriveType
' Purpose:
' Generates a string describing the drive type of a given Drive object.
' Demonstrates the following
' - Drive.DriveType
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ShowDriveType(Drive)
Dim S
Select Case Drive.DriveType
Case DriveTypeRemovable
S = "Removable"
Case DriveTypeFixed
S = "Fixed"
Case DriveTypeNetwork
S = "Network"
Case DriveTypeCDROM
S = "CD-ROM"
Case DriveTypeRAMDisk
S = "RAM Disk"
Case Else
S = "Unknown"
End Select
ShowDriveType = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowFileAttr
' Purpose:
' Generates a string describing the attributes of a file or folder.
' Demonstrates the following
' - File.Attributes
' - Folder.Attributes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ShowFileAttr(File) ' File can be a file or folder
Dim S
Dim Attr
Attr = File.Attributes
If Attr = 0 Then
ShowFileAttr = "Normal"
Exit Function
End If
If Attr And FileAttrDirectory Then S = S & "Directory "
If Attr And FileAttrReadOnly Then S = S & "Read-Only "
If Attr And FileAttrHidden Then S = S & "Hidden "
If Attr And FileAttrSystem Then S = S & "System "
If Attr And FileAttrVolume Then S = S & "Volume "
If Attr And FileAttrArchive Then S = S & "Archive "
If Attr And FileAttrAlias Then S = S & "Alias "
If Attr And FileAttrCompressed Then S = S & "Compressed "
ShowFileAttr = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateDriveInformation
' Purpose:
' Generates a string describing the current state of the
' available drives.
' Demonstrates the following
' - FileSystemObject.Drives
' - Iterating the Drives collection
' - Drives.Count
' - Drive.AvailableSpace
' - Drive.DriveLetter
' - Drive.DriveType
' - Drive.FileSystem
' - Drive.FreeSpace
' - Drive.IsReady
' - Drive.Path
' - Drive.SerialNumber
' - Drive.ShareName
' - Drive.TotalSize
' - Drive.VolumeName
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateDriveInformation(FSO)
Dim Drives
Dim Drive
Dim S
Set Drives = FSO.Drives
S = "Number of drives:" & TabStop & Drives.Count & NewLine & NewLine
' Construct 1st line of report.
S = S & String(2, TabStop) & "Drive"
S = S & String(3, TabStop) & "File"
S = S & TabStop & "Total"
S = S & TabStop & "Free"
S = S & TabStop & "Available"
S = S & TabStop & "Serial" & NewLine
' Construct 2nd line of report.
S = S & "Letter"
S = S & TabStop & "Path"
S = S & TabStop & "Type"
S = S & TabStop & "Ready?"
S = S & TabStop & "Name"
S = S & TabStop & "System"
S = S & TabStop & "Space"
S = S & TabStop & "Space"
S = S & TabStop & "Space"
S = S & TabStop & "Number" & NewLine
' Separator line.
S = S & String(105, "-") & NewLine
For Each Drive In Drives
S = S & Drive.DriveLetter
S = S & TabStop & Drive.Path
S = S & TabStop & ShowDriveType(Drive)
S = S & TabStop & Drive.IsReady
If Drive.IsReady Then
If DriveTypeNetwork = Drive.DriveType Then
S = S & TabStop & Drive.ShareName
Else
S = S & TabStop & Drive.VolumeName
End If
S = S & TabStop & Drive.FileSystem
S = S & TabStop & Drive.TotalSize
S = S & TabStop & Drive.FreeSpace
S = S & TabStop & Drive.AvailableSpace
S = S & TabStop & Hex(Drive.SerialNumber)
End If
S = S & NewLine
Next
GenerateDriveInformation = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateFileInformation
' Purpose:
' Generates a string describing the current state of a file.
' Demonstrates the following
' - File.Path
' - File.Name
' - File.Type
' - File.DateCreated
' - File.DateLastAccessed
' - File.DateLastModified
' - File.Size
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateFileInformation(File)
Dim S
S = NewLine & "Path:" & TabStop & File.Path
S = S & NewLine & "Name:" & TabStop & File.Name
S = S & NewLine & "Type:" & TabStop & File.Type
S = S & NewLine & "Attribs:" & TabStop & ShowFileAttr(File)
S = S & NewLine & "Created:" & TabStop & File.DateCreated
S = S & NewLine & "Accessed:" & TabStop & File.DateLastAccessed
S = S & NewLine & "Modified:" & TabStop & File.DateLastModified
S = S & NewLine & "Size" & TabStop & File.Size & NewLine
GenerateFileInformation = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateFolderInformation
' Purpose:
' Generates a string describing the current state of a folder.
' Demonstrates the following
' - Folder.Path
' - Folder.Name
' - Folder.DateCreated
' - Folder.DateLastAccessed
' - Folder.DateLastModified
' - Folder.Size
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateFolderInformation(Folder)
Dim S
S = "Path:" & TabStop & Folder.Path
S = S & NewLine & "Name:" & TabStop & Folder.Name
S = S & NewLine & "Attribs:" & TabStop & ShowFileAttr(Folder)
S = S & NewLine & "Created:" & TabStop & Folder.DateCreated
S = S & NewLine & "Accessed:" & TabStop & Folder.DateLastAccessed
S = S & NewLine & "Modified:" & TabStop & Folder.DateLastModified
S = S & NewLine & "Size:" & TabStop & Folder.Size & NewLine
GenerateFolderInformation = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateAllFolderInformation
' Purpose:
' Generates a string describing the current state of a
' folder and all files and subfolders.
' Demonstrates the following
' - Folder.Path
' - Folder.SubFolders
' - Folders.Count
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateAllFolderInformation(Folder)
Dim S
Dim SubFolders
Dim SubFolder
Dim Files
Dim File
S = "Folder:" & TabStop & Folder.Path & NewLine & NewLine
Set Files = Folder.Files
If 1 = Files.Count Then
S = S & "There is 1 file" & NewLine
Else
S = S & "There are " & Files.Count & " files" & NewLine
End If
If Files.Count <> 0 Then
For Each File In Files
S = S & GenerateFileInformation(File)
Next
End If
Set SubFolders = Folder.SubFolders
If 1 = SubFolders.Count Then
S = S & NewLine & "There is 1 sub folder" & NewLine & NewLine
Else
S = S & NewLine & "There are " & SubFolders.Count & " sub folders" _
NewLine & NewLine
End If
If SubFolders.Count <> 0 Then
For Each SubFolder In SubFolders
S = S & GenerateFolderInformation(SubFolder)
Next
S = S & NewLine
For Each SubFolder In SubFolders
S = S & GenerateAllFolderInformation(SubFolder)
Next
End If
GenerateAllFolderInformation = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateTestInformation
' Purpose:
' Generates a string describing the current state of the C:\Test
' folder and all files and subfolders.
' Demonstrates the following
' - FileSystemObject.DriveExists
' - FileSystemObject.FolderExists
' - FileSystemObject.GetFolder
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateTestInformation(FSO)
Dim TestFolder
Dim S
If Not FSO.DriveExists(TestDrive) Then Exit Function
If Not FSO.FolderExists(TestFilePath) Then Exit Function
Set TestFolder = FSO.GetFolder(TestFilePath)
GenerateTestInformation = GenerateAllFolderInformation(TestFolder)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteTestDirectory
' Purpose:
' Cleans up the test directory.
' Demonstrates the following
' - FileSystemObject.GetFolder
' - FileSystemObject.DeleteFile
' - FileSystemObject.DeleteFolder
' - Folder.Delete
' - File.Delete
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DeleteTestDirectory(FSO)
Dim TestFolder
Dim SubFolder
Dim File
' Two ways to delete a file:
FSO.DeleteFile(TestFilePath & "\Beatles\OctopusGarden.txt")
Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
File.Delete
' Two ways to delete a folder:
FSO.DeleteFolder(TestFilePath & "\Beatles")
FSO.DeleteFile(TestFilePath & "\ReadMe.txt")
Set TestFolder = FSO.GetFolder(TestFilePath)
TestFolder.Delete
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CreateLyrics
' Purpose:
' Builds a couple of text files in a folder.
' Demonstrates the following
' - FileSystemObject.CreateTextFile
' - TextStream.WriteLine
' - TextStream.Write
' - TextStream.WriteBlankLines
' - TextStream.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateLyrics(Folder)
Dim TextStream
Set TextStream = Folder.CreateTextFile("OctopusGarden.txt")
' Note that this does not add a line feed to the file.
TextStream.Write("Octopus' Garden ")
TextStream.WriteLine("(by Ringo Starr)")
TextStream.WriteBlankLines(1)
TextStream.WriteLine("I'd like to be under the sea in an octopus' garden in the shade,")
TextStream.WriteLine("He'd let us in, knows where we've been -- in his octopus' garden in the shade.")
TextStream.WriteBlankLines(2)
TextStream.Close
Set TextStream = Folder.CreateTextFile("BathroomWindow.txt")
TextStream.WriteLine("She Came In Through The Bathroom Window (by Lennon/McCartney)")
TextStream.WriteLine("")
TextStream.WriteLine("She came in through the bathroom window protected by a silver spoon")
TextStream.WriteLine("But now she sucks her thumb and wanders by the banks of her own lagoon")
TextStream.WriteBlankLines(2)
TextStream.Close
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetLyrics
' Purpose:
' Displays the contents of the lyrics files.
' Demonstrates the following
' - FileSystemObject.OpenTextFile
' - FileSystemObject.GetFile
' - TextStream.ReadAll
' - TextStream.Close
' - File.OpenAsTextStream
' - TextStream.AtEndOfStream
' - TextStream.ReadLine
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLyrics(FSO)
Dim TextStream
Dim S
Dim File
' There are several ways to open a text file, and several
' ways to read the data out of a file. Here's two ways
' to do each:
Set TextStream = FSO.OpenTextFile(TestFilePath & "\Beatles\OctopusGarden.txt", OpenFileForReading)
S = TextStream.ReadAll & NewLine & NewLine
TextStream.Close
Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
Set TextStream = File.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = S & TextStream.ReadLine & NewLine
Loop
TextStream.Close
GetLyrics = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' BuildTestDirectory
' Purpose:
' Builds a directory hierarchy to demonstrate the FileSystemObject.
' We'll build a hierarchy in this order:
' C:\Test
' C:\Test\ReadMe.txt
' C:\Test\Beatles
' C:\Test\Beatles\OctopusGarden.txt
' C:\Test\Beatles\BathroomWindow.txt
' Demonstrates the following
' - FileSystemObject.DriveExists
' - FileSystemObject.FolderExists
' - FileSystemObject.CreateFolder
' - FileSystemObject.CreateTextFile
' - Folders.Add
' - Folder.CreateTextFile
' - TextStream.WriteLine
' - TextStream.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function BuildTestDirectory(FSO)
Dim TestFolder
Dim SubFolders
Dim SubFolder
Dim TextStream
' Bail out if (a) the drive does not exist, or if (b) the directory is being built
' already exists.
If Not FSO.DriveExists(TestDrive) Then
BuildTestDirectory = False
Exit Function
End If
If FSO.FolderExists(TestFilePath) Then
BuildTestDirectory = False
Exit Function
End If
Set TestFolder = FSO.CreateFolder(TestFilePath)
Set TextStream = FSO.CreateTextFile(TestFilePath & "\ReadMe.txt")
TextStream.WriteLine("My song lyrics collection")
TextStream.Close
Set SubFolders = TestFolder.SubFolders
Set SubFolder = SubFolders.Add("Beatles")
CreateLyrics SubFolder
BuildTestDirectory = True
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The main routine
' First, it creates a test directory, along with some subfolders
' and files. Then, it dumps some information about the available
' disk drives and about the test directory, and then cleans
' everything up again.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main
Dim FSO
' Set up global data.
TabStop = Chr(9)
NewLine = Chr(10)
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not BuildTestDirectory(FSO) Then
Print "Test directory already exists or cannot be created. Cannot continue."
Exit Sub
End If
Print GenerateDriveInformation(FSO) & NewLine & NewLine
Print GenerateTestInformation(FSO) & NewLine & NewLine
Print GetLyrics(FSO) & NewLine & NewLine
DeleteTestDirectory(FSO)
End Sub
--------------------------------------------------------------------------------
? 2001 Microsoft Corporation. All rights reserved.
Build: Topic Version 5.6.9309.1546
Уважаемые Тютюнников и 3dcad! Очень приятно, что Вы мне дали столько информации. Только байт - это двузначное шестнадцатеричное целое и один символ может быть представлен в системе DOS двумя байтами. Насколько я понял это младший байт и старший байт, а вместе они образуют слово. Вернее пара байтов записанных в соседних ячейках памяти называется словом.
"При этом младший байт слова хранится по адресу, значение которого совпадает с адресом слова, а адрес старшего байта на 1 больше".
Книга "Освоим QBasic играючи", Эрни Каспер, Изд. "Радио и связь", стр. 127, 6 абзац свеху.
В языке QBasic есть специальные функции для чтения этих байтов (пример для чтения целых чисел типа INTEGER):
CLS 'Очистка экрана A%=0 'Присвоение значения переменой PRINT A% 'Вывод значения на экран pag&=VARSEG(A%) 'Определение сегмента adr&=VARPTR(A%) 'Определение смещения DEFSEG=pag& 'Задание сегмента для чтения из ОЗУ B0%=PEEK(adr&) 'Чтение младшего байта B1%=PEEK(adr&+1) 'Чтение старшего байта PRINT B0%, B1% 'Вывод значений байтов на экран
Для правильного чтения знака числа и вывода численного значения числа на экран последнюю строку надо заменить на следующие 6 строк:
IF B1%<128 THEN 'Проверка знака числа C%=B0%+256*B1% 'Вычисление положительного значения ELSE C%=B0%+256*(B1%-256) 'Вычисление отрицательного значения ENDIF PRINT C% 'Вывод значения числа на экран
"Правильность понимания кодирования чисел типа INTEGER будет продемонстрирована совпадением значений, напечатанных в первой и второй строках", стр. 128.
На основании этих данных мне удалось написать 4 подпрограммы 3 из которых вроде не выдают ошибки. А вот 4 для типа DOUBLE не хочет никак работать. Изучите пожалуйста эти программы и помогите мне исправить ошибки в 4 подпрограмме чтобы она правильно работала:
Public Sub BaitInteger()
Dim b0 As Integer, b1 As Integer, Число As Integer, ЧислоОтвет As Variant
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
Число = CInt(InputBox(0, "Веди число"))
Put 1#, , Число
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
Close 1#
If b1 < 128 Then 'Проверка знака числа
ЧислоОтвет = b0 + 256 * b1 'Вычисление положительного значения
Else
ЧислоОтвет = b0 + 256 * (b1 - 256) 'Вычисление отрицательного значения
End If
MsgBox "Старший байт: " & CStr(b0) & vbLf & _
"Младший байт: " & CStr(b1) & vbLf & _
"Было введено число: " & ЧислоОтвет
GoTo ПроверитьСледующееЧисло
End Sub
Public Sub BaitLong()
Dim b0 As Long, b1 As Long, b2 As Long, b3 As Long, Число As Long, ЧислоОтвет As Long
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
Число = CLng(InputBox(0, "Веди число"))
Put 1#, , Число
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
b2 = Asc(Input(1, 1#))
b3 = Asc(Input(1, 1#))
Close 1#
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3)
If b3 < 128 Then 'Проверка знака числа
ЧислоОтвет = b0 + 256 * (b1 + 256 * (b2 + 256 * b3)) 'Вычисление положительного значения
Else
ЧислоОтвет = b0 + 256 * (b1 + 256 * (b2 + 256 * (b3 - 256))) 'Вычисление отрицательного значения
End If
MsgBox "Было введено число: " & ЧислоОтвет
GoTo ПроверитьСледующееЧисло
End Sub
Public Sub BaitSingle()
Dim b0 As Single, b1 As Single, b2 As Single, b3 As Single, Число As Single, ЧислоОтвет As Single
Dim ЗнакЧисла As Integer, ПорядокЧисла As Integer, I As Integer
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
Число = CSng(InputBox("Веди число", "SINGLE"))
Put 1#, , Число
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
b2 = Asc(Input(1, 1#))
b3 = Asc(Input(1, 1#))
Close 1#
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3)
'Определение знака числа
If b3 < 128 Then 'Проверка знака числа
ЗнакЧисла = 1
Else
ЗнакЧисла = -1
b3 = b3 - 128
End If
'Вычисление кода порядка
ПорядокЧисла = 2 * b3
'Коррекция кодов порядка и мантиссы
If b2 > 127 Then
ПорядокЧисла = ПорядокЧисла + 1
b2 = b2 - 128
End If
'Коррекция нормализованной мантиссы
If ПорядокЧисла > 0 Then
b2 = b2 + 128
End If
'Вычисление мантиссы
ЧислоОтвет = ((b0 / 256 + b1) / 256 + b2) / 256
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3) & vbLf & _
"Знак числа: " & CStr(ЗнакЧисла) & vbLf & _
"Порядок числа: " & CStr(ПорядокЧисла)
'Вычисление модуля
If ПорядокЧисла > 126 Then
' при положительном порядке
For I = 1 To ПорядокЧисла - 126
ЧислоОтвет = ЧислоОтвет * 2
Next I
ElseIf ПорядокЧисла < 126 Then
' при отрицательном порядке
For I = 1 To 126 - ПорядокЧисла
ЧислоОтвет = ЧислоОтвет / 2
Next I
End If
'Коррекция знака числа
If ЗнакЧисла < 0 Then
ЧислоОтвет = -ЧислоОтвет
End If
MsgBox "Было введено число: " & ЧислоОтвет
GoTo ПроверитьСледующееЧисло
End Sub
Public Sub BaitDouble()
Dim b0 As Double, b1 As Double, b2 As Double, b3 As Double, b4 As Double, b5 As Double, b6 As Double, b7 As Double, Число As Double, ЧислоОтвет As Double
Dim ЗнакЧисла As Integer, ПорядокЧисла As Integer, I As Integer
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
Число = CDbl(InputBox("Веди число", "Double"))
Put 1#, , Число
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
b2 = Asc(Input(1, 1#))
b3 = Asc(Input(1, 1#))
b4 = Asc(Input(1, 1#))
b5 = Asc(Input(1, 1#))
b6 = Asc(Input(1, 1#))
b7 = Asc(Input(1, 1#))
Close 1#
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3) & vbLf & _
"Байт ?5: " & CStr(b4) & vbLf & _
"Байт ?6: " & CStr(b5) & vbLf & _
"Байт ?7: " & CStr(b6) & vbLf & _
"Байт ?8: " & CStr(b7)
'Определение знака числа
If b7 < 128 Then 'Проверка знака числа
ЗнакЧисла = 1
Else
ЗнакЧисла = -1
b7 = b7 - 128
End If
'Вычисление кода порядка
ПорядокЧисла = 2 * b7
'Коррекция кодов порядка и мантиссы
If b6 > 127 Then
ПорядокЧисла = ПорядокЧисла + 1
b6 = b6 - 128
End If
'Коррекция нормализованной мантиссы
If ПорядокЧисла > 0 Then
b6 = b6 + 128
End If
'Вычисление мантиссы
ЧислоОтвет = ((((((b0 / 256 + b1) / 256 + b2) / 256 + b3) / 256 + b4) / 256 + b5) / 256 + b6) / 256
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3) & vbLf & _
"Байт ?5: " & CStr(b4) & vbLf & _
"Байт ?6: " & CStr(b5) & vbLf & _
"Байт ?7: " & CStr(b6) & vbLf & _
"Байт ?8: " & CStr(b7) & vbLf & _
"Знак числа: " & CStr(ЗнакЧисла) & vbLf & _
"Порядок числа: " & CStr(ПорядокЧисла)
'Вычисление модуля
If ПорядокЧисла > 126 Then
' при положительном порядке
For I = 1 To ПорядокЧисла - 126
ЧислоОтвет = ЧислоОтвет * 2
Next I
ElseIf ПорядокЧисла < 126 Then
' при отрицательном порядке
For I = 1 To 126 - ПорядокЧисла
ЧислоОтвет = ЧислоОтвет / 2
Next I
End If
'Коррекция знака числа
If ЗнакЧисла < 0 Then
ЧислоОтвет = -ЧислоОтвет
End If
MsgBox "Было введено число: " & ЧислоОтвет
GoTo ПроверитьСледующееЧисло
End SubМне кажется что для типа Double 2 последних байта отвечают за порядок числа но как они эти байты взаимоувязываются друг с другом мне не понятно. Если сделать 4 подпрограмму в следующем виде:
Public Sub BaitDouble()
Dim b0 As Double, b1 As Double, b2 As Double, b3 As Double, b4 As Double, b5 As Double, b6 As Double, b7 As Double, Число As Double, ЧислоОтвет As Double
Dim ЗнакЧисла As Integer, ПорядокЧисла As Integer, I As Integer
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
Число = CDbl(InputBox("Веди число", "Double"))
Put 1#, , Число
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
b2 = Asc(Input(1, 1#))
b3 = Asc(Input(1, 1#))
b4 = Asc(Input(1, 1#))
b5 = Asc(Input(1, 1#))
b6 = Asc(Input(1, 1#))
b7 = Asc(Input(1, 1#))
Close 1#
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3) & vbLf & _
"Байт ?5: " & CStr(b4) & vbLf & _
"Байт ?6: " & CStr(b5) & vbLf & _
"Байт ?7: " & CStr(b6) & vbLf & _
"Байт ?8: " & CStr(b7)
'Определение знака числа
If b7 < 128 Then 'Проверка знака числа
ЗнакЧисла = 1
Else
ЗнакЧисла = -1
b7 = b7 - 128
End If
'Вычисление кода порядка
ПорядокЧисла = 2 * b7
'Коррекция кодов порядка и мантиссы
If b5 > 127 Then
ПорядокЧисла = ПорядокЧисла + 1
b5 = b5 - 128
End If
'Коррекция нормализованной мантиссы
If ПорядокЧисла > 0 Then
b5 = b5 + 128
End If
'Вычисление мантиссы
ЧислоОтвет = (((((b0 / 256 + b1) / 256 + b2) / 256 + b3) / 256 + b4) / 256 + b5) / 256
MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
"Байт ?2: " & CStr(b1) & vbLf & _
"Байт ?3: " & CStr(b2) & vbLf & _
"Байт ?4: " & CStr(b3) & vbLf & _
"Байт ?5: " & CStr(b4) & vbLf & _
"Байт ?6: " & CStr(b5) & vbLf & _
"Байт ?7: " & CStr(b6) & vbLf & _
"Байт ?8: " & CStr(b7) & vbLf & _
"Знак числа: " & CStr(ЗнакЧисла) & vbLf & _
"Порядок числа: " & CStr(ПорядокЧисла)
'Вычисление модуля
If ПорядокЧисла > 126 Then
' при положительном порядке
For I = 1 To ПорядокЧисла - 126
ЧислоОтвет = ЧислоОтвет * 2
Next I
ElseIf ПорядокЧисла < 126 Then
' при отрицательном порядке
For I = 1 To 126 - ПорядокЧисла
ЧислоОтвет = ЧислоОтвет / 2
Next I
End If
'Коррекция знака числа
If ЗнакЧисла < 0 Then
ЧислоОтвет = -ЧислоОтвет
End If
MsgBox "Было введено число: " & ЧислоОтвет
GoTo ПроверитьСледующееЧисло
End SubТо для числа 0,5 программа работает правильно, а для чисел 0,6; 0,7 не правильно. Помогите пожалуйста разобраться в чём тут дело!
Помогите пожалуйста разобраться для чего чтобы разобраться с кодированием знака числа надо задавать число равным целым степеням 2 (2,4,8,16,32,64...). Смотри текст на стр. 130.
И как можно по значению байта выдаваемого функцией Asc определить какой разряд двоичного числа изменяется при изменении числа Double?
Далее почему в тексте написано:
"По этим наблюдениям можно убедиться, что порядок числа кодируется 6 разрядами байта b3 (за исключением старшего разряда) и старшим разрядом b2", стр. 130.
6+1 (старший разряд)=7
Но байт это двузначное шестнадцатеричное или 8 значное двоичное. Должно быть 8 разрядов. Почему в тексте говороится только о 7 разрядах?
Коррекция кода порядка происходит следующим образом:
if b2>127 then
b2=b2-128
endif
Коррекция нормализованной мантиссы делается следующим образом:
if p>0 then
b2=b2+128
endif
На основании чего делаются такие коррекции? Сначала вычитается 128 а потом прибавляется.
Для лёгкости исследований у меня в Excell получилась следующая програмка:
Dim НомЧисла As Long, НачЯчейка As Range
Private Sub CommandButton1_ПротестироватьФункцию_Click()
Dim КолвоЧисел As Long, Число As Double, ШагПриращения As Double
Число = Range("НачЧисло")
ШагПриращения = Range("ШагПриращения")
КолвоЧисел = Range("КолвоЧисел")
Set НачЯчейка = Range("НачалоТаблицы")
For НомЧисла = 1 To КолвоЧисел
Call TestBaitDouble(Число)
Число = Число + ШагПриращения
Next НомЧисла
End Sub
Public Sub TestBaitDouble(dblЧисло As Double)
Dim b0 As Double, b1 As Double, b2 As Double, b3 As Double, b4 As Double, b5 As Double, b6 As Double, b7 As Double, Число As Double, ЧислоОтвет As Double
Dim ЗнакЧисла As Integer, ПорядокЧисла As Integer, I As Integer
ПроверитьСледующееЧисло:
Open "bait" For Binary As 1#
' Число = CDbl(InputBox("Веди число", "Double"))
Put 1#, , dblЧисло
Close 1#
Open "bait" For Binary As 1#
b0 = Asc(Input(1, 1#))
b1 = Asc(Input(1, 1#))
b2 = Asc(Input(1, 1#))
b3 = Asc(Input(1, 1#))
b4 = Asc(Input(1, 1#))
b5 = Asc(Input(1, 1#))
b6 = Asc(Input(1, 1#))
b7 = Asc(Input(1, 1#))
Close 1#
' MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
' "Байт ?2: " & CStr(b1) & vbLf & _
' "Байт ?3: " & CStr(b2) & vbLf & _
' "Байт ?4: " & CStr(b3) & vbLf & _
' "Байт ?5: " & CStr(b4) & vbLf & _
' "Байт ?6: " & CStr(b5) & vbLf & _
' "Байт ?7: " & CStr(b6) & vbLf & _
' "Байт ?8: " & CStr(b7)
НачЯчейка.Offset(НомЧисла, 0) = НомЧисла
НачЯчейка.Offset(НомЧисла, 1) = dblЧисло
НачЯчейка.Offset(НомЧисла, 2) = b0
НачЯчейка.Offset(НомЧисла, 3) = b1
НачЯчейка.Offset(НомЧисла, 4) = b2
НачЯчейка.Offset(НомЧисла, 5) = b3
НачЯчейка.Offset(НомЧисла, 6) = b4
НачЯчейка.Offset(НомЧисла, 7) = b5
НачЯчейка.Offset(НомЧисла, 8) = b6
НачЯчейка.Offset(НомЧисла, 9) = b7
'Определение знака числа
If b7 < 128 Then 'Проверка знака числа
ЗнакЧисла = 1
Else
ЗнакЧисла = -1
b7 = b7 - 128
End If
'Вычисление кода порядка
ПорядокЧисла = 2 * b7
'Коррекция кодов порядка и мантиссы
If b6 - 117 > 127 Then
ПорядокЧисла = ПорядокЧисла + 1
b5 = b5 - 128
End If
'Коррекция нормализованной мантиссы
If ПорядокЧисла > 0 Then
b5 = b5 + 128
End If
'Вычисление мантиссы
ЧислоОтвет = (((((b0 / 256 + b1) / 256 + b2) / 256 + b3) / 256 + b4) / 256 + b5) / 256
' MsgBox "Байт ?1 : " & CStr(b0) & vbLf & _
' "Байт ?2: " & CStr(b1) & vbLf & _
' "Байт ?3: " & CStr(b2) & vbLf & _
' "Байт ?4: " & CStr(b3) & vbLf & _
' "Байт ?5: " & CStr(b4) & vbLf & _
' "Байт ?6: " & CStr(b5) & vbLf & _
' "Байт ?7: " & CStr(b6) & vbLf & _
' "Байт ?8: " & CStr(b7) & vbLf & _
' "Знак числа: " & CStr(ЗнакЧисла) & vbLf & _
' "Порядок числа: " & CStr(ПорядокЧисла)
'Вычисление модуля
If ПорядокЧисла > 126 Then
' при положительном порядке
For I = 1 To ПорядокЧисла - 126
ЧислоОтвет = ЧислоОтвет * 2
Next I
ElseIf ПорядокЧисла < 126 Then
' при отрицательном порядке
For I = 1 To 126 - ПорядокЧисла
ЧислоОтвет = ЧислоОтвет / 2
Next I
End If
'Коррекция знака числа
If ЗнакЧисла < 0 Then
ЧислоОтвет = -ЧислоОтвет
End If
НачЯчейка.Offset(НомЧисла, 10) = ЗнакЧисла
НачЯчейка.Offset(НомЧисла, 11) = ПорядокЧисла
НачЯчейка.Offset(НомЧисла, 12) = ЧислоОтвет
' MsgBox "Было введено число: " & ЧислоОтвет
' GoTo ПроверитьСледующееЧисло
End SubДумаю специалисты (кому надо) разберутся что надо сделать чтобы она работала. А для тех кто не понимает поясню. Надо на листе Excell Создать именнованные ячейки:
1. "НачЧисло"
2. "ШагПриращения"
3. "КолвоЧисел"
4. "НачалоТаблицы"
и создать кнопку: "CommandButton1_ПротестироватьФункцию"
Далее указать числа в первых 3 именнованных ячейках и нажать кнопку "CommandButton1_ПротестироватьФункцию".
Удачных Вам исследований!
> Миша
Уважаемые Тютюнников и 3dcad!. Только байт - это двузначное шестнадцатеричное .......
для того, чтобы разложить 8-байтное число в строку битов, надо посмотреть в спецификацию майкрософт(см.выше), а собственно выдернуть байты из 8-байтной переменной (хотя Ваш способ по своему уникален, ) можно проще -
Option Explicit Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Type ValueDouble byte1 As Byte byte2 As Byte byte3 As Byte byte4 As Byte byte5 As Byte byte6 As Byte byte7 As Byte byte8 As Byte End Type Sub typeDouble() Dim AA As Double, CC As Variant, BB As ValueDouble AA = 8855.23422 CopyMemory BB, AA, 8 Debug.Print BB.byte1, BB.byte2, BB.byte3, BB.byte4, BB.byte5, BB.byte6, BB.byte7, BB.byte8 End Sub
вот и исследуйте......
///---------------------------------------------------------
www.mechmagic.com
У меня всё получилось с помощью функции:
dim dbl as Double
Get 1#, , dbl
dbl получается вещественым двойной точности.
Однако все равно интересно как закодированы переменные типа Double с помощью 8 байтов. Пока мне это не удалось понять.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Как десятичные числа с плавающей точкой перевести в байтовый вид и наоборот?
Форум работает на PunBB, при поддержке Informer Technologies, Inc
