Random写入变长字符应该怎么写?
用random写入变长字符,len应该怎么算?
Private Type data data As String End Type Dim x As data '调用自定义数据类型前必须声明自定义数据变量。 x.data = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '调用自定义数据前必须要给其成员赋值。 Open FileName For Random As #1 Len = Len(x.data) '调用自定义数据必须调用自定义变量的成员。 Put #1, , data
Option Explicit 'FTEDIT '数据是否修改标志。 '无数据; '已读数据:读盘,并且数据未修改,修改过数据保存后会设置为这个状态; '数据已修改:修改过数据未存盘。 '这个状态也会分别设置每条数据的状态 Const 文件标志字符 = "FD" '限定为2字节长度,如果修改,需要修改结构定义和保存时的位置 '数据文件 Public Type FileTypeHand '文件头结构 文件标志 As String * 2 '1-2,FD 索引开始地址 As Long '3-6 索引大小 As Long '7-10 数据区开始地址 As Long '11-14 数据区大小 As Long '15-18 文件总大小 As Long '19-22 End Type Public Type FileTIndexType '索引项的结构 起始地址 As Long 长度 As Long End Type Public Type FileTIndex '索引区结构 总项数 As Long 有效项数 As Long 索引项() As FileTIndexType End Type Public Enum 标志状态 无数据 = 0 已读数据 = 1 数据已修改 = 2 End Enum Public Type FileTData '数据保存结构 D As String '数据 B As 标志状态 End Type Public FTH As FileTypeHand '文件头 Public FTI As FileTIndex '索引区 Public FTD() As FileTData '文件所有的数据 Public FTEDIT As 标志状态 '文件是否修改 Public Function OpenFile(FileName As String, Optional 错误提示 As Boolean = False) Dim s As String s = Trim(FileName) If Len(s) = 0 Then OpenFile = -1 If 错误提示 Then MsgBox "文件名为空", vbCritical, "错误" Exit Function End If If Len(Dir(s)) = 0 Then OpenFile = -2 If 错误提示 Then MsgBox "文件不存在", vbCritical, "错误" Exit Function End If Dim i As Long Dim Fr As Long Fr = FreeFile With FTH Open s For Binary As #Fr Get #Fr, , .文件标志 If .文件标志 <> 文件标志字符 Then OpenFile = -3 Close #Fr If 错误提示 Then MsgBox "文件格式错误", vbCritical, "错误" Exit Function End If Get #Fr, , .索引开始地址 Get #Fr, , .索引大小 Get #Fr, , .数据区开始地址 Get #Fr, , .数据区大小 Get #Fr, , .文件总大小 If LOF(Fr) <> .文件总大小 Then OpenFile = -4 Close #Fr If 错误提示 Then MsgBox "文件长度错误", vbCritical, "错误" Exit Function End If End With With FTI Get #Fr, FTH.索引开始地址, .总项数 Get #Fr, , .有效项数 ReDim .索引项(.总项数) For i = 1 To .有效项数 Get #Fr, , .索引项(i).起始地址 Get #Fr, , .索引项(i).长度 Next i ReDim FTD(FTI.总项数) For i = 1 To .有效项数 If .索引项(i).起始地址 > 0 Then Seek #Fr, .索引项(i).起始地址 FTD(i).D = Input(.索引项(i).长度, Fr) FTD(i).B = 已读数据 End If Next i End With Close #Fr FTEDIT = 已读数据 End Function Public Function savedall(FileName As String, Optional 错误提示 As Boolean = False) Dim s As String s = Trim(FileName) If Len(s) = 0 Then savedall = -1 If 错误提示 Then MsgBox "文件名为空", vbCritical, "错误" Exit Function End If Dim i As Long Dim s1 As String Dim dtj As Long s1 = App.Path If Right(s1, 1) = "\" Then s1 = s1 & "tmp.tmp" Else s1 = s1 & "\tmp.tmp" End If If Dir(s1) <> "" Then Kill s1 '如果存在同名临时文件,删掉 Dim Fr As Long Fr = FreeFile Open s1 For Binary As #Fr With FTH Put #Fr, , 文件标志字符 .索引开始地址 = Len(FTH) + 1 .索引大小 = FTI.总项数 * 8 .数据区开始地址 = .索引开始地址 + .索引大小 Put #Fr, , .索引开始地址 Put #Fr, , .索引大小 Put #Fr, , .数据区开始地址 End With With FTI dtj = 0 Seek #Fr, FTH.数据区开始地址 For i = 1 To .有效项数 If FTD(i).B <> 无数据 Then .索引项(i).起始地址 = Seek(Fr) .索引项(i).长度 = Len(FTD(i).D) dtj = dtj + .索引项(i).长度 Put #Fr, , FTD(i).D End If FTD(i).B = 已读数据 '已保存的数据,设置为未修改 Next i Seek #Fr, FTH.索引开始地址 Put #Fr, , .总项数 Put #Fr, , .有效项数 For i = 1 To .总项数 Put #Fr, , .索引项(i).起始地址 Put #Fr, , .索引项(i).长度 Next i End With FTH.数据区大小 = dtj FTH.文件总大小 = Len(FTH) + FTH.索引大小 + FTH.数据区大小 Put #Fr, 15, FTH.数据区大小 Put #Fr, 19, FTH.文件总大小 Close #Fr FTEDIT = 已读数据 If Len(Dir(s)) <> 0 Then '原文件存在,删掉 Kill s End If Name s1 As s '临时文件改名为数据文件名 End Function Public Sub setdata(Cs As String, index As Long) '给数据区设置数据,会修改标志会 If index > FTI.总项数 Then FTI.总项数 = index + 20 '预留多少空位位置 ReDim Preserve FTI.索引项(FTI.总项数) ReDim Preserve FTD(FTI.总项数) End If FTD(index).D = Cs FTD(index).B = 数据已修改 If index > FTI.有效项数 Then FTI.有效项数 = index End If FTEDIT = 数据已修改 End Sub
Private Sub Command1_Click() Call setdata("11111111", 1) Call setdata("22222222", 2) Call setdata("33333333", 4) '这行特意跳格保存了 If savedall("e:\d.dat", True) <> 0 Then MsgBox "保存过程中出现错误" End If End Sub Private Sub Command2_Click() If OpenFile("e:\d.dat", True) = 0 Then MsgBox "读取成功" Else MsgBox "读取错误" End If End Sub
[此贴子已经被作者于2018-11-2 11:21编辑过]