花落谁家，你作主！	盛大widget设计大赛英雄榜

二进制文件加密程序，欢迎提出修改意见！！

楼主chsl918（Story Book）2002-01-24 17:42:52 在 VB / 基础类提问

这个程序是一个网友要的，目的是将一个二进制文件加密和解密！！算法就是最基本的XOR，因为我从前重来没有做过二进制文件的操作，所以有些地方欢迎大家提出修改意见，另外我是这两天才到这里来的，没什么分！所以这个帖子实在是给不了多少我一共就58分能用，请大家见谅！
Private Sub Form_Load()
EDcode "d:\234.dat", "d:\123.dat"
End Sub

'******************************************************************************
' 目的: 文本加密解密
' 输入: FileName 加密解密的文件
' OutName 结果文件
'函数返回值:
' 日期: 2002/01/24
' 作者: 陈颂雷
' E-Mail:chsl@cattsoft.com
'******************************************************************************
Public Sub EDcode(FileName As String, OutName As String)
Dim x As Single, I As Long, L As Long
Dim CharNum As Integer, PassInteger As Integer
Dim CharSingle As Byte
Dim CharString As String * 1
Const PassW = "ABCDEFGHJKLMNopu" '17个字长的加密串必须为英文
On Local Error GoTo EDcodeError
Open FileName For Binary As #1

I = 1
L = 1
Do While Not EOF(1)
DoEvents
Get #1, , CharSingle
Open "c:\temp.dat" For Binary As #2
If L = 17 Then L = 1
PassInteger = Asc(Mid$(PassW, L, 1))
CharNum = CharSingle Xor PassInteger
Put #2, I, CharNum
L = L + 1
I = I + 1
Close #2
Loop
Close #1
'希望下面的代码能够省掉,但是不加这个就会长出两个字节,再解密就是长出4个字节了
'各位高手能否给看看?
Open "c:\temp.dat" For Binary As #1
For I = 1 To I - 2
Get #1, , CharSingle
Open OutName For Binary As #2
Put #2, I, CharSingle
Close #2
Next I
Close #1
Kill "c:\temp.dat"
Exit Sub
EDcodeError:
MsgBox "错"
End Sub
问题点数：58、回复次数：10Top

1 楼chsl918（Story Book）回复于 2002-01-24 18:09:13 得分 0

对了提出代码修改意见一定加分!!虽然就29但是礼轻情意重嘛!!所以各位拜托了!!Top

2 楼chsl918（Story Book）回复于 2002-01-24 23:50:14 得分 0

up!!同志们关心一下我这个东东好不好？！！另外我刚刚想出来加密串支持中文的做法！！Top

3 楼chsl918（Story Book）回复于 2002-01-25 12:53:23 得分 0

算了，看来没有人关心这个东东了Top

4 楼xsp（半个程序员）回复于 2002-01-25 13:07:25 得分 15

最后的那段代码可能省不掉，我认为是去掉对文件结束符（eof）的处理的。Top

5 楼KiteGirl（小仙妹）回复于 2002-01-25 13:12:05 得分 0

稍后给你一个新的完整函数组合，其中有改进措施。Top

6 楼chsl918（Story Book）回复于 2002-01-25 13:31:00 得分 0

哇！！真是没有想到谢谢大家的回帖，我准备加分
另外支持中文的语句如下，将
PassInteger = Asc(Mid$(PassW, L, 1))
CharNum = CharSingle Xor PassInteger
之中加入
PassInteger=PassInteger And &H7F
或者
PassInteger=PassInteger And 127
没有经过测试，我想原理差不多Top

7 楼KiteGirl（小仙妹）回复于 2002-01-25 19:18:20 得分 13

程序暂时没有写好。写出它不难，但是写得规范却不容易。所以你要等等了。
我的思路是这样的。将文件的内容与一个字符串的字符循环Xor。
比如：密钥是k28h5
则第一个字节和k做xor，第二个和2做xor……第六个还是和k做xor……如此循环。
PassStart=Address Mod PassLong
第Address个字节和密钥字符串的第PassStart个字符做xor。
大概原理是这样，具体实现就涉及到许多问题。比如是一个字节还是两个字节的问题。
Top

8 楼KiteGirl（小仙妹）回复于 2002-01-25 19:22:20 得分 0

上面所说的是我设计的一维Xor加密法，另有多维加密法暂时还在研究中。Top

9 楼KiteGirl（小仙妹）回复于 2002-01-25 20:50:50 得分 30

这是我编写的一组加密文件的核心函数。无论对文件加密还是对字符串加密都可以应用。（你可以把文件变成Bytes()数组来加密，相信你也知道如何去做。）完全兼容中文（兼容对中文字符串加密，也兼容中文密钥。）

Function StringGetByBytes(pBytes() As Byte) As String
'从Byte数组获得字符串[兼容中文]
Dim tOutStr As String
Dim tLoop As Integer
Dim tByteLen As Integer

tByteLen = UBound(pBytes)

For tLoop = 0 To tByteLen
tOutStr = tOutStr & ChrB(pBytes(tLoop))
Next

StringGetByBytes = tOutStr
End Function

Function BytesGetByString(pString As String, pBytes() As Byte)
'将字符串保存到数组[兼容中文]
Dim tStrLength As Integer
Dim tLoop As Integer
Dim tCodeStart As Byte

tStrLength = LenB(pString)

For tLoop = 1 To tStrLength
tCodeStart = AscB(MidB(pString, tLoop, 1))
ReDim Preserve pBytes(tLoop - 1)
pBytes(tLoop - 1) = tCodeStart
Next

End Function

Function EncryptBytesGet(pBytes() As Byte, pKeyWords() As Byte)
'根据一个密钥加密一个Byte数组
Dim tByteStart As Long
Dim tByteEnd As Long
Dim tByteOn As Long
Dim tKeyStart As Integer
Dim tKeyLen As Integer
tByteEnd = UBound(pBytes)
tByteOn = LBound(pBytes)
tKeyLen = UBound(pKeyWords) + 1
For tByteStart = tByteOn To tByteEnd
tKeyStart = tByteStart Mod tKeyLen
pBytes(tByteStart) = pBytes(tByteStart) Xor pKeyWords(tKeyStart)
Next
End Function

Function EncryptKeyWordsGetByString(pKeyStr As String, pKeyWords() As Byte) As Integer
'根据一个字符串获得密钥Byte数组。

Dim tStrLength As Integer
Dim tLoop As Integer
Dim tCodeStart As Byte
Dim tArrayLen As Integer

tStrLength = LenB(pKeyStr)

For tLoop = 1 To tStrLength
tCodeStart = AscB(MidB(pKeyStr, tLoop, 1))
If tCodeStart Then
ReDim Preserve pKeyWords(tArrayLen)
pKeyWords(tArrayLen) = tCodeStart
tArrayLen = tArrayLen + 1
End If
Next

EncryptKeyWordsGetByString = tArrayLen
End Function
Top

10 楼chsl918（Story Book）回复于 2002-01-28 08:55:00 得分 0

TO:KiteGirl(小仙妹)
对不起这两天没有来得及看，刚刚看了看发现比我的程序整齐多了需要好好向同志学习
另外我这个程序其实就是用文本串加密程序改的。只是核心都一样所以就没有发出来。
再次谢谢！！结帐Top