[转贴]：经典VBS代码

eachy

经典VBS代码


注销/重起/关闭本地Windows NT/2000 计算机

Sub ShutDown()
Dim Connection, WQL, SystemClass, System

Get connection To local wmi
Set Connection = GetObject("winmgmts:root\cimv2")

Get Win32_OperatingSystem objects - only one object In the collection
WQL = "Select Name From Win32_OperatingSystem"
Set SystemClass = Connection.ExecQuery(WQL)

Get one system object
I think there is no way To get the object using URL?
For Each System In SystemClass
System.Win32ShutDown (2)
Next
End Sub


注销/重起/关闭远程Windows NT/2000 计算机

Sub ShutDownEx(Server, User, Password) Dim Connection, WQL, SystemClass, System Get connection To remote wmi Dim Locator Set Locator = CreateObject("WbemScripting.SWbemLocator") Set Connection = Locator.ConnectServer(Server, "root\cimv2", User, Password) Get Win32_OperatingSystem objects - only one object In the collection WQL = "Select Name From Win32_OperatingSystem" Set SystemClass = Connection.ExecQuery(WQL) Get one system object I think there is no way To get the object using URL? For Each System In SystemClass System.Win32ShutDown (2) NextEnd Sub


上面两段代码都用到了WMI中Win32_OperationSystem的方法Win32ShutDown,Win32ShutDown(flag)中flag的参数可以是下表中的任意一种: 值 描述
0 注销
0 + 4 强制注销
1 关机
1 + 4 强制关机
2 重起
2 + 4 强制重起
8 关闭电源
8 + 4 强制关闭电源


使用ADODB.Stream对象写二进制文件

Function SaveBinaryData(FileName, ByteArray)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2

Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

Specify stream type - we want To save binary data.
BinaryStream.Type = adTypeBinary

Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.Write ByteArray

Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
End Function


使用ADODB.Stream对象写文本文件

Function SaveTextData(FileName, Text, CharSet)
Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText

Specify charset For the source text (unicode) data.
If Len(CharSet) > 0 Then
BinaryStream.CharSet = CharSet
End If

Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.WriteText Text

Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
End Function



使用ADODB.Stream对象读二进制文件

Function ReadBinaryFile(FileName)
Const adTypeBinary = 1

Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

Specify stream type - we want To get binary data.
BinaryStream.Type = adTypeBinary

Open the stream
BinaryStream.Open

Load the file data from disk To stream object
BinaryStream.LoadFromFile FileName

Open the stream And get binary data from the object
ReadBinaryFile = BinaryStream.Read
End Function



使用ADODB.Stream对象读文本文件

Function ReadTextFile(FileName, CharSet)
Const adTypeText = 2

Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

Specify stream type - we want To get binary data.
BinaryStream.Type = adTypeText

Specify charset For the source text (unicode) data.
If Len(CharSet) > 0 Then
BinaryStream.CharSet = CharSet
End If

Open the stream
BinaryStream.Open

Load the file data from disk To stream object
BinaryStream.LoadFromFile FileName

Open the stream And get binary data from the object
ReadTextFile = BinaryStream.ReadText
End Function



使用FileSystemObject对象写文件

Function SaveBinaryDataTextStream(FileName, ByteArray)
Create FileSystemObject object
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")

Create text stream object
Dim TextStream
Set TextStream = FS.CreateTextFile(FileName)

Convert binary data To text And write them To the file
TextStream.Write BinaryToString(ByteArray)
End Function



读取和写入Windows的INI文件

Sub WriteINIStringVirtual(Section, KeyName, Value, FileName)
WriteINIString Section, KeyName, Value, _
Server.MapPath(FileName)
End Sub
Function GetINIStringVirtual(Section, KeyName, Default, FileName)
GetINIStringVirtual = GetINIString(Section, KeyName, Default, _
Server.MapPath(FileName))
End Function


Work with INI files In VBS (ASP/WSH)
v1.00
2003 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
Function GetINIString(Section, KeyName, Default, FileName)
Sub WriteINIString(Section, KeyName, Value, FileName)

Sub WriteINIString(Section, KeyName, Value, FileName)
Dim INIContents, PosSection, PosEndSection

Get contents of the INI file As a string
INIContents = GetFile(FileName)

Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1

Separate section contents
Dim OldsContents, NewsContents, Line
Dim sKeyName, Found
OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
OldsContents = split(OldsContents, vbCrLf)

Temp variable To find a Key
sKeyName = LCase(KeyName & "=")

Enumerate section lines
For Each Line In OldsContents
If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
Line = KeyName & "=" & Value
Found = True
End If
NewsContents = NewsContents & Line & vbCrLf
Next

If isempty(Found) Then
key Not found - add it at the end of section
NewsContents = NewsContents & KeyName & "=" & Value
Else
remove last vbCrLf - the vbCrLf is at PosEndSection
NewsContents = Left(NewsContents, Len(NewsContents) - 2)
End If

Combine pre-section, new section And post-section data.
INIContents = Left(INIContents, PosSection-1) & _
NewsContents & Mid(INIContents, PosEndSection)
elseif PosSection>0 Then
Section Not found. Add section data at the end of file contents.
If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then
INIContents = INIContents & vbCrLf
End If
INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
KeyName & "=" & Value
end ifif PosSection>0 Then
WriteFile FileName, INIContents
End Sub

Function GetINIString(Section, KeyName, Default, FileName)
Dim INIContents, PosSection, PosEndSection, sContents, Value, Found

Get contents of the INI file As a string
INIContents = GetFile(FileName)

Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1

Separate section contents
sContents = Mid(INIContents, PosSection, PosEndSection - PosSection)

If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare)>0 Then
Found = True
Separate value of a key.
Value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
End If
End If
If isempty(Found) Then Value = Default
GetINIString = Value
End Function

Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
Dim PosB: PosB = InStr(1, sFrom, sStart, 1)
If PosB > 0 Then
PosB = PosB + Len(sStart)
Dim PosE: PosE = InStr(PosB, sFrom, sEnd, 1)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(sFrom, PosB, PosE - PosB)
End If
End Function


File functions
Function GetFile(ByVal FileName)
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
Go To windows folder If full path Not specified.
If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
FileName = FS.GetSpecialFolder(0) & "\" & FileName
End If
On Error Resume Next

GetFile = FS.OpenTextFile(FileName).ReadAll
End Function

Function WriteFile(ByVal FileName, ByVal Contents)

Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next

Go To windows folder If full path Not specified.
If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
FileName = FS.GetSpecialFolder(0) & "\" & FileName
End If

Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)
OutStream.Write Contents
End Function


可能会看起来比较乱，大家可以到
http://zeus.hacker.com.cn/codes/classical_VBS.html

rave

佩服。
进步神速。
Eachy，别用来干坏事啊