VBS枚举当前所有进程并保存到配置文件中 - TC官方合作论坛

On Error Resume Next
inipath=getfolder&"\Config.ini"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(inipath) Then
objFSO.DeleteFile(inipath)
End If
Set objFile = objFSO.CreateTextFile(inipath)
Set objFile =nothing
Set objTextFile = objFSO.OpenTextFile (inipath, 8, True)
objTextFile.WriteLine("[Process]")
objTextFile.Close
Set objTextFile =nothing
Set objFSO =nothing
Dim Cells(10000,4)
call tt()
Sub tt()
st = "."
Set objp = GetObject("winmgmts:\\" & st)
Set objs = objp.instancesof("Win32_Process")
i = 1
For Each ps In objs
Cells(i, 1) = ps.Name
Cells(i, 2) = ps.ProcessID
Cells(i, 3) = ps.commandline
Call WriteINI(inipath,"Process","Process"&i,Cells(i, 1)&"||"&Cells(i, 2))
i = i + 1
Next
Call WriteINI(inipath,"Process","ProcessT","OK")
End Sub
'VBS获取自身所在文件夹
Function getfolder()
getfolder=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\")-1)
end Function
'VBS读取.INI文件键值
Function ReadINI(FilePath,Bar,PrimaryKey)
Dim iniFileSys,sReadLine,i,j,ss
ss=""
Set iniFileSys=CreateObject("Scripting.FileSystemObject")
If iniFileSys.FileExists(FilePath) Then
Set INIfile=iniFileSys.opentextfile(FilePath,1)
do until INIfile.atendofstream
sReadLine=INIfile.readline
If Trim(sReadLine)="["& Bar &"]" then '找到小节名
'查找该小节名下的键名
Do until INIfile.atendofstream
sReadLine=INIfile.readline '读取小节名后的行
j=instr(sReadLine,"=")
If j>0 then '小节名后的文本行存在
If instr(Left(sReadLine,j),PrimaryKey)>0 then '从"="左边字符串找到键名
ss = Trim(Right(sReadLine,len(sReadLine)-instr(sReadLine,"=")))
Exit do
'Else
'INIfile.skipline '没找到键名跳过此行
End If
'Else
'INIfile.skipline
End If
Loop
End If
loop
INIfile.close
end if
Set iniFileSys=nothing
ReadINI = ss
End Function
'VBS修改.INI文件键值
Function WriteINI(FilePath, Bar, PrimaryKey, Value)
C**t ForReading=1
C**t ForWriting=2
C**t ForAppending=8
Dim iniFileSys, sRead, i, j, sReadLine, BE, stxt
Set iniFileSys=CreateObject("Scripting.FileSystemObject")
Set ForRead=iniFileSys.opentextfile(FilePath,1)
Dim a() '文本内容逐行放入数组
i=0
j=0
BE=0
sRead=ForRead.ReadAll
ForRead.close
If Instr(sRead,"[")=0 then '说明INI文件没有主键,那么写入主键和键值即可
Set ForWrite=iniFileSys.opentextfile(FilePath,2)
ForWrite.WriteLine "["& Bar &"]"
ForWrite.WriteLine PrimaryKey &"="& Value
Else
Dim sArray
sArray=split(sRead,"[")
For i=1 to UBound(sArray)
If Left(sArray(i),Len(Bar))=Bar then '小节名存在
If Instr(sArray(i),PrimaryKey)>0 then '找到键名
Set ForRead=iniFileSys.opentextfile(FilePath,1)
Do Until ForRead.AtEndOfStream
sReadLine = ForRead.ReadLine
If Instr(sReadLine,"["& Bar &"]")>0 then
While Instr(sReadLine,PrimaryKey)<1 '读到键名为止
sReadLine = ForRead.ReadLine
Wend
stxt =sReadLine
'valueline=Len(sReadLine)-len(Left(sReadLine,instr(sReadLine,"=")))
'stxt = Right(sReadLine,valueline)
Exit do
End If
Loop
sArray(i)=Replace(sArray(i), stxt, PrimaryKey &"="& Value) '将键值替换为Value
Else
sArray(i)=Replace(sArray(i),Bar&"]",Bar&"]"& vbcrlf & PrimaryKey &"="& Value)
'sArray(i)=sArray(i)& vbcrlf & PrimaryKey &"="& Value
End If
'msgbox Value
BE=1
Else
End If
Next
If BE=1 then 'BE=1说明小节名存在,用数组配置好了键名与键值
ForRead.close
Set ForWrite=iniFileSys.opentextfile(FilePath,2) '覆盖原有内容重新写入
ForWrite.Write ""
ForWrite.close
Set ForWrite=iniFileSys.opentextfile(FilePath,8) '清空并追加写入内容
i=0
For i=1 to UBound(sArray)
ForWrite.Write "["& sArray(i)
Next
ForWrite.close
Set iniFileSys=nothing
Exit Function
End If
ForRead.close '写入小节名和键值
Set ForWrite=iniFileSys.opentextfile(FilePath,8)
ForWrite.WriteLine "["& Bar &"]"
ForWrite.WriteLine PrimaryKey &"="& Value
End If
ForWrite.close
Set iniFileSys=nothing
End Function

复制代码