一段VB代码的转换,(100分)

  • 主题发起人 主题发起人 eire
  • 开始时间 开始时间
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 代码
 
procedure TFrmMain.WriteFile(const sFile, sText, sPwd, sDay: string);
const
modeRead = $0 ;
modeWrite = $1 ;
modeReadWrite = $2 ;
shareCompat = $0 ;
shareExclusive = $10;
shareDenyWrite = $20;
shareDenyRead = $30;
shareDenyNone = $40;
modeNoInherit = $80;
modeCreate = $1000;
modeNoTruncate = $2000;
typeText = $4000;
typeBinary = $8000;
osNoBuffer = $10000;
osWriteThrough = $20000;
osRandomAccess = $40000;
osSequentialScan = $80000;
HEADLEN = 20 ;
var
CFile:TCryptFile;
OldBuf:array of byte;
OldLen:integer;
OldStr:string;

CurLen:integer;
CurBuf:array of byte;

StrTmp:string;
BufUnited:array of Byte;
UnitedLen:integer;

SumLen:integer;
HashNum:integer;

BufHash:array[1..20] of byte;
StrHash:string;

BufandHash:array of byte;
SumHashLen:integer;
begin
//-756463425
CFile:=TCryptFile.Create(self);
try
CFile.FileName:=sFile;
if not FileExists(sFile) then
CFile.Flags:=modeCreate or modeReadWrite
else
CFile.Flags:=modeReadWrite;
CFile.Password:=sPwd;
CFile.Active:=true;
CFile.SeekToEnd;
OldLen:=CFile.Length;
if OldLen > 0 then
begin
SetLength(OldBuf,OldLen+1);
CFile.SeekToBegin;
CFile.Read(OldBuf[0],OldLen+1);
OldStr:=ArrayToString(OldBuf);
memo1.Lines.Text:=copy(oldstr,21,system.length(oldstr));
end;
FillChar(BufHash,sizeof(BufHash),0);
CurLen :=system.Length(Trim(sText));//当前写入数据的长度;
if OldLen > 0 then
begin
SetLength(BufUnited, CurLen+OldLen-HEADLEN);
StrTmp:=myRight(OldStr,system.length(OldStr)-HEADLEN)+sText;
CopyMemory(@BufUnited[0],@StrTmp,CurLen+OldLen-HEADLEN);
HashNum:=CFile.GetHash(BufUnited[0],CurLen+OldLen-HEADLEN);
end else
begin
Setlength(bufunited,curLen);
Strtmp:=sText;
Copymemory(@bufunited[0],@StrTmp,CurLen);
HashNum:=CFile.GetHash(BufUnited[0], CurLen);
end;
StrHash := sDay+' '+inttostr(HashNum);
CopyMemory(@BufHash[1],@StrHash,HEADLEN);
//合并所有的文件
if OldLen > 0 Then
begin
SetLength(BufandHash,curlen+OldLen);
CopyMemory(@BufandHash[0],@BufHash[1],HEADLEN);
CopyMemory(@BufandHash[20],@BufUnited[0],CurLen+OldLen-HEADLEN);
end else
begin
SetLength(BufandHash,CurLen+HEADLEN+1);
CopyMemory(@BufandHash[0],@BufHash,HEADLEN);
CopyMemory(@BufAndHash[20], @BufUnited[0],CurLen);
end;
CFile.SeekToBegin;
if CurLen > 0 then
CFile.Write(BufandHash[0],CurLen + OldLen)
else
CFile.Write(BufandHash[0],CurLen + HEADLEN);
CFile.Flush;
CFile.Active:=false;
finally
CFile.Free;
end;
end;
 
呵,好长一段啊...绝对的佩服eire这种助人为乐的精神,要是我,可没这功夫.
 
写入后,数据有差异。请各位高手指点。
 
借光VC代码转换
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3084532
 
后退
顶部