批处理之家 - Powered by Discuz! Board

Set ws = CreateObject("Wscript.Shell")
Set dict = WSH.CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
dstFolder = "." '指定截图保存目录，默认为当前目录下
ext = "jpg" '指定截图文件格式，支持jpg/gif/png/bmp
interval = 1000 '指定截屏间歇时间(毫秒)
If Left(ext, 1) = "." Then ext = Right(ext, 3)
If Right(dstFolder, 1) <> "\" Then dstFolder=dstFolder&"\"
arr = Split(dstFolder, "\")
arrFolder = arr(0)
For i = 1 To UBound(arr) -1
arrFolder = arrFolder & "\" & arr(i)
If Not fso.FolderExists(arrFolder) Then fso.CreateFolder(arrFolder)
Next
dict.Add "jpg", "ImageFormat.Jpeg"
dict.Add "gif", "ImageFormat.Gif"
dict.Add "png", "ImageFormat.Png"
dict.Add "bmp", "ImageFormat.Bmp"
Set tmp = fso.GetSpecialFolder(2)
Set systemroot = fso.GetSpecialFolder(0)
net = systemroot&"\Microsoft.NET\Framework"
Call CreateCs
Set SubFolders = fso.GetFolder(net).SubFolders
For Each Folder In SubFolders
If fso.FileExists(Folder&"\csc.exe") Then
cscpath = Folder&"\csc.exe"
Exit For
End If
Next
If cscpath = "" Then
Msgbox "未安装Microsoft .NET Framework 2.0及以上版本组件或是相关程序缺失！"
WSH.Quit
Else
'调用csc.exe编译cs文件
ws.Run cscpath&" /out:"""&tmp&"\$PrtSc.exe"" """&tmp&"\$PrtSc.cs""", 0, True
End If
Do
ws.Run tmp&"\$PrtSc.exe", 0, True '执行截屏
WSH.Sleep interval
Loop '退出程序需从任务管理器结束wscript.exe进程
Function CreateCs
Set cs = fso.CreateTextFile(tmp&"\$PrtSc.cs", 2)
cs.Write _
"using System.Drawing;using System.Drawing.Imaging;using System.Windows.Forms;" & vbCrLf & _
"public class MyClass{" & vbCrLf & _
" public static void Main(){" & vbCrLf & _
" Image img = new Bitmap(Screen.AllScreens[0].Bounds.Width, Screen.AllScreens[0].Bounds.Height);" & vbCrLf & _
" Graphics g = Graphics.FromImage(img);" & vbCrLf & _
" g.CopyFromScreen(new Point(0, 0), new Point(0, 0), Screen.AllScreens[0].Bounds.Size);" & vbCrLf & _
" string dt = System.DateTime.Now.ToString(""yyyyMMddHHmmss-fff"");" & vbCrLf & _
" img.Save("""&replace(fso.GetFolder(dstFolder).Path,"\","\\")&"\\""+dt+""."&Lcase(ext)&""", "&dict.Item(Lcase(ext))&");}}"
End Function