位置:首页 > 综合教程 > 新云4软件采集时解密迅雷快车旋风地址

新云4软件采集时解密迅雷快车旋风地址

时间:2014-05-18  |  作者:本站整理  |  阅读:232

如果修改过/inc/base64.asp和/admin/soft/admin_savedata.asp的朋友请按照下面步骤进行修改。

一、打开/inc/base64.asp
   找到
Function Base64decode(asContents) 
'//将Base64编码字符串转换成Ansi编码的字符串
'//asContents应当也是ANSI编码的字符串(二进制的字符串也可以)
   和
End Function  
%>
   把中间的代码改成
Dim sBASE_64_CHARACTERS 
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
 
    '将Base64编码字符串转换成Ansi编码的字符串   
    'asContents应当也是ANSI编码的字符串(二进制的字符串也可以)   
    Dim lsResult   
    Dim lnPosition   
    Dim lsGroup64, lsGroupBinary   
    Dim Char1, Char2, Char3, Char4   
    Dim Byte1, Byte2, Byte3   
    Dim M4, len1, len2   
       
    len1 = Lenb(asContents)   
    M4 = len1 Mod 4   
       
    If len1 < 1 Or M4 > 0 Then  
        '字符串长度应当是4的倍数   
        Base64decode = ""  
        Exit Function  
    End If  
       
    '判断最后一位是不是 = 号   
    '判断倒数第二位是不是 = 号   
    '这里m4表示最后剩余的需要单独处理的字符个数   
    If midb(asContents, len1, 1) = chrb(61) Then m4 = 3   
    If midb(asContents, len1 -1, 1) = chrb(61) Then m4 = 2   
       
    If m4 = 0 Then  
        len2 = len1   
    Else  
        len2 = len1 -4   
    End If  
       
    For lnPosition = 1 To Len2 Step 4   
        lsGroupBinary = ""  
        lsGroup64 = Midb(asContents, lnPosition, 4)   
        Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1   
        Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1   
        Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1   
        Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1   
        Byte1 = Chrb(((Char2 And 48) / 16) Or (Char1 * 4) And &HFF)   
        Byte2 = lsGroupBinary & Chrb(((Char3 And 60) / 4) Or (Char2 * 16) And &HFF)   
        Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))   
        lsGroupBinary = Byte1 & Byte2 & Byte3   
           
        lsResult = lsResult & lsGroupBinary   
    Next  
       
    '处理最后剩余的几个字符   
    If M4 > 0 Then  
        lsGroupBinary = ""  
        lsGroup64 = Midb(asContents, len2 + 1, m4) & chrB(65) 'chr(65)=A,转换成值为0   
        If M4 = 2 Then '补足4位,是为了便于计算   
            lsGroup64 = lsGroup64 & chrB(65)   
        End If  
        Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1   
        Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1   
        Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1   
        Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1   
        Byte1 = Chrb(((Char2 And 48) / 16) Or (Char1 * 4) And &HFF)   
        Byte2 = lsGroupBinary & Chrb(((Char3 And 60) / 4) Or (Char2 * 16) And &HFF)   
        Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))   
           
        If M4 = 2 Then  
            lsGroupBinary = Byte1   
        ElseIf M4 = 3 Then  
            lsGroupBinary = Byte1 & Byte2   
        End If  
           
        lsResult = lsResult & lsGroupBinary   
    End If  
       
    Base64decode = lsResult


二、打开admin/soft/admin_savedata.asp
  ㈠在顶部包含跟目录下的base64.asp文件。。
  即:
  <!--#include file="const.asp"-->
  <!--#include file="../inc/cls_xmlhttp.asp"-->
  <!--#include file="collection.asp"-->
  <!--#include file="../../inc/base64.asp"-->


    ㈡找到


      End If
  Rs.update
  softid = Rs("softid")
  m_strMessage="恭喜您!软件采集成功。"
 Else
  m_strMessage="软件采集失败!目标软件已存在,不予采集。"
 End If
 Rs.Close: Set Rs = Nothing
 If blnUpdate=False Then
  Set Rs=NewAsp.CreateAXObject("ADODB.Recordset")
  Rs.Open "SELECT TOP 1 softid FROM NC_SoftList WHERE ChannelID="&ChannelID&" ORDER BY softid DESC", Conn, 1, 1
  softid = Rs("softid")
  Rs.Close: Set Rs = Nothing
 End If
 
 '--如果选择了下载服务器,添加下载地址


    ㈢在上一步中找到的代码下面添加代码
    '============解密迅雷快车地址======
        Dim DeCodeUrl,DeCodeStrHT,DeCodeStrFT,DeCodeStrHF,DeCodeStrFF,DeCodeStrHQ,DeCodeStrFQ
       
        DeCodeStrHT = LCase(Left(m_strFileName,10)) '迅雷地址前缀
        DeCodeStrFT = Right(m_strFileName,Len(m_strFileName)-10) '去除迅雷地址前缀
  DeCodeStrHF = LCase(Left(m_strFileName,11)) '快车地址前缀
        DeCodeStrFF = Right(m_strFileName,Len(m_strFileName)-11)&"&" '去除快车地址前缀
        DeCodeStrFF = Split(DeCodeStrFF,"&")
  DeCodeStrHQ = LCase(Left(m_strFileName,7)) 'QQ旋风地址前缀
        DeCodeStrFQ = Right(m_strFileName,Len(m_strFileName)-7) '去除QQ旋风地址前缀
  
      If DeCodeStrHT = "thunder://" Or DeCodeStrHF = "flashget://" Or DeCodeStrHQ = "qqdl://" Then
         If DeCodeStrHT = "thunder://" Then
           DeCodeUrl = strAnsi2Unicode(Base64decode(strUnicode2Ansi(DeCodeStrFT)))
           DeCodeUrl = Right(DeCodeUrl,Len(DeCodeUrl)-2)
           DeCodeUrl = Left(DeCodeUrl,Len(DeCodeUrl)-2)
         ElseIf DeCodeStrHF = "flashget://" Then
           DeCodeUrl = strAnsi2Unicode(Base64decode(strUnicode2Ansi(DeCodeStrFF(0))))
           DeCodeUrl = Right(DeCodeUrl,Len(DeCodeUrl)-10)
           DeCodeUrl = Left(DeCodeUrl,Len(DeCodeUrl)-10)
   Else
     DeCodeUrl = strAnsi2Unicode(Base64decode(strUnicode2Ansi(DeCodeStrFQ)))
         End If
      Else
           DeCodeUrl = m_strFileName
      End If
        
      If DeCodeUrl = "" Then
        DeCodeUrl = m_strFileName
      End If
 '===============春天制作====================

     ㈣再往下两行,把
     AddDownServer ChannelID, downid, softid, Trim(m_strFileName), "立即下载"
       改成
     AddDownServer ChannelID, downid, softid, Trim(DeCodeUrl), "立即下载"
     
     ㈤继续往下,在附近,不要跑远了~_~。把
     Rs("DownFileName") = Trim(m_strFileName)
     Rs("DownText") = "立即下载"
      改成
     Rs("DownFileName") = Trim(DeCodeUrl)
     Rs("DownText") = "立即下载"

     ㈥继续下,把
     '--如果下载地址存在就更新
     Rs("downid") = downid
     Rs("DownFileName") = Trim(m_strFileName)
     
      改成

     '--如果下载地址存在就更新
     Rs("downid") = downid
     Rs("DownFileName") = Trim(DeCodeUrl)
     
     ㈦ 保存。

     ㈧ 关闭页面。
    
     ㈨ 再次OK。

福利游戏

相关文章

更多

精选合集

更多

大家都在玩

热门话题

大家都在看

更多