以前做过一个vb的小项目，客户需要软件同时能够支持中文和英文，为此写了一个自动语言切换的模块来用，不敢独享，拿来给大家参考一下，如果你有什么改进也可以写信给我count 可选项

0

环境:WinXP VB6 sp6 SqlServer2000

数据库:test

表:Users

CREATETABLE[dbo].[users](

[id][int]IDENTITY(1,1)NOTNULL,

[truename][char](10)COLLATEChinese_PRC_CI_ASNULL,

[regname][char](10)COLLATEChinese_PRC_CI_ASNULL,

[pwd][char](10)COLLATEChinese_PRC_CI_ASNULL,

[sex][char](10)COLLATEChinese_PRC_CI_ASNULL,

[email][text]COLLATEChinese_PRC_CI_ASNULL,

[jifen][decimal](18,2)NULL

)ON[PRIMARY]TEXTIMAGE_ON[PRIMARY]

GO

ALTERTABLE[dbo].[users]WITHNOCHECKADD

CONSTRAINT[PK_users]PRIMARYKEYCLUSTERED

(

[id]

)ON[PRIMARY]

GO

存储过程select_users

CREATEPROCEDUREselect_users@regnamechar(20),@numrowsintOUTPUT

AS

Select*fromusers

SELECT@numrows=@@ROWCOUNT

if@numrows=0

return0

elsereturn1

GO

存储过程insert_users

CREATEPROCEDUREinsert_users@truenamechar(20),@regnamechar(20),@pwdchar(20),@sexchar(20),@emailchar(20),@jifendecimal(19,2)

AS

insertintousers(truename,regname,pwd,sex,email,jifen)values(@truename,@regname,@pwd,@sex,@email,@jifen)

GO

在VB环境中，添加DataGrid控件，4个按钮，6个文本框

代码简单易懂

Private Const BITS_TO_A_BYTE=8 Private Const BYTES_TO_A_WORD=4 Private Const BITS_TO_A_WORD=32 Private m_lOnBits(30) Private m_l2Power(30) m_lOnBits(0)=CLng(1) m_lOnBits(1)=CLng(3) m_lOnBits(2)=CLng(7) m_lOnBits(3)=CLng(15) m_lOnBits(4)=CLng(31) m_lOnBits(5)=CLng(63) m_lOnBits(6)=CLng(127) m_lOnBits(7)=CLng(255) m_lOnBits(8)=CLng(511) m_lOnBits(9)=CLng(1023) m_lOnBits(10)=CLng(2047) m_lOnBits(11)=CLng(4095) m_lOnBits(12)=CLng(8191) m_lOnBits(13)=CLng(16383) m_lOnBits(14)=CLng(32767) m_lOnBits(15)=CLng(65535) m_lOnBits(16)=CLng(131071) m_lOnBits(17)=CLng(262143) m_lOnBits(18)=CLng(524287) m_lOnBits(19)=CLng(1048575) m_lOnBits(20)=CLng(2097151) m_lOnBits(21)=CLng(4194303) m_lOnBits(22)=CLng(8388607) m_lOnBits(23)=CLng(16777215) m_lOnBits(24)=CLng(33554431) m_lOnBits(25)=CLng(67108863) m_lOnBits(26)=CLng(134217727) m_lOnBits(27)=CLng(268435455) m_lOnBits(28)=CLng(536870911) m_lOnBits(29)=CLng(1073741823) m_lOnBits(30)=CLng(2147483647) m_l2Power(0)=CLng(1) m_l2Power(1)=CLng(2) m_l2Power(2)=CLng(4) m_l2Power(3)=CLng(8) m_l2Power(4)=CLng(16) m_l2Power(5)=CLng(32) m_l2Power(6)=CLng(64) m_l2Power(7)=CLng(128) m_l2Power(8)=CLng(256) m_l2Power(9)=CLng(512) m_l2Power(10)=CLng(1024) m_l2Power(11)=CLng(2048) m_l2Power(12)=CLng(4096) m_l2Power(13)=CLng(8192) m_l2Power(14)=CLng(16384) m_l2Power(15)=CLng(32768) m_l2Power(16)=CLng(65536) m_l2Power(17)=CLng(131072) m_l2Power(18)=CLng(262144) m_l2Power(19)=CLng(524288) m_l2Power(20)=CLng(1048576) m_l2Power(21)=CLng(2097152) m_l2Power(22)=CLng(4194304) m_l2Power(23)=CLng(8388608) m_l2Power(24)=CLng(16777216) m_l2Power(25)=CLng(33554432) m_l2Power(26)=CLng(67108864) m_l2Power(27)=CLng(134217728) m_l2Power(28)=CLng(268435456) m_l2Power(29)=CLng(536870912) m_l2Power(30)=CLng(1073741824) a=inputbox("请输入密码：") wscript.echo md5(a) Private Function LShift(lValue, iShiftBits) If iShiftBits=0 Then LShift=lValue Exit Function ElseIf iShiftBits=31 Then If lValue And 1 Then LShift=&H80000000 Else LShift=0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If If (lValue And m_l2Power(31 - iShiftBits)) Then LShift=((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000 Else LShift=((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits)) End If End Function Private Function RShift(lValue, iShiftBits) If iShiftBits=0 Then RShift=lValue Exit Function ElseIf iShiftBits=31 Then If lValue And &H80000000 Then RShift=1 Else RShift=0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If RShift=(lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits) If (lValue And &H80000000) Then RShift=(RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) End If End Function Private Function RotateLeft(lValue, iShiftBits) RotateLeft=LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) End Function Private Function AddUnsigned(lX, lY) Dim lX4 Dim lY4 Dim lX8 Dim lY8 Dim lResult lX8=lX And &H80000000 lY8=lY And &H80000000 lX4=lX And &H40000000 lY4=lY And &H40000000 lResult=(lX And &H3FFFFFFF) + (lY And &H3FFFFFFF) If lX4 And lY4 Then lResult=lResult Xor &H80000000 Xor lX8 Xor lY8 ElseIf lX4 Or lY4 Then If lResult And &H40000000 Then lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8 Else lResult=lResult Xor &H40000000 Xor lX8 Xor lY8 End If Else lResult=lResult Xor lX8 Xor lY8 End If AddUnsigned=lResult End Function Private Function F(x, y, z) F=(x And y) Or ((Not x) And z) End Function Private Function G(x, y, z) G=(x And z) Or (y And (Not z)) End Function Private Function H(x, y, z) H=(x Xor y Xor z) End Function Private Function I(x, y, z) I=(y Xor (x Or (Not z))) End Function Private Sub FF(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub GG(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub HH(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub II(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Function ConvertToWordArray(sMessage) Dim lMessageLength Dim lNumberOfWords Dim lWordArray() Dim lBytePosition Dim lByteCount Dim lWordCount Const MODULUS_BITS=512 Const CONGRUENT_BITS=448 lMessageLength=Len(sMessage) lNumberOfWords=(((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD) ReDim lWordArray(lNumberOfWords - 1) lBytePosition=0 lByteCount=0 Do Until lByteCount >=lMessageLength lWordCount=lByteCount \ BYTES_TO_A_WORD lBytePosition=(lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount=lByteCount + 1 Loop lWordCount=lByteCount \ BYTES_TO_A_WORD lBytePosition=(lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(&H80, lBytePosition) lWordArray(lNumberOfWords - 2)=LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1)=RShift(lMessageLength, 29) ConvertToWordArray=lWordArray End Function Private Function WordToHex(lValue) Dim lByte Dim lCount For lCount=0 To 3 lByte=RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex=WordToHex & Right("0" & Hex(lByte), 2) Next End Function Public Function MD5(sMessage) Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d Const S11=7 Const S12=12 Const S13=17 Const S14=22 Const S21=5 Const S22=9 Const S23=14 Const S24=20 Const S31=4 Const S32=11 Const S33=16 Const S34=23 Const S41=6 Const S42=10 Const S43=15 Const S44=21 x=ConvertToWordArray(sMessage) a=&H67452301 b=&HEFCDAB89 c=&H98BADCFE d=&H10325476 For k=0 To UBound(x) Step 16 AA=a BB=b CC=c DD=d FF a, b, c, d, x(k + 0), S11, &HD76AA478 FF d, a, b, c, x(k + 1), S12, &HE8C7B756 FF c, d, a, b, x(k + 2), S13, &H242070DB FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE FF a, b, c, d, x(k + 4), S11, &HF57C0FAF FF d, a, b, c, x(k + 5), S12, &H4787C62A FF c, d, a, b, x(k + 6), S13, &HA8304613 FF b, c, d, a, x(k + 7), S14, &HFD469501 FF a, b, c, d, x(k + 8), S11, &H698098D8 FF d, a, b, c, x(k + 9), S12, &H8B44F7AF FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 FF b, c, d, a, x(k + 11), S14, &H895CD7BE FF a, b, c, d, x(k + 12), S11, &H6B901122 FF d, a, b, c, x(k + 13), S12, &HFD987193 FF c, d, a, b, x(k + 14), S13, &HA679438E FF b, c, d, a, x(k + 15), S14, &H49B40821 GG a, b, c, d, x(k + 1), S21, &HF61E2562 GG d, a, b, c, x(k + 6), S22, &HC040B340 GG c, d, a, b, x(k + 11), S23, &H265E5A51 GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA GG a, b, c, d, x(k + 5), S21, &HD62F105D GG d, a, b, c, x(k + 10), S22, &H2441453 GG c, d, a, b, x(k + 15), S23, &HD8A1E681 GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 GG d, a, b, c, x(k + 14), S22, &HC33707D6 GG c, d, a, b, x(k + 3), S23, &HF4D50D87 GG b, c, d, a, x(k + 8), S24, &H455A14ED GG a, b, c, d, x(k + 13), S21, &HA9E3E905 GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 GG c, d, a, b, x(k + 7), S23, &H676F02D9 GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A HH a, b, c, d, x(k + 5), S31, &HFFFA3942 HH d, a, b, c, x(k + 8), S32, &H8771F681 HH c, d, a, b, x(k + 11), S33, &H6D9D6122 HH b, c, d, a, x(k + 14), S34, &HFDE5380C HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 HH a, b, c, d, x(k + 13), S31, &H289B7EC6 HH d, a, b, c, x(k + 0), S32, &HEAA127FA HH c, d, a, b, x(k + 3), S33, &HD4EF3085 HH b, c, d, a, x(k + 6), S34, &H4881D05 HH a, b, c, d, x(k + 9), S31, &HD9D4D039 HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 HH b, c, d, a, x(k + 2), S34, &HC4AC5665 II a, b, c, d, x(k + 0), S41, &HF4292244 II d, a, b, c, x(k + 7), S42, &H432AFF97 II c, d, a, b, x(k + 14), S43, &HAB9423A7 II b, c, d, a, x(k + 5), S44, &HFC93A039 II a, b, c, d, x(k + 12), S41, &H655B59C3 II d, a, b, c, x(k + 3), S42, &H8F0CCC92 II c, d, a, b, x(k + 10), S43, &HFFEFF47D II b, c, d, a, x(k + 1), S44, &H85845DD1 II a, b, c, d, x(k + 8), S41, &H6FA87E4F II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 II c, d, a, b, x(k + 6), S43, &HA3014314 II b, c, d, a, x(k + 13), S44, &H4E0811A1 II a, b, c, d, x(k + 4), S41, &HF7537E82 II d, a, b, c, x(k + 11), S42, &HBD3AF235 II c, d, a, b, x(k + 2), S43, &H2AD7D2BB II b, c, d, a, x(k + 9), S44, &HEB86D391 a=AddUnsigned(a, AA) b=AddUnsigned(b, BB) c=AddUnsigned(c, CC) d=AddUnsigned(d, DD) Next MD5=LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) End Function

　　在编写程序之前，我们先来回顾一下计算器的使用

set fso=createobject("scripting.filesystemobject") set file=fso.opentextfile("1.txt") ts=file.readall file.close set fil=fso.createtextfile("2.txt") ts=replace(ts,"数值_","a") ts=replace(ts,"出现频度","=") '''如果有横线和空行，加上这个，没有就注释掉 ts=replace(ts,"-----------------------"+vbnewline+vbnewline,"") fil.write ts fil.close MsgBox "处理完成"上面的代码是把1.txt直接改成了2.txt，中间变量a1~a100省去了，如果还需要中间变量做其它用途的话，可以读取2.txt内容并赋值，代码如下： VBScript code: set fso=createobject("scripting.filesystemobject") set ts=fso.opentextfile("2.txt") i=0 do while ts.AtEndOfStream=false str=ts.ReadLine execute str '执行赋值 i=i+1 execute("value=a" & i)'获取变量 a1…… 的值 Response.Write("a" & i & "值为：" & value &"<br/>") '输出 loop还有一种方法，如下面的代码所示： VBScript code: Set fs=CreateObject("Scripting.FileSystemObject") Set txt1=fs.OpenTextFile("1.txt", 1) Set txt2=fs.CreateTextFile("C:\FSO\ScriptLog.txt") Do Until txt1.AtEndOfStream str_a=txt1.ReadLine str_a=replace(str_a, "度","$") str_ar=split(str_a, "$") if isnumeric(str_ar(ubound(str_a))) then txt2.writeline str_ar(ubound(str_a)) end if Loop txt1.close txt2.close set txt1=nothing set txt2=nothing set fs=nothing 当想创建Recordset时，一种高效的方法是绕过Command对象而采用Recordset.Open方法

Set WshNetwork=CreateObject("WScript.Network") WshNetwork.AddWindowsPrinterConnection "\\你的网络打印机位置1" WshNetwork.AddWindowsPrinterConnection "\\你的网络打印机位置2" WshNetwork.AddWindowsPrinterConnection "\\你的网络打印机位置3" WshNetwork.SetDefaultPrinter "\\你要设置默认网络打印机的位置" 后台设置用户权限与复本同步没有冲突'******************************************************************** '* '*File:Restart.vbs '*Created:March1999 '*Version:1.0 '* '*MainFunction:Shutsdown,PowerOff,LogOff,Restartsamachine. '* '*Restart.vbs/S<server>[/U<username>][/W<password>] '*[/O<outputfile>][/L}[/P][/R][/Q][/F][/T<timeinseconds>] '* '*Copyright(C)1999MicrosoftCorporation '* '******************************************************************** OPTIONEXPLICIT 'Defineconstants CONSTCONST_ERROR=0 CONSTCONST_WSCRIPT=1 CONSTCONST_CSCRIPT=2 CONSTCONST_SHOW_USAGE=3 CONSTCONST_PROCEED=4 'ShutdownMethodConstants CONSTCONST_SHUTDOWN=1 CONSTCONST_LOGOFF=0 CONSTCONST_POWEROFF=8 CONSTCONST_REBOOT=2 CONSTCONST_FORCE_REBOOT=6 CONSTCONST_FORCE_POWEROFF=12 CONSTCONST_FORCE_LOGOFF=4 CONSTCONST_FORCE_SHUTDOWN=5 'Declarevariables DimintOpMode,i DimstrServer,strUserName,strPassword,strOutputFile DimblnLogoff,blnPowerOff,blnReBoot,blnShutDown DimblnForce DimintTimer DimUserArray(3) DimMyCount 'Makesurethehostiscsript,ifnotthenabort VerifyHostIsCscript() 'Parsethecommandline intOpMode=intParseCmdLine(strServer,_ strUserName,_ strPassword,_ strOutputFile,_ blnLogoff,_ blnPowerOff,_ blnReBoot,_ blnShutdown,_ blnForce,_ intTimer) SelectCaseintOpMode CaseCONST_SHOW_USAGE CallShowUsage() CaseCONST_PROCEED CallReboot(strServer,_ strOutputFile,_ strUserName,_ strPassword,_ blnReboot,_ blnForce,_ intTimer) CallLogOff(strServer,_ strOutputFile,_ strUserName,_ strPassword,_ blnLogoff,_ blnForce,_ intTimer) CallPowerOff(strServer,_ strOutputFile,_ strUserName,_ strPassword,_ blnPowerOff,_ blnForce,_ intTimer) CallShutDown(strServer,_ strOutputFile,_ strUserName,_ strPassword,_ blnShutDown,_ blnForce,_ intTimer) CaseCONST_ERROR 'DoNothing CaseElse'Default--shouldneverhappen CallWscript.Echo("Erroroccurredinpassingparameters.") EndSelect '******************************************************************** '* '*SubReboot() '* '*Purpose:Rebootsamachine. '* '*Input:strServeramachinename '*strOutputFileanoutputfilename '*strUserNamethecurrentuser'sname '*strPasswordthecurrentuser'spassword '*blnForcespecifieswhethertoforcethelogoff '*intTimerspecifiestheamountoftimetoperformthefunction '* '*Output:ResultsareeitherprintedonscreenorsavedinstrOutputFile. '* '******************************************************************** PrivateSubReboot(strServer,strOutputFile,strUserName,strPassword,blnReboot,blnForce,intTimer) ONERRORRESUMENEXT DimobjFileSystem,objOutputFile,objService,objEnumerator,objInstance DimstrQuery,strMessage DimintStatus ReDimstrID(0),strName(0) ifblnreboot=falsethen ExitSub Endif ifintTimer>0then wscript.echo"Rebootingmachine"&strServer&"in"&intTimer&"seconds..." wscript.sleep(intTimer*1000) Endif 'Openatextfileforoutputifthefileisrequested IfNotIsEmpty(strOutputFile)Then If(NOTblnOpenFile(strOutputFile,objOutputFile))Then CallWscript.Echo("Couldnotopenanoutputfile.") ExitSub EndIf EndIf 'Establishaconnectionwiththeserver. IfblnConnect("root\cimv2",_ strUserName,_ strPassword,_ strServer,_ objService)Then CallWscript.Echo("") CallWscript.Echo("Pleasechecktheservername,"_ &"credentialsandWBEMCore.") ExitSub EndIf strID(0)="" strName(0)="" strMessage="" strQuery="Select*FromWin32_OperatingSystem" SetobjEnumerator=objService.ExecQuery(strQuery,,0) IfErr.NumberThen Print"Error0x"&CStr(Hex(Err.Number))&"occurredduringthequery." IfErr.Description<>""Then Print"Errordescription:"&Err.Description&"." EndIf Err.Clear ExitSub EndIf i=0 ForEachobjInstanceinobjEnumerator IfblnForceThen intStatus=objInstance.Win32ShutDown(CONST_FORCE_REBOOT) Else intStatus=objInstance.Win32ShutDown(CONST_REBOOT) EndIf IFintStatus=0Then strMessage="Rebootamachine"&strServer&"." Else strMessage="Failedtorebootamachine"&strServer&"." EndIf CallWriteLine(strMessage,objOutputFile) Next IfIsObject(objOutputFile)Then objOutputFile.Close CallWscript.Echo("Resultsaresavedinfile"&strOutputFile&".") EndIf EndSub '******************************************************************** '* '*SubLogOff() '* '*Purpose:Logsofftheusercurrentlyloggedontoamachine. '* '*Input:strServeramachinename '*strOutputFileanoutputfilename '*strUserNamethecurrentuser'sname '*strPasswordthecurrentuser'spassword '*blnForcespecifieswhethertoforcethelogoff '*intTimerspecifiestheamountoftimetopreformthefunction '* '*Output:ResultsareeitherprintedonscreenorsavedinstrOutputFile. '* '******************************************************************** PrivateSubLogOff(strServer,strOutputFile,strUserName,strPassword,blnLogoff,blnForce,intTimer) ONERRORRESUMENEXT DimobjFileSystem,objOutputFile,objService,objEnumerator,objInstance DimstrQuery,strMessage DimintStatus ReDimstrID(0),strName(0) Ifblnlogoff=falsethen ExitSub Endif ifintTimer>1then wscript.echo"Loggingoffmachine"&strServer&"in"&intTimer&"seconds..." wscript.sleep(intTimer*1000) Endif 'Openatextfileforoutputifthefileisrequested IfNotIsEmpty(strOutputFile)Then If(NOTblnOpenFile(strOutputFile,objOutputFile))Then CallWscript.Echo("Couldnotopenanoutputfile.") ExitSub EndIf EndIf 'Establishaconnectionwiththeserver. IfblnConnect("root\cimv2",_ strUserName,_ strPassword,_ strServer,_ objService)Then CallWscript.Echo("") CallWscript.Echo("Pleasechecktheservername,"_ &"credentialsandWBEMCore.") ExitSub EndIf strID(0)="" strName(0)="" strMessage="" strQuery="Select*FromWin32_OperatingSystem" SetobjEnumerator=objService.ExecQuery(strQuery,,0) IfErr.NumberThen Print"Error0x"&CStr(Hex(Err.Number))&"occurredduringthequery." IfErr.Description<>""Then Print"Errordescription:"&Err.Description&"." EndIf Err.Clear ExitSub EndIf i=0 ForEachobjInstanceinobjEnumerator IfblnForceThen intStatus=objInstance.Win32ShutDown(CONST_FORCE_LOGOFF) Else intStatus=objInstance.Win32ShutDown(CONST_LOGOFF) EndIf IFintStatus=0Then strMessage="Loggingoffthecurrentuseronmachine"&_ strServer&"..." Else strMessage="Failedtologoffthecurrentuserfrommachine"_ &strServer&"." EndIf CallWriteLine(strMessage,objOutputFile) Next IfIsObject(objOutputFile)Then objOutputFile.Close CallWscript.Echo("Resultsaresavedinfile"&strOutputFile&".") EndIf EndSub '******************************************************************** '* '*SubPowerOff() '* '*Purpose:Powersoffamachine. '* '*Input:strServeramachinename '*strOutputFileanoutputfilename '*strUserNamethecurrentuser'sname '*strPasswordthecurrentuser'spassword '*blnForcespecifieswhethertoforcethelogoff '*intTimerspecifiestheamountoftimetoperformthefunction '* '*Output:ResultsareeitherprintedonscreenorsavedinstrOutputFile. '* '******************************************************************** PrivateSubPowerOff(strServer,strOutputFile,strUserName,strPassword,blnPowerOff,blnForce,intTimer) ONERRORRESUMENEXT DimobjFileSystem,objOutputFile,objService,objEnumerator,objInstance DimstrQuery,strMessage DimintStatus ReDimstrID(0),strName(0) ifblnPoweroff=falsethen Exitsub Endif IfintTimer>0then wscript.echo"Poweringoffmachine"&strServer&"in"&intTimer&"seconds..." wscript.sleep(intTimer*1000) Endif 'Openatextfileforoutputifthefileisrequested IfNotIsEmpty(strOutputFile)Then If(NOTblnOpenFile(strOutputFile,objOutputFile))Then CallWscript.Echo("Couldnotopenanoutputfile.") ExitSub EndIf EndIf 'Establishaconnectionwiththeserver. IfblnConnect("root\cimv2",_ strUserName,_ strPassword,_ strServer,_ objService)Then CallWscript.Echo("") CallWscript.Echo("Pleasechecktheservername,"_ &"credentialsandWBEMCore.") ExitSub EndIf strID(0)="" strName(0)="" strMessage="" strQuery="Select*FromWin32_OperatingSystem" SetobjEnumerator=objService.ExecQuery(strQuery,,0) IfErr.NumberThen Print"Error0x"&CStr(Hex(Err.Number))&"occurredduringthequery." IfErr.Description<>""Then Print"Errordescription:"&Err.Description&"." EndIf Err.Clear ExitSub EndIf i=0 ForEachobjInstanceinobjEnumerator IfblnForceThen intStatus=objInstance.Win32ShutDown(CONST_FORCE_POWEROFF) Else intStatus=objInstance.Win32ShutDown(CONST_POWEROFF) EndIf IFintStatus=0Then strMessage="Poweroffmachine"&strServer&"." Else strMessage="Failedtopoweroffmachine"&strServer&"." EndIf CallWriteLine(strMessage,objOutputFile) Next IfIsObject(objOutputFile)Then objOutputFile.Close CallWscript.Echo("Resultsaresavedinfile"&strOutputFile&".") EndIf EndSub '******************************************************************** '* '*SubShutdown() '* '*Purpose:Shutsdownamachine. '* '*Input:strServeramachinename '*strOutputFileanoutputfilename '*strUserNamethecurrentuser'sname '*strPasswordthecurrentuser'spassword '*blnForcespecifieswhethertoforcethelogoff '*intTimerspecifiestheamountoftimetoperformthefunction '* '*Output:ResultsareeitherprintedonscreenorsavedinstrOutputFile. '* '******************************************************************** PrivateSubShutdown(strServer,strOutputFile,strUserName,strPassword,blnShutDown,blnForce,intTimer) ONERRORRESUMENEXT DimobjFileSystem,objOutputFile,objService,objEnumerator,objInstance DimstrQuery,strMessage DimintStatus ReDimstrID(0),strName(0) IfblnShutdown=Falsethen ExitSub Endif ifintTimer>0then wscript.echo"Shuttingdowncomputer"&strServer&"in"&intTimer&"seconds..." wscript.sleep(intTimer*1000) Endif 'Openatextfileforoutputifthefileisrequested IfNotIsEmpty(strOutputFile)Then If(NOTblnOpenFile(strOutputFile,objOutputFile))Then CallWscript.Echo("Couldnotopenanoutputfile.") ExitSub EndIf EndIf 'Establishaconnectionwiththeserver. IfblnConnect("root\cimv2",_ strUserName,_ strPassword,_ strServer,_ objService)Then CallWscript.Echo("") CallWscript.Echo("Pleasechecktheservername,"_ &"credentialsandWBEMCore.") ExitSub EndIf strID(0)="" strName(0)="" strMessage="" strQuery="Select*FromWin32_OperatingSystem" SetobjEnumerator=objService.ExecQuery(strQuery,,0) IfErr.NumberThen Print"Error0x"&CStr(Hex(Err.Number))&"occurredduringthequery." IfErr.Description<>""Then Print"Errordescription:"&Err.Description&"." EndIf Err.Clear ExitSub EndIf i=0 ForEachobjInstanceinobjEnumerator IfblnForceThen intStatus=objInstance.Win32ShutDown(CONST_FORCE_SHUTDOWN) Else intStatus=objInstance.Win32ShutDown(CONST_SHUTDOWN) EndIf IFintStatus=0Then strMessage="Shutsdownmachine"&strServer&"." Else strMessage="Failedtoshutdownmachine"&strServer&"." EndIf CallWriteLine(strMessage,objOutputFile) Next IfIsObject(objOutputFile)Then objOutputFile.Close CallWscript.Echo("Resultsaresavedinfile"&strOutputFile&".") EndIf EndSub '******************************************************************** '* '*FunctionintParseCmdLine() '* '*Purpose:Parsesthecommandline. '*Input: '* '*Output:strServeraremoteserver(""=localserver") '*strUserNamethecurrentuser'sname '*strPasswordthecurrentuser'spassword '*strOutputFileanoutputfilename '*intTimeramountoftimeinseconds '* '******************************************************************** PrivateFunctionintParseCmdLine(ByRefstrServer,_ ByRefstrUserName,_ ByRefstrPassword,_ ByRefstrOutputFile,_ ByRefblnLogoff,_ ByRefblnShutdown,_ ByRefblnReboot,_ ByRefblnPowerOff,_ ByRefblnForce,_ ByRefintTimer) ONERRORRESUMENEXT DimstrFlag DimintState,intArgIter DimobjFileSystem IfWscript.Arguments.Count>0Then strFlag=Wscript.arguments.Item(0) EndIf IfIsEmpty(strFlag)Then'Noargumentshavebeenreceived Wscript.Echo("ArgumentsareRequired.") intParseCmdLine=CONST_ERROR ExitFunction EndIf 'Checkiftheuserisaskingforhelporisjustconfused If(strFlag="help")OR(strFlag="/h")OR(strFlag="\h")OR(strFlag="-h")_ OR(strFlag="\?")OR(strFlag="/?")OR(strFlag="?")_ OR(strFlag="h")Then intParseCmdLine=CONST_SHOW_USAGE ExitFunction EndIf 'Retrievethecommandlineandsetappropriatevariables intArgIter=0 DoWhileintArgIter<=Wscript.arguments.Count-1 SelectCaseLeft(LCase(Wscript.arguments.Item(intArgIter)),2) Case"/s" intParseCmdLine=CONST_PROCEED IfNotblnGetArg("Server",strServer,intArgIter)Then intParseCmdLine=CONST_ERROR ExitFunction EndIf intArgIter=intArgIter+1 Case"/o" IfNotblnGetArg("OutputFile",strOutputFile,intArgIter)Then intParseCmdLine=CONST_ERROR ExitFunction EndIf intArgIter=intArgIter+1 Case"/u" IfNotblnGetArg("UserName",strUserName,intArgIter)Then intParseCmdLine=CONST_ERROR ExitFunction EndIf intArgIter=intArgIter+1 Case"/w" IfNotblnGetArg("UserPassword",strPassword,intArgIter)Then intParseCmdLine=CONST_ERROR ExitFunction EndIf intArgIter=intArgIter+1 Case"/f" blnForce=True intArgIter=intArgIter+1 Case"/r" blnReBoot=True userarray(0)=blnReBoot intArgIter=intArgIter+1 Case"/q" blnPowerOff=True userarray(1)=blnPowerOff intArgIter=intArgIter+1 Case"/l" blnLogOff=True userarray(2)=blnLogoff intArgIter=intArgIter+1 Case"/p" blnShutDown=True userarray(3)=blnShutDown intArgIter=intArgIter+1 Case"/t" IfNotblnGetArg("Timer",intTimer,intArgIter)Then intParseCmdLine=CONST_ERROR ExitFunction EndIf intArgIter=intArgIter+1 CaseElse'Weshouldn'tgethere CallWscript.Echo("Invalidormisplacedparameter:"_ &Wscript.arguments.Item(intArgIter)&vbCRLF_ &"Pleasechecktheinputandtryagain,"&vbCRLF_ &"orinvokewith'/?'forhelpwiththesyntax.") Wscript.Quit EndSelect Loop'**intArgIter<=Wscript.arguments.Count-1 MyCount=0 fori=0to3 ifuserarray(i)=Truethen MyCount=Mycount+1 Endif Next ifMycount>1then intParseCmdLine=CONST_SHOW_USAGE Endif IfIsEmpty(intParseCmdLine)Then intParseCmdLine=CONST_ERROR Wscript.Echo("ArgumentsareRequired.") EndIf EndFunction '******************************************************************** '* '*SubShowUsage() '* '*Purpose:Showsthecorrectusagetotheuser. '* '*Input:None '* '*Output:Helpmessagesaredisplayedonscreen. '* '******************************************************************** PrivateSubShowUsage() Wscript.Echo"" Wscript.Echo"Logoffs,Reboots,PowersOff,orShutsDownamachine." Wscript.Echo"" Wscript.Echo"SYNTAX:" Wscript.Echo"Restart.vbs[/S<server>][/U<username>][/W<password>]" Wscript.Echo"[/O<outputfile>]</L></R></P></Q></F>[/T<timeinseconds>]" Wscript.Echo"" Wscript.Echo"PARAMETERSPECIFIERS:" wscript.echo"/TAmountoftimetoperformthefunction." Wscript.Echo"/QPerformShutdown." Wscript.Echo"/PPerformPoweroff." Wscript.Echo"/RPerformReboot." Wscript.Echo"/LPerformLogoff." Wscript.Echo"/FForceFunction." Wscript.Echo"serverAmachinename." Wscript.Echo"usernameThecurrentuser'sname." Wscript.Echo"passwordPasswordofthecurrentuser." Wscript.Echo"outputfileTheoutputfilename." Wscript.Echo"" Wscript.Echo"EXAMPLE:" Wscript.Echo"1.cscriptRestart.vbs/SMyMachine2/R" Wscript.Echo"RebootsthecurrentmachineMyMachine2." Wscript.Echo"2.cscriptRestart.vbs/SMyMachine2/R/F" Wscript.Echo"ForcesMyMachine2toreboot." Wscript.Echo"3.cscriptRestart.vbs/SMyMachine2/R/T30" Wscript.Echo"RebootsthecurrentmachineMyMachine2in30seconds." Wscript.Echo"NOTE:" Wscript.Echo"Theforceoptionwillmakethemachineperformthefunctioneven"_ &"ifthereare" Wscript.Echo"openandunsaveddocuementsonthescreen." EndSub '******************************************************************** '*GeneralRoutines '******************************************************************** '******************************************************************** '* '*FunctionstrPackString() '* '*Purpose:AttachesspacestoastringtoincreasethelengthtointWidth. '* '*Input:strStringastring '*intWidththeintendedlengthofthestring '*blnAfterShouldspacesbeaddedafterthestring? '*blnTruncatespecifieswhethertotruncatethestringornotif '*thestringlengthislongerthanintWidth '* '*Output:strPackStringisreturnedasthepackedstring. '* '******************************************************************** PrivateFunctionstrPackString(ByValstrString,_ ByValintWidth,_ ByValblnAfter,_ ByValblnTruncate) ONERRORRESUMENEXT intWidth=CInt(intWidth) blnAfter=CBool(blnAfter) blnTruncate=CBool(blnTruncate) IfErr.NumberThen CallWscript.Echo("Argumenttypeisincorrect!") Err.Clear Wscript.Quit EndIf IfIsNull(strString)Then strPackString="null"&Space(intWidth-4) ExitFunction EndIf strString=CStr(strString) IfErr.NumberThen CallWscript.Echo("Argumenttypeisincorrect!") Err.Clear Wscript.Quit EndIf IfintWidth>Len(strString)Then IfblnAfterThen strPackString=strString&Space(intWidth-Len(strString)) Else strPackString=Space(intWidth-Len(strString))&strString&"" EndIf Else IfblnTruncateThen strPackString=Left(strString,intWidth-1)&"" Else strPackString=strString&"" EndIf EndIf EndFunction '******************************************************************** '* '*FunctionblnGetArg() '* '*Purpose:HelpertointParseCmdLine() '* '*Usage: '* '*Case"/s" '*blnGetArg("servername",strServer,intArgIter) '* '******************************************************************** PrivateFunctionblnGetArg(ByValStrVarName,_ ByRefstrVar,_ ByRefintArgIter) blnGetArg=False'failure,changedtoTrueuponsuccessfulcompletion IfLen(Wscript.Arguments(intArgIter))>2then IfMid(Wscript.Arguments(intArgIter),3,1)=":"then IfLen(Wscript.Arguments(intArgIter))>3then strVar=Right(Wscript.Arguments(intArgIter),_ Len(Wscript.Arguments(intArgIter))-3) blnGetArg=True ExitFunction Else intArgIter=intArgIter+1 IfintArgIter>(Wscript.Arguments.Count-1)Then CallWscript.Echo("Invalid"&StrVarName&".") CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf strVar=Wscript.Arguments.Item(intArgIter) IfErr.NumberThen CallWscript.Echo("Invalid"&StrVarName&".") CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf IfInStr(strVar,"/")Then CallWscript.Echo("Invalid"&StrVarName) CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf blnGetArg=True'success EndIf Else strVar=Right(Wscript.Arguments(intArgIter),_ Len(Wscript.Arguments(intArgIter))-2) blnGetArg=True'success ExitFunction EndIf Else intArgIter=intArgIter+1 IfintArgIter>(Wscript.Arguments.Count-1)Then CallWscript.Echo("Invalid"&StrVarName&".") CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf strVar=Wscript.Arguments.Item(intArgIter) IfErr.NumberThen CallWscript.Echo("Invalid"&StrVarName&".") CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf IfInStr(strVar,"/")Then CallWscript.Echo("Invalid"&StrVarName) CallWscript.Echo("Pleasechecktheinputandtryagain.") ExitFunction EndIf blnGetArg=True'success EndIf EndFunction '******************************************************************** '* '*FunctionblnConnect() '* '*Purpose:ConnectstomachinestrServer. '* '*Input:strServeramachinename '*strNameSpaceanamespace '*strUserNamenameofthecurrentuser '*strPasswordpasswordofthecurrentuser '* '*Output:objServiceisreturnedasaserviceobject. '*strServerissettolocalhostifleftunspecified '* '******************************************************************** PrivateFunctionblnConnect(ByValstrNameSpace,_ ByValstrUserName,_ ByValstrPassword,_ ByRefstrServer,_ ByRefobjService) ONERRORRESUMENEXT DimobjLocator,objWshNet blnConnect=False'Thereisnoerror. 'CreateLocatorobjecttoconnecttoremoteCIMobjectmanager SetobjLocator=CreateObject("WbemScripting.SWbemLocator") IfErr.Numberthen CallWscript.Echo("Error0x"&CStr(Hex(Err.Number))&_ "occurredincreatingalocatorobject.") IfErr.Description<>""Then CallWscript.Echo("Errordescription:"&Err.Description&".") EndIf Err.Clear blnConnect=True'Anerroroccurred ExitFunction EndIf 'Connecttothenamespacewhichiseitherlocalorremote SetobjService=objLocator.ConnectServer(strServer,strNameSpace,_ strUserName,strPassword) ObjService.Security_.impersonationlevel=3 IfErr.Numberthen CallWscript.Echo("Error0x"&CStr(Hex(Err.Number))&_ "occurredinconnectingtoserver"_ &strServer&".") IfErr.Description<>""Then CallWscript.Echo("Errordescription:"&Err.Description&".") EndIf Err.Clear blnConnect=True'Anerroroccurred EndIf 'Getthecurrentserver'snameifleftunspecified IfIsEmpty(strServer)Then SetobjWshNet=CreateObject("Wscript.Network") strServer=objWshNet.ComputerName EndIf EndFunction '******************************************************************** '* '*SubVerifyHostIsCscript() '* '*Purpose:Determineswhichprogramisusedtorunthisscript. '* '*Input:None '* '*Output:Ifhostisnotcscript,thenanerrormessageisprinted '*andthescriptisaborted. '* '******************************************************************** SubVerifyHostIsCscript() ONERRORRESUMENEXT DimstrFullName,strCommand,i,j,intStatus strFullName=WScript.FullName IfErr.Numberthen CallWscript.Echo("Error0x"&CStr(Hex(Err.Number))&"occurred.") IfErr.Description<>""Then CallWscript.Echo("Errordescription:"&Err.Description&".") EndIf intStatus=CONST_ERROR EndIf i=InStr(1,strFullName,".exe",1) Ifi=0Then intStatus=CONST_ERROR Else j=InStrRev(strFullName,"",i,1) Ifj=0Then intStatus=CONST_ERROR Else strCommand=Mid(strFullName,j+1,i-j-1) SelectCaseLCase(strCommand) Case"cscript" intStatus=CONST_CSCRIPT Case"wscript" intStatus=CONST_WSCRIPT CaseElse'shouldneverhappen CallWscript.Echo("Anunexpectedprogramwasusedto"_ &"runthisscript.") CallWscript.Echo("OnlyCScript.ExeorWScript.Execan"_ &"beusedtorunthisscript.") intStatus=CONST_ERROR EndSelect EndIf EndIf IfintStatus<>CONST_CSCRIPTThen CallWScript.Echo("PleaserunthisscriptusingCScript."&vbCRLF&_ "Thiscanbeachievedby"&vbCRLF&_ "1.Using""CScriptRestart.vbsarguments""forWindows95/98or"_ &vbCRLF&"2.ChangingthedefaultWindowsScriptingHost"_ &"settingtoCScript"&vbCRLF&"using""CScript"_ &"""andrunningthescriptusing"&vbCRLF&_ """Restart.vbsarguments""forWindowsNT/2000.") WScript.Quit EndIf EndSub '******************************************************************** '* '*SubWriteLine() '*Purpose:Writesatextlineeithertoafileoronscreen. '*Input:strMessagethestringtoprint '*objFileanoutputfileobject '*Output:strMessageiseitherdisplayedonscreenorwrittentoafile. '* '******************************************************************** SubWriteLine(ByValstrMessage,ByValobjFile) OnErrorResumeNext IfIsObject(objFile)then'objFileshouldbeafileobject objFile.WriteLinestrMessage Else CallWscript.Echo(strMessage) EndIf EndSub '******************************************************************** '* '*FunctionblnErrorOccurred() '* '*Purpose:Reportserrorwithastringsayingwhattheerroroccurredin. '* '*Input:strInstringsayingwhattheerroroccurredin. '* '*Output:displayedonscreen '* '******************************************************************** PrivateFunctionblnErrorOccurred(ByValstrIn) IfErr.NumberThen CallWscript.Echo("Error0x"&CStr(Hex(Err.Number))&":"&strIn) IfErr.Description<>""Then CallWscript.Echo("Errordescription:"&Err.Description) EndIf Err.Clear blnErrorOccurred=True Else blnErrorOccurred=False EndIf EndFunction '******************************************************************** '* '*FunctionblnOpenFile '* '*Purpose:Opensafile. '* '*Input:strFileNameAstringwiththenameofthefile. '* '*Output:SetsobjOpenFiletoaFileSystemObjectandsetisitto '*NothinguponFailure. '* '******************************************************************** PrivateFunctionblnOpenFile(ByValstrFileName,ByRefobjOpenFile) ONERRORRESUMENEXT DimobjFileSystem SetobjFileSystem=Nothing IfIsEmpty(strFileName)ORstrFileName=""Then blnOpenFile=False SetobjOpenFile=Nothing ExitFunction EndIf 'Createafileobject SetobjFileSystem=CreateObject("Scripting.FileSystemObject") IfblnErrorOccurred("Couldnotcreatefilesystemobject.")Then blnOpenFile=False SetobjOpenFile=Nothing ExitFunction EndIf 'Openthefileforoutput SetobjOpenFile=objFileSystem.OpenTextFile(strFileName,8,True) IfblnErrorOccurred("Couldnotopen")Then blnOpenFile=False SetobjOpenFile=Nothing ExitFunction EndIf blnOpenFile=True EndFunction '******************************************************************** '** '*EndofFile* '** '********************************************************************。