Question

我需要一个VB脚本来检查文件大小并捕获它，并在下一次检查中将它与之前的检查进行比较。如果大小增加，则应提示文件大小增加。

Answer 1

您可以试试这个vbscript：

Option Explicit
const bytesToKb = 1024
Dim strFile,Title
Title = "The File Size Checker by Hackoo 2015"
strFile = "C:\test.txt"
Call CheckSize(strFile)
'*****************************************************************
Sub CheckSize(File)
    Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = ws.ExpandEnvironmentStrings("%Temp%")
    MySizeFile = Temp & "\MyFileSize.txt"
    If Not fso.FileExists(MySizeFile) Then
        Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
        set objFile = fso.GetFile(strFile)
        WriteSize.Write objFile.Size
    End If
    Set ReadSize = fso.OpenTextFile(MySizeFile,1)
    LastSize = ReadSize.readall
    set objFile = fso.GetFile(strFile)
    If CLng(objFile.Size) = CLng(LastSize) Then 
    MsgBox "There is no change on file size : " & CLng(LastSize) & " bytes" & vbcr &_
    "Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbInformation,Title
    else
    Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
        MsgBox "Last File Size is : " & CLng(LastSize) & " bytes" & vbcr &_
        "New File Size is : " & objFile.Size & " bytes" & vbcr &_
        "Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
    WriteSize.Write objFile.Size 
    end if
End Sub 
'*******************************************************************

我改进了一点这个脚本来检查循环中的每一分钟是否大小改变了，如果是，它会弹出一个msgbox来通知你大小已经改变，如果没有，它会睡1分钟它会检查再一次。

Option Explicit
const bytesToKb = 1024
Dim strFile,Title
Title = "The File Size Checker by Hackoo 2015"
strFile = "C:\test.txt"
If AppPrevInstance() Then   
    MsgBox "There is an existing proceeding",VbExclamation,"There is an existing proceeding"    
    WScript.Quit   
Else   
    Do   
        Call CheckSize(strFile)
    Loop   
End If 
'*****************************************************************
Sub CheckSize(File)
    Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = ws.ExpandEnvironmentStrings("%Temp%")
    MySizeFile = Temp & "\MyFileSize.txt"
    If Not fso.FileExists(MySizeFile) Then
        Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
        set objFile = fso.GetFile(strFile)
        WriteSize.Write objFile.Size
    End If
    Set ReadSize = fso.OpenTextFile(MySizeFile,1)
    LastSize = ReadSize.readall
    set objFile = fso.GetFile(strFile)
    If CLng(objFile.Size) = CLng(LastSize) Then 
        Call Pause(1) 'To sleep for 1 minute
    else
    Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
        MsgBox strFile & vbcr &"Last Size is : " & CLng(LastSize) & " bytes" & vbcr &_
        "New Size is : " & objFile.Size & " bytes" & vbcr &_
        "Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
    WriteSize.Write objFile.Size 
    end if
End Sub 
'**************************************************************************
'Checks whether a script with the same name as this script is already running
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
        " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function   
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************
Sub Pause(Minutes)    
    Wscript.Sleep(Minutes*1000*60)    
End Sub   
'**************************************************************************

这是另一个可以在更改大小时监视和检查多个文件的approch：

Option Explicit
const bytesToKb = 1024
Dim Title,strFile,ListFiles
Title = "The File Size Checker by Hackoo 2015"
ListFiles = Array("c:\test.txt","E:\My test dossier\t.txt","E:\My test dossier\TmpLog.txt")
If AppPrevInstance() Then   
    MsgBox "There is an existing proceeding",VbExclamation,"There is an existing proceeding"    
    WScript.Quit   
Else   
    Do   
        Call Main(ListFiles)
        Call Pause(1) 'To Sleep for 1 minute
    Loop   
End If 
'******************************************************************
Sub Main(strFilesPaths)   
    Dim strFile   
    For Each strFile In strFilesPaths     
        CheckSize(strFile)   
    Next   
End Sub   
'******************************************************************
Function StripPath(Path)   
    Dim arrStr : arrStr = Split(Path,"\")   
    StripPath = arrStr(UBound(arrStr))   
End Function   
'*****************************************************************
Sub CheckSize(File)
    Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize,strFile
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = ws.ExpandEnvironmentStrings("%Temp%")
    For Each strFile In ListFiles 
        MySizeFile = Temp & "\" & StripPath(strFile)
        If Not fso.FileExists(MySizeFile) Then
            Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
            set objFile = fso.GetFile(strFile)
            WriteSize.Write objFile.Size
        End If
        Set ReadSize = fso.OpenTextFile(MySizeFile,1)
        LastSize = ReadSize.readall
        set objFile = fso.GetFile(strFile)
        If CLng(objFile.Size) = CLng(LastSize) Then 
        else
            Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
            MsgBox strFile & vbcr &"Last Size is : " & CLng(LastSize) & " bytes" & vbcr &_
            "New Size is : " & objFile.Size & " bytes" & vbcr &_
            "Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
            WriteSize.Write objFile.Size 
        end if
    Next
End Sub 
'**************************************************************************
'Checks whether a script with the same name as this script is already running
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function   
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************
Sub Pause(Minutes)    
    Wscript.Sleep(Minutes*1000*60)    
End Sub   
'**************************************************************************

用于检查文件大小是否已从上一次检查增加的VB脚本

1 个答案: