当前位置:编程学习 > VB >>

转换二进制文件到文本文件

二进制方件是按照巴恩斯范式以块的方式存储的。关键字块和数据块,关键字块标明关键字类型,例如整型或单精度、双精度实型以及数据个数,相应到数据块去读数据。
要用到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
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,