源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

VBS 加解密 For MS Script Encode

  • 时间:2020-04-04 03:32 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:VBS 加解密 For MS Script Encode
[b]一、加密[/b]
[u]复制代码[/u] 代码如下:
Dim ObjectFSO If (lcase(right(wscript.fullname,11))="wscript.exe") Then  WScript.Quit(0) End If If wscript.arguments.count<2 Then  Wscript.Echo "VBS Code Encoder v1.0 Powered by ENUN. http://www.enun.net/"  Wscript.Echo "Notes: dFileName Must be '*.vbe'!"  Wscript.Echo "Usage: cscript.exe //nologo sFileName dFileName"  Wscript.Echo "   eg: cscript.exe //nologo test.vbs enc.vbe"  WScript.Quit(0) End If sFileName = Wscript.Arguments(0) dFileName = Wscript.Arguments(1) Set ObjectFSO = CreateObject("Scripting.FileSystemObject") Set ReadData = ObjectFSO.OpenTextFile(sFileName, 1) ObjectFSO.OpenTextFile(dFileName, 8, true).Write(Encoder(ReadData.Readall)) Function Encoder(data)     Encoder = CreateObject("Scripting.Encoder").EncodeScriptFile(".vbs", data, 0, "VBScript") End Function
[b]二、解密[/b]
[u]复制代码[/u] 代码如下:
option explicit Dim oArgs, NomFichier 'Optional argument : the encoded filename NomFichier="" Set oArgs = WScript.Arguments Select Case oArgs.Count Case 0 'No Arg, popup a dialog box to choose the file         NomFichier=BrowseForFolder("Choose an encoded file", &H4031, &H0011) Case 1         If Instr(oArgs(0),"?")=0 Then '-? ou /? => aide                 NomFichier=oArgs(0)         End If Case Else         WScript.Echo "Too many parameters" End Select Set oArgs = Nothing If NomFichier<>"" Then         Dim fso         Set fso=WScript.CreateObject("Scripting.FileSystemObject")         If fso.FileExists(NomFichier) Then                 Dim fic,contenu                 Set fic = fso.OpenTextFile(NomFichier, 1)                 Contenu=fic.readAll                 fic.close                 Set fic=Nothing                 Const TagInit="#@~^" '#@~^awQAAA==                 Const TagFin="==^#~@" '& chr(0)                 Dim DebutCode, FinCode                 Do      FinCode=0      DebutCode=Instr(Contenu,TagInit)      If DebutCode>0 Then       If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag        FinCode=Instr(DebutCode,Contenu,TagFin)        If FinCode>0 Then         Contenu=Left(Contenu,DebutCode-1) & _         Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _         Mid(Contenu,FinCode+6)        End If       End If      End If                 Loop Until FinCode=0                 WScript.Echo Contenu         Else                 WScript.Echo Nomfichier & " not found"         End If         Set fso=Nothing Else         WScript.Echo "Please give a filename"         WScript.Echo "Usage : " & wscript.fullname  & " " & WScript.ScriptFullName & " <filename>" End If   Function Decode(Chaine)         Dim se,i,c,j,index,ChaineTemp         Dim tDecode(127)         Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"         Set se=WSCript.CreateObject("Scripting.Encoder")         For i=9 to 127                 tDecode(i)="JLA"         Next         For i=9 to 127                 ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)                 For j=1 to 3                         c=Asc(Mid(ChaineTemp,j,1))                         tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)                 Next         Next         'Next line we correct a bug, otherwise a ")" could be decoded to a ">"         tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)         Set se=Nothing         Chaine=Replace(Replace(Chaine,"@&",chr(10)),"@#",chr(13))         Chaine=Replace(Replace(Chaine,"@*",">"),"@!","<")         Chaine=Replace(Chaine,"@$","@")         index=-1         For i=1 to Len(Chaine)                 c=asc(Mid(Chaine,i,1))                 If c<128 Then index=index+1                 If (c=9) or ((c>31) and (c<128)) Then                         If (c<>60) and (c<>62) and (c<>64) Then                                 Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1)                         End If                 End If         Next         Decode=Chaine End Function   Function BrowseForFolder(ByVal pstrPrompt, ByVal pintBrowseType, ByVal pintLocation)         Dim ShellObject, pstrTempFolder, x         Set ShellObject=WScript.CreateObject("Shell.Application")         On Error Resume Next         Set pstrTempFolder=ShellObject.BrowseForFolder(&H0,pstrPrompt,pintBrowseType,pintLocation)         BrowseForFolder=pstrTempFolder.ParentFolder.ParseName(pstrTempFolder.Title).Path         If Err.Number<>0 Then BrowseForFolder=""         Set pstrTempFolder=Nothing         Set ShellObject=Nothing End Function
原文: http://www.enun.net/?p=866
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部