中国DOS联盟

'电脑爱好者专用版        编写：李兴旺        E-MAIL：wors_hip*163.com

MsgBox_Title_Text = "压缩的同步文件夹"
CompressionFolder = InputBox("请输入即将压缩的文件夹路径：", MsgBox_Title_Text, "C:\PHP")
If CompressionFolder = "" Then WScript.Quit

Function Interrogation(Contents)
    Dim intButton
    intButton = MsgBox(Contents, vbQuestion + vbYesNo, MsgBox_Title_Text )
    Interrogation = intButton = vbYes
End Function

Function Compression(CompressionFolder)
    FileName = "压缩的同步文件夹.vbs"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Destination = UCase(fso.GetFile(FileName).Drive) & "\"
    DIM cmd
    set fso= wscript.CreateObject("wscript.shell")
    cmd = "WINRAR A -IBCK -R " & Destination & "压缩的同步文件夹.RAR " & CompressionFolder
    fso.run cmd
    MsgBox "成功把 " & CompressionFolder & " 文件夹压缩到 " & Destination, vbInformation, MsgBox_Title_Text
End Function

If Interrogation("定时压缩文件夹，同步数据到闪盘，请点击“是”！" & vbCrLf & "马上压缩文件夹，同步数据到闪盘，请点击“否”！") Then
    Savetime = InputBox("请输入24 小时格式 (hh:mm) 的时间：", MsgBox_Title_Text, "11:30")
    If Savetime = "" Then WScript.Quit
    MsgBox "已经运行了定时压缩文件夹，请不要重复运行！", vbExclamation, MsgBox_Title_Text
    Dim Check
    Check = True
    Do
        HHMM = FormatDateTime(Time, 4)
        If HHMM = Savetime Then
            Compression(CompressionFolder)
            Exit Do
        End If
    Loop Until Check = False
Else
    Compression(CompressionFolder)
End If