一、加密

代码如下:

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

二、解密

代码如下:

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

更多信息请查看IT技术专栏