form1.frm

为VB编写的程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2580
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   ScaleHeight     =   2580
   ScaleWidth      =   4665
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   3240
      TabIndex        =   3
      Top             =   1680
      Width           =   1092
   End
   Begin MSComDlg.CommonDialog comDlg 
      Left            =   0
      Top             =   0
      _ExtentX        =   688
      _ExtentY        =   688
      _Version        =   393216
   End
   Begin VB.TextBox txtShow 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   480
      TabIndex        =   2
      Top             =   720
      Width           =   3732
   End
   Begin VB.CommandButton cmdSaveFile 
      Caption         =   "保存信息"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   1800
      TabIndex        =   1
      Top             =   1680
      Width           =   1092
   End
   Begin VB.CommandButton cmdReadFile 
      Caption         =   "读信息"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   360
      TabIndex        =   0
      Top             =   1680
      Width           =   1092
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim fstrMessage As String

Private Sub cmdExit_Click()
    txtShow.Text = ""
    Unload Me
End Sub

Private Sub cmdReadFile_Click()
    Dim strFName As String
    
    txtShow.Text = ""
    cmdReadFile.Enabled = False
    
    fstrMessage = ""
    
On Error Resume Next

    comDlg.Flags = cdlOFNHideReadOnly Or cdlOFNExplorer
    comDlg.CancelError = True
    comDlg.DialogTitle = "打开数据文件"
    comDlg.Filter = "数据文件 (*.txt)|*.txt|所有文件 (*.*)|*.*"
    comDlg.FileName = ""
    comDlg.ShowOpen
    If Err = cdlCancel Then
        cmdReadFile.Enabled = True
        Exit Sub
    End If
    
    strFName = comDlg.FileName
    
    Dim FileNumber As Integer
    Dim Cline As String
    
    FileNumber = FreeFile

    Open strFName For Input As FileNumber
        Do While Not EOF(FileNumber)
            Line Input #FileNumber, Cline
            Cline = Trim(Cline)
            If Cline <> "" Then
                If Left(Cline, 7) = "Datas: " Then
                    fstrMessage = fstrMessage & Right(Cline, Len(Cline) - 7)
                End If
            End If
        Loop
    Close FileNumber
    txtShow.Text = "数据读取完成！"
    
    cmdReadFile.Enabled = True
    cmdSaveFile.Enabled = True
    
End Sub

Private Sub cmdSaveFile_Click()

    Dim bytResult() As Byte
    Dim intNum As Integer
    
    ReDim bytResult(4096)
    
    txtShow.Text = ""
    cmdSaveFile.Enabled = False
    
    bytResult = ParaCode(fstrMessage)
    
    intNum = UBound(bytResult)

    On Error GoTo ErrResult
    
    comDlg.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
    comDlg.Filter = "数据文件 (*.bin)|*.bin|所有文件 (*.*)|*.*"
    comDlg.FilterIndex = 1
    comDlg.ShowSave

    Dim Cline As String
    Dim FileNumber As Integer
    FileNumber = FreeFile

    Dim lngWrite As Long
    Dim intCir As Integer
    
    lngWrite = 1
    
    Open comDlg.FileName For Binary As FileNumber
        For intCir = 0 To intNum
            Put #FileNumber, lngWrite, bytResult(intCir)
            lngWrite = lngWrite + 1
        Next
    Close FileNumber
    txtShow.Text = "数据转化成功！"
    
    cmdSaveFile.Enabled = True
    
ErrResult:
End Sub

Public Function ParaCode(ByVal strPara As String) As Variant
    Dim intLen As Integer
    Dim bytArray() As Byte
    Dim intTotal As Integer
    Dim strPart As String
    
    If strPara = "" Then
        ParaCode = bytArray
        Exit Function
    End If
    ReDim bytArray(4096)
    intTotal = Len(strPara) / 2
    For intLen = 1 To intTotal
        strPart = Mid(strPara, intLen * 2 - 1, 2)
        bytArray(intLen - 1) = "&H" & strPart
    Next
    ReDim Preserve bytArray(intTotal - 1)
    ParaCode = bytArray
End Function

Private Sub Form_Load()
    cmdSaveFile.Enabled = False
End Sub