100分求DES加解密源码

Question

不要http://www.mf100.com/download.asp?id=46的，因为不能用，巨多Bug...
要求：有源代码、能正确根据密钥进行加解密，谢谢

Answer 1

http://sevillaonline.com/ActiveX/vb5/index.htm

Answer 2

to zhllwarez(星夜听松,冷月伴青灯):
晕
要的是源码呀
老大连源码跟控件都分不清呀？？？

Answer 3

rc4加密
public sub main() 
dim key as string 
for i = 1 to 16 
    randomize 
    key = key & chr(rnd * 255) 
next i 
msgbox rc4(rc4("welcome to plindge studio!", key), key) 
end sub 
public function rc4(inp as string, key as string) as string 
dim s(0 to 255) as byte, k(0 to 255) as byte, i as long 
dim j as long, temp as byte, y as byte, t as long, x as long 
dim outp as string for i = 0 to 255 
    s(i) = i 
next j = 1 
for i = 0 to 255 
    if j > len(key) then j = 1 
    k(i) = asc(mid(key, j, 1)) 
    j = j + 1 
next i 

Answer 4

j = 0 
for i = 0 to 255 
    j = (j + s(i) + k(i)) mod 256 
    temp = s(i) 
    s(i) = s(j) 
    s(j) = temp 
next i i = 0 
j = 0 
for x = 1 to len(inp) 
    i = (i + 1) mod 256 
    j = (j + s(i)) mod 256 
    temp = s(i) 
    s(i) = s(j) 
    s(j) = temp 
    t = (s(i) + (s(j) mod 256)) mod 256 
    y = s(t) 
     
    outp = outp & chr(asc(mid(inp, x, 1)) xor y) 
next 
rc4 = outp 
end function 

Answer 5

rc4加密
public sub main() 
dim key as string 
for i = 1 to 16 
    randomize 
    key = key & chr(rnd * 255) 
next i 
msgbox rc4(rc4("welcome to plindge studio!", key), key) 
end sub 
public function rc4(inp as string, key as string) as string 
dim s(0 to 255) as byte, k(0 to 255) as byte, i as long 
dim j as long, temp as byte, y as byte, t as long, x as long 
dim outp as string for i = 0 to 255 
    s(i) = i 
next j = 1 
for i = 0 to 255 
    if j > len(key) then j = 1 
    k(i) = asc(mid(key, j, 1)) 
    j = j + 1 
next i 

Answer 6

to strongfisher(Haiwolf):
天啊
我要的是DES，怎么变成RC4了？？

Answer 7

Option Explicit
Function crypt(Action As String, Key As String, Src As String) As String
Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, dest As String, offset As Integer, TmpSrcAsc, SrcPos
KeyLen = Len(Key)
If Action = ″E″ Then
Randomize
offset = (Rnd ＊ 10000 Mod 255) ＋ 1
dest = Hex＄(offset)
If Len(dest) = 1 Then
dest = ″0″ ＋ dest
End If
For SrcPos = 1 To Len(Src)

Answer 8

SrcAsc = (Asc(Mid＄(Src, SrcPos, 1)) ＋ offset) Mod 255
If KeyPos < KeyLen Then KeyPos = KeyPos ＋ 1 Else KeyPos = 1
SrcAsc = SrcAsc Xor Asc(Mid＄(Key, KeyPos, 1))
dest = dest ＋ Format＄(Hex＄(SrcAsc), ″@@″)
offset = SrcAsc
Next
ElseIf Action = ″D″ Then
offset = Val(″＆H″ ＋ Left＄(Src, 2))
For SrcPos = 3 To Len(Src) Step 2
SrcAsc = Val(″＆H″ ＋ Trim(Mid＄(Src, SrcPos, 2)))
If KeyPos < KeyLen Then KeyPos = KeyPos ＋ 1 Else KeyPos = 1
TmpSrcAsc = SrcAsc Xor Asc(Mid＄(Key, KeyPos, 1))
If TmpSrcAsc <= offset Then
TmpSrcAsc = 255 ＋ TmpSrcAsc － offset
Else
TmpSrcAsc = TmpSrcAsc － offset
End If
dest = dest ＋ Chr(TmpSrcAsc)
offset = SrcAsc
Next
End If
crypt = dest
End Function

Answer 9

Public Function Base64Encode(InStr1 As String) As String
    Dim mInByte(3) As Byte, mOutByte(4) As Byte
    Dim myByte As Byte
    Dim i As Integer, LenArray As Integer, j As Integer
    Dim myBArray() As Byte
    Dim OutStr1 As String
    
    myBArray() = StrConv(InStr1, vbFromUnicode)
    LenArray = UBound(myBArray) + 1
    For i = 0 To LenArray Step 3
        If LenArray - i = 0 Then
            Exit For
        End If
        If LenArray - i = 2 Then
            mInByte(0) = myBArray(i)
            mInByte(1) = myBArray(i + 1)
            Base64EncodeByte mInByte, mOutByte, 2
        ElseIf LenArray - i = 1 Then
            mInByte(0) = myBArray(i)
            Base64EncodeByte mInByte, mOutByte, 1
        Else
            mInByte(0) = myBArray(i)
            mInByte(1) = myBArray(i + 1)
            mInByte(2) = myBArray(i + 2)
            Base64EncodeByte mInByte, mOutByte, 3
        End If
        For j = 0 To 3
            OutStr1 = OutStr1 & Chr(mOutByte(j))
        Next j
    Next i
    Base64Encode = OutStr1
End Function

Answer 10

to strongfisher(Haiwolf):
晕
你这个又是什么加解密算法来的？？？
DES怎么连个迭代及S盒操作的影子都找不到的？？？

Answer 11

老大连源码跟控件都分不清呀？？？
你说给你个能用的,我就没仔细看,丢人了.哈哈
这个你应该满意了:
http://www.hongw.com/Read_Article.asp?Id=20658

Answer 12

to zhllwarez(星夜听松,冷月伴青灯):
这个我原来也下过，四千多行的源码，编译的时候就差点死掉了，有没有一个没这么死板的呀？？谢了(注：我很佩服写这源码的作者，能用函数的地方绝对不用函数，每一轮迭代每一个S盒都是Hard Code的，我不服不行啊，但加上这个库，我每次重编译的时候要多花四五分钟的时候，还要有准死机的危险，不爽啊~~~)

Answer 13

我还没有发现更为完整的vb代码，不过现在成熟的算法源代码很多都是c的，网上成堆，我看实在不行的话找个好使的c代码用vb调用就是了，你认为呢？

Answer 14

我还没有发现更为完整的vb代码，不过现在成熟的算法源代码很多都是c的，网上成堆，我看实在不行的话找个好使的c代码用vb调用就是了，你认为呢？

Answer 15

to zhllwarez(星夜听松,冷月伴青灯):
真的实在不行只好自己写一个了，没想这么通用的东西还要亲力亲为，唉~~~~

Answer 16

to Jackile(东方朔):
vckbase里应该只有C的吧？？
to atmjn(laowang):
来个不凉不热的就好打发了嘛，呵呵看来是只能自己写了
下午就前没有人有源码就结贴了，跟过贴的都有分，要是有人给了好用的源码分就只给那个人了

Answer 17

我可以给你一个C语言的DLL，要不？

Answer 18

我用VC写好了DES的DLL，还有RSA，MD5的DLL
加解密的速度绝对快。
用VB是不可能达到那么快的速度。
我的E_mail:[email protected]

Answer 19

to program2100(程序员2100):
C的源码我也有
to anteye(anteye):
速度不一定是最重要的，老板要求不能用DLL，我要是用了DLL不但加解密速度快，我滚蛋的速度更快，谢了~~~