CODE: [Copy to clipboard]
Dim SStr,Costr,ts,SavageSSC,SavageSS,L,strs,stre,ls,flag,Head
dim a()
Info1=chr(13) & "_______________________________" & chr(13) & "Powered By Savage Studio (2008)" & chr(13) & "EM:log2.0@163.com QQ:24807208" & chr(13) & "HomePage:savage100.xingkong.com"
Randomize(Hour(Now)& Minute(Now)& Second(Now))
SavageSS="U}'mf6jSb@HI3XW]5we?9:0Rs{il|KZn8T,<#qv[MNx>V*/DE(O\.`7k-Lt^u$oF)=G&aJh gyzp1!A+4BCrc2PQdY"
L=len(SavageSS)
strs="%_:~"
stre=",1%"
ReDim a(L)
for i=1 to L
Head= Join(a," ")
ls=int(rnd()*(L)+1)
If Int(i/L*100)>80 Then ls=1
While(instr(Head," " & ls & " ")>0)
If Int(i/L*100)>80 Then ls=ls+1 Else ls=int(rnd()*(L)+1)
wend
a(i)=ls
Next
Head="::Crypt by Savage Studio | EM:log2.0@163.com | HomePage:savage100.xingkong.com | QQ:24807208::" & vbCrLf & "@echo off & set _=" & chr(34) & SavageSS & chr(34) & vbCrLf
for i=1 to L
SavageSSC= SavageSSC & Mid(SavageSS,a(i),1)
Next
SStr="if 0 equ 9 pause&cls&exit" & vbCrLf & "set _=" & chr(34) & SavageSSC & chr(34)
for i=1 to len(SStr)
ts=mid(SStr,i,1)
ls=InStr(SavageSS,ts)
if ls=0 then Head=Head & ts else Head=Head & strs & (ls) & stre
Next
Head=Head & vbCrLf
SavageSS=SavageSSC
Set fso = CreateObject("Scripting.FileSystemObject")
Set fso_file = fso.opentextfile(InputBox("Source file name:" & info1,"Input..."), 1 , True)
SStr="if 0 equ 9 pause&cls&exit" & vbCrLf
'SStr="if 0 equ 9 pause&cls&exit" & vbCrLf & ReadFile(InputBox("Source file name:","Input..."),"GB2312")
Do While len(sstr)>0
for i=1 to len(sstr)
ts=mid(sstr,i,1)
ls=InStr(SavageSS,ts)
if ts="%" Then
flag=flag+1
if flag>1 then flag=0
tc=mid(sstr,i+1,1)
If IsNumeric(tc) Or tc="*" Then 'proccess %0-9 And *
ts=ts & tc
i=i+1
ls=0
flag=0
End If
end If
If i=1 and ts=":" Then 'proccess :flag
Costr=Costr & sstr
exit for
End If
if ls=0 or flag then Costr=Costr & ts else Costr=Costr & strs & (ls) & stre
next
if fso_file.AtEndOfStream then sstr="" else sstr = fso_file.ReadLine & vbCrLf
Loop
fso_file.Close
WriteToFile InputBox("Input Target file name:" & info1,"Save as..."),Head & Costr,"GB2312"
Function WriteToFile(Getfile, Str, CharSet)
Set stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.Mode = 3
stm.CharSet = CharSet
stm.Open
stm.WriteText Str
stm.SaveToFile Getfile, 2
stm.Flush
stm.Close
Set stm = Nothing
End Function
'Function ReadFile(SourceFile, CharSet)
' Set stm = CreateObject("Adodb.Stream")
' stm.Type = 2
' stm.Mode = 3
' stm.CharSet = CharSet
' stm.Open
' stm.LoadFromFile SourceFile
' ReadFile = stm.ReadText
' stm.Close
' Set stm = Nothing
'End Function