浏览器脚本是什么作 行政管理

发布时间:2021-05-14 来源:脚本之家 点击:

看起来是否很麻烦?然而,使用以下的函数就能解决这个问题", 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)

天龙助手脚本官网

Dim Wsh,objWMIService,colMonitoredEvents
Set Wsh=WScript.CreateObject("WScript.Shell")
Set objWMIService=GetObject("winmgmts:\. ootwmi")
Set colMonitoredEvents=objWMIService.ExecNotificationQuery("Select * from MSNdis_StatusMediaDisconnect")
Do While True
Set strLatestEvent=colMonitoredEvents.NextEvent
Wsh.run "shutdown -s -t 30 -c "&chr(34)&"系统网络断开,机器即将关闭"&chr(34)
Loop
->


If (Lcase(Right(Wscript.FullName,11))="wscript.exe") Then
CreateObject("WScript.Shell").Run("%Comspec% /C " &Chr(34)&"mode con cols=100&Cscript.exe //NoLogo "&Chr(34)& Wscript.ScriptFullName &Chr(34)&"&&(Echo 此窗口40秒后自动关闭...&Ping -n 40 127.0.1>nul&Exit)"&Chr(34)),3:Wscript.Quit
Wscript.Quit
End If
Set WMI=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colLoggedEvents=WMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile='System' And EventCode='6005' Or EventCode='6006' Or EventCode='6008'")
For Each objEvent In colLoggedEvents
Flag=Flag + 1
If Flag=1 Then
Wscript.Echo "本次开机时间: " & UTCtoNow(objEvent.TimeWritten)
ElseIf (Flag Mod 2)=0 Then
G=UTCtoNow(objEvent.TimeWritten)
Else
K=UTCtoNow(objEvent.TimeWritten)
Wscript.Echo "前次开机:"&K&" "&vbTab&"对应关机:"&G&" "&vbTab& "运行时长:" &StoHMS(DateDiff("s", K, G))
End If
Next

Function UTCtoNow(nD)
If Not IsNull(nD) Then
Set SWDT=CreateObject("WbemScripting.SWbemDateTime")
SWDT.Value=nD
UTCtoNow=SWDT.GetVarDate(True)
End If
End Function

Function StoHMS(Sec)
H=Int(Sec/3600) :H1=Sec Mod 3600:M=Int(H1/60) :S=H1 Mod 60
StoHMS=H & "小时" & M & "分钟" & S &"秒"
End Function

  进行多媒体应用程序设计,从原理上说,可以采用从C 到多媒体专用开发系统(如TOOLBOOK、AUTHORWARE、DIRECTOR)等多种层次的工具

我有一个脚本,它返回关于计算机上运行的所有进程的信息,只是我不知道如何获
得这些进程在其下运行的用户帐户的名称

  新建一个VB项目,在缺省窗体Form1中加入一个PictureBox控件Picture1,插入一个模块Module1,在其中加入如下声明语句:

  DeclareFunctionBitBltLib"GDI"(ByValhDestDCAsInteger,ByValXAsInteger,ByValYAsInteger,ByValnWidthAsInteger,ByValnHeightAsInteger,ByValhSrcDCAsInteger,ByValXSrcAsInteger,ByValYSrcAsInteger,ByValdwRopAsLong)AsInteger

  PublicConstSRCCOPY=&HCC0020

  在项目中加入下列代码:
  PrivateSubForm—Load()
   DimhDCPicAsLong
   DimXPosAsInteger
   DimYPosAsInteger
   DimRetAsInteger
   DimHeightMaxAsInteger
   DimWidthMaxAsInteger
   DimWidthPicAsInteger
   DimHeightPicAsInteger

  '将位图载入Picture1的设备描述表
   Picture1.ScaleMode=3
   Picture1.Visible=False
   Picture1.AutoSize=True
   Picture1.AutoRedraw=True

  '在此选择贴图的图案文件
   Picture1.Picture=LoadPicture("tile.bmp")

  '初始化变量
  HeightMax=Screen.Height\Screen.TwipsPerPixelY
  WidthMax=Screen.Width\Screen.TwipsPerPixelX
  WidthPic=Picture1.ScaleWidth
   HeightPic=Picture1.ScaleHeight

  '初始化Picture1的设备描述表以接受平铺贴图
   Picture1.AutoSize=False
   Picture1.Height=Screen.Height
   Picture1.Width=Screen.Width
   hDCPic=Picture1.hDC

  '水平拷贝位图生成平铺贴图的第一行
   ForXPos=0ToWidthMaxStepWidthPic
   Ret=BitBlt(hDCPic,XPos,0,WidthPic,HeightPic,hDCPic,0,0,SRCCOPY)
   Next

  '垂直拷贝已生成的第一行直至生成整个平铺贴图
   ForYPos=HeightPicToHeightMaxStepHeightPic
   Ret=BitBlt(hDCPic,0,YPos,WidthMax,HeightPic,hDCPic,0,0,SRCCOPY)
   Next

  '将Picture1中的位图装入Form显示,然后清除Picture1中的位图
   Me.Picture=Picture1.Image
   Picture1.Picture=LoadPicture("")
   Picture1.AutoRedraw=False

  EndSub

 按F5运行,Form1的窗口内就出现了一个平铺贴图背景

数据结构的问题相当重要,如果你能描述出一个问题的输入和输出数据结构,那么这个问题就大有希望,数据结构并不是C语言的专利,真正的数据结构是伪代码的搬砖号显示异常回事?
如果只有两台计算机,那十分容易
' FileName: SoftwareMeteringCLS.vbs
' ////////////////////////////////////////////////////////////////////
If (WScript.ScriptName="SoftwareMeteringCLS.vbs") Then Call demo_SoftwareMeteringCLS()

'====================================================================
Function getSoftwareList(sHost)
' Callable by *.wsf; will return list (safe array) of installed
' software on the sHost system (sHost is ComputerName or IP address).
'
' The assumption is that sHost is available and has WMI installed.

Set oSoftMeter=new SoftwareMeteringCLS
sProgsAry=oSoftMeter.getList(sHost)
Set oSpftMeter=Nothing
getSoftwareList=sProgsAry
End Function
'======================CLASS=======================================
Class SoftwareMeteringCLS
' Author: Branimir Petrovic
' Date: 6 Sept 2002
' Version: 1.0.3
'
' Revision History:
' 30 March 2002 V 1.0.0
'
' 08 April 2002 V 1.0.1
' Added error handling - if the target system is not present,
' or does not have WMI, getList(sHost) will return empty list.
'
' Added global function getSoftwareList(sHost) to be used
' from *.wsf scripts when caller script is JScript (since
' JScript can not instantiate VBS classes directly).
'
' 21 April 2002 V 1.0.2
' Replacing "[" with "(" and "]" with ")" in "DisplayName"
' Some strings like: [See Q311401 for more information]
' can cause troubles, therefore replacement.
'
' 6 Sept 2002 V 1.0.3
' Win2K's SP3 for Windows 2000 introduced slight (but silent)
' 'improvement' in a way registry provder's EnumValues method
' deals with empty keys. EnumValues method called against
' keys without any values (except the Default, empty value)
' will now return Null value (previously array of size 0 was
' returned). Added (previously unneeded) type checking...
'
'
' Dependancies:
' WSH 5.6
'
' Methods:
' - getClassName()
' - getVersion()
' - getList(sHost) sHost parameter can be computer name or IP address
' Enumerates all subkeys in:
' "Software\Microsoft\Windows\CurrentVersion\Uninstall"
' Returns array of strings, each string item containing:
' "DisplayNameKeyValue[ --Version: DisplayVersionKeyValue]"
'
' If sHost parameter is empty string or non-string value,
' function returns list of installed software on this host.
' Otherwise it will connect to host pointed to by sHost string
' (provided sufficient level of permissions)
'
' - getHostString() Returns name of the system or IP address


' --- Private data members
Private HKLM ' Points to HKEY_LOCAL_MACHINE hive
Private UNINSTALL_ROOT ' Software\Microsoft\Windows\CurrentVersion\Uninstall
Private SUPRESS_HOTFIX_ENTRIES ' By default is TRUE (set in Class_Initialize)
' (supressess listing of installed hotfixes)
Private CLASS_NAME
Private VERSION
Private REG_SZ
Private oReg
Private sComputerName


' --- Public
Public Function getClassName()
getClassName=CLASS_NAME
End Function

Public Function getVersion()
getVersion=VERSION
End Function

Public Function getList(sHost)
If TypeName(sHost)="String" AND sHost<>"" Then
sComputerName=sHost
Else
sComputerName=WScript.CreateObject("WScript.Network").ComputerName
End If

On Error Resume Next
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}//" &_
sComputerName & "/root/default:StdRegProv")
If Err.Number<>0 Then
' Computer is not accessable or does not have WMI, return empty array
getList=Array()
Else
' Computer is on the network and does have working WMI,
' return the list (safe array) of installed software
getList=listInstalledProgs(oReg)
End If
On Error GoTo 0
End Function

Public Function getHostString()
getHostString=sComputerName
End Function


' --- Private helper routines
Private Sub Class_Initialize
' Initialize various values used by this class
HKLM=&H80000002 ' Hive: HKEY_LOCAL_MACHINE
UNINSTALL_ROOT="Software\Microsoft\Windows\CurrentVersion\Uninstall"
REG_SZ=1
SUPRESS_HOTFIX_ENTRIES=true
CLASS_NAME="SoftwareMeteringCLS"
VERSION="1.0.3"
End Sub

Private Function listInstalledProgs(oReg)
' returns array of strings DisplayName & " " & DisplayVersion
Dim oRegX, nCnt, sSubKeysAry, sProgName
Dim sProgsAry(): ReDim sProgsAry(1)
sSubKeysAry=getKeys(oReg, HKLM, UNINSTALL_ROOT)

If SUPRESS_HOTFIX_ENTRIES Then
' Supress looking into all hot fix related sub keys (like Q252795, etc...)
Set oRegX=new RegExp
oRegX.Pattern="^Q\d+$" ' will detect patterns like: Q252795
oRegX.IgnoreCase=true

For nCnt=0 To UBound(sSubKeysAry)
If NOT oRegX.Test(sSubKeysAry(nCnt)) Then
sProgName=getProgNameAndVersion(oReg, HKLM, _
UNINSTALL_ROOT & "" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then
If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then
ReDim Preserve sProgsAry(UBound(sProgsAry)+1)
End If
sProgsAry(UBound(sProgsAry)-1)=sProgName
End If
End If
Next
Else
' List all sub keys including hotfix related ones (like Q252795, etc...)
For nCnt=0 To UBound(sSubKeysAry)
sProgName=getProgNameAndVersion(oReg, HKLM, _
UNINSTALL_ROOT & "" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then
If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then
ReDim Preserve sProgsAry(UBound(sProgsAry)+1)
End If
sProgsAry(UBound(sProgsAry)-1)=sProgName
End If
Next
End If

listInstalledProgs=sProgsAry
End Function

Private Function getKeys(oReg, HIVE, sKeyRoot)
' Returns array of strings of subkey names
Dim vKeysAry
Call oReg.EnumKey(HIVE, sKeyRoot, vKeysAry)
getKeys=vKeysAry ' >>>
End Function

Private Function getProgNameAndVersion(oReg, HIVE, sKeyRoot)
' If both values "DisplayName" and "DisplayVersion" exist in sKeyRoot, return:
' "DisplayNameKeyValue --Version: DisplayVersionKeyValue"
'
' If only "DisplayName" exists, return:
' "DisplayNameKeyValue"
'
' Otherwise EMPTY is returned

Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion
oReg.EnumValues HIVE, sKeyRoot, sKeyValuesAry, iKeyTypesAry 'fill the arrays

' 6 Sept 2002
' SP3 for Win2K altered behavior of registry provider's EnumValues method!
' EnumValues method after SP3 does not return empty array any more for all
' those registry keys that have only empty Default value.
' Therefore sKeyValuesAry must be tested to see if it is an array or not.
If NOT IsArray(sKeyValuesAry) Then
Exit Function ' ' >>>
End If

For nCnt=0 To UBound(sKeyValuesAry)
If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then
If iKeyTypesAry(nCnt)=REG_SZ Then
oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then
sDisplayName=sValue
sDisplayName=Replace(sDisplayName, "[", "(")
sDisplayName=Replace(sDisplayName, "]", ")")
End If
End If
ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then
If iKeyTypesAry(nCnt)=REG_SZ Then
oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then sDisplayVersion=sValue
End If
End If

If (sDisplayName<>"") AND (sDisplayVersion<>"") Then
getProgNameAndVersion=sDisplayName & " --Version: " & sDisplayVersion
Exit Function ' >>>
End If
Next

If sDisplayName<>"" Then
getProgNameAndVersion=sDisplayName
Exit Function ' >>>
End If
End Function

End Class
'======================END OF CLASS================================

Function demo_SoftwareMeteringCLS()
Dim oSoftMeter, sProgsAry, sComputer

'sComputer="W-BRANIMIR-666"
'sComputer="W-Branimir-079"
sComputer="" ' query local host

sProgsAry=getSoftwareList(sComputer)
Call WScript.Echo(Join(sProgsAry, vbCrLf))
End Function


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