各种加密小结(asp/vb)

function encrypt(sStr,sFlag)
    Dim texts
    dim i
    for i=1 to len(sStr)
        texts=texts & chr(asc(mid(sStr,i,2))+i)
    next
    encrypt = texts
end function

function decrypt(sStr,sFlag) 
    dim texts
    dim i
    for i=1 to len(sStr)
        texts=texts & chr(asc(mid(sStr,i,2))-i)
    next
    decrypt=texts
end function

function encryptBIG(sStr)
     dim i
     dim texts
     dim ch
     for i=1 to len(sStr)
            ch=mid(sStr,i,1)
        
       if asc(ch)>45126 and asc(ch)<63487 then
            texts=texts & chr(45127+63486+asc(ch)) 
        else
            texts=texts & ch 
        end if    
     next
     encryptBIG=texts
         response.write asc(ch)
end function

function encryptNew(sStr)
    Dim texts
    dim i
    for i=1 to len(sStr)
        texts=texts & chr((asc(mid(sStr,i,1)) And &HFFFF& ) +i)
    next
    encryptNew= texts
end function

function decryptNew(sStr)
    Dim texts
    dim i
    for i=1 to len(sStr)
        texts=texts & chr((asc(mid(sStr,i,1)) And &HFFFF&)  -i)
    next
    decryptNew= texts
end function

'加密
function encryptNew2(venshop)
 dim  vena
for i=1 to len(venshop)
 if mid(venshop,i,1)<>chr(13) then
    ven=asc(mid(venshop,i,1))+5
  if ven>127 or ven<33 then
      ven=ven-95
        end if
  vena=vena&chr(ven)
 else
  vena=vena &"＋"
 end if
next
      vencoded=vena
end function

'解密
function decryptNew2(venshop)
   dim  vena
for i=1 to len(venshop)
 if mid(venshop,i,1)<>"＋" then
  ven=asc(mid(venshop,i,1))-5
  if ven>126 then
   ven=ven-95
  elseif ven<32 then
   ven=ven+95
  end if
  
  vena=vena&chr(ven)
 else
  vena=vena&chr(13)
 end if
next
    vencode=vena
end function

'**************************************************************
'Description: 加密时以 uncode 码存取,解密时 可用下述解密
'Createdate : 2007-04-10
'CreatedBy: jim

'UrlEncode 加密,即字符以 urlEncode形式存取来达到加密
Function URLEncode1(deStr)
  dim enStr
         enStr=Server.UrlEncode(deStr)
      URLEncode1=enStr
End function

'UrlEncode 解码
Function URLDecode1(enStr)
dim deStr,strSpecial
dim c,i,v
deStr=""
strSpecial="!""#$%&'()*+,.-_/:;<=>?@[\]^`{|}~%"
for i=1 to len(enStr)
     c=Mid(enStr,i,1)
   if c="%" then
              v=eval("&h"+Mid(enStr,i+1,2))
                if inStr(strSpecial,chr(v))>0 then
                      deStr=deStr&chr(v)
                      i=i+2
               else
                      v=eval("&h"+ Mid(enStr,i+1,2) + Mid(enStr,i+4,2))
                      deStr=deStr & chr(v)
                     i=i+5
                end if
   else
             if c="+" then
                    deStr=deStr&" "
            else
                    deStr=deStr&c
            end if
   end if
next
        URLDecode1=deStr
End function

'********************************************************************
'///////////////////////////////////////////////////////////////////
'Description:
              1.采用5位固定原始密钥,由注册表读取
              2.由原始密钥生成加密密钥(5*51)
              3.将加密密钥对明文加密
              
'Createdate : 2007-04-12
'CreatedBy: jim

 

Function URLEncode(deStr)
  dim enStr
         enStr=Server.UrlEncode(encryptNew3(deStr))
      URLEncode=enStr
End function

Function URLDecode(enStr)
  dim deStr
      deStr=DecryptNew3(enStr)
        URLDecode=deStr
End function

'异或加密
Function encryptNew3(strCryptThis)
   Dim strChar, iKeyChar, iStringChar, i
  
  
   '原始密钥
   strOrigialKey=Application("OrigalKey")

    '加密密钥    固定长为5位,生成加密密钥长为255
     strFullKey=CreateFullKey(strOrigialKey,51)

  
   for i = 1 to Len(strCryptThis)
      iKeyChar = Asc(mid(strFullKey,i,1))
      iStringChar = Asc(mid(strCryptThis,i,1))
      iCryptChar = iKeyChar Xor iStringChar
      strEncrypted =  strEncrypted & Chr(iCryptChar)
   next
   EnCrypt = strEncrypted
End Function

'异或解密
Function DecryptNew3(strEncrypted)
Dim strChar, iKeyChar, iStringChar, i

   
'原始密钥
strOrigialKey=Application("OrigalKey")

'加密密钥    固定长为5位,生成加密密钥长为255
 strFullKey=CreateFullKey(strOrigialKey,51)

   for i = 1 to Len(strEncrypted)
      iKeyChar = (Asc(mid(strFullKey,i,1)))
      iStringChar = Asc(mid(strEncrypted,i,1))
      iDeCryptChar = iKeyChar Xor iStringChar
      strDecrypted =  strDecrypted & Chr(iDeCryptChar)
   next
   DeCrypt = strDecrypted
End Function

'由原始密钥生成固定加密密钥
Function CreateFullKey(strOrigal,strlength)
    Dim i,UB
    Dim Temp
    Temp = ""
    For i = 1 To strlength
        Temp = Temp & strOrigal
    Next
    CreateFullKey= Temp
End Function

 

'//////////////////////////////////////////////////////////////////

posted on 2007-04-12 14:47 木子的blog 阅读(394)   

--------------------next---------------------