E
eire
Unregistered / Unconfirmed
GUEST, unregistred user!
以前的VB代码。
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private FF As comtlb.CryptFile
Private Const HEADLEN As Integer = 20
Private Enum FileFlag
modeRead = &H0
modeWrite = &H1
modeReadWrite = &H2
shareCompat = &H0
shareExclusive = &H10
shareDenyWrite = &H20
shareDenyRead = &H30
shareDenyNone = &H40
modeNoInherit = &H80
modeCreate = &H1000
modeNoTruncate = &H2000
typeText = &H4000 ' typeText and typeBinary are
typeBinary = &H8000 ' used in derived classes only
osNoBuffer = &H10000
osWriteThrough = &H20000
osRandomAccess = &H40000
osSequentialScan = &H80000
End Enum
Public Sub WritrFile(strfile As String, strText As String, strPWD As String, strDay As String)
'写加密文件
'#1:文件全名和路径]
On Error Resume Next
Dim Buffer() As Byte, lngStrLen As Long, strTemp As String '当前写入文件的数据区
Dim BufferFormer() As Byte, lngFormerLen As Long, strFormer As String
Dim BufferSum() As Byte, lngSumLen As Long, lngGetHash As Long, BufferHash(1 To 20) As Byte, strHash As String '合并过后的文件
Dim BufferAndHash() As Byte, lngSumHashLen As Long '加上hash值的数据
'打开文件或者创建文件
Set FF = New comtlb.CryptFile
FF.FileName = strfile
If Dir(strfile) = "" Then
FF.Flags = FileFlag.modeCreate Or FileFlag.modeReadWrite
Else
FF.Flags = FileFlag.modeReadWrite
End If
FF.Password = strPWD
FF.Active = True
FF.SeekToEnd
lngFormerLen = FF.Length
If lngFormerLen > 0 Then
ReDim BufferFormer(1 To lngFormerLen)
FF.SeekToBegin
FF.Read BufferFormer(1), lngFormerLen
strFormer = StrConv(BufferFormer, vbUnicode)
End If
Open "e:/aa.txt" For Output As #1
Print #1, strFormer
Close #1
'把当前要写的内容拷贝到数据区
lngStrLen = LenB(StrConv(strText, vbFromUnicode)) '当前写入数据的长度
Open "e:/aa.txt" For Append As #1
Print #1, strText
Close #1
If lngFormerLen > 0 Then
ReDim BufferSum(1 To lngStrLen + lngFormerLen - HEADLEN)
strTemp = Right(strFormer, Len(strFormer) - HEADLEN) & strText
CopyMemory ByVal VarPtr(BufferSum(1)), ByVal StrPtr(StrConv(strTemp, vbFromUnicode)), lngStrLen + lngFormerLen - HEADLEN
lngGetHash = FF.GetHash(BufferSum(1), lngStrLen + lngFormerLen - HEADLEN)
Else
ReDim BufferSum(1 To lngStrLen)
strTemp = strText
CopyMemory ByVal VarPtr(BufferSum(1)), ByVal StrPtr(StrConv(strTemp, vbFromUnicode)), lngStrLen
lngGetHash = FF.GetHash(BufferSum(1), lngStrLen)
End If
'得到hash值
strHash = strDay & " " & lngGetHash
CopyMemory ByVal VarPtr(BufferHash(1)), ByVal StrPtr(StrConv(strHash, vbFromUnicode)), HEADLEN
'合并所有的文件
If lngFormerLen > 0 Then
ReDim BufferAndHash(1 To lngStrLen + lngFormerLen)
CopyMemory ByVal VarPtr(BufferAndHash(1)), ByVal VarPtr(BufferHash(1)), HEADLEN
CopyMemory ByVal VarPtr(BufferAndHash(21)), ByVal VarPtr(BufferSum(1)), lngStrLen + lngFormerLen - HEADLEN
Else
ReDim BufferAndHash(1 To lngStrLen + HEADLEN)
CopyMemory ByVal VarPtr(BufferAndHash(1)), ByVal VarPtr(BufferHash(1)), HEADLEN
CopyMemory ByVal VarPtr(BufferAndHash(21)), ByVal VarPtr(BufferSum(1)), lngStrLen
End If
'写入文件
FF.SeekToBegin
If lngFormerLen > 0 Then
FF.Write BufferAndHash(1), lngStrLen + lngFormerLen
Else
FF.Write BufferAndHash(1), lngStrLen + 20
End If
FF.Flush
Set FF = Nothing
End Sub
--我翻译的delphi 代码
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private FF As comtlb.CryptFile
Private Const HEADLEN As Integer = 20
Private Enum FileFlag
modeRead = &H0
modeWrite = &H1
modeReadWrite = &H2
shareCompat = &H0
shareExclusive = &H10
shareDenyWrite = &H20
shareDenyRead = &H30
shareDenyNone = &H40
modeNoInherit = &H80
modeCreate = &H1000
modeNoTruncate = &H2000
typeText = &H4000 ' typeText and typeBinary are
typeBinary = &H8000 ' used in derived classes only
osNoBuffer = &H10000
osWriteThrough = &H20000
osRandomAccess = &H40000
osSequentialScan = &H80000
End Enum
Public Sub WritrFile(strfile As String, strText As String, strPWD As String, strDay As String)
'写加密文件
'#1:文件全名和路径]
On Error Resume Next
Dim Buffer() As Byte, lngStrLen As Long, strTemp As String '当前写入文件的数据区
Dim BufferFormer() As Byte, lngFormerLen As Long, strFormer As String
Dim BufferSum() As Byte, lngSumLen As Long, lngGetHash As Long, BufferHash(1 To 20) As Byte, strHash As String '合并过后的文件
Dim BufferAndHash() As Byte, lngSumHashLen As Long '加上hash值的数据
'打开文件或者创建文件
Set FF = New comtlb.CryptFile
FF.FileName = strfile
If Dir(strfile) = "" Then
FF.Flags = FileFlag.modeCreate Or FileFlag.modeReadWrite
Else
FF.Flags = FileFlag.modeReadWrite
End If
FF.Password = strPWD
FF.Active = True
FF.SeekToEnd
lngFormerLen = FF.Length
If lngFormerLen > 0 Then
ReDim BufferFormer(1 To lngFormerLen)
FF.SeekToBegin
FF.Read BufferFormer(1), lngFormerLen
strFormer = StrConv(BufferFormer, vbUnicode)
End If
Open "e:/aa.txt" For Output As #1
Print #1, strFormer
Close #1
'把当前要写的内容拷贝到数据区
lngStrLen = LenB(StrConv(strText, vbFromUnicode)) '当前写入数据的长度
Open "e:/aa.txt" For Append As #1
Print #1, strText
Close #1
If lngFormerLen > 0 Then
ReDim BufferSum(1 To lngStrLen + lngFormerLen - HEADLEN)
strTemp = Right(strFormer, Len(strFormer) - HEADLEN) & strText
CopyMemory ByVal VarPtr(BufferSum(1)), ByVal StrPtr(StrConv(strTemp, vbFromUnicode)), lngStrLen + lngFormerLen - HEADLEN
lngGetHash = FF.GetHash(BufferSum(1), lngStrLen + lngFormerLen - HEADLEN)
Else
ReDim BufferSum(1 To lngStrLen)
strTemp = strText
CopyMemory ByVal VarPtr(BufferSum(1)), ByVal StrPtr(StrConv(strTemp, vbFromUnicode)), lngStrLen
lngGetHash = FF.GetHash(BufferSum(1), lngStrLen)
End If
'得到hash值
strHash = strDay & " " & lngGetHash
CopyMemory ByVal VarPtr(BufferHash(1)), ByVal StrPtr(StrConv(strHash, vbFromUnicode)), HEADLEN
'合并所有的文件
If lngFormerLen > 0 Then
ReDim BufferAndHash(1 To lngStrLen + lngFormerLen)
CopyMemory ByVal VarPtr(BufferAndHash(1)), ByVal VarPtr(BufferHash(1)), HEADLEN
CopyMemory ByVal VarPtr(BufferAndHash(21)), ByVal VarPtr(BufferSum(1)), lngStrLen + lngFormerLen - HEADLEN
Else
ReDim BufferAndHash(1 To lngStrLen + HEADLEN)
CopyMemory ByVal VarPtr(BufferAndHash(1)), ByVal VarPtr(BufferHash(1)), HEADLEN
CopyMemory ByVal VarPtr(BufferAndHash(21)), ByVal VarPtr(BufferSum(1)), lngStrLen
End If
'写入文件
FF.SeekToBegin
If lngFormerLen > 0 Then
FF.Write BufferAndHash(1), lngStrLen + lngFormerLen
Else
FF.Write BufferAndHash(1), lngStrLen + 20
End If
FF.Flush
Set FF = Nothing
End Sub
--我翻译的delphi 代码