[问题求助] 两段vbs整合：建立新文件和UTF-8（已解决）

窄口牛

建立新文件的vbs

Dim na
na=Inputbox("请输入扩展名:","确定默认txt,取消无后缀","TXT")
set fso=createobject("scripting.filesystemobject")
If Not(fso.fileexists("新文件."&na)) Then
fso.CreateTextFile("新文件."&na)
else
name=1
while fso.fileexists("新文件"&name&"."&na)=true
name=name+1
wend
end if
set o=fso.opentextfile("新文件"&name&"."&na,2,true)
if lcase(na)="bat" then
o.write "@echo off"&chr(13)&chr(10)&"Setlocal enabledelayedexpansion"&chr(13)&chr(10)&"reg query HKU\S-1-5-20>nul || echo;CreateObject^(""Shell.Application""^).ShellExecute ""%~f0"", """", """", ""runas"", 1 > ""%temp%\getadmin.vbs"" && cscript //b ""%temp%\getadmin.vbs"" && exit /b & del ""%temp%\getadmin.vbs"" /f /q>nul 2>nul"&chr(13)&chr(10)&"pushd ""%CD%""&& CD /D ""%~dp0"""
o.writeblanklines(8)
o.write "pause>nul"
elseif lcase(na)="vbs" then
o.write "'On Error Resume Next"
elseif lcase(na)="reg" then
o.write "Windows Registry Editor Version 5.00"
elseif lcase(na)="zip" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 44 Step 2
      o.Write Chr(Clng("&h" & Mid("504B0506000000000000000000000000000000000000",x,2)))
   Next
elseif lcase(na)="xml" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 12 Step 2
      o.Write Chr(Clng("&h" & Mid("3C68746D6C3E",x,2)))
   Next
elseif lcase(na)="html" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 10 Step 2
      o.Write Chr(Clng("&h" & Mid("68746D6C3E",x,2)))
   Next
elseif lcase(na)="xls" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 24 Step 2
      o.Write Chr(Clng("&h" & Mid("0902060000001000B9045C00",x,2)))
   Next
elseif lcase(na)="sh" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 32 Step 2
      o.Write Chr(Clng("&h" & Mid("23212F73797374656D2F62696E2F7368",x,2)))
   Next
end if
复制代码

后面怎么把建立utf-8的这一段加上，达到相同逻辑呈现

Option Explicit
Dim sTEXT,sFILE
sFILE = "grub.cfg"
sTEXT = "Сампле тест"
Call WriteFileUTF8_NOBOM(sFILE,sTEXT)
WScript.Echo(sTEXT)
Private Sub WriteFileUTF8_NOBOM(sFILE,sTEXT)
    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeReadWrite = 3
    Dim oUTF8Stream,oBinaryStream
    Set oUTF8Stream = CreateObject("ADODB.Stream")
    Set oBinaryStream = CreateObject("ADODB.Stream")
    oUTF8Stream.Type = adTypeText
    oUTF8Stream.Charset = "utf-8"
    oUTF8Stream.Open
    oUTF8Stream.WriteText sTEXT
    oUTF8Stream.Position = 3 ' Skip BOM
    oBinaryStream.Type = adTypeBinary
    oBinaryStream.Mode = adModeReadWrite
    oBinaryStream.Open
    oUTF8Stream.CopyTo oBinaryStream
    oUTF8Stream.Flush
    oUTF8Stream.Close
    oBinaryStream.SaveToFile sFILE, adSaveCreateOverWrite
    oBinaryStream.Flush
    oBinaryStream.Close
    Set oUTF8Stream = Nothing
    Set oBinaryStream = Nothing
End Sub
复制代码

窄口牛

utf-8的新文件后缀包括sh，cfg目前就想到这两个。

czjt1234

所谓屎山代码，不外如是

整合如下，未测试

Dim na
na=Inputbox("请输入扩展名:","确定默认txt,取消无后缀","TXT")
set fso=createobject("scripting.filesystemobject")
If Not(fso.fileexists("新文件."&na)) Then
fso.CreateTextFile("新文件."&na)
else
name=1
while fso.fileexists("新文件"&name&"."&na)=true
name=name+1
wend
end if
set o=fso.opentextfile("新文件"&name&"."&na,2,true)
if lcase(na)="bat" then
o.write "@echo off"&chr(13)&chr(10)&"Setlocal enabledelayedexpansion"&chr(13)&chr(10)&"reg query HKU\S-1-5-20>nul || echo;CreateObject^(""Shell.Application""^).ShellExecute ""%~f0"", """", """", ""runas"", 1 > ""%temp%\getadmin.vbs"" && cscript //b ""%temp%\getadmin.vbs"" && exit /b & del ""%temp%\getadmin.vbs"" /f /q>nul 2>nul"&chr(13)&chr(10)&"pushd ""%CD%""&& CD /D ""%~dp0"""
o.writeblanklines(8)
o.write "pause>nul"
elseif lcase(na)="vbs" then
o.write "'On Error Resume Next"
elseif lcase(na)="reg" then
o.write "Windows Registry Editor Version 5.00"
elseif lcase(na)="zip" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 44 Step 2
      o.Write Chr(Clng("&h" & Mid("504B0506000000000000000000000000000000000000",x,2)))
   Next
elseif lcase(na)="xml" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 12 Step 2
      o.Write Chr(Clng("&h" & Mid("3C68746D6C3E",x,2)))
   Next
elseif lcase(na)="html" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 10 Step 2
      o.Write Chr(Clng("&h" & Mid("68746D6C3E",x,2)))
   Next
elseif lcase(na)="xls" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 24 Step 2
      o.Write Chr(Clng("&h" & Mid("0902060000001000B9045C00",x,2)))
   Next
elseif lcase(na)="sh" then
Set objFso = CreateObject("Scripting.FileSystemObject") 
   For x = 1 To 32 Step 2
      o.Write Chr(Clng("&h" & Mid("23212F73797374656D2F62696E2F7368",x,2)))
   Next
end if

o.Close()
if LCase(na) = "sh" Or LCase(na) = "cfg" Then
    sFILE = "新文件" & name & "." & na
    sTEXT = o.OpenTextFile(sFILE).ReadAll()
    Call WriteFileUTF8_NOBOM(sFILE,sTEXT)
End If

Private Sub WriteFileUTF8_NOBOM(sFILE,sTEXT)
    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeReadWrite = 3
    Dim oUTF8Stream,oBinaryStream
    Set oUTF8Stream = CreateObject("ADODB.Stream")
    Set oBinaryStream = CreateObject("ADODB.Stream")
    oUTF8Stream.Type = adTypeText
    oUTF8Stream.Charset = "utf-8"
    oUTF8Stream.Open
    oUTF8Stream.WriteText sTEXT
    oUTF8Stream.Position = 3 ' Skip BOM
    oBinaryStream.Type = adTypeBinary
    oBinaryStream.Mode = adModeReadWrite
    oBinaryStream.Open
    oUTF8Stream.CopyTo oBinaryStream
    oUTF8Stream.Flush
    oUTF8Stream.Close
    oBinaryStream.SaveToFile sFILE, adSaveCreateOverWrite
    oBinaryStream.Flush
    oBinaryStream.Close
    Set oUTF8Stream = Nothing
    Set oBinaryStream = Nothing
End Sub
复制代码

窄口牛

谢谢了，不会写，前面都是自己拼接的。