Board logo

标题: [问题求助] 两段vbs整合:建立新文件和UTF-8(已解决) [打印本页]

作者: 窄口牛    时间: 2023-10-2 07:54     标题: 两段vbs整合:建立新文件和UTF-8(已解决)

本帖最后由 窄口牛 于 2023-10-2 14:00 编辑

建立新文件的vbs
  1. Dim na
  2. na=Inputbox("请输入扩展名:","确定默认txt,取消无后缀","TXT")
  3. set fso=createobject("scripting.filesystemobject")
  4. If Not(fso.fileexists("新文件."&na)) Then
  5. fso.CreateTextFile("新文件."&na)
  6. else
  7. name=1
  8. while fso.fileexists("新文件"&name&"."&na)=true
  9. name=name+1
  10. wend
  11. end if
  12. set o=fso.opentextfile("新文件"&name&"."&na,2,true)
  13. if lcase(na)="bat" then
  14. 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"""
  15. o.writeblanklines(8)
  16. o.write "pause>nul"
  17. elseif lcase(na)="vbs" then
  18. o.write "'On Error Resume Next"
  19. elseif lcase(na)="reg" then
  20. o.write "Windows Registry Editor Version 5.00"
  21. elseif lcase(na)="zip" then
  22. Set objFso = CreateObject("Scripting.FileSystemObject")
  23.    For x = 1 To 44 Step 2
  24.       o.Write Chr(Clng("&h" & Mid("504B0506000000000000000000000000000000000000",x,2)))
  25.    Next
  26. elseif lcase(na)="xml" then
  27. Set objFso = CreateObject("Scripting.FileSystemObject")
  28.    For x = 1 To 12 Step 2
  29.       o.Write Chr(Clng("&h" & Mid("3C68746D6C3E",x,2)))
  30.    Next
  31. elseif lcase(na)="html" then
  32. Set objFso = CreateObject("Scripting.FileSystemObject")
  33.    For x = 1 To 10 Step 2
  34.       o.Write Chr(Clng("&h" & Mid("68746D6C3E",x,2)))
  35.    Next
  36. elseif lcase(na)="xls" then
  37. Set objFso = CreateObject("Scripting.FileSystemObject")
  38.    For x = 1 To 24 Step 2
  39.       o.Write Chr(Clng("&h" & Mid("0902060000001000B9045C00",x,2)))
  40.    Next
  41. elseif lcase(na)="sh" then
  42. Set objFso = CreateObject("Scripting.FileSystemObject")
  43.    For x = 1 To 32 Step 2
  44.       o.Write Chr(Clng("&h" & Mid("23212F73797374656D2F62696E2F7368",x,2)))
  45.    Next
  46. end if
复制代码
后面怎么把建立utf-8的这一段加上,达到相同逻辑呈现
  1. Option Explicit
  2. Dim sTEXT,sFILE
  3. sFILE = "grub.cfg"
  4. sTEXT = "Сампле тест"
  5. Call WriteFileUTF8_NOBOM(sFILE,sTEXT)
  6. WScript.Echo(sTEXT)
  7. Private Sub WriteFileUTF8_NOBOM(sFILE,sTEXT)
  8.     Const adSaveCreateNotExist = 1
  9.     Const adSaveCreateOverWrite = 2
  10.     Const adTypeBinary = 1
  11.     Const adTypeText = 2
  12.     Const adModeReadWrite = 3
  13.     Dim oUTF8Stream,oBinaryStream
  14.     Set oUTF8Stream = CreateObject("ADODB.Stream")
  15.     Set oBinaryStream = CreateObject("ADODB.Stream")
  16.     oUTF8Stream.Type = adTypeText
  17.     oUTF8Stream.Charset = "utf-8"
  18.     oUTF8Stream.Open
  19.     oUTF8Stream.WriteText sTEXT
  20.     oUTF8Stream.Position = 3 ' Skip BOM
  21.     oBinaryStream.Type = adTypeBinary
  22.     oBinaryStream.Mode = adModeReadWrite
  23.     oBinaryStream.Open
  24.     oUTF8Stream.CopyTo oBinaryStream
  25.     oUTF8Stream.Flush
  26.     oUTF8Stream.Close
  27.     oBinaryStream.SaveToFile sFILE, adSaveCreateOverWrite
  28.     oBinaryStream.Flush
  29.     oBinaryStream.Close
  30.     Set oUTF8Stream = Nothing
  31.     Set oBinaryStream = Nothing
  32. End Sub
复制代码

作者: 窄口牛    时间: 2023-10-2 07:56

utf-8的新文件后缀包括sh,cfg目前就想到这两个。
作者: czjt1234    时间: 2023-10-2 11:35

所谓屎山代码,不外如是

整合如下,未测试
  1. Dim na
  2. na=Inputbox("请输入扩展名:","确定默认txt,取消无后缀","TXT")
  3. set fso=createobject("scripting.filesystemobject")
  4. If Not(fso.fileexists("新文件."&na)) Then
  5. fso.CreateTextFile("新文件."&na)
  6. else
  7. name=1
  8. while fso.fileexists("新文件"&name&"."&na)=true
  9. name=name+1
  10. wend
  11. end if
  12. set o=fso.opentextfile("新文件"&name&"."&na,2,true)
  13. if lcase(na)="bat" then
  14. 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"""
  15. o.writeblanklines(8)
  16. o.write "pause>nul"
  17. elseif lcase(na)="vbs" then
  18. o.write "'On Error Resume Next"
  19. elseif lcase(na)="reg" then
  20. o.write "Windows Registry Editor Version 5.00"
  21. elseif lcase(na)="zip" then
  22. Set objFso = CreateObject("Scripting.FileSystemObject")
  23.    For x = 1 To 44 Step 2
  24.       o.Write Chr(Clng("&h" & Mid("504B0506000000000000000000000000000000000000",x,2)))
  25.    Next
  26. elseif lcase(na)="xml" then
  27. Set objFso = CreateObject("Scripting.FileSystemObject")
  28.    For x = 1 To 12 Step 2
  29.       o.Write Chr(Clng("&h" & Mid("3C68746D6C3E",x,2)))
  30.    Next
  31. elseif lcase(na)="html" then
  32. Set objFso = CreateObject("Scripting.FileSystemObject")
  33.    For x = 1 To 10 Step 2
  34.       o.Write Chr(Clng("&h" & Mid("68746D6C3E",x,2)))
  35.    Next
  36. elseif lcase(na)="xls" then
  37. Set objFso = CreateObject("Scripting.FileSystemObject")
  38.    For x = 1 To 24 Step 2
  39.       o.Write Chr(Clng("&h" & Mid("0902060000001000B9045C00",x,2)))
  40.    Next
  41. elseif lcase(na)="sh" then
  42. Set objFso = CreateObject("Scripting.FileSystemObject")
  43.    For x = 1 To 32 Step 2
  44.       o.Write Chr(Clng("&h" & Mid("23212F73797374656D2F62696E2F7368",x,2)))
  45.    Next
  46. end if
  47. o.Close()
  48. if LCase(na) = "sh" Or LCase(na) = "cfg" Then
  49.     sFILE = "新文件" & name & "." & na
  50.     sTEXT = o.OpenTextFile(sFILE).ReadAll()
  51.     Call WriteFileUTF8_NOBOM(sFILE,sTEXT)
  52. End If
  53. Private Sub WriteFileUTF8_NOBOM(sFILE,sTEXT)
  54.     Const adSaveCreateNotExist = 1
  55.     Const adSaveCreateOverWrite = 2
  56.     Const adTypeBinary = 1
  57.     Const adTypeText = 2
  58.     Const adModeReadWrite = 3
  59.     Dim oUTF8Stream,oBinaryStream
  60.     Set oUTF8Stream = CreateObject("ADODB.Stream")
  61.     Set oBinaryStream = CreateObject("ADODB.Stream")
  62.     oUTF8Stream.Type = adTypeText
  63.     oUTF8Stream.Charset = "utf-8"
  64.     oUTF8Stream.Open
  65.     oUTF8Stream.WriteText sTEXT
  66.     oUTF8Stream.Position = 3 ' Skip BOM
  67.     oBinaryStream.Type = adTypeBinary
  68.     oBinaryStream.Mode = adModeReadWrite
  69.     oBinaryStream.Open
  70.     oUTF8Stream.CopyTo oBinaryStream
  71.     oUTF8Stream.Flush
  72.     oUTF8Stream.Close
  73.     oBinaryStream.SaveToFile sFILE, adSaveCreateOverWrite
  74.     oBinaryStream.Flush
  75.     oBinaryStream.Close
  76.     Set oUTF8Stream = Nothing
  77.     Set oBinaryStream = Nothing
  78. End Sub
复制代码

作者: 窄口牛    时间: 2023-10-2 14:00

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




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2