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. 

  48. o.Close()

  49. if LCase(na) = "sh" Or LCase(na) = "cfg" Then

  50.     sFILE = "新文件" & name & "." & na

  51.     sTEXT = o.OpenTextFile(sFILE).ReadAll()

  52.     Call WriteFileUTF8_NOBOM(sFILE,sTEXT)

  53. End If

  54. 

  55. Private Sub WriteFileUTF8_NOBOM(sFILE,sTEXT)

  56.     Const adSaveCreateNotExist = 1

  57.     Const adSaveCreateOverWrite = 2

  58.     Const adTypeBinary = 1

  59.     Const adTypeText = 2

  60.     Const adModeReadWrite = 3

  61.     Dim oUTF8Stream,oBinaryStream

  62.     Set oUTF8Stream = CreateObject("ADODB.Stream")

  63.     Set oBinaryStream = CreateObject("ADODB.Stream")

  64.     oUTF8Stream.Type = adTypeText

  65.     oUTF8Stream.Charset = "utf-8"

  66.     oUTF8Stream.Open

  67.     oUTF8Stream.WriteText sTEXT

  68.     oUTF8Stream.Position = 3 ' Skip BOM

  69.     oBinaryStream.Type = adTypeBinary

  70.     oBinaryStream.Mode = adModeReadWrite

  71.     oBinaryStream.Open

  72.     oUTF8Stream.CopyTo oBinaryStream

  73.     oUTF8Stream.Flush

  74.     oUTF8Stream.Close

  75.     oBinaryStream.SaveToFile sFILE, adSaveCreateOverWrite

  76.     oBinaryStream.Flush

  77.     oBinaryStream.Close

  78.     Set oUTF8Stream = Nothing

  79.     Set oBinaryStream = Nothing

  80. End Sub
复制代码
作者: 窄口牛    时间: 2023-10-2 14:00

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



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