主要用来在vbs中"夹带"exe,dll以及ocx。支持拖放，参数。
'***********************************************************************************
'恢复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
请大家帮忙测试。
