|
|
本帖最后由 mxl 于 2023-9-22 19:40 编辑
本人在网上找的修改后自用，vbs脚本。
Sub ShowHelp()
MsgBox "命令行参数说明(不区分大小写)" &vbLf& _
"/?、/h、/help 查看此帮助信息" &vbLf& _
"/i:RegFile 指定要转换的注册表文件路径" &vbLf& _
"/e:OutFileExt 指定转换的文件扩展名" &vbLf& _
"例如:" &vbLf& _
"简易模式:WScript Reg2Wcs.vbs [/e:ini] [/i:]slore.reg" &vbLf& _
" 输出为注册表文件同名文件" _
,64,"Reg2Wcs By Slore 更新于:2020年9月28日"
WSH.Quit
End Sub
Set WSS = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
FileName = WSH.ScriptName
FileFullName = WSH.ScriptFullName
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath,FileName)
OutFileExt = "bat"
'参数处理
With WSH.Arguments
If .Count > 0 Then
Select Case .Item(0)
Case "/?","-?","/h","-h","/help","-help": ShowHelp
End Select
If .Named.Exists("e") Then OutFileExt = .Named("e")
If .Named.Exists("i") Then RegFile = .Named("i")
If .Unnamed.Count > 0 Then RegFile = .Unnamed(0)
ELSEIf Not FSO.FileExists(InsFullName) then
Setup
ELSE
RegFile = WSS.Exec("mshta.exe ""about:<input type=file id=F><script>F.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(F.value);close();</script>""").StdOut.ReadAll
End If
End With
If RegFile = "" Then Setup
Select Case OutFileExt
Case "wcs","ini": ofe = 0
Case "cmd","bat": ofe = 1
End Select
'获取注册表文件编码
FileEncoding = GetEncoding(RegFile)
Select Case FileEncoding
Case "ANSI": Format = 0
Case "Unicode": Format = -1
Case Else :MsgBox "注册表文件的编码不正确。",64,"文件编码:"&FileEncoding: WSH.Quit
End Select
'格式化注册表文件
With FSO.OpenTextFile(RegFile,1,0,Format)
Do Until .AtEndOfStream
Line = Trim(.ReadLine)
If Line <> "" And Left(Line,1) <> ";" And Left(Line,1) <> "#" Then '清除空行 ,清除注释行
f = InStr(Line,";")
If f Then If Instr(" ]\0""",Mid(Line,f-1,1)) or Instr(Line,"dword:") Then Line = Trim(Left(Line,f-1)) '清除行后注释
Str = Str&Line&vbLf
End If
Loop
.Close
End With
'合并hex(?)类型多行数据
hPos = InStr(Str,",\"&vbLf)
Do While hPos > 0
Str = Left(Str,hPos)&Mid(Str,hPos+3)
hPos = InStr(hPos,Str,",\"&vbLf)
Loop
'替换主键为缩写
Lines = Split(Replace(Replace(Replace(Replace(Replace(Str,"HKEY_LOCAL_MACHINE","HKLM"),"HKEY_CURRENT_USER","HKCU"),"HKEY_CLASSES_ROOT","HKCR"),"HKEY_USERS","HKU"),"HKEY_CUREENT_CONFIG","HKCC"),vbLf)
'检验文件头
If Lines(0) <> "REGEDIT4" And Lines(0) <> "Windows Registry Editor Version 5.00" Then MsgBox "不是注册表文件",64,"错误": WSH.Quit
For i = 1 To UBound(Lines)
HCR = Left(Lines(i),1)
If HCR = "[" Then
If Mid(Lines(i),2,1) = "-" Then o = 1 Else o = 0
Key = Mid(Lines(i),2+o,Len(Lines(i))-2-o)
n = 0
for x = i+1 To UBound(Lines)-1
if Left(Lines(x),1) <> "[" then n = n+1 Else Exit For
next
If ofe = 0 Then
If o = 1 then
Out =Out&"REGI "&Key&"\!"&vbLf: Key = ""
else
if n > 1 then Out = Out&"SET R="&Key&vbLf
end if
End If
If ofe = 1 Then
Key = """"&Key&""""
If o = 1 then
Out = Out&"reg delete "&Key&" /f"&vbCrLf: Key = ""
else
if n > 1 then Out = Out&"SET R="&Key&vbCrLf
end if
End If
if InStr(Key,R) Then Key=Replace(Key,R,"%R%") Else R=Key
ElseIf HCR = "@" And Len(Key) Then
GetTD Mid(Lines(i),3),oType,oData
If ofe = 0 Then
If oData = "-" then
if n > 1 then Out = Out&"REGI %R%\="&vbLf else Out = Out&"REGI "&Key&"\="&vbLf
else
if n > 1 then Out = Out&"REGI "&oType&"%R%\="&oData&vbLf else Out = Out&"REGI "&oType&Key&"\="&oData&vbLf
end if
End If
If ofe = 1 Then
If oData = "-" then
if n > 1 then Out = Out&"reg delete %R% /f /ve"&vbCrLf else Out = Out&"reg delete "&Key&" /f /ve"&vbCrLf
else
if n > 1 then Out = Out&"reg add %R% /f /ve /t " &oType&" /d "&oData&vbCrLf else Out = Out&"reg add "&Key&" /f /ve /t " &oType&" /d "&oData&vbCrLf
end if
End If
R=Key
ElseIf HCR = """" And Len(Key) Then
vPos = InStr(2,Lines(i),"""=")
If vPos Then
Val = Replace(Replace(Left(Lines(i),vPos),"\\","\"),"%","%%")
GetTD Mid(Lines(i),vPos+2),oType,oData
If ofe = 0 Then
Val = Replace(Mid(Val,2,Len(Val)-2),"\""","""")
If InStr(Val,",") or InStr(Val,"=") Then
Out = Out&"SET E="&Val&vbLf
If oData = "-" then
if n > 1 then Out = Out&"REGI %R%\\%E%="&vbLf else Out = Out&"REGI "&Key&"\\%E%="&vbLf
else
if n > 1 then Out = Out&"REGI "&oType&"%R%\\%E%="&oData&vbLf else Out = Out&"REGI "&oType&Key&"\\%E%="&oData&vbLf
end if
Else
If oData = "-" then
if n > 1 then Out = Out&"REGI %R%\\"&Val&"="&vbLf else Out = Out&"REGI "&Key&"\\"&Val&"="&vbLf
else
if n > 1 then Out = Out&"REGI "&oType&"%R%\\"&Val&"="&oData&vbLf else Out = Out&"REGI "&oType&Key&"\\"&Val&"="&oData&vbLf
end if
End If
End if
If ofe = 1 Then
If oData = "-"then
if n > 1 then Out = Out&"reg delete %R% /f /v "&Val&vbCrLf else Out = Out&"reg delete "&Key&" /f /v "&Val&vbCrLf
else
if n > 1 then Out = Out&"reg add %R% /f /v "&Val&" /t "&oType&" /d "&oData&vbCrLf else Out = Out&"reg add "&Key&" /f /v "&Val&" /t "&oType&" /d "&oData&vbCrLf
end if
End If
End If
End If
Next
'保存文件
With FSO.CreateTextFile(Left(RegFile,InstrRev(RegFile,"."))&OutFileExt,True):.Write Out:.Close:End With
Set WSS = Nothing: Set FSO = Nothing
'-----------------自定义函数------------------
Sub Setup()
CloseTime=5
Copyright="聚鑫科技"
QQ="QQ:360180986"
Email="Email:360180986@qq.com"
InsTitle="Reg2Wcs"
InsAnswer="Reg2Wcs"
RegPath="HKCR\regfile\shell\convert\"
If Not FSO.FileExists(InsFullName) then
intAnswer=MsgBox("【是】将“"+InsAnswer+"”加入到右键菜单。",36,"安装 - "+ InsTitle +" - "+ Copyright+" - "+Email)
If intAnswer=6 Then
WSS.RegWrite RegPath&"MUIVerb","转换"
WSS.RegWrite RegPath&"Position","Top"
WSS.RegWrite RegPath&"Icon","regedit.exe,0"
WSS.RegWrite RegPath&"SubCommands",""
WSS.RegWrite RegPath&"shell\Reg2Wcs\Icon","pecmd.exe,0"
WSS.RegWrite RegPath&"shell\Reg2Wcs\command\","Wscript.exe """&InsFullName&""" /e:wcs ""%L"""
WSS.RegWrite RegPath&"shell\Reg2Cmd\Icon","cmd.exe,0"
WSS.RegWrite RegPath&"shell\Reg2Cmd\command\","Wscript.exe """&InsFullName&""" /e:cmd ""%L"""
FSO.CopyFile FileFullName,InsFullName
WSS.popup _
"添加脚本文件："+vbLf+""""+InsFullName+""""+vbLf+vbLf+ _
"添加注册表项："+vbLf+""""+RegPath+""""+vbLf+ _
vbLf&CloseTime&" 秒钟后本窗口将自动关闭!"+vbLf+vbLf+ _
vbLf+"Copyright(C) "+Copyright+" "&QQ&" "+Email _
,CloseTime,"安装成功 - "+InsTitle+" - "+Copyright,64
End If
ELSE
intAnswer=MsgBox("【是】将“"+InsAnswer+"”删除右键菜单。",52,"卸载 - "+ InsTitle +" - "+ Copyright+" - "+Email)
If intAnswer=6 Then
FSO.DeleteFile InsFullName
WSS.RegDelete RegPath&"shell\Reg2Wcs\command\"
WSS.RegDelete RegPath&"shell\Reg2Wcs\"
WSS.RegDelete RegPath&"shell\Reg2Cmd\command\"
WSS.RegDelete RegPath&"shell\Reg2Cmd\"
WSS.RegDelete RegPath&"shell\"
WSS.RegDelete RegPath
WSS.popup _
"删除脚本文件："+vbLf+""""+InsFullName+""""+vbLf+vbLf+ _
"删除注册表项："+vbLf+""""+RegPath+""""+vbLf+ _
vbLf&CloseTime&" 秒钟后本窗口将自动关闭!"+vbLf+vbLf+ _
vbLf+"Copyright(C) "+Copyright+" "&QQ&" "+Email _
,CloseTime,"卸载成功 - "+InsTitle+" - "+Copyright,48
End If
End If
WSH.Quit
End Sub
'检测文本文件编码
Function GetEncoding(FileName)
Dim HBt(1)
With CreateObject("Adodb.Stream")
.Type = 1: .Mode = 3
.Open: .LoadFromFile FileName
HBin = .Read(2): .Close
End With
HBt(0) = AscB(MidB(HBin,1,1))
HBt(1) = AscB(MidB(HBin,2,1))
GetEncoding = "ANSI"
If HBt(0) = &HFF And HBt(1) = &HFE Then GetEncoding = "Unicode"
If HBt(0) = &HFE And HBt(1) = &HFF Then GetEncoding = "Unicode Big Endian"
If HBt(0) = &HEF And HBt(1) = &HBB Then GetEncoding = "UTF-8"
End Function
'按类型处理数据
Sub GetTD(iStr,oType,oData)
oType = "": oData = ""
If iStr = "" Then Exit Sub
If iStr = "-" Then oData = "-": Exit Sub
If Left(iStr,1) = """" Then
iStr = Replace(Replace(Mid(iStr,2,Len(iStr)-2),"\\","\"),"%","%%")
If ofe = 0 Then oType = "$": oData = Replace(iStr,"\""","""")
If ofe = 1 Then
oType = "REG_SZ"
If Right(iStr,1) = "\" Then iStr = iStr&"\"
oData = """"&iStr&""""
End If
ElseIf LCase(Left(iStr,4)) = "hex:" Then
If ofe = 0 Then oType = "--16 @"
If ofe = 1 Then oType = "REG_BINARY"
oData = Replace(Mid(iStr,5),",","")
ElseIf LCase(Left(iStr,6)) = "dword:" Then
If ofe = 0 Then oType = "#"
If ofe = 1 Then oType = "REG_DWORD"
oData = H2D(Mid(iStr,7)) 'CLng("&H"&Mid(iStr,7))
ElseIf LCase(Left(iStr,4)) = "hex(" Then
Select Case Mid(iStr,4,3)
Case "(2)"
If ofe = 0 Then oType = "~"
If ofe = 1 Then oType = "REG_EXPAND_SZ"
oData = H2A(iStr)
Case "(7)"
If ofe = 0 Then oType = "*"
If ofe = 1 Then oType = "REG_MULTI_SZ"
oData = H2A(iStr)
Case "(b)"
If ofe = 0 Then oType = "+"
If ofe = 1 Then oType = "REG_QWORD"
iStr = Replace(Mid(iStr,8),",","")
For j = 1 To Len(iStr) Step 2
sRet = Mid(iStr,j,2)&sRet
Next
oData = "0x"&sRet
Case Else
oData = """不支持的类型。"""
End Select
End If
End Sub
Function H2A(Hex)
Hex = Replace(Replace(Mid(Hex,8),",00",""),",","")
For j = 1 To Len(Hex) Step 2
sRet = sRet&Chr("&H"&Mid(Hex,j,2))
Next
H2A = Replace(sRet,"%","%%")
If ofe = 1 Then
If Right(H2A,1) = "\" Then H2A = H2A&"\"
H2A = """"&Replace(H2A,"""","\""")&""""
End If
End Function
Function H2D(Hex)
Hex = LCase(Hex)
For j = 0 To Len(Hex)-1
a = Mid(Hex,Len(Hex)-j,1)
Select Case a
Case "a": a = 10
Case "b": a = 11
Case "c": a = 12
Case "d": a = 13
Case "e": a = 14
Case "f": a = 15
End Select
H2D = H2D+16^j*a
Next
End Function
|
|
IP卡
狗仔卡
发表于 2023-9-11 17:35:28
收藏
支持
反对
提升卡
沉默卡
喧嚣卡
变色卡
千斤顶
显身卡
楼主
