转换二进制文件到文本文件
二进制方件是按照巴恩斯范式以块的方式存储的。关键字块和数据块,关键字块标明关键字类型,例如整型或单精度、双精度实型以及数据个数,相应到数据块去读数据。要用到API函数( CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 4)
我加上
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public fMainForm As frmMain
总是提示错误,直接退出了。
请帮我修改一下,谢谢了!
下面是具体程序,窗体那一部分。
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal Hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Const Hwndx = -1
Private Sub Command1_Click()
Dim I As Integer
Dim hexData As String, hexData2 As String
Dim a As Single
Dim buffer(0 To 3) As Byte
a = Val(Text1)
CopyMemory buffer(0), a, 4
For I = 0 To 3
If Len(Hex(buffer(I))) = 1 Then
hexData = "0" & Hex(buffer(I)) + hexData
Else
hexData = Hex(buffer(I)) + hexData
End If
Next
For I = 0 To 3
If Len(Hex(buffer(3 - I))) = 1 Then
hexData2 = "0" & Hex(buffer(3 - I)) + hexData2
Else
hexData2 = Hex(buffer(3 - I)) + hexData2
End If
Next
Text2 = hexData
Text6 = hexData2
End Sub
Private Sub Command2_Click()
Dim sinStr As String
Dim sinSj As Single
Dim buffer(0 To 3) As Byte
Dim I As Integer, j%
sinStr = Text4
j = Len(Text4)
If j > 7 Then
j = 7
End If
For I = 1 To j Step 2
buffer((7 - I) / 2) = Val("&H" & Mid(sinStr, I, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 4
Text3 = sinSj
'Text4 = Round(sinSj, 6)
End Sub
Private Sub Command3_Click()
Dim str As String, str1 As String
str = Text5
str1 = Mid(str, 7, 2) + Mid(str, 5, 2) + Mid(str, 3, 2) + Mid(str, 1, 2)
Text4.Text = str1
End Sub
Private Sub Command4_Click()
Dim Noncepath, Filename As String
Dim ReadFileNo, WriteFileNO As Integer
Noncepath = App.Path
Filename = Noncepath & "\history.EGRID"
'读写文件号
ReadFileNo = FreeFile
Open Filename For Binary Access Read As ReadFileNo
Filename = Noncepath & "\history.d"
'读写文件号
WriteFileNO = FreeFile
Open Filename For Output As WriteFileNO
Dim key1 As KeywordBlock
Dim data1 As DataBlock
Dim chrTemp As String
Dim ByteSum As Integer
Dim sinSj As Single
Dim intSj As Integer
Dim chrSj As String
Dim douSj As Long
ByteSum = 0
Do While Not EOF(1)
'读KEYWORD块
chrTemp = ReadByte(1, 4)
Print #WriteFileNO, chrTemp
key1.KeywordBlockLength1 = IntCovert(chrTemp)
chrTemp = ReadByte(1, 8)
Print #WriteFileNO, chrTemp
key1.Keyword = CharCovert(chrTemp)
chrTemp = ReadByte(1, 4)
key1.ParamCount = IntCovert(chrTemp)
chrTemp = ReadByte(1, 4)
key1.ParamType = CharCovert(chrTemp)
chrTemp = ReadByte(1, 4)
key1.KeywordBlockLength2 = IntCovert(chrTemp)
ByteSum = ByteSum + key1.KeywordBlockLength2
'读DATA块
ReDim data1.data(key1.ParamCount) As String
Dim I As Integer
chrTemp = ReadByte(1, 4)
data1.DataBlockLength1 = IntCovert(chrTemp)
If key1.ParamType = "INTE" Then
For I = 0 To key1.ParamCount - 1
chrTemp = ReadByte(1, 4)
data1.data(I) = IntCovert(chrTemp)
Next I
ElseIf key1.ParamType = "REAL" Then
For I = 0 To key1.ParamCount - 1
chrTemp = ReadByte(1, 4)
data1.data(I) = RealCovert(chrTemp)
Next I
ElseIf key1.ParamType = "DOUB" Then
For I = 0 To key1.ParamCount - 1
chrTemp = ReadByte(1, 8)
data1.data(I) = DoubCovert(chrTemp)
Next I
ElseIf key1.ParamType = "CHAR" Then
For I = 0 To key1.ParamCount - 1
chrTemp = ReadByte(1, 4)
data1.data(I) = CharCovert(chrTemp)
Next I
End If
chrTemp = ReadByte(1, 4)
data1.DataBlockLength2 = IntCovert(chrTemp)
ByteSum = ByteSum + data1.DataBlockLength2
'输出两个块的关键字
Print #WriteFileNO, key1.Keyword
For I = 1 To key1.ParamCount - 1
Print #WriteFileNO, data1.data(I)
Next I
Loop
Close
End Sub
Private Sub Form_Load()
Dim XX As Long
XX = SetWindowPos(Me.Hwnd, Hwndx, 0, 0, 0, 0, 3)
' Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 500)
' Me.Top = GetSetting(App.Title, "Settings", "MainTop", 500)
' Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 3000)
' Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 3000)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim I As Integer
'close all sub forms
For I = Forms.Count - 1 To 1 Step -1
Unload Forms(I)
Next
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
End Sub
还有一个子程序模块
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public fMainForm As frmMain
Const ReadFileNo = 1
Public buffer() As Byte
Type KeywordBlock
KeywordBlockLength1 As Integer
Keyword As String
ParamCount As Integer
ParamType As String
KeywordBlockLength2 As Integer
End Type
Type DataBlock
DataBlockLength1 As Integer
data() As String
TypeData As String
Count As Integer
DataBlockLength2 As Integer
End Type
Sub Main()
Set fMainForm = New frmMain
fMainForm.Show
End Sub
Function ReadByte(ReadFileNo, ByteCount As Integer) As String
Dim dsx() As Integer
ReDim dsx(ByteCount) As Integer
Dim j As Integer
ReadByte = ""
For j = 0 To ByteCount - 1
Get #ReadFileNo, , dsx(j)
ReadByte = ReadByte + Chr(dsx(j))
Next j
'Print ReadByte
End Function
Function IntCovert(sinStr As String) As Integer
Dim sinSj As Integer
ReDim buffer(4) As Byte
Dim I As Integer, j%
j = Len(sinStr)
If j > 7 Then
j = 7
End If
For I = 1 To j Step 2
buffer((7 - I) / 2) = Val("&H" & Mid(sinStr, I, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 4
IntCovert = sinSj
End Function
Function CharCovert(sinStr As String) As String
Dim sinSj As String
ReDim buffer(4) As Byte
Dim I As Integer, j%
j = Len(sinStr)
If j > 7 Then
j = 7
End If
For I = 1 To j Step 2
buffer((7 - I) / 2) = Val("&H" & Mid(sinStr, I, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 4
CharCovert = sinSj
End Function
Function RealCovert(sinStr As String) As Single
Dim sinSj As Single
ReDim buffer(4) As Byte
Dim I As Integer, j%
j = Len(sinStr)
If j > 7 Then
j = 7
End If
For I = 1 To j Step 2
buffer((7 - I) / 2) = Val("&H" & Mid(sinStr, I, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 4
RealCovert = sinSj
End Function
Function LogiCovert(sinStr As String) As Integer
End Function
Function DoubCovert(sinStr As String) As Double
Dim sinSj As Double
ReDim buffer(8) As Byte
Dim I As Integer, j%
j = Len(sinStr)
If j > 16 Then
j = 16
End If
For I = 1 To j Step 2
buffer((7 - I) / 2) = Val("&H" & Mid(sinStr, I, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(buffer(0)), 8
DoubCovert = sinSj
End Function
--------------------编程问答-------------------- 大侠们,帮帮我吧
--------------------编程问答-------------------- 这个问题自己解决了,错误出在转换文本那里。
但输入文件为什么还是二进制的
补充:VB , API