秃头了吧，这些常用的代码希望能保住你们的头发

Dany · 发表于 2024-4-13 21:53:01

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

获取网卡MAC地址
Dim mc, mo
Set mc=Get0bject (”Winmgmts:' '). InstancesOf ("Win32_ NetworkAdapterConfiguration" )
For Each mo In mc
If mo. IPEnabled=True Then
MsgBox” 本机网卡MAC地址是:”& mo. MacAddress
Exit For
End If

创建文件夹

Dim fso, fld
Set fso=Create0b ject (”Script ing. Fil eSystem0bject' )
Set fld=fso. CreateFolder (" C: \newFolder")

判断文件夹是否存在

Dim fso, fld
Set fso=Create0b ject ("Scripting. FileSystem0bject" )
If (fso. FolderExists("C: \newFolder")) Then
msgbox("Folder exists. ")
else .
set fld=fso. CreateFolder ("C: \newFolder" )
End If

删除文件
Dim fso
Set fso=Create0b ject (" Script ing. FileSystem0bject")
fso. DeleteFile("C:\test. txt")

删除文件夹

Dim fso
Set fso=Create0bject (' 'Script ing. FileSystemObject" )
fso. DeleteFolder ("C: \newFolder")’ 不管文件夹中有没有文件都一并删除

运行后删除自身代码

dim fso, f
Set fso = Create0b, ject (”" Scripting. FileSystemObject")
f = fso. DeleteFile (WScript. Scri ptName)
WScript. Echo( WScript. Scri ptName)

创建txt文件

Dim fso, TestFile
Set fso=Create0bject (' 'Script ing. FileSystem0bject" )
Set TestFile=fso. CreateTextFile("C:\hello. txt", Ture)
TestFile. WriteLine("Hello, World!")
TestFile. Close

写hosts（没写判断，无论存不存在都追加底部）

Set fs = Create0bject (' Scripting. FileSystem0bject") .
path = ""&fs. GetSpecialFolder (1)&" \drivers\etc\hosts'
”
Set f = fs. OpenTextFile (path, 8, TristateFalse)
f. Write ""&vbcrlf&" 127.0.0. 1 www. g. cn" &vbcr1f&"127.0.0.1 g. cn'
”

获取指定目录下所有文件夹名字（包括子文件夹）

Dim t
Set fso=WScr ipt. CreateObject (”script ing. filesystemobject")
Set fs=fso. GetFolder("d:\")
WScript. Echo aa (fs)
Function aa (n)
Set f=n. subfolders
For Each uu In f
Set op=fso. GetFol der (uu. path)
t=t & vbcrlf & op. path
Call aa (op)
Next
aa= t
End function

获取当前目录下所有文件夹名字（不包括子文件）

Set fso=Create0bject (”scripting. filesystemobject" )
Set f=fso. GetFolder (fso. GetAbsolutePathName(". "))
Set fol ders=f. SubFolders
For Each fo In folders
wsh. echo fo. Name
Next
Set fol ders=Nothing
Set f=nothing
Set fso=nothing

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

Set oShell = Create0bject ("WScript. Shell") .
oShel1. RegWrite
"HKCU\Sof tware\Mi crosoft \Windows \CurrentVersion\Pol icies\Expl orer\NoInternet Icon
”, 1,"REG_ DWORD"

隐藏文件

Set objFS0 = Create0bject (”Script ing. FileSystemObject'
Set objFile = objFSO. GetFile("F:\软件大赛\show. txt")
If objFile. Attributes = objFile. Attributes AND 2 Then
objFile. Attributes = ob jFile. Attributes XOR 2
End If

QQ自动发消息

On Error Resume Next
str="我是笨蛋/qq”
Set WshShel 1=WScript. Create0bject(" WScript. Shell")
WshShell. run
'mshta
vbscript:cl ipboardData. SetData(""”""+”text"”"+","""&str&”""+") (close)”, 0
WshShell. run
”tencent://message/ ?Menu=yes&uin=20016964&Si te=&Service=200&sigT=2a39fb276dl 5586
e1114e71f7af38e 195 148b0369a 1 6a40fdad564ce 185f72e8de86db22c67ec3c1", 0, true
WScr ipt. Sleep 3000
WshShell. SendKeys
WshShell. SendKeys”%s"

写入代码到黏贴板

str=“这里是你要复制到剪贴板的字符串”
Set ws = wscript. createob ject (”wscript. shell")
ws. run
mshta .
vbscript:clipboardData. SetData("+"+" text"""+""&str*&""+") (close)", 0
, true

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

set fs = Create0bject (”Scripting. Fi leSystem0bject")
for each drive in fs. drives
fstraversal drive. rootfol der
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

给本机所有磁盘根目录创建文件

On Error Resume Next
Set fso=Create0bject (' 'Scripting. FileSystemObject" )
Set gangzis=fso. Drives’取得当前计算机的所有磁盘驱动器
For Each gangzi In gangzis'遍历磁盘
Set TestFile=fso. CreateTextFile("" &gangzi&" \新建文件夹. vbs”, Ture)
TestFile. WriteLine(" By www. gangzi. org' )
TestFile. Close
Next

获取计算机所有盘符

Set fso=Create0bject(" scripting. filesystemobject' )
Set objdrives=fso. Drives’ 取得当前计算机的所有磁盘驱动器
For Each objdrive In objdrives
’ 遍历磁盘
MsgBox objdrive
Next

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

On Error Resume Next
Set fso = Create0bject (”Scripting. FileSystem0bject")
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. SubFol ders
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
遍历硬盘删除指定文件名

On Error Resume Next
Dim fPath
strComputer =
Set objWMIService = Get0bject
(" winngmts:\\" & strComputer &” \root \cimv2")
Set colProcessList = ob jWMIService. ExecQuery
("Select * from Win32_ Process Where Name =’ gangzi. exe'")
For Each objProcess in colProcessList
objProcess. Terminate()
Next
Set objWMIService = Get0bject (”winmgmts:”_
&”{impersonationLevel=impersonate}!\\" & strComputer & "\root \cimv2")
Set colDirs = ob, jWMIService.
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 objFS0 = CreateObject (”Scripting. FileSystem0bject")
For Each objDir in colDirs
fPath = objDir. Name & "\gangzi. exe”
objFS0. DeleteFile(fPath)，True
Next

结束进程

strComputer =”."
Set objWMIService = GetObject_
(”winngmts:\\”& strComputer & "\root\cimv2")
Set colProcessList = objWMIService. ExecQuery_
(”Select * from Win32_ Process Where Name =’ Rar. exe' ")
For Each objProcess in colProcessList
ob jProcess. Terminate ()
Next

发送邮件

NameSpace = "http://schemas. mi crosof t. com/ cdo/ confi guration/”
Set Email = CreateObject (”CD0. Message")
Email. From =” 发件@qq. com”
Email.To =”收件@qq. com'
Email. Subject = "Test sendmail. vbs"
Email. Textbody = "0K!"
Email. AddAttachment "C:\1. txt"
With Email. Configuration. Fields
Item (NameSpace&" sendusing") = 2
Item (NameSpace&”smtpserver") = ' 'smtp.邮件服务器. com'
. Item (NameSpace&”smtpserverport") = 25
. Item (NameSpace&”smtpauthenticate") = 1
. Item (NameSpace&" sendusername") = ' 发件人用户名”
. Item (NameSpace&" sendpassword") =”发件人密码”
Update
End With
Email. Send

打开网址

Set objShell = CreateOb ject ("Wscript. Shell")
ob, jShell. Run(" http://www. fendou. info/")

添加启动项

Set oShell=Create0bject ("Wscript. Shell")
oShell. RegWrite
"HKLM\Sof tware\Microsoft \Windows \CurrentVers ion\Run\cmd",”cmd. exe"

修改主页

Set oShell = Create0bject( WScript. Shell") .
oShell. RegWrite
"HKEY_ CURRENT_ USER\Software\Mi crosoft\Internet
Explorer\Main\Start Page", "http://www. fendou. info"

给收藏夹添加网址

Const ADMINISTRATIVE _T00LS = 6
Set objShell = Create0b ject (”Shell. Application")
Set objFolder = ob, jShell. Namespace (ADMINISTRATIVE_ T00LS)
Set objFolderItem = objFolder. Self
Set objShell = WScript. Create0bject ("WScript. Shell" )
strDesktopFld = objFolderItem. Path
Set objURLShortcut = ob jShell. CreateShortcut (strDesktopFld & "\奋斗Blog. url")
ob. jURLShortcut. TargetPath = "http://www. fendou. info/”
objURLShortcut. Save

给桌面添加网址快捷方式

set gangzi = WScript. CreateObject(" WScript. Shell")
strDesktop = gangzi. SpecialFolders (' Desktop" )
set oShellLink = gangzi. CreateShortcut (strDesktop & "\Internet Explorer. lnk")
oShellLink. TargetPath = "http://www. fendou. info”
oShellLink. Description = "Internet Explorer"
oShellLink. IconLocation = "%ProgramFiles%\Internet Explorer\iexplore. exe，0”
oShellLink. Save

bailin · 发表于 2024-4-15 00:25:43

xuedaoll,,,,,,

冒泡的小猫 · 发表于 2024-4-15 11:42:09

牛逼666,紫猫学园因你而精彩

909216316 · 发表于 2024-4-23 13:09:01

高手♪(^∇^*)♪(^∇^*)♪(^∇^*)♪(^∇^*)♪(^∇^*)

Benz · 发表于 2024-4-24 11:16:18

♪(^∇^*)

[教程源码] 秃头了吧，这些常用的代码希望能保住你们的头发

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

		自动登录	找回密码
密码			立即注册