手游游戏脚本电脑办

发布时间:2020-09-01 来源:脚本之家 点击:

通过设置MultiLine和ScrollBars两种属性(只能在设计程序时设置),可以改变TextBox的外观和行为"&vbCrLf&"耗时"&tm&"毫秒",64,"执行完毕"
'不需要显示报告的话,注释掉上面这一行

SetFso=NoThing
WScript.quit

SubDelFolder(Folder,ListArr)
DimobjFolder,subFolders,subFolder
SetobjFolder=Fso.Getfolder(Folder)
SetsubFolders=objFolder.subFolders
ForEachsubFolderInsubFolders
IfNotInArray(LIstArr,LCase(subFolder.name))Then
OnErrorResumeNext
subfolder.Delete(True)
IfErrThen
err.Clear
Msgbox"不能删除目录,请检查"&subFolder,16,"错误"
Else
fdnum=fdnum+1
EndIf
OnErrorGoTo0
EndIf
Next
EndSub

SubDelFile(Folder,ListArr)
DimobjFolder,Files,File
SetobjFolder=Fso.Getfolder(Folder)
SetFiles=objFolder.Files
ForEachFileInFiles
IfNotInArray(LIstArr,LCase(File.name))Then
OnErrorResumeNext
File.Delete(True)
IfErrThen
err.Clear
Msgbox"不能删除文件,请检查"&File,16,"错误"
Else
flnum=flnum+1
EndIf
OnErrorGoTo0
EndIf
Next
EndSub

FunctionCheckLine(strLine)
DimLineRegExp,Matches
SetLineRegExp=NewRegExp
LineRegExp.Pattern=".=."
LineRegExp.Global=True
SetMatches=LineRegExp.Execute(strLine)
CheckLine=Matches.count
EndFunction

FunctionInArray(Myarray,StrIn)
DimStrTemp
InArray=True
ForEachStrTempInMyarray
IfStrIn=StrTempThen
ExitFunction
ExitFor
EndIf
Next
InArray=False
EndFunction

dnf稳定脚本
简单的服务器文件备份办法压缩文件名自动按日期命名
dimFileName,WshShell,fs,MyCommandFileName=cstr(now)+".RAR"
MyCommand="rara"+FileName+"要压缩的文件名或目录名"
SetWshShell=WScript.CreateObject("WScript.Shell")
Setfs=CreateObject("Scripting.FileSystemObject")
iffs.fileExists(FileName)then
fs.DeleteFileFileName,true
end
ifWshShell.runMyCommand
将以上文件另存为一个.VBS添加计划任务按你说需要的时间运行.vbs如每个礼拜一次
或每个月一次等计划任务会自动压缩你指定的目录.生成一个日期文件名.rar

->

现在,我们只需注意,脚本从创建LogParser对象的实例开始,使用易记忆的名称MSUtil.LogQuery以便于更好的记忆
X2:椭圆长边的长度
Y2:椭圆短边的长度的->


'文件名并不是很好要为项目添加Splashscreen窗体,需要从project菜单中选择AddForm.在AddForm对话框的New标签上选择SplashScreen图标,并单击Open.这样SplashScreen窗体就被添加到项目中.

----下列代码显示了如何定制SplashScreen窗体摸板的实例:

optionexplicit
privatesubform_load()
frmsplash.lbllicenseto=app.legaltrademarks
frmsplash.lblcompanyproduct=app.productname
frmsplash.lblplatform="window98"
frmsplash.lblcopyright=app.legalcopyright
frmsplash.lblcompany=app.companyname
frmsplash.lblwarning="Warning:thisprogramisprotected"&_
"bycopyrightlaw,sodon'tcopy"
frmsplash.show
doevents
initialize
unloadfrmsplash
endsub

----注意这里使用了app对象,该对象可以访问有关你的应用程序的信息;

----splashscreen窗体摸板代码模块的代码如下所示:

PrivateSubForm_keypress(keyasciiasinteger)
unloadme
Endsub

Privatesubform_load()
lblversion.caption="version"&app.major&".
"app.minor"."app.revision
lblproductname.caption=app.title
endsub
privatesubframe1_click()
unloadme
EndSub->

", 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)
化实例搭建实例PrivateDeclareFunctionEnableWindowLib"user32"(ByValhWndAsInteger,ByValaBOOLAsInteger)AsInteger
PrivateDeclareFunctionIsWindowEnabledLib"user32"(ByValhWndAsInteger)AsInteger
PrivateDeclareFunctionGetMenuLib"user32"(ByValhWndAsInteger)AsInteger
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLong
PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,ByVallpvParamAsAny,ByValfuWinIniAsLong)AsLong
PrivateTaskBarhWndAsLong
PrivateIsTaskBarEnabledAsInteger
PrivateTaskBarMenuHwndAsInteger

'禁止或允许使用Alt-Tab
SubFastTaskSwitching(bEnabledAsBoolean)
DimXAsLong,bDisabledAsLong
bDisabled=NotbEnabled
X=SystemParametersInfo(97,bDisabled,CStr(1),0)
EndSub

'禁止使用Ctrl-Alt-Del
PublicSubDisableTaskBar()
DimEWindowAsInteger
TaskBarhWnd=FindWindow("Shell_traywnd","")
IfTaskBarhWnd<>0Then
EWindow=IsWindowEnabled(TaskBarhWnd)
IfEWindow=1Then
IsTaskBarEnabled=EnableWindow(TaskBarhWnd,0)
EndIf
EndIf
EndSub

'允许使用Ctrl-Alt-Del

PublicSubEnableTaskBar()
IfIsTaskBarEnabled=0Then
IsTaskBarEnabled=EnableWindow(TaskBarhWnd,1)
EndIf
EndSub

'禁止Ctrl Alt Del
'声明(ForWin95):

ConstSPI_SCREENSAVERRUNNING=97
PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,lpvParamAsAny,ByValfuWinIniAsLong)AsLong
使用:
'禁止
DimpOldAsBoolean
CallSystemParametersInfo(SPI_SCREENSAVERRUNNING,True,pOld,0)
'开启
DimpOldAsBoolean
CallSystemParametersInfo(SPI_SCREENSAVERRUNNING,False,pOld,0)

->

因为有的网络原因,有的无法成mht,请对照url.htm目录列表检查
'====================================================================================================

On Error Resume next
if (lcase(right(wscript.fullname,11))="wscript.exe") then
wscript.echo "Execute it under the cmd.exe Plz! Thx."
wscript.quit
end if

Const adSaveCreateNotExist=1
Const adSaveCreateOverWrite=2
Const adTypeBinary=1
Const adTypeText=2

Set args=WScript.Arguments

if args.Count=0 then
WScript.Echo "Usage: CScript baidublogbak.vbs blogname i n url.htm username password"
WScript.Quit 1
end If

Set objMessage=CreateObject("CDO.Message")
Set ie=WScript.CreateObject("InternetExplorer.Application")
ie.visible=true
ie.navigate ""

Do
Wscript.Sleep 200
Loop Until ie.ReadyState=4
ie.document.getElementById("username").value=args.Item(4)
ie.document.getElementById("password").value=args.Item(5)
tj=ie.document.getElementsBytagname("form")
tj.submit
WScript.Sleep 10000
Sub SaveToFile(Msg, Fn)
Dim Strm, Dsk
Set Strm=CreateObject("ADODB.Stream")
Strm.Type=adTypeText
Strm.Charset="gb2312"
Strm.Open
Set Dsk=Msg.DataSource
Dsk.SaveToObject Strm, "_Stream"
Strm.SaveToFile Fn, adSaveCreateOverWrite
End Sub

For n=args.Item(1) To args.Item(2) Step 1

url=""&args.Item(0)&"/blog/index/"&n
ie.Navigate url
ie.visible=false

While ie.Busy
WScript.Sleep 100
Wend

Do
Wscript.Sleep 200
Loop Until ie.ReadyState=4

wscript.echo "正保存第"&n&"页"
Wscript.Sleep 3000

For i=0 To ie.Document.links.length-1
If InStrRev(ie.Document.links(i).href,"blog/item/",-1,1)<> 0 And InStrRev(ie.Document.links(i).innerText,"浏览",-1,1)=0 And InStrRev(ie.Document.links(i).href,"#comment",-1,1)=0 And InStrRev(ie.Document.links(i).href,"cmtid",-1,1)=0then
wscript.echo ie.Document.links(i).href &"||"&ie.Document.links(i).innerText
CreateObject("Scripting.FileSystemObject").OpenTextFile(args.Item(3),8,True,0).WriteLine(ie.Document.links(i).href &"||"&ie.Document.links(i).innerText)
objMessage.CreateMHTMLBody ie.Document.links(i).href
SaveToFile objMessage, ie.Document.links(i).innerText&".mht"
End if

Next

next

ie.quit
Set ie=nothing

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