任何文件转成vbs文件的脚本

清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>

'all2vbs.vbs
'***********************************************************************************
'恢复exe文件的代码
'***********************************************************************************
     sCode = "sFile = InputBox(""输入要生成的文件名,包括扩展名:"")" + vbCrLf + _
             "     if Len(Trim(sFile)) = 0 Then Wscript.Quit" + vbCrLf + _
             "Set oStream = Createobject(""Adodb.Stream"")" + vbCrLf + _
             "Set oXML = Createobject(""Microsoft.XMLDOM"")" + vbCrLf + _
             "Set oElement = oXML.CreateElement(""oTmpElement"")" + vbCrLf + _
             "     oElement.DataType = ""bin.hex""" + vbCrLf + _
             "     oElement.NodeTypedValue = str" + vbCrLf + _
             "With oStream" + vbCrLf + _            
             "     .Type = 1" + vbCrLf + _
             "     .Mode = 3" + vbCrLf + _
             "     .Open" + vbCrLf + _
             "     .Write oElement.NodeTypedValue" + vbCrLf + _
             "     .SaveToFile sFile" + vbCrLf + _
             "End With" + vbCrLf + _
             "     oStream.Close" + vbCrLf + _
             "Set oStream = Nothing" + vbCrLf + _
             "Set oXML = Nothing" + vbCrLf + _
             "Set oElement = Nothing" 


'***********************************************************************************
'开始
'***********************************************************************************
sFile = GetFile()
Set oStream = CreateObject("Adodb.Stream")
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFile = oFso.OpenTextFile(sFile & ".vbs",2,True)
     oFile.WriteLine "str= _"
With oStream
     .Type = 1
     .Open
     .LoadFromFile sFile
End With
Do Until oStream.EOS

'生成的vbs文件每一行的长度由oStream.Read()中的参数来控制
     oFile.WriteLine Space(4) + "+" + Chr(34) + _
                     Bin2Str(oStream.Read(20)) + chr(34) + " _" 

Loop
'由于上一行结束有"_",所以要空一行
     oFile.WriteLine Space(1)
     oFile.Write sCode
    
oStream.Close
oFile.Close
Set oStream = Nothing
Set oFile = Nothing
Set oFso = Nothing
'***********************************************************************************
'2进制转换为16进制字符串
'***********************************************************************************
Function Bin2Str(bin)

     Dim i,str
     For i = 1 To Lenb(bin)
         If Ascb(Midb(bin,i,1)) < 16 Then str = str + "0"
         str = str & Hex(Ascb(Midb(bin,i,1)))
     Next
     Bin2Str = str

End Function

'***********************************************************************************
'获得要操作的文件
'***********************************************************************************
Function GetFile()

On Error Resume Next
Dim strFile,objFso,objFile
     If WScript.Arguments.Count < 1 Then
         Set objDialog = CreateObject("UserAccounts.CommonDialog")
         objDialog.Filter = "exe 文件|*.exe|dll 文件|*.dll|ocx 文件|*.ocx|所有 文件|*.*"
         objDialog.ShowOpen
         strFile = objDialog.FileName
         Set objDialog = Nothing
     Else
         strFile = WScript.Arguments(0)
     end if
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(strFile)
     If Err Then 
         If Err.Number = 5 Then WScript.Quit
         WScript.Echo Err.Description 
         Err.Clear
         WScript.Quit
     Else
         GetFile = strFile
     End If
    
Set objFile = Nothing
Set objFso = Nothing
End Function