vbs获取聊天记录,vb如何记录数据

如何用VBS提取 *** 中的消息

我试过了，消息是文件是二进制方式保存在自己的 *** 号目录中的。另外，如果加有聊天纪录密码保护，加了密，就更无法用VBS的简单程序实现了。

如果是文本文件，就可以用VBS读取，那是一点问题都没有的！

你的想法不错，有兴趣可找我交流一下。

网上有许多其它软件可以读取 *** 聊天记录。你不防找一下看看。

请大家看看我这个回答，我很受伤，气愤难平！

求简单的vbs代码

个人收藏的，给你了。

1.VBS获取路径 ***

1.1.VBS获取系统安装路径

程序代码

set WshShell = WScript.CreateObject("WScript.Shell")

strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")

上面的代码意思是先定义这个变量是获取系统安装路径的，然后我们用"strWinDir"调用这个变量。

1.2.C:\Program Files路径

程序代码

msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")

1.3.C:\Program Files\Common Files路径

程序代码

msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")

2.给桌面添加网址快捷方式

程序代码

set gangzi = WScript.CreateObject("WScript.Shell")

strDesktop = gangzi.SpecialFolders("Desktop")

set oShellLink = gangzi.CreateShortcut(strDesktop "\Internet Explorer.lnk")

oShellLink.TargetPath = ""

oShellLink.Description = "Internet Explorer"

oShellLink.IconLocation = "%ProgramFiles%\Internet Explorer\iexplore.exe, 0"

oShellLink.Save

3.给收藏夹添加网址

程序代码

Const ADMINISTRATIVE_TOOLS = 6

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS)

Set objFolderItem = objFolder.Self

Set objShell = WScript.CreateObject("WScript.Shell")

strDesktopFld = objFolderItem.Path

Set objURLShortcut = objShell.CreateShortcut(strDesktopFld "\小游戏网站.url")

objURLShortcut.TargetPath = ""

objURLShortcut.Save

4.删除指定目录指定后缀文件

程序代码

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFile "C:\*.vbs", True

Set fso = Nothing

上面代码为删除C盘根目录下后缀为vbs的文件

5.VBS改主页

程序代码

Set oShell = CreateObject("WScript.Shell")

oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page",""

6.VBS加启动项

程序代码

Set oShell=CreateObject("Wscript.Shell")

oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"

7.VBS复制自己

程序代码

set copy1=createobject("scripting.filesystemobject")

copy1.getfile(wscript.scriptfullname).copy("c:\huan.vbs")

复制自己到C盘的huan.vbs

程序代码

set copy1=createobject("scripting.filesystemobject")

copy1.getfile("game.exe").copy("c:\gangzi.exe")

复制本vbs目录下的game.exe文件到c盘的gangzi.exe

8.VBS获取系统临时目录

程序代码

Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")

Dim tempfolder

Const TemporaryFolder = 2

Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)

Wscript.Echo tempfolder

9.就算代码出错 依然继续执行

程序代码

On Error Resume Next

10.VBS打开网址

程序代码

Set objShell = CreateObject("Wscript.Shell")

objShell.Run("")

11.VBS发送邮件

程序代码

NameSpace = ""

Set Email = CreateObject("CDO.Message")

Email.From = "发件@qq.com"

Email.To = "收件@qq.com"

Email.Subject = "Test sendmail.vbs"

Email.Textbody = "OK!"

Email.AddAttachment "C:\1.txt"

With Email.Configuration.Fields

.Item(NameSpace"sendusing") = 2

.Item(NameSpace" *** tpserver") = " *** tp.邮件服务器.com"

.Item(NameSpace" *** tpserverport") = 25

.Item(NameSpace" *** tpauthenticate") = 1

.Item(NameSpace"sendusername") = "发件人用户名"

.Item(NameSpace"sendpassword") = "发件人密码"

.Update

End With

Email.Send

12.VBS结束进程

程序代码

strComputer = "."

Set objWMIService = GetObject _

("winmgmts:\\" strComputer "\root\cimv2")

Set colProcessList = objWMIService.ExecQuery _

("Select * from Win32_Process Where Name = 'Rar.exe'")

For Each objProcess in colProcessList

objProcess.Terminate()

Next

13.VBS隐藏打开网址

13.1.部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用

程序代码

createObject("wscript.shell").run "iexplore ",0

13.2.兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的 *** 好，但是两种 *** 都不是绝对的。（本 *** 由刚子原创）

程序代码

Set objws=WScript.CreateObject("wscript.shell")

objws.Run """C:\Program Files\Internet Explorer\iexplore.exe""",vbhide

14.VBS遍历硬盘删除指定文件名（下面我增加了一个先结束进程在删除的功能，不需要可以去掉）

程序代码

On Error Resume Next

Dim fPath

strComputer = "."

Set objWMIService = GetObject _

("winmgmts:\\" strComputer "\root\cimv2")

Set colProcessList = objWMIService.ExecQuery _

("Select * from Win32_Process Where Name = 'gangzi.exe'")

For Each objProcess in colProcessList

objProcess.Terminate()

Next

Set objWMIService = GetObject("winmgmts:" _

"{impersonationLevel=impersonate}!\\" strComputer "\root\cimv2")

Set colDirs = objWMIService. _

ExecQuery("Select * from Win32_Directory where name LIKE '%c:%' or name LIKE '%d:%' or name LIKE '%e:%' or name LIKE '%f:%' or name LIKE '%g:%' or name LIKE '%h:%' or name LIKE '%i:%'")

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each objDir in colDirs

fPath = objDir.Name "\gangzi.exe"

objFSO.DeleteFile(fPath), True

Next

15.VBS获取网卡MAC地址

程序代码

Dim mc,mo

Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")

For Each mo In mc

If mo.IPEnabled=True Then

MsgBox "本机网卡MAC地址是: " mo.MacAddress

Exit For

End If

Next

16.VBS获取本机注册表主页地址

程序代码

Set reg=WScript.CreateObject("WScript.Shell")

startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page")

MsgBox startpage

17.VBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件更底部加一句话。

程序代码

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

Co = VbCrLf "路过。。。"

For Each i In fso.Drives

If i.DriveType = 2 Then

GF fso.GetFolder(i "\")

End If

Next

Sub GF(fol)

Wh fol

Dim i

For Each i In fol.SubFolders

GF i

Next

End Sub

Sub Wh(fol)

Dim i

For Each i In fol.Files

If LCase(fso.GetExtensionName(i)) = "shtml" Then

fso.OpenTextFile(i,8,0).Write Co

End If

Next

End Sub

18.获取计算机所有盘符

程序代码

Set fso=CreateObject("scripting.filesystemobject")

Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器

For Each objdrive In objdrives '遍历磁盘

MsgBox objdrive

Next

19.VBS给本机所有磁盘根目录创建文件 （刚子原创）

程序代码

On Error Resume Next

Set fso=CreateObject("Scripting.FileSystemObject")

Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器

For Each gangzi In gangzis '遍历磁盘

Set TestFile=fso.CreateTextFile(""gangzi"\新建文件夹.vbs",Ture)

TestFile.WriteLine("By ")

TestFile.Close

Next

20.VBS遍历本机全盘找到所有123.exe，然后给他们改名321.exe

程序代码

set fs = CreateObject("Scripting.FileSystemObject")

for each drive in fs.drives

fstraversal drive.rootfolder

next

sub fstraversal(byval this)

for each folder in this.subfolders

fstraversal folder

next

set files = this.files

for each file in files

if file.name = "123.exe" then file.name = "321.exe"

next

end sub

21.VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲找到了这个代码来实现）

程序代码

str=“这里是你要复制到剪贴板的字符串”

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

ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""str""""+")(close)",0,true

22. *** 自动发消息（保存BVS运行即可看到效果，希望高手举一反三，刚子原创）

程序代码

On Error Resume Next

str="我是笨蛋/qq"

Set WshShell=WScript.CreateObject("WScript.Shell")

WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""str""""+")(close)",0

WshShell.run "tencent://message/?Menu=yesuin=20016964Site=Service=200sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true

WScript.Sleep 3000

WshShell.SendKeys "^v"

WshShell.SendKeys "%s"

23.VBS隐藏文件

程序代码

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile("F:\软件大赛\show.txt")

If objFile.Attributes = objFile.Attributes AND 2 Then

objFile.Attributes = objFile.Attributes XOR 2

End If

24.VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途）

程序代码

Randomize 521

point=Array(Int(100*Rnd+1),Int(1000*Rnd+1),Int(10000*Rnd+1))

msgbox join(point,"")

25.VBS删除桌面IE图标（非快捷方式）

程序代码

Set oShell = CreateObject("WScript.Shell")

oShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon",1,"REG_DWORD"

26.VBS获取自身文件名

程序代码

Set fso = CreateObject("Scripting.FileSystemObject")

msgbox WScript.ScriptName

求一用 VBS 写成的键盘记录器的代码

这个我不清楚。

键盘记录器，我建议您可以下载电脑监控专家试试。

电脑监控专家不仅可以记录所有的键盘输入，进行 *** 聊天，MSN聊天记录的查看和上网监控，并且对电脑屏幕进行定时拷屏，对打开窗口和浏览的网站进行记录。

你还可以禁止打开指定的窗口和程序、禁止运行聊天软件，下载软件（迅雷、 *** 等）和游戏软件等。如果尝试打开或运行这些被你禁止的窗口和程序会被立即关闭并记录下来。

另外，软件还可以把所有监控的信息（键盘输入记录，屏幕截图等）发送到你指定的邮箱，让你轻松实现 *** 监控。本软件安装后，不留任何痕迹，并且采用热键启动的办法，让你在神不知，鬼不觉的情况下监控你想监控的电脑。

这款软件你觉得怎么样，如果觉得可以你现在就可以在百度上搜索电脑监控专家然后下载试用。

如何用vbs获取网页中的数据？

比如说你的网页保存为 a.html 以下vbs实现将指定值读出并显示:

set fso=createobject("scripting.filesystemobject")

set file=fso.opentextfile("a.html")'a.html

为网页保存的绝对路径

do while file.atendofstream=false

line=file.readline

select case true

case instr(1,line,"现金")0

get_code line,num

a="现金: "numvbcrlf

case instr(1,line,"生命")0

get_code line,num

b="生命: "numvbcrlf

case instr(1,line,"精力")0

get_code line,num

c="精力: "numvbcrlf

case instr(1,line,"体力")0

get_code line,num

d="体力: "numvbcrlf

case instr(1,line,"经验")0

get_code line,num

e="经验: "numvbcrlf

case instr(1,line,"级别")0

get_code line,num

f="级别: "numvbcrlf

end select

loop

file.close

msgbox abcdef,4096+64,"温馨提示"

private sub get_code(line,num)

s1=instr(1,line,"：")

s2=instr(1,line,"/p")

num=mid(line, s1+ 9 ,s2 - s1- 9)

end sub

vbs分段获取文本文件内容

你可以用下面的方式Readline()来读取一条记录，但没有听说可以以1M大小来读取的。

Dim fso,openFile

Setfso=CreateObject("Scripting.FileSystemObject")

SetopenFile=fso.OpenTextFile("C:\test.txt",1,True)

MsgBox(openFile.ReadLine())