[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[技术讨论] VBS自定义CMD命令函数

本帖最后由 yu2n 于 2012-12-17 00:04 编辑

直接上代码,欢迎加强。
:) 更新:2012-12-16   写了一个公共函数,方便新手使用。请点击 这里 (本栋6楼)查看完整文档。

' ====================================================================================================
' ****************************************************************************************************
' * + 公共函数
' *   - 使用方式:将本段"所有"代码置于程序任意位置,将以下代码(2行,以注释“REM”开头)加入程序首行即可:
REM     Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, MeName, MePid, UNCHost
REM     Call GetGloVar() ' 获得全局变量
' *   - 发电邮获得支持:[email]yu2n@qq.com[/email]
' *   - 第 0007 次更新:2012-12-15 17:14
' ****************************************************************************************************
' 功能索引
' 命令行支持:
'     检测环境:IsCmdMode是否在CMD下运行
'     模拟命令:Exist是否存在文件或文件夹、MD创建目录、Copy复制文件或文件夹、Del删除文件或文件夹、
'               Attrib更改文件或文件夹属性、Ping检测网络联通、
' 对话框:
'     提示消息:WarningInfo警告消息、TipInfo提示消息、ErrorInfo错误消息
'     输入密码:GetPassword提示输入密码、
' 文件系统:
'     复制、删除、更改属性:参考“命令行支持”。
'     INI文件处理:读写INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
'     注册表处理:RegRead读注册表、RegWrite写注册表
'     日志处理:WriteLog写文本日志
' 字符串处理:
'     提取:RegExpTest
' 程序:
'     检测:IsRun是否运行、MeIsAlreadyRun本程序是否执行、、、、
'     执行:Run前台等待执行、RunHide隐藏等待执行、RunNotWait前台不等待执行、RunHideNotWait后台不等待执行、
'     加密运行:MeEncoder
' 系统:
'     版本
'     延时:Sleep
'     发送按键:SendKeys
' 网络:
'     检测:Ping、参考“命令行支持”。
'     连接:文件共享、、、、、、、、、、
' 时间:Format_Time格式化时间、NowDateTime当前时间
' ====================================================================================================
' ====================================================================================================
MD命令,vbs-plkj改进算法,vbs-yu2n加入UNC路径支持。

更新2次:08:49 2012.11.03
  1. '作者:vbs-plkj | vbs-yu2n
  2. '使用:Call MD("D:\a\b\c\d\e\f\g\h")
  3. ' Call MD("\\PCName\Share$\a\b\c\d\e\f\g\h\")
  4. Sub MD(ByVal strPath)
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Dim arrPath, strTemp, valStart
  7. arrPath = Split(strPath, "\")
  8. If Left(strPath, 2) = "\\" Then    ' UNC Path
  9. valStart = 3
  10. strTemp = arrPath(0) & "\" & arrPath(1) & "\" & arrPath(2)
  11. Else                              ' Local Path
  12. valStart = 1
  13. strTemp = arrPath(0)
  14. End If
  15. For i = valStart To UBound(arrPath)
  16. strTemp = strTemp & "\" & arrPath(i)
  17. WScript.Echo strTemp
  18. If Not fso.FolderExists( strTemp ) Then fso.CreateFolder( strTemp )
  19. Next
  20. Set fso = Nothing
  21. End Sub
复制代码
Attrib 支持  [+R | -R] [+A | -A ] [+S | -S] [+H | -H] 参数

更新3次:19:49 2012.11.03
  1. Sub Attrib(strPath, strArgs)    'strArgs = [+R | -R] [+A | -A ] [+S | -S] [+H | -H]
  2.    Dim fso, valAttrib, arrAttrib()
  3.    Set fso = CreateObject("Scripting.FileSystemObject")
  4.    If (fso.FileExists(strPath)) Then valAttrib = fso.getFile(strPath).attributes
  5.    If (fso.FolderExists(strPath)) Then valAttrib = fso.getFolder(strPath).attributes
  6.    If valAttrib = "" Or strArgs = "" Then Exit Sub
  7.    binAttrib = DecToBin(valAttrib)   ' 十进制转二进制
  8.    For i = 0 To 16                   ' 二进制转16位二进制
  9.       ReDim Preserve arrAttrib(i)
  10.       arrAttrib(i) = 0
  11.       If i > 16 - Len(binAttrib) Then arrAttrib(i) = Mid(binAttrib, i - (16 - Len(binAttrib)), 1)
  12.    Next
  13.    If Instr(1, LCase(strArgs), "+r", 1) Then arrAttrib(16 - 0) = 1   'ReadOnly 1
  14.    If Instr(1, LCase(strArgs), "-r", 1) Then arrAttrib(16 - 0) = 0
  15.    If Instr(1, LCase(strArgs), "+h", 1) Then arrAttrib(16 - 1) = 1   'Hidden 2
  16.    If Instr(1, LCase(strArgs), "-h", 1) Then arrAttrib(16 - 1) = 0
  17.    If Instr(1, LCase(strArgs), "+s", 1) Then arrAttrib(16 - 2) = 1   'System 4
  18.    If Instr(1, LCase(strArgs), "-s", 1) Then arrAttrib(16 - 2) = 0
  19.    If Instr(1, LCase(strArgs), "+a", 1) Then arrAttrib(16 - 5) = 1   'Archive 32
  20.    If Instr(1, LCase(strArgs), "-a", 1) Then arrAttrib(16 - 5) = 0
  21.    valAttrib = BinToDec(Join(arrAttrib,""))   ' 二进制转十进制
  22.    If (fso.FileExists(strPath)) Then fso.getFile( strPath ).attributes = valAttrib
  23.    If (fso.FolderExists(strPath)) Then fso.getFolder( strPath ).attributes = valAttrib
  24.    Set fso = Nothing
  25. End Sub
  26. Function DecToBin(ByVal number)
  27.    Dim remainder
  28.    remainder = number
  29.    Do While remainder > 0
  30.       DecToBin = CStr(remainder mod 2) & DecToBin
  31.       remainder = remainder \ 2
  32.   Loop
  33. End Function
  34. Function BinToDec(ByVal binStr)
  35.    Dim i
  36.    For i = 1 to Len(binStr)
  37.       BinToDec = BinToDec + (CInt(Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))
  38.    Next
  39. End Function
复制代码
Copy 函数

更新1次:22:40 2012/11/5
  1. Sub Copy( ByVal strSource, ByVal strDestination )
  2.    On Error Resume Next ' Required 必选
  3.    Set fso = CreateObject("Scripting.FileSystemObject")
  4.     ' 如果来源是一个文件
  5.    If (fso.FileExists(strSource)) Then            
  6.       ' 如果目的地是一个文件夹,加上路径后缀反斜线“\”
  7.       If (fso.FolderExists(strDestination)) Then   
  8.          fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "\", True
  9.       Else   
  10.          ' 如果目的地是一个文件,直接复制
  11.          fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
  12.       End If
  13.    End If   
  14.    ' 如果来源是一个文件夹
  15.    If (fso.FolderExists(strSource)) Then fso.CopyFolder fso.GetFolder(strSource).Path, fso.GetFolder(strDestination).Path, True
  16.    Set fso = Nothing
  17. End Sub
复制代码
类CMD命令,待改进,本人会持续更新……
  1. '===========================================================================================
  2. '类CMD命令
  3. Sub Echo( strOutput )
  4.     If Not IsCmdMode Then Exit Sub
  5. If strOutput = "" Or strOutput = VbCrLf Then
  6. WScript.Echo VbCrLf
  7. Else
  8. WScript.Echo strOutput
  9. End If
  10. End Sub
  11. Function Pause(msg)    '暂停函数
  12. If Not IsCmdMode Then Exit Function
  13. WScript.Echo ""
  14. WScript.Echo msg
  15. WScript.StdIn.ReadLine
  16. End Function
  17. Function ReadInput( enquiryStr )    ' 读取输入,相当于Set/p p=
  18. If Not IsCmdMode Then Exit Function
  19. WScript.StdOut.Write enquiryStr
  20. ReadInput = Trim( WScript.StdIn.ReadLine )
  21. End Function
  22. Function Exist( strPath )
  23. Set fso = CreateObject("Scripting.FileSystemObject")
  24. If ((fso.FolderExists( strPath )) Or (fso.FileExists( strPath ))) then
  25. Exist = True
  26. Else
  27. Exist = False
  28. End if
  29. Set fso = Nothing
  30. End Function
  31. Sub MD( strPath )
  32. Set fso = CreateObject("Scripting.FileSystemObject")
  33. If Not fso.FolderExists( strPath ) Then
  34. fso.CreateFolder( strPath )
  35. End If
  36. Set fso = Nothing
  37. End Sub
  38. Sub Copy( strSource, strDestination )
  39. On Error Resume Next
  40. If Exist( strSource ) Then
  41. Set fso = CreateObject("Scripting.FileSystemObject")
  42. If (fso.FileExists(strSource)) Then fso.CopyFile strSource, strDestination, True    ' 源文件 - 目标文件
  43. If (fso.FolderExists(strSource)) Then fso.CopyFolder strSource, strDestination, True
  44. Set fso = Nothing
  45. Else
  46. WarningInfo "警告", "找不到 " & strSource & " 文件!", 2
  47. End If
  48. End Sub
  49. Sub Del( strPath )
  50. On Error Resume Next
  51. If Exist( strPath ) Then
  52. Set fso = CreateObject("Scripting.FileSystemObject")
  53. If (fso.FileExists(strPath)) Then
  54. fso.getFile( strPath ).attributes=0
  55. fso.getFile( strPath ).delete
  56. End If
  57. If (fso.FolderExists(strPath)) Then
  58. fso.getFolder( strPath ).attributes=0
  59. fso.getFolder( strPath ).delete
  60. End If
  61. Set fso = Nothing
  62. End If
  63. End Sub
  64. Sub Attrib( strPath, valAttrib )
  65. 'ReadOnly:1 只读文件。可读写。  'Hidden:2 隐藏文件。可读写。
  66. 'System:4 系统文件。可读写。  'Archive:32 上次备份后已更改的文件。可读写。
  67. On Error Resume Next
  68. Set fso = CreateObject("Scripting.FileSystemObject")
  69. If (fso.FileExists( strPath )) Then fso.getFile( strPath ).attributes = valAttrib
  70. ' 39 '设置此文件属性为系统、隐藏、只读
  71. If (fso.FolderExists( strPath )) Then fso.getFolder( strPath ).attributes = valAttrib
  72. Set fso = Nothing
  73. End Sub
  74. Sub RunAs( strAppPath, strArgs )
  75. On Error Resume Next
  76. Set Shell = CreateObject("Shell.Application")
  77. Shell.ShellExecute strAppPath, strArgs, "", "runas", 1
  78. Set Shell = Nothing
  79. End Sub
  80. '检测是否为CMD模式
  81. Function IsCmdMode()
  82. If LCase(Right(WScript.FullName,11))="wscript.exe" Then
  83. IsCmdMode = True
  84. Else
  85. IsCmdMode = False
  86. End If
  87. End Function
  88. '以CMD模式运行
  89. Function CmdMode(ByVal title,ByVal color)   '强制以命令行模式运行
  90. If LCase(Right(WScript.FullName,11))="wscript.exe" Then
  91. With CreateObject("Wscript.Shell")
  92. .Run "cmd /c cls&@echo off&title "&title&"&color "&color&"&Cscript //Nologo """&WScript.ScriptFullName&"""", 1 ,False
  93. REM .Run "taskkill /f /im cmd.exe",0
  94. End With
  95. WScript.Quit
  96. End If
  97. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

本帖最后由 yu2n 于 2012-11-3 08:39 编辑

引用改进的MD函数
vbs-plkj(58005744)  23:15:13

  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. Set WshShell = CreateObject("WScript.Shell")
  3. path="D:\a\b\c\d"
  4. arr_path = Split(path, "\")
  5. WScript.Echo UBound(arr_path)
  6. temp = arr_path(0)
  7. For i = 1 To UBound(arr_path)
  8.     temp = temp & "\" & arr_path(i)
  9.     WScript.Echo temp
  10.     If Not fso.FolderExists(temp) Then fso.CreateFolder(temp)
  11. Next
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

少用On Error Resume Next

TOP

本帖最后由 yu2n 于 2012-11-5 22:39 编辑
Copy 函数
  1. Sub Copy( ByVal strSource, ByVal strDestination )
  2.    On Error Resume Next ' Required 必选
  3.    Set fso = CreateObject("Scripting.FileSystemObject")
  4.     ' 如果来源是一个文件
  5.    If (fso.FileExists(strSource)) Then            
  6.       ' 如果目的地是一个文件夹,加上路径后缀反斜线“\”
  7.       If (fso.FolderExists(strDestination)) Then   
  8.          fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "\", True
  9.       Else   
  10.          ' 如果目的地是一个文件,直接复制
  11.          fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
  12.       End If
  13.    End If   
  14.    ' 如果来源是一个文件夹
  15.    If (fso.FolderExists(strSource)) Then fso.CopyFolder fso.GetFolder(strSource).Path, fso.GetFolder(strDestination).Path, True
  16.    Set fso = Nothing
  17. End Sub
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

个人感觉要写一个命令的话,它应该有必要的提示信息,合适的返回值,然后就是在内部自己尽量避免由于不规范或者预期之外的参数传入造成的影响。你要写CMD命令的话还是可以边试参考系统的,有些功能估计用VBS还可以扩充一些额外的参数,但是有些可能就难以实现了。做起来是个很大的工程啊,自己有兴趣就好。
我刚刚也写了一个attrib,也没有/s参数,但是加入了一些提示:
  1. Function Attrib(strPath, strArgs)
  2.     Dim strAttr, strOp, strArgsU
  3.     strAttr = "RHSVDALC"
  4.     strOp   = "-+"
  5.     strArgsU = UCase(strArgs)
  6.     Dim fso, df, valAttrib
  7.     Set fso = CreateObject("Scripting.FileSystemObject")
  8.     If fso.FileExists(strPath) Then
  9.         Set df = fso.GetFile(strPath)
  10.     ElseIf fso.FolderExists(strPath) Then
  11.         Set df = fso.getFolder(strPath)
  12.     Else
  13.         Err.Description = "File not found - " & aa
  14.         Err.Raise 3265
  15.         Exit Function
  16.     End If
  17.     valAttrib = df.attributes
  18.     If Not strArgsU = "" Then
  19.         Dim pa, po, i, j, s
  20.         For pa = 1 To 8
  21.             i = pa - 1
  22.             For po = 1 To 2
  23.                 j = po - 1
  24.                 s = Mid(strOp, po, 1) & Mid(strAttr, pa, 1)
  25.                 If Instr(strArgsU, s) > 0 Then
  26.                     If j = 0 Then
  27.                         valAttrib = valAttrib And (&HFF - 2 ^ i)
  28.                     ElseIf j = 1 Then
  29.                         valAttrib = valAttrib Or (2 ^ i)
  30.                     End If
  31.                 End If
  32.             Next
  33.         Next
  34.         df.attributes = valAttrib
  35.     End If
  36.     For i = 0 To 7
  37.         If df.attributes And (2 ^ i) Then
  38.             Attrib = Attrib & Mid(strAttr, i + 1, 1)
  39.         Else
  40.             Attrib = Attrib & "-"
  41.         End If
  42.     Next
  43.     Attrib = Attrib & vbTab & df.Path
  44. End Function
复制代码

TOP

直接写了一个公共函数方便使用,新手可以看看了。
' ====================================================================================================
Dim WhoAmI, TmpDir, WinDir, AppDataDir, MeDir :    Call GetGloVar()    ' 初始化全局变量

' 重复运行则退出
' If MeIsAlreadyRun() = True Then WScript.Quit

' 加密自身
' MeEncoder

' 显示程序运行信息
Dim ScriptName
ScriptName = Right(WScript.FullName, Len(WScript.FullName)-InstrRev(WScript.FullName,
"\"))
Msgbox  WhoAmI & VbCrLf & VbCrLf & _
        
"MeIsAlreadyRun = " & MeIsAlreadyRun() & VbCrLf & VbCrLf & _
        
"IsRun(" & ScriptName & ", " & WScript.ScriptFullName & ")" & _
        
" = " & IsRun(ScriptName, WScript.ScriptFullName), , IsRun(ScriptName, WScript.ScriptFullName)
        
WScript.Quit


' ====================================================================================================
' ****************************************************************************************************
' * + 公共函数
' *   - 使用方式:将本段"所有"代码置于程序任意位置,将以下代码(2行,以注释“REM”开头)加入程序首行即可:
REM     Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, MeName, MePid, UNCHost
REM     Call GetGloVar() ' 获得全局变量
' *   - 发电邮获得支持:[email]yu2n@qq.com[/email]
' *   - 第 0007 次更新:2012-12-15 17:14
' ****************************************************************************************************
' 功能索引
' 命令行支持:
'     检测环境:IsCmdMode是否在CMD下运行
'     模拟命令:Exist是否存在文件或文件夹、MD创建目录、Copy复制文件或文件夹、Del删除文件或文件夹、
'               Attrib更改文件或文件夹属性、Ping检测网络联通、
' 对话框:
'     提示消息:WarningInfo警告消息、TipInfo提示消息、ErrorInfo错误消息
'     输入密码:GetPassword提示输入密码、
' 文件系统:
'     复制、删除、更改属性:参考“命令行支持”。
'     INI文件处理:读写INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
'     注册表处理:RegRead读注册表、RegWrite写注册表
'     日志处理:WriteLog写文本日志
' 字符串处理:
'     提取:RegExpTest
' 程序:
'     检测:IsRun是否运行、MeIsAlreadyRun本程序是否执行、、、、
'     执行:Run前台等待执行、RunHide隐藏等待执行、RunNotWait前台不等待执行、RunHideNotWait后台不等待执行、
'     加密运行:MeEncoder
' 系统:
'     版本
'     延时:Sleep
'     发送按键:SendKeys
' 网络:
'     检测:Ping、参考“命令行支持”。
'     连接:文件共享、、、、、、、、、、
' 时间:Format_Time格式化时间、NowDateTime当前时间
' ====================================================================================================
' ====================================================================================================
' 初始化全局变量
Sub GetGloVar()
    WhoAmI = CreateObject(
"WScript.Network" ).ComputerName & "\" & CreateObject( "WScript.Network" ).UserName  
' 使用者信息
   
TmpDir = CreateObject("Scripting.FileSystemObject").getspecialfolder(2) & "\"                               ' 临时文件夹路径
   
WinDir = CreateObject("wscript.Shell").ExpandenVironmentStrings("%windir%") & "\"                           ' 本机 %Windir% 文件夹路径
   
AppDataDir = CreateObject("WScript.Shell").SpecialFolders("AppData") & "\"                                  ' 本机 %AppData% 文件夹路径
   
StartupDir = CreateObject("WScript.Shell").SpecialFolders("Startup") & "\"                                  ' 本机启动文件夹路径
   
MeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))                                  ' 脚本所在文件夹路径
   
MeName = Left( WScript.ScriptName, InStrRev(WScript.ScriptName,".") - 1 )                                   ' 取得文件名称(不包括文件后缀名)
   
MePid = GetMePid()                                                                                          ' 取得本程序PID
    ' 脚本位于共享的目录时,取得共享的电脑名(UNCHost),进行位置验证(If UNCHost <> "SerNTF02" Then WScript.Quit) ' 防止拷贝到本地运行
   
UNCHost = LCase(Mid(WScript.ScriptFullName,InStr(WScript.ScriptFullName,"\\")+2,InStr(3,WScript.ScriptFullName,"\",1)-3))
End Sub


' ====================================================================================================
' 小函数
Sub Sleep( sTime )                          ' 延时 sTime 毫秒
   
WScript.Sleep sTime
End Sub
Sub
SendKeys( strKey )                     
' 发送按键
   
CreateObject("WScript.Shell").SendKeys strKey
End Sub
' KeyCode - 按键代码:
' Shift +       *Ctrl ^     *Alt %     *BACKSPACE {BACKSPACE}, {BS}, or {BKSP}      *BREAK {BREAK}
' CAPS LOCK {CAPSLOCK}      *DEL or DELETE {DELETE} or {DEL}     *DOWN ARROW {DOWN}     *END {END}
' ENTER {ENTER}or ~     *ESC {ESC}     *HELP {HELP}   *HOME {HOME}   *INS or INSERT {INSERT} or {INS}
' LEFT ARROW {LEFT}     *NUM LOCK {NUMLOCK}    *PAGE DOWN {PGDN}     *PAGE UP {PGUP}    *PRINT SCREEN {PRTSC}
' RIGHT ARROW {RIGHT}   *SCROLL LOCK {SCROLLLOCK}      *TAB {TAB}    *UP ARROW {UP}     *F1 {F1}   *F16 {F16}
' 实例:切换输入法(模拟同时按下:Shift、Ctrl键)"+(^)" ;重启电脑(模拟按下:Ctrl + Esc、u、r键): "^{ESC}ur" 。
' 同时按键:在按 e和 c的同时按 SHIFT 键: "+(ec)" ;在按 e时只按 c(而不按 SHIFT): "+ec" 。
' 重复按键:按 10 次 "x": "{x 10}"。按键和数字间有空格。
' 特殊字符:发送 “+”、“^” 特殊的控制按键:"{+}"、"{^}"
' 注意:只可以发送重复按一个键的按键。例如,可以发送 10次 "x",但不可发送 10次 "Ctrl+x"。  
' 注意:不能向应用程序发送 PRINT SCREEN键{PRTSC}。
Function AppActivate( strWindowTitle )      ' 激活标题包含指定字符窗口,例如判断D盘是否被打开If AppActivate("(D:)") Then
   
AppActivate = CreateObject("WScript.Shell").AppActivate( strWindowTitle )
End Function


' ====================================================================================================
' ShowMsg 消息弹窗
Sub WarningInfo( strTitle, strMsg, sTime )
    CreateObject(
"wscript.Shell").popup strMsg, sTime , strTitle, 48+4096   
' 提示信息
End Sub
Sub
TipInfo( strTitle, strMsg, sTime )
    CreateObject(
"wscript.Shell").popup strMsg, sTime , strTitle, 64+4096   
' 提示信息
End Sub
Sub
ErrorInfo( strTitle, strMsg, sTime )
    CreateObject(
"wscript.Shell").popup strMsg, sTime , strTitle, 16+4096   
' 提示信息
End Sub

' ====================================================================================================
' RunApp 执行程序
Sub Run( strCmd )
    CreateObject(
"WScript.Shell").Run strCmd, 1, True      
' 正常运行 + 等待程序运行完成
End Sub
Sub
RunNotWait( strCmd )
    CreateObject(
"WScript.Shell").Run strCmd, 1, False      
' 正常运行 + 不等待程序运行完成
End Sub
Sub
RunHide( strCmd )
    CreateObject(
"WScript.Shell").Run strCmd, 0, True      
' 隐藏后台运行 + 等待程序运行完成
End Sub
Sub
RunHideNotWait( strCmd )
    CreateObject(
"WScript.Shell").Run strCmd, 0, False      
' 隐藏后台运行 + 不等待程序运行完成
End Sub

' ====================================================================================================
' CMD 命令集
' ----------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------
' 获取CMD输出
Function CmdOut(str)
   
Set ws = CreateObject("WScript.Shell")
    host = WScript.FullName
   
'Demon注:这里不用这么复杂吧,LCase(Right(host, 11))不就行了
   
If LCase( right(host, len(host)-InStrRev(host,"\")) ) = "wscript.exe" Then
        
ws.run "cscript """ & WScript.ScriptFullName & chr(34), 0
        
WScript.Quit
   
End If
    Set
oexec = ws.Exec(str)
    pid = oExec.ProcessId
    CmdOut = oExec.StdOut.ReadAll
End Function
' 检测是否运行于CMD模式
Function IsCmdMode()
    IsCmdMode =
False
    If
(LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then IsCmdMode = True
End Function
' Exist 检测文件或文件夹是否存在
Function Exist( strPath )
    Exist =
False
    Set
fso = CreateObject("Scripting.FileSystemObject")
   
If ((fso.FolderExists(strPath)) Or (fso.FileExists(strPath))) Then Exist = True
    Set
fso = Nothing
End Function
' ----------------------------------------------------------------------------------------------------
' MD 创建文件夹路径
Sub MD( ByVal strPath )
   
Dim arrPath, strTemp, valStart
    arrPath = Split(strPath,
"\")
   
If Left(strPath, 2) = "\\" Then   
' UNC Path
        
valStart = 3
        
strTemp = arrPath(0) & "\" & arrPath(1) & "\" & arrPath(2)
   
Else                              
' Local Path
        
valStart = 1
        
strTemp = arrPath(0)
   
End If
    Set
fso = CreateObject("Scripting.FileSystemObject")
   
For i = valStart To UBound(arrPath)
        strTemp = strTemp &
"\" & arrPath(i)
        
If Not fso.FolderExists( strTemp ) Then fso.CreateFolder( strTemp )
   
Next
    Set
fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' copy 复制文件或文件夹
Sub Copy( ByVal strSource, ByVal strDestination )
   
On Error Resume Next
' Required 必选
   
Set fso = CreateObject("Scripting.FileSystemObject")
   
If (fso.FileExists(strSource)) Then               
' 如果来源是一个文件
        
If (fso.FolderExists(strDestination)) Then    ' 如果目的地是一个文件夹,加上路径后缀反斜线“\”
            
fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "\", True
        Else                                          
' 如果目的地是一个文件,直接复制
            
fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
        End If
    End If                                             
' 如果来源是一个文件夹,复制文件夹
   
If (fso.FolderExists(strSource)) Then fso.CopyFolder fso.GetFolder(strSource).Path, fso.GetFolder(strDestination).Path, True
    Set
fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' del 删除文件或文件夹
Sub Del( strPath )
   
On Error Resume Next
' Required 必选
   
Set fso = CreateObject("Scripting.FileSystemObject")
   
If (fso.FileExists(strPath)) Then
        
fso.GetFile( strPath ).attributes = 0
        
fso.GetFile( strPath ).delete
   
End If
    If
(fso.FolderExists(strPath)) Then
        
fso.GetFolder( strPath ).attributes = 0
        
fso.GetFolder( strPath ).delete
   
End If
    Set
fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' attrib 改变文件属性
Sub Attrib( strPath, strArgs )    'strArgs = [+R | -R] [+A | -A ] [+S | -S] [+H | -H]
   
Dim fso, valAttrib, arrAttrib()
   
Set fso = CreateObject("Scripting.FileSystemObject")
   
If (fso.FileExists(strPath)) Then valAttrib = fso.getFile( strPath ).attributes
   
If (fso.FolderExists(strPath)) Then valAttrib = fso.getFolder( strPath ).attributes
   
If valAttrib = "" Or strArgs = "" Then Exit Sub
   
binAttrib = DecToBin(valAttrib)   
' 十进制转二进制
   
For i = 0 To 16                   ' 二进制转16位二进制
        
ReDim Preserve arrAttrib(i) : arrAttrib(i) = 0
        
If i > 16-Len(binAttrib) Then arrAttrib(i) = Mid(binAttrib, i-(16-Len(binAttrib)), 1)
   
Next
    If
Instr(1, LCase(strArgs), "+r", 1) Then arrAttrib(16-0) = 1   
'ReadOnly 1 只读文件。
   
If Instr(1, LCase(strArgs), "-r", 1) Then arrAttrib(16-0) = 0
   
If Instr(1, LCase(strArgs), "+h", 1) Then arrAttrib(16-1) = 1   
'Hidden 2 隐藏文件。
   
If Instr(1, LCase(strArgs), "-h", 1) Then arrAttrib(16-1) = 0
   
If Instr(1, LCase(strArgs), "+s", 1) Then arrAttrib(16-2) = 1   
'System 4 系统文件。
   
If Instr(1, LCase(strArgs), "-s", 1) Then arrAttrib(16-2) = 0
   
If Instr(1, LCase(strArgs), "+a", 1) Then arrAttrib(16-5) = 1   
'Archive 32 上次备份后已更改的文件。
   
If Instr(1, LCase(strArgs), "-a", 1) Then arrAttrib(16-5) = 0
   
valAttrib = BinToDec(Join(arrAttrib,""))   
' 二进制转十进制
   
If (fso.FileExists(strPath)) Then fso.getFile( strPath ).attributes = valAttrib
   
If (fso.FolderExists(strPath)) Then fso.getFolder( strPath ).attributes = valAttrib
   
Set fso = Nothing
End Sub
Function
DecToBin(ByVal number)   
' 十进制转二进制
   
Dim remainder
   remainder = number
   
Do While remainder > 0
      
DecToBin = CStr(remainder Mod 2) & DecToBin
      remainder = remainder \
2
   
Loop
End Function
Function
BinToDec(ByVal binStr)   
' 二进制转十进制
   
Dim i
   
For i = 1 To Len(binStr)
      BinToDec = BinToDec + (CInt(
Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))
   
Next
End Function
' ----------------------------------------------------------------------------------------------------
' Ping 判断网络是否联通
Function Ping(host)
   
On Error Resume Next
   
Ping = False :   If host = "" Then Exit Function
    Set
objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & host & "'")
   
For Each objStatus in objPing
        
If objStatus.ResponseTime >= 0 Then Ping = True :   Exit For
    Next
    Set
objPing = nothing
End Function

' ====================================================================================================
' 获取当前的日期时间,并格式化
Function NowDateTime()
   
'MyWeek = "周" & Right(WeekdayName(Weekday(Date())), 1) & " "
   
MyWeek = ""
   
NowDateTime = MyWeek & Format_Time(Now(),2) & " " & Format_Time(Now(),3)
End Function
Function
Format_Time(s_Time, n_Flag)
   
Dim y, m, d, h, mi, s
    Format_Time =
""
   
If IsDate(s_Time) = False Then Exit Function
   
y = cstr(year(s_Time))
    m = cstr(month(s_Time))
        
If len(m) = 1 Then m = "0" & m
    d = cstr(day(s_Time))
        
If len(d) = 1 Then d = "0" & d
    h = cstr(hour(s_Time))
        
If len(h) = 1 Then h = "0" & h
    mi = cstr(minute(s_Time))
        
If len(mi) = 1 Then mi = "0" & mi
    s = cstr(second(s_Time))
        
If len(s) = 1 Then s = "0" & s
   
Select Case n_Flag
        
Case 1
            
Format_Time = y  & m & d  & h  & mi  & s   
' yyyy-mm-dd hh:mm:ss
        
Case 2
            
Format_Time = y & "-" & m & "-" & d   
' yyyy-mm-dd
        
Case 3
            
Format_Time = h & ":" & mi & ":" & s   
' hh:mm:ss
        
Case 4
            
Format_Time = y & "年" & m & "月" & d & "日"   
' yyyy年mm月dd日
        
Case 5
            
Format_Time = y & m & d   
' yyyymmdd
   
End Select
End Function


' ====================================================================================================
' 检查字符串是否符合正则表达式
'Msgbox Join(RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Value"), VbCrLf)
'Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Count")
'Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"")
Function RegExpTest(patrn, strng, mode)
   
Dim regEx, Match, Matches      
' 建立变量。
   
Set regEx = New RegExp         ' 建立正则表达式。
        
regEx.Pattern = patrn      ' 设置模式。
        
regEx.IgnoreCase = True    ' 设置是否区分字符大小写。
        
regEx.Global = True        ' 设置全局可用性。
   
Dim RetStr, arrMatchs(), i  :  i = -1
   
Set Matches = regEx.Execute(strng)     
' 执行搜索。
   
For Each Match in Matches              ' 遍历匹配集合。
        
i = i + 1
        
ReDim Preserve arrMatchs(i)        
' 动态数组:数组随循环而变化
        
arrMatchs(i) = Match.Value
        RetStr = RetStr &
"Match found at position " & Match.FirstIndex & ". Match Value is '" & Match.Value & "'." & vbCRLF
   
Next
    If
LCase(mode) = LCase("Value") Then RegExpTest = arrMatchs      
' 以数组返回所有符合表达式的所有数据
   
If LCase(mode) = LCase("Count") Then RegExpTest = Matches.Count   ' 以整数返回符合表达式的所有数据总数
   
If IsEmpty(RegExpTest) Then RegExpTest = RetStr                   ' 返回所有匹配结果
End Function


' ====================================================================================================
' 读写注册表
' strKeyType
' [ REG_SZ    | REG_MULTI_SZ  | REG_DWORD_BIG_ENDIAN    |
'   REG_DWORD | REG_BINARY    | REG_DWORD_LITTLE_ENDIAN |
'   REG_NONE  | REG_EXPAND_SZ ]
Function RegRead( strKey )
   
On Error Resume Next
    Set
wso = CreateObject("WScript.Shell")
    RegRead = wso.RegRead( strKey )   
'strKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\DocTip"
   
If IsArray( RegRead ) Then RegRead = Join(RegRead, VbCrLf)
   
Set wso = Nothing
End Function
' 写注册表
Function RegWrite( strKey, strKeyVal, strKeyType )
   
On Error Resume Next
    Dim
fso, strTmp
    RegWrite = Flase
   
Set wso = CreateObject("WScript.Shell")
    wso.RegWrite strKey, strKeyVal, strKeyType
    strTmp = wso.RegRead( strKey )
   
If strTmp <> "" Then RegWrite = True
    Set
wso = Nothing
End Function

' ====================================================================================================
' 读写INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
' This subroutine writes a value to an INI file
'
' Arguments:
' myFilePath  [string]  the (path and) file name of the INI file
' mySection   [string]  the section in the INI file to be searched
' myKey       [string]  the key whose value is to be written
' myValue     [string]  the value to be written (myKey will be
'                       deleted if myValue is <DELETE_THIS_VALUE>)
'
' Returns:
' N/A
'
' CAVEAT:     WriteIni function needs ReadIniUnicode function to run
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
Sub WriteIniUnicode( myFilePath, mySection, myKey, myValue )
   
On Error Resume Next

    Const
ForReading   = 1
   
Const ForWriting   = 2
   
Const ForAppending = 8
   
Const TristateTrue = -1

   
Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
   
Dim intEqualPos
   
Dim objFSO, objNewIni, objOrgIni, wshShell
   
Dim strFilePath, strFolderPath, strKey, strLeftString
   
Dim strLine, strSection, strTempDir, strTempFile, strValue

    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

   
Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
   
Set wshShell = CreateObject( "WScript.Shell" )

    strTempDir  = wshShell.ExpandEnvironmentStrings(
"%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

   
Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True, TristateTrue)
   
Set objNewIni = objFSO.OpenTextFile( strTempFile, ForWriting, True, TristateTrue)
   
'Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

   
blnInSection     = False
   
blnSectionExists = False
   
' Check if the specified key already exists
   
blnKeyExists     = ( ReadIniUnicode( strFilePath, strSection, strKey ) <> "" )
    blnWritten       =
False

   
' Check if path to INI file exists, quit if not
   
strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
   
If Not objFSO.FolderExists ( strFolderPath ) Then
        
REM WScript.Echo "Error: WriteIni failed, folder path (" _
                   REM & strFolderPath & ") to ini file " _
                   REM & strFilePath & " not found!"
        
Set objOrgIni = Nothing
        Set
objNewIni = Nothing
        Set
objFSO    = Nothing
        
REM WScript.Quit 1
        
Exit Sub
    End If

    While
objOrgIni.AtEndOfStream = False
        
strLine = Trim( objOrgIni.ReadLine )
        
If blnWritten = False Then
            If
LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
               
blnSectionExists = True
               
blnInSection = True
            ElseIf
InStr( strLine, "[" ) = 1 Then
               
blnInSection = False
            End If
        End If

        If
blnInSection Then
            If
blnKeyExists Then
               
intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
               
If intEqualPos > 0 Then
                    
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    
If LCase( strLeftString ) = LCase( strKey ) Then
                        
' Only write the key if the value isn't empty
                        ' Modification by Johan Pol
                        
If strValue <> "<DELETE_THIS_VALUE>" Then
                           
objNewIni.WriteLine strKey & "=" & strValue
                        
End If
                        
blnWritten   = True
                        
blnInSection = False
                    End If
                End If
                If Not
blnWritten Then
                    
objNewIni.WriteLine strLine
               
End If
            Else
               
objNewIni.WriteLine strLine
                    
' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    
If strValue <> "<DELETE_THIS_VALUE>" Then
                        
objNewIni.WriteLine strKey & "=" & strValue
                    
End If
               
blnWritten   = True
               
blnInSection = False
            End If
        Else
            
objNewIni.WriteLine strLine
        
End If
    Wend

    If
blnSectionExists = False Then
' section doesn't exist
        
objNewIni.WriteLine
        objNewIni.WriteLine
"[" & strSection & "]"
            
' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            
If strValue <> "<DELETE_THIS_VALUE>" Then
               
objNewIni.WriteLine strKey & "=" & strValue
            
End If
    End If

   
objOrgIni.Close
    objNewIni.Close

   
' Delete old INI file
   
objFSO.DeleteFile strFilePath, True
   
' Rename new INI file
   
objFSO.MoveFile strTempFile, strFilePath

   
Set objOrgIni = Nothing
    Set
objNewIni = Nothing
    Set
objFSO    = Nothing
    Set
wshShell  = Nothing

End Sub
Function
ReadIniUnicode( myFilePath, mySection, myKey )
   
On Error Resume Next

    Const
ForReading   = 1
   
Const ForWriting   = 2
   
Const ForAppending = 8
   
Const TristateTrue = -1

   
Dim intEqualPos
   
Dim objFSO, objIniFile
   
Dim strFilePath, strKey, strLeftString, strLine, strSection

   
Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ReadIniUnicode     =
""
   
strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

   
If objFSO.FileExists( strFilePath ) Then
        Set
objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False, TristateTrue )
        
Do While objIniFile.AtEndOfStream = False
            
strLine = Trim( objIniFile.ReadLine )

            
' Check if section is found in the current line
            
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
               
strLine = Trim( objIniFile.ReadLine )

               
' Parse lines until the next section is reached
               
Do While Left( strLine, 1 ) <> "["
                    
' Find position of equal sign in the line
                    
intEqualPos = InStr( 1, strLine, "=", 1 )
                    
If intEqualPos > 0 Then
                        
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        
' Check if item is found in the current line
                        
If LCase( strLeftString ) = LCase( strKey ) Then
                           
ReadIniUnicode = Trim( Mid( strLine, intEqualPos + 1 ) )
                           
' In case the item exists but value is blank
                           
If ReadIniUnicode = "" Then
                                
ReadIniUnicode = " "
                           
End If
                           
' Abort loop when item is found
                           
Exit Do
                        End If
                    End If

                    
' Abort if the end of the INI file is reached
                    
If objIniFile.AtEndOfStream Then Exit Do

                    
' Continue with next line
                    
strLine = Trim( objIniFile.ReadLine )
               
Loop
            Exit Do
            End If
        Loop
        
objIniFile.Close
   
Else
        
REM WScript.Echo strFilePath & " doesn't exists. Exiting..."
        REM Wscript.Quit 1
        REM Msgbox strFilePath & " doesn't exists. Exiting..."
        
Exit Function
    End If
End Function

' ====================================================================================================
' 写文本日志
Sub WriteLog(str, file)
   
If (file = "") Or (str = "") Then Exit Sub
   
str = NowDateTime & "   " & str & VbCrLf
   
Dim fso, wtxt
   
Const ForAppending = 8         
'ForReading = 1 (只读不写), ForWriting = 2 (只写不读), ForAppending = 8 (在文件末尾写)
   
Const Create = True            'Boolean 值,filename 不存在时是否创建新文件。允许创建为 True,否则为 False。默认值为 False。
   
Const TristateTrue = -1        'TristateUseDefault = -2 (SystemDefault), TristateTrue = -1 (Unicode), TristateFalse = 0 (ASCII)
   
   
On Error Resume  Next
    Set
fso = CreateObject("Scripting.filesystemobject")
   
set wtxt = fso.OpenTextFile(file, ForAppending, Create, TristateTrue)
    wtxt.Write str
    wtxt.Close()
   
set fso = Nothing
    set
wtxt = Nothing
End Sub



' ====================================================================================================
' 程序控制
' 检测是否运行
Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")
   
IsRun = 0 : i = 0
   
For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
        
IF LCase(ps.name) = LCase(AppName) Then
            If
AppPath = "" Then IsRun = 1 : Exit Function
            IF
Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
        
End IF
    Next
   
IsRun = i
End Function
' ----------------------------------------------------------------------------------------------------
' 获取自身PID
Function GetMePid()
   
For Each ps In Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
        
If ((LCase(ps.name) = LCase(Right(WScript.FullName, 11))) And _
            Instr(LCase(ps.CommandLine) , LCase(WScript.ScriptFullName)))
Then
            
GetMePid = ps.ProcessID
            
Exit Function
        End If
    Next
End Function
' ----------------------------------------------------------------------------------------------------
' 检测自身是否重复运行
Function MeIsAlreadyRun()
    MeIsAlreadyRun =
False
    If
((IsRun("WScript.exe",WScript.ScriptFullName)>1) Or (IsRun("CScript.exe",WScript.ScriptFullName)>1)) Then MeIsAlreadyRun = True
End Function
' ----------------------------------------------------------------------------------------------------
' 关闭自身启动的子进程
Function Close_Me_Sub_Process()
   
Dim i
   
For i = 1 To 5
        
For Each ps In Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
            
If ((LCase(ps.name) = LCase(Right(WScript.FullName, 11))) And _
                ps.ProcessID <> MePid)
Then ps.terminate
        
Next
        
WScript.Sleep 200
   
Next
End Function
' ----------------------------------------------------------------------------------------------------
' 关闭指定程序名的其他进程
Sub Close_Process(ProcessName)
   
'On Error Resume Next
   
For each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_    '循环进程
        
If Ucase(ps.name)=Ucase(ProcessName) Then
            
ps.terminate   
'Call RunHideNotWait("ntsd.exe -c q -p " & ps.ProcessID)
        
End if
    Next
End Sub


' ====================================================================================================
' 系统
' 检查操作系统版本
Sub CheckOS()
   
If LCase(OSVer()) <> "xp" Then
        
Msgbox "不支持该操作系统!    ", 48+4096, "警告"
        
WScript.Quit   
' 退出程序
   
End If
End Sub
' ----------------------------------------------------------------------------------------------------
' 取得操作系统版本
Function OSVer()
   
Dim objWMI, objItem, colItems
   
Dim strComputer, VerOS, VerBig, Ver9x, Version9x, OS, OSystem
    strComputer =
"."
   
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
   
Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
   
For Each objItem in colItems
        VerBig = Left(objItem.Version,
3)
   
Next
    Select Case
VerBig
        
Case "6.1" OSystem = "Win7"
        
Case "6.0" OSystem = "Vista"
        
Case "5.2" OSystem = "Windows 2003"
        
Case "5.1" OSystem = "XP"
        
Case "5.0" OSystem = "W2K"
        
Case "4.0" OSystem = "NT4.0"
        
Case Else OSystem = "Unknown"
                  
If CInt(Join(Split(VerBig,"."),"")) < 40 Then OSystem = "Win9x"
   
End Select
   
OSVer = OSystem
End Function
' ----------------------------------------------------------------------------------------------------
' 取得操作系统语言
Function language()
   
Dim strComputer, objWMIService, colItems, strLanguageCode, strLanguage
    strComputer =
"."
   
Set objWMIService = GetObject("winmgmts://" &strComputer &"/root/CIMV2")
   
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
   
For Each objItem In colItems
        strLanguageCode = objItem.OSLanguage
   
Next
    Select Case
strLanguageCode
        
Case "1033" strLanguage = "en"
        
Case "2052" strLanguage = "chs"
        
Case Else  strLanguage = "en"
   
End Select
   
language = strLanguage
End Function

' ====================================================================================================
' 加密自身
Sub MeEncoder()
   
Dim MeAppPath, MeAppName, MeAppFx, MeAppEncodeFile, data
    MeAppPath = left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,
"\"))
    MeAppName = Left( WScript.ScriptName, InStrRev(WScript.ScriptName,
".") - 1 )
    MeAppFx = Right(WScript.ScriptName, Len(WScript.ScriptName) - InStrRev(WScript.ScriptName,
".") + 1 )
    MeAppEncodeFile = MeAppPath & MeAppName &
".s.vbe"
   
If Not ( LCase(MeAppFx) = LCase(".vbs") ) Then Exit Sub
    Set
fso = CreateObject("Scripting.FileSystemObject")
    data = fso.OpenTextFile(WScript.ScriptFullName,
1, False, -1).ReadAll
    data = CreateObject(
"Scripting.Encoder").EncodeScriptFile(".vbs", data, 0, "VBScript")
    fso.OpenTextFile(MeAppEncodeFile,
2, True, -1).Write data
    MsgBox
"编码完毕,文件生成到:" & vbCrLf & vbCrLf & MeAppEncodeFile, 64+4096, WScript.ScriptName
   
Set fso = Nothing
   
WScript.Quit
End Sub
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

本帖最后由 yu2n 于 2012-12-17 01:07 编辑

回复 5# Spring
个人觉得这个是面向开发者,不需要那么繁琐吧。
而且我不太专业啊。还是生手。

Ps:最近发现用 Notepad2 可以直接导出语法高亮度的UBB代码。看帖子好方便。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

VBS自定义CMD命令函数

TOP

返回列表