[GH-ISSUE #309] 改进 WINDOWS 的 VBS, 解决运行时间长网络变慢, 且无法结束proxy进程等问题 #228

New issue

Open

opened 2026-02-27 23:16:04 +03:00 by kerem · 0 comments

kerem commented

2026-02-27 23:16:04 +03:00

Owner

Originally created by @ABC333Love on GitHub (Aug 10, 2019).
Original GitHub issue: https://github.com/snail007/goproxy/issues/309


Option Explicit

' 设置全局脚本参数
Const HIDDEN_WINDOW = 0 ' 隐藏显示
Const EXEC_FILE ="proxy.exe" ' 运行进程名
Const EXEC_ARGS = "socks -t tcp -p ""0.0.0.0:38080""" ' 运行参数
Const REMINTE = 10 ' 多少分钟重启一次进程,设置为-1则执行完毕后自动退出

' 创建对象
Dim fs,sh
Set fs = CreateObject("Scripting.FileSystemObject")
Set sh = CreateObject("wscript.shell")

' 函数_WMI执行命令行
Function execCmdLine(cmdLine, show)
	on error resume Next
	err.Clear
    Dim dt,ws,ps,st,cf,er,pid
    Set dt = CreateObject("Scripting.Dictionary")
    Set ps = GetObject("winmgmts:root\cimv2:Win32_Process")
    Set ws = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set st = ws.Get("Win32_ProcessStartup")
    Set cf = st.SpawnInstance_
    cf.ShowWindow = show
    er = ps.Create( cmdLine , Null, cf, pid)
    dt.Add "err", er
    dt.Add "pid", pid
    Set ps = Nothing
    Set ws = Nothing
    Set st = Nothing
    Set cf = Nothing
    Set execCmdLine = dt
End Function

' 函数_结束进程PID
Sub killPid(pid)
	on error resume Next
	err.Clear
	Dim ws,pl,ps
	Set ws = GetObject("winmgmts:\\.\root\cimv2")
	Set pl = ws.ExecQuery("Select * from Win32_Process Where ProcessID = " & pid)
	For Each ps in pl
	    ps.Terminate()
	Next
	Set ws = Nothing
	Set pl = Nothing
End Sub

' 函数_结束进程PID从文件读
Sub killPidReadFile(fileName)
	on error resume Next
	err.Clear
	Dim f,fso,pid
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.OpenTextFile(fileName, 1, False)
	If err.Number = 0 Then
		pid = CInt(f.ReadAll)
		f.Close
		fso.DeleteFile fileName, True
		If pid > 0 Then
			Call killPid(pid)
		End If
	Else
		err.clear
	End If
	Set fso = Nothing
	Set f = Nothing
End Sub

' 初始化参数
Dim cFile,qFile,sFile,cPath,ePid,sPid,cLine
cFile = WScript.ScriptFullName 'vbsFullName
cPath = fs.GetFile(cFile).ParentFolder.Path 'vbsPath
cFile = cPath & "\" & EXEC_FILE 'execFileFullName
sFile = fs.GetFile(cFile).ShortPath 'execFileShortPath
qFile = Chr(34) & sFile & Chr(34) 'WithChinese
ePid = cPath & "\ePid.txt" 'ePidShortPath
cLine = qFile & " " & EXEC_ARGS 'commandLine

' 文件不存在
If fs.fileExists(sFile) = False Then
    MsgBox cFile,vbOKOnly,"文件不存在"
    WScript.Quit
End If

' 启动任务
Do While True
	
	' 结束任务进程
	Call killPidReadFile(ePid)
	
	' 运行命令
	Dim rs
	Set rs = execCmdLine(cLine, HIDDEN_WINDOW)
	
	' 记录进程PID
	If rs.Item("err") = 0 Then
		With fs.CreateTextFile(ePid, True)
		    .Write(rs.Item("pid"))
		    .Close
		End With
	End If
	
	' 延时重启
	Dim vbsBegin,vbsEnd,vbsDiff,reMin
	vbsBegin = Timer()
	reMin = REMINTE * 60 '分钟
	
	Do 
		WScript.Sleep(1000)
		vbsEnd = Timer()
		vbsDiff = vbsEnd - vbsBegin
	Loop While vbsDiff < reMin
	
Loop

Originally created by @ABC333Love on GitHub (Aug 10, 2019). Original GitHub issue: https://github.com/snail007/goproxy/issues/309 ```vbs Option Explicit ' 设置全局脚本参数 Const HIDDEN_WINDOW = 0 ' 隐藏显示 Const EXEC_FILE ="proxy.exe" ' 运行进程名 Const EXEC_ARGS = "socks -t tcp -p ""0.0.0.0:38080""" ' 运行参数 Const REMINTE = 10 ' 多少分钟重启一次进程,设置为-1则执行完毕后自动退出 ' 创建对象 Dim fs,sh Set fs = CreateObject("Scripting.FileSystemObject") Set sh = CreateObject("wscript.shell") ' 函数_WMI执行命令行 Function execCmdLine(cmdLine, show) on error resume Next err.Clear Dim dt,ws,ps,st,cf,er,pid Set dt = CreateObject("Scripting.Dictionary") Set ps = GetObject("winmgmts:root\cimv2:Win32_Process") Set ws = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set st = ws.Get("Win32_ProcessStartup") Set cf = st.SpawnInstance_ cf.ShowWindow = show er = ps.Create( cmdLine , Null, cf, pid) dt.Add "err", er dt.Add "pid", pid Set ps = Nothing Set ws = Nothing Set st = Nothing Set cf = Nothing Set execCmdLine = dt End Function ' 函数_结束进程PID Sub killPid(pid) on error resume Next err.Clear Dim ws,pl,ps Set ws = GetObject("winmgmts:\\.\root\cimv2") Set pl = ws.ExecQuery("Select * from Win32_Process Where ProcessID = " & pid) For Each ps in pl ps.Terminate() Next Set ws = Nothing Set pl = Nothing End Sub ' 函数_结束进程PID从文件读 Sub killPidReadFile(fileName) on error resume Next err.Clear Dim f,fso,pid Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(fileName, 1, False) If err.Number = 0 Then pid = CInt(f.ReadAll) f.Close fso.DeleteFile fileName, True If pid > 0 Then Call killPid(pid) End If Else err.clear End If Set fso = Nothing Set f = Nothing End Sub ' 初始化参数 Dim cFile,qFile,sFile,cPath,ePid,sPid,cLine cFile = WScript.ScriptFullName 'vbsFullName cPath = fs.GetFile(cFile).ParentFolder.Path 'vbsPath cFile = cPath & "\" & EXEC_FILE 'execFileFullName sFile = fs.GetFile(cFile).ShortPath 'execFileShortPath qFile = Chr(34) & sFile & Chr(34) 'WithChinese ePid = cPath & "\ePid.txt" 'ePidShortPath cLine = qFile & " " & EXEC_ARGS 'commandLine ' 文件不存在 If fs.fileExists(sFile) = False Then MsgBox cFile,vbOKOnly,"文件不存在" WScript.Quit End If ' 启动任务 Do While True ' 结束任务进程 Call killPidReadFile(ePid) ' 运行命令 Dim rs Set rs = execCmdLine(cLine, HIDDEN_WINDOW) ' 记录进程PID If rs.Item("err") = 0 Then With fs.CreateTextFile(ePid, True) .Write(rs.Item("pid")) .Close End With End If ' 延时重启 Dim vbsBegin,vbsEnd,vbsDiff,reMin vbsBegin = Timer() reMin = REMINTE * 60 '分钟 Do WScript.Sleep(1000) vbsEnd = Timer() vbsDiff = vbsEnd - vbsBegin Loop While vbsDiff < reMin Loop ```