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

VB script to check if the file size has been increased from the previous check

我需要一个 VB 脚本来检查文件大小并捕获它,并在下一次检查中将其与上一次检查进行比较。如果大小增加了,应该提示File size increased.

你可以试试这个 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 
'*******************************************************************

我对这个脚本做了一点改进,在循环中每分钟检查一次大小是否更改,如果是,它将弹出一个消息框通知您大小已更改,如果没有,它会休眠 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   
'**************************************************************************

这是另一种可以监控和检查多个文件大小变化的方法:

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   
'**************************************************************************