经典VBS代码
作者:admin 日期:2003-12-04
字体大小: 小 中 大  
下面是我认为比较经典的VBS代码,其中包括Windows 2000的管理、编码、解码等等...
希望大家能够也喜欢上VBS。 

http:_________________________________________________________________

注销/重起/关闭本地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 强制关闭电源 

http:_________________________________________________________________

使用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

http:_________________________________________________________________

使用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

http:_________________________________________________________________

使用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

http:_________________________________________________________________

使用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

http:_________________________________________________________________

使用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

http:_________________________________________________________________

读取和写入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)
else'if 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 if'if 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