中国DOS联盟论坛 - Powered by Discuz! Board

标题: Reg2VBS→vbs版 [打印本页]

作者: baomaboy 时间: 2007-6-1 12:27 标题: Reg2VBS→vbs版

To wert123

reg2vbs.rar

作者: wert123 时间: 2007-6-1 14:01
辛苦了啊，baomaboy大师又一个vbs版的好东东
不过最好把源码还原出来吧
reg转换生成的vbs也能还原的更清楚些吗

作者: zhoushijay 时间: 2007-6-1 14:09
让我猜猜你的原理:
应该是把里面的注册表路径提取出来放入变量 a
然后再把这个reg文件改写成, ws.write a 名字再换成*.VBS

是这样的吗?

作者: baomaboy 时间: 2007-6-1 14:16

Quote:

Originally posted by wert123 at 2007-6-1 14:01:
辛苦了啊，baomaboy大师又一个vbs版的好东东
不过最好把源码还原出来吧
reg转换生成的vbs也能还原的更清楚些吗

算不得什么好东东，只是简单得文本读取创建而已，并且没什么实用价值，如果不是因为你不喜欢reg只喜欢vbs这个原因此东东都没必要存在，另外你说reg转vbs后加密了，其实没有，从那个转换后得文件完全可以推出我的源码，这也是不加密转换后代码得原因。
源码加密还是老原因，模版、无用代码、每次都要引起口舌。。。。

作者: baomaboy 时间: 2007-6-1 14:32

Quote:

Originally posted by zhoushijay at 2007-6-1 14:09:
让我猜猜你的原理:
应该是把里面的注册表路径提取出来放入变量 a
然后再把这个reg文件改写成, ws.write a 名字再换成*.VBS

是这样的吗?

基本正确

作者: zhoushijay 时间: 2007-6-1 14:35
O 也

作者: wert123 时间: 2007-6-1 15:26
源码加密还是老原因，老原因是什么
麻烦把源码贴出来吧，我不会推，也不会转
我O 也不了啊

作者: baomaboy 时间: 2007-6-1 15:51
得，看下面的吧还是。。。。。。

[ Last edited by baomaboy on 2007-6-1 at 04:12 PM ]

作者: slore 时间: 2007-6-1 16:04
Rem EnCode_4.0 By baomaboy
'reg2vbs.vbs by baomaboy
Dim WshSHell,FSO
on Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)

InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPathFileName)
LnkPathNT = WshSHell.SpecialFolders(2)
LnkPath9X = WshSHell.SpecialFolders(14)
LnkPathAll = WshSHell.SpecialFolders("SendTo")
OtherFileName = "Manage_New.txt"

OtherFilePath = FSO.GetSpecialFolder(2)
TemFileName = "无标题":TemFilePath = FSO.GetSpecialFolder(2)
Copyright = "玲珑科技"
Email = "Email：fty1995@163.com"
InsTitle = "Reg2Vbsbybaomaboy"
RegPath1 = "HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\"
RegValue1 = "转换为VBS脚本文件"
RegForm1 = "REG_SZ"
RegPath2 = "HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\command\"
RegValue2 = "wscript.exe""""%L"""
RegForm2 = "REG_SZ"

If FileFullName <> InsFullName Then

intAnswer = MsgBox("【是】将“" + InsAnswer + "”加入到右键菜单，" & Chr(10) & Chr(10) & "【否】将“" + InsAnswer + "”从右键菜单删除。",vbQuestion + vbYesNoCancel,"安装-" + InsTitle + "-" + Copyright)

If intAnswer = vbYes Then

      WshSHell.RegWrite RegPath1,RegValue1,RegForm1
      WshSHell.RegWriteRegPath2,RegValue2,RegForm2
      FSO.GetFile(FileFullName).Copy(InsFullName)
      WshSHell.popup "添加脚本文件：" + vbLf + InsFullName + vbLf + "添加注册表项：" + _
Chr(34) + RegPath1 + Chr(34) + vbLf & CloseTime & " 秒钟后本窗口将自动关闭!" + vbLf + vbLf + _
" Copyright(C)" + Copyright + " " & QQ & " " + Email,CloseTime,"安装成功 - " + InsTitle + " - " + Copyright, 0 + 64
End If

If IntAnswer = vbNo Then
      WshSHell.RegDelete RegPath2
      WshSHell.RegDelete RegPath1
      FSO.DeleteFile InsFullName

      WshSHell.popup "删除脚本文件：" + vbLf + InsFullName + vbLf + "删除注册表项：" + _
Chr(34) + RegPath1 + Chr(34) + vbLf & CloseTime & " 秒钟后本窗口将自动关闭!" + vbLf + vbLf + _
" Copyright(C)" + Copyright + " " & QQ & " " + Email,CloseTime,"卸载成功 - " + InsTitle + " - " + Copyright, 0 + 64
End If

If intAnswer = vbCancel Then
End If
Else

If Args.count = 0 Then  wscript.quit

Set ReadFile = FSO.OpenTextFile(Args(0),1,False, - 1)
ReadAllText = ReadFile.ReadAll
ReadFile.Close

If Mid(ReadAllText,1,3) <> "Win" And Mid(ReadAllText,1,3) <> "REG" Then

      Set ReadFile = FSO.OpenTextFile(Args(0),1)
      ReadAllText = ReadFile.ReadAll
      ReadFile.Close

End If

For i = 1 To Len(ReadAllText)
      TempNum = Asc(Mid(ReadAllText,i,1))
      If TempNum = 34 Then
         TempNum = 18
      ElseIf TempNum = 13 Then
         TempNum = 28
      ElseIf TempNum = 10 Then
         TempNum = 29
      End If
      ThisText1 = ThisText1 & Chr(TempNum)
Next

Set WriteFile = FSO.OpenTextFile(Args(0) & ".VBS",2,True)

WriteFile.WriteLine("On Error Resume Next:Dim WshSHell,FSO,Reg2Vbs:Set WshSHell = WScript.CreateObject(""WScript.Shell""):Set FSO = CreateObject(""Scripting.FileSystemObject""):Reg2Vbs=""" & ThisText1 & """")
WriteFile.WriteLine("Execute(""For i=1 To Len(Reg2Vbs)""&vbCrLf&""TempNum = Asc(Mid(Reg2Vbs,i,1))""&vbCrLf&""If TempNum = 28 Then""&vbCrLf&""TempNum = 13""&vbCrLf&""ElseIf TempNum = 29 Then""&vbCrLf&""TempNum = 10""&vbCrLf&""elseif TempNum=18 Then""&vbCrLf&""TempNum = 34""&vbCrLf&""End If""&vbCrLf&""ThisText2 = ThisText2 & chr(TempNum)""&vbCrLf&""Next"")")
WriteFile.WriteLine("Set RegFile = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg""),2,True):RegFile.WriteLine(ThisText2):RegFile.Close:WshSHell.Run(""regedit /s ""&FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")):WScript.Sleep 500:FSO.DeleteFile FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")")

WriteFile.Close
End If

Set  WshSHell = Nothing:SetFSO = Nothing:Set Args = Nothing:WScript.Quit(0)

[ Last edited by slore on 2007-6-2 at 06:43 PM ]

作者: wert123 时间: 2007-6-1 16:09
谢谢啊

[ Last edited by wert123 on 2007-6-1 at 04:11 PM ]

作者: slore 时间: 2007-6-1 16:31
For i = 1 To Len(ReadAllText)
TempNum = Asc(Mid(ReadAllText,i,1))
If TempNum = 34 Then
      TempNum = 18
ElseIf TempNum = 13 Then
      TempNum = 28
ElseIf TempNum = 10 Then
      TempNum = 29
End If
ThisText1 = ThisText1 & Chr(TempNum)
Next
这个部分……为什么不用replace函数？引号的话转义成双引号就好了。

这个原理简直…………

你还说zhoushijay的基本是对的＝。＝一点都不搭边。。。

作者: baomaboy 时间: 2007-6-1 16:32
slore 兄的代码着色是论坛的功能吗？好像还没见别人用啊？还是你自己做的。真不错。

作者: slore 时间: 2007-6-1 16:35
自己做的……问题还很多，所以没有发布。。。对我自己的测试代码行不通自己还要手动改好多地方（自己想的测试代码太BT了，自己有点挑剔吧，要做就做好，不然不想做）……

比如End If要上2次相同的颜色……这个要改。。。最近都没时间……

还有_换行的问题……

作者: baomaboy 时间: 2007-6-1 16:39
最初是加密reg的（后删掉了那句)，所以没考虑用replace。

zhoushijay说，读给变量，再写回去reg，基本思路就是这样吗。只是他说的笼统一些怎么会不搭边啊。

[ Last edited by baomaboy on 2007-6-1 at 04:49 PM ]

作者: baomaboy 时间: 2007-6-1 16:46

Quote:

Originally posted by slore at 2007-6-1 16:35:
自己做的……问题还很多，所以没有发布。。。对我自己的测试代码行不通自己还要手动改好多地方（自己想的测试代码太BT了，自己有点挑剔吧，要 ...

希望slore兄早日完成，若做成本论坛的插件，那可是。。。。。

作者: slore 时间: 2007-6-1 16:47
ThisText1 = Replace(ReadAllText,vbCr,Chr(28))
ThisText1 = Replace(ThisText1,vbLf,Chr(29))
ThisText1 = Replace(ThisText1,Chr(34),Chr(18))

这样就不用循环……我是这个意思……

zhoushijay的你再看看……他说的原理是真正的reg2vbs……
将reg所表达的信息用vbs中的regwrite等方法实现。

作者: slore 时间: 2007-6-1 16:49
论坛插件的话要网页里的脚本……我是用VB写的……

作者: baomaboy 时间: 2007-6-1 16:58

Quote:

Originally posted by slore at 2007-6-1 16:47:
ThisText1 = Replace(ReadAllText,vbCr,Chr(28) ...

明白了，最初是要加密reg的，删掉了加密那句，所以结构还保留了原for

另外你说的真reg2vbs，受人之托后首先想到的就是用VBS自身的方法，但你应该知道，VBS自身那方法局限性太大并不能完全实现reg文件的作用，甚至wmi也考虑了，最后还是选择了文件转换，虽然笨拙，但是最有效且不易出错的。

作者: slore 时间: 2007-6-1 17:01
是有局限性，所以我就叫它保留reg，用vbs调用regedit /s就好……

作者: baomaboy 时间: 2007-6-1 17:07

Quote:

Originally posted by slore at 2007-6-1 17:01:
是有局限性，所以我就叫它保留reg，用vbs调用regedit /s就好……

呵呵我也是这么和他说的，可他说讨厌带着一堆reg，他只喜欢vbs。

另外问兄，是否知道如何判断文件编码方式，(ansi和unicode)如此例。

不想使用流，所以必然涉及编码方式，此例中用了取巧的方法，兄是否可有方法判断。

作者: slore 时间: 2007-6-1 17:17
unicode的话2进制读取的前2个是FFFE(255 254)

VB里我是
Open strFileName For Binary As #iReadNumber
Get #iReadNumber, 1, Ucodehead
Get #iReadNumber, 3, mem
Close #iReadNumber
If Ucodehead(0) = 255 And Ucodehead(1) = 254 Then OutStr = CStr(mem) Else OutStr = StrConv(mem, vbUnicode)

脚本没研究过……

作者: baomaboy 时间: 2007-6-1 17:21
判断文件头的方法我也查到了，好像找不到脚本的。

作者: slore 时间: 2007-6-1 17:25
脚本的opentextfile使用u模式读取文件。

A模式读U的文本会出错，不知道用u模式读A的文件会怎么样。。。

作者: baomaboy 时间: 2007-6-1 17:40

Quote:

Originally posted by slore at 2007-6-1 17:25:
脚本的opentextfile使用u模式读取文件。

A模式读U的文本会出错，不知道用u模式读A的文件会怎么样。。。

试过乱码

作者: wert123 时间: 2007-6-2 10:56
不行啊，运行老有错误啊，改了半天，在右键菜单转注册表转不了啊
slore大师啊，你贴掉了一些东西吧
麻烦再贴一遍吧

作者: slore 时间: 2007-6-2 11:51
我贴出的那个你双击后复制到system32下就可以了。

作者: chishingchan 时间: 2008-6-23 19:42
9 楼的代码还不是很完善，右击注册表文件时点击出错。

作者: baomaboy 时间: 2008-6-24 07:13
'*****************************************************************************
' FileName:          Reg2Vbs.VBS
' Author:          baomaboy
' Abstract:          将Reg文件转换为VBS文件保存
'*****************************************************************************
Dim WshShell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:25926183@qq.com"
InsTitle="Reg2Vbs-Txt"
InsAnswer="Reg2Vbs-Txt"
RegPath1="HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\"
RegValue1="REG转VBS脚本文件"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\command\"
RegValue2="wscript.exe """& InsFullName &""" ""%L"""
RegForm2="REG_SZ"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - by baomaboy")
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
      If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
      If intAnswer = vbCancel Then
end if
ELSE
if Args.count=0 then wscript.quit
Set ReadFile = FSO.OpenTextFile(Args(0), 1,false,-1)
ReadAllText = ReadFile.ReadAll
ReadFile.Close
if mid(ReadAllText,1,3) <> "Win" and mid(ReadAllText,1,3) <> "REG" then
Set ReadFile = FSO.OpenTextFile(Args(0), 1)
ReadAllText = ReadFile.ReadAll
ReadFile.Close
end if
For i=1 To Len(ReadAllText)
TempNum = Asc(Mid(ReadAllText,i,1))
if TempNum = 34 Then
TempNum = 18
elseIf TempNum = 13 Then
TempNum = 28
ElseIf TempNum = 10 Then
TempNum = 29
end if
ThisText1 = ThisText1 & chr(TempNum)
Next
Set WriteFile = FSO.OpenTextFile(Args(0)&".VBS",2,True)
WriteFile.WriteLine("On Error Resume Next : Dim WshSHell,FSO,Reg2Vbs:Set WshSHell = WScript.CreateObject(""WScript.Shell""):Set FSO = CreateObject(""Scripting.FileSystemObject""):Reg2Vbs="""& ThisText1 &"""")
WriteFile.WriteLine("Execute(""For i=1 To Len(Reg2Vbs)""&vbCrLf&""TempNum = Asc(Mid(Reg2Vbs,i,1))""&vbCrLf&""If TempNum = 28 Then""&vbCrLf&""TempNum = 13""&vbCrLf&""ElseIf TempNum = 29 Then""&vbCrLf&""TempNum = 10""&vbCrLf&""elseif TempNum=18 Then""&vbCrLf&""TempNum = 34""&vbCrLf&""End If""&vbCrLf&""ThisText2 = ThisText2 & chr(TempNum)""&vbCrLf&""Next"")")
WriteFile.WriteLine("Set RegFile = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg""),2,True):RegFile.WriteLine(ThisText2):RegFile.Close:WshSHell.Run(""regedit /s ""&FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")):WScript.Sleep 500:FSO.DeleteFile FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")")
WriteFile.Close
end if
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)