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

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

'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,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

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!