Board logo

标题: 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
Originally posted by wert123 at 2007-6-1 14:01: 辛苦了啊,baomaboy大师又一个vbs版的好东东 不过最好把源码还原出来吧 reg转换生成的vbs也能还原的更清楚些吗
算不得什么好东东,只是简单得文本读取创建而已,并且没什么实用价值,如果不是因为你不喜欢reg只喜欢vbs这个原因此东东都没必要存在,另外你说reg转vbs后加密了,其实没有,从那个转换后得文件完全可以推出我的源码,这也是不加密转换后代码得原因。 源码加密还是老原因,模版、无用代码、每次都要引起口舌。。。。

作者: baomaboy     时间: 2007-6-1 14:32
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
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
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
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
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)