发信人: foxzz()
整理人: foxzz(2004-10-12 09:34:53), 站内信件
|
调用方法：? killprocess("MYPROJ.EXE")
*!***********************************************
FUNC killprocess
PARAMETERS p_KillName
#Define TH32CS_SNAPPROCESS 2
Declare INTEGER CreateToolhelp32Snapshot IN kernel32 INTEGER lFlags , INTEGER lProcessID
Declare INTEGER Process32First IN kernel32 INTEGER hSnapShot , STRING @uProcess
Declare INTEGER Process32Next IN kernel32 INTEGER hSnapShot ,STRING @uProcess
Declare INTEGER TerminateProcess IN kernel32 INTEGER ApphProcess, INTEGER uExitCode
Declare INTEGER OpenProcess IN kernel32 INTEGER dwDesiredAccess , INTEGER bInheritHandle, INTEGER dwProcessId
Declare INTEGER CloseHandle IN kernel32 INTEGER hObject
local rProcessFound,hSnapShot,szExename,exitCode,myProcess ,iFound
LOCAL KillApp
KillApp = 0
LOCAL louProcess, hPrinter, lcSrvName, lcPrnName, lcDrvName, lcStr
louProcess = CREATE("struct_PROCESSENTRY32")
louProcess.fld('dwSize') = 296
lcBuff = louProcess.Structure
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
rProcessFound = Process32First(hSnapShot, @lcBuff)
LOCAL M_szExeFile,M_th32ProcessID,m_lnVal
Do While rProcessFound <> 0
m_lnVal = SUBSTR(lcBuff,37,260)
M_szExeFile= fTypeToVal(m_lnVal,"STRING")
iFound = at(Chr(0), M_szExeFile)
If iFound > 0
szExename = upper(Left(M_szExeFile, iFound))
If LEFT(szExename, Len(p_KillName)) = upper(p_KillName)
m_lnVal = SUBSTR(lcBuff,9,4)
M_th32ProcessID = fTypeToVal(m_lnVal,"LONG")
myProcess = OpenProcess(1, 0, M_th32ProcessID)
KillApp = TerminateProcess(myProcess, exitCode)
=CloseHandle(myProcess)
EndIf
EndIf
rProcessFound = Process32Next(hSnapShot, @lcBuff)
enddo
=CloseHandle(hSnapShot)
return KillApp
*!******************************************************************
DEFINE CLASS struct_PROCESSENTRY32 AS Struct_William
PROCEDURE Init
THIS.AddField( 'dwSize', 'LONG', 0 )
THIS.AddField( 'cntUsage', 'LONG', 0 )
THIS.AddField( 'th32ProcessID', 'LONG', 0 )
THIS.AddField( 'th32DefaultHeapID', 'LONG', 0 )
THIS.AddField( 'th32moduleID', 'LONG', 0 )
THIS.AddField( 'cntThreads', 'LONG', 0 )
THIS.AddField( 'th32ParentProcessID', 'LONG', 0 )
THIS.AddField( 'pcPriClassBase', 'LONG', 0)
THIS.AddField( 'dwFlags', 'LONG', 0)
THIS.AddField( 'szExeFile', 'STRING', SPACE(260) )
ENDPROC
ENDDEFINE
****************************************************************************
DEFINE CLASS Struct_William AS Session
*DEFINE CLASS Struct_William
* Author: William GC Steinford
* Purpose: This class simplifies creating structures to pass to Api routines,
* and retrieving values out of structures changed by Api routines.
* Usage: Just subclass this class, and override the Init event, calling
* AddField( 'fieldname', 'type', starting_value )
* once for each field in the structure.
* Notes: PCHAR fields are automatically allocated, destroyed, and de-referenced
* whenever needed.
* Sub-Structures can be handled by defining them as an "@STRING",
* creating a second class/object for the substructure,
* then assigning the sub-structure's ".Structure" property
* to the parent structure's @STRING field
*
DIMENSION arrFields[1,5]
DIMENSION Fld[1]
&& Name, Type, Pos, Len, MemAddr
FieldCount = 0
Structure = ''
DataSession = 1 && Default DataSession
FUNCTION AddField( pcField, pcType, pvValue )
LOCAL lcEnc
THIS.FieldCount = THIS.FieldCount + 1
DIMENSION THIS.arrFields[THIS.FieldCount,5]
THIS.arrFields[THIS.FieldCount,1] = upper(pcField)
THIS.arrFields[THIS.FieldCount,2] = pcType
THIS.arrFields[THIS.FieldCount,3] = LEN(THIS.Structure)+1
THIS.arrFields[THIS.FieldCount,4] = THIS.TypeLen(pcType,pvValue)
lcEnc = THIS.ValToType(pvValue,pcType,THIS.arrFields[THIS.FieldCount,4])
THIS.Structure = THIS.Structure + lcEnc
ENDFUNC
FUNCTION TypeLen( pcType, pvVal )
DO CASE
CASE Inlist(upper(pcType),'INTEGER','WORD')
RETURN 2
CASE Inlist(upper(pcType),'LONG','DOUBLE','DWORD')
RETURN 4
CASE Inlist(upper(pcType),'@STRING')
RETURN 4
CASE Inlist(upper(pcType),'STRING')
RETURN len(pvVal)
ENDCASE
ENDFUNC
FUNCTION ValToType( pvVal, pcType, pnLen )
* Convert a value of the given type to the Struct Encoding
LOCAL lnRet
DO CASE
CASE Inlist(upper(pcType),'INTEGER','WORD')
ASSERT Type('pvVal')='N' MESSAGE "Incorrect Type"
RETURN Chr(MOD(pvVal,256)) + CHR(INT(pvVal/256))
CASE Inlist(upper(pcType),'LONG','DOUBLE','DWORD')
ASSERT Type('pvVal')='N' MESSAGE "Incorrect Type"
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
LOCAL b0, b1, b2, b3
b3 = Int(pvVal/m2)
b2 = Int((pvVal - b3*m2)/m1)
b1 = Int((pvVal - b3*m2 - b2*m1)/m0)
b0 = Mod(pvVal, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
CASE upper(pcType)='STRING'
ASSERT Type('pvVal')='C' MESSAGE "Incorrect Type"
RETURN PadR(pvVal,pnLen,chr(0))
CASE upper(pcType)='@STRING'
ASSERT Type('pvVal')='C' MESSAGE "Incorrect Type"
if len(pvVal)=1 and asc(pvVal)=0 && NULL pointer
RETURN THIS.ValToType(0,'LONG')
endif
Declare LONG GlobalAlloc IN "kernel32" LONG wFlags, LONG dwBytes
lnRet = GlobalAlloc(0,len(pvVal))
Declare LONG RtlMoveMemory IN "kernel32" ;
LONG ptrIntoHere, STRING @ cFromHere, LONG cb
RtlMoveMemory(lnRet,@pvVal,len(pvVal))
RETURN THIS.ValToType(lnRet,'LONG')
ENDCASE
ENDFUNC
FUNCTION TypeToVal( pcVal, pcType )
* Convert a struct encoded Type back to it's original value
LOCAL lnPtr, lcRet
DO CASE
CASE Inlist(upper(pcType),'INTEGER','WORD')
RETURN Asc(SUBSTR(pcVal, 1,1)) + ;
Asc(SUBSTR(pcVal, 2,1)) * 256
CASE Inlist(upper(pcType),'LONG','DOUBLE','DWORD')
RETURN Asc(SUBSTR(pcVal, 1,1)) + ;
Asc(SUBSTR(pcVal, 2,1)) * 256 +;
Asc(SUBSTR(pcVal, 3,1)) * 65536 +;
Asc(SUBSTR(pcVal, 4,1)) * 16777216
CASE upper(pcType)='STRING'
RETURN pcVal
CASE upper(pcType)='@STRING'
lnPtr = THIS.TypeToVal( pcVal, 'LONG' )
Declare LONG GlobalSize IN "Kernel32" LONG HGLOBAL_hMem
lnLen = GlobalSize(lnPtr)
ASSERT lnLen>0 MESSAGE "Could not determine length of string."
lcRet = SPACE(lnLen)
Declare LONG RtlMoveMemory IN "kernel32" ;
STRING @ cIntoHere, LONG ptrFromHere, LONG cb
RtlMoveMemory(@lcRet,lnPtr,lnLen)
RETURN lcRet
ENDCASE
ENDFUNC
FUNCTION Fld_Access( pncIdx )
LOCAL lnIdx, lnVal
if type('pncIdx')='N'
lnIdx = pncIdx
else
ASSERT type('pncIdx')='C' MESSAGE "Must provide numeric or character Index!"
lnIdx = ASCAN(THIS.arrFields,upper(pncIdx))
ASSERT lnIdx>0 MESSAGE "Field not found"
lnIdx = ASUBSCRIPT(THIS.arrFields,lnIdx,1)
endif
lnVal = SUBSTR(THIS.Structure,THIS.arrFields[lnIdx,3],THIS.arrFields[lnIdx,4])
RETURN THIS.TypeToVal(lnVal,THIS.arrFields[lnIdx,2])
ENDFUNC
FUNCTION Fld_Assign( pvNewVal, pncIdx )
LOCAL lcBuf, lnIdx, lnVal, lcNewVal, lnPtr
if type('pvNewVal.Structure')='C' && substructure... take string version
lcNewVal = pvNewVal.Structure
else
lcNewVal = pvNewVal
endif
if type('pncIdx')='N'
lnIdx = pncIdx
else
ASSERT type('pncIdx')='C' MESSAGE "Must provide numeric or character Index!"
lnIdx = ASCAN(THIS.arrFields,upper(pncIdx))
ASSERT lnIdx>0 MESSAGE "Field not found"
lnIdx = ASUBSCRIPT(THIS.arrFields,lnIdx,1)
endif
if THIS.arrFields[lnIdx,2]='@STRING'
Declare LONG GlobalFree IN "kernel32" LONG hmem
THIS.arrFields[lnIdx,2] = 'LONG' && Not going to be a pointer much longer.
lnPtr = THIS.fld[lnIdx] && get it as a LONG pointer
THIS.arrFields[lnIdx,2] = '@STRING'
if lnPtr>0
GlobalFree(lnPtr)
endif
endif
lcBuf = THIS.ValToType(lcNewVal,THIS.arrFields[lnIdx,2],THIS.arrFields[lnIdx,4])
THIS.Structure = STUFF( THIS.Structure, THIS.arrFields[lnIdx,3], THIS.arrFields[lnIdx,4], lcBuf )
ENDFUNC
FUNCTION Destroy
LOCAL lnI, lnPtr
Declare LONG GlobalFree IN "kernel32" LONG hmem
for lnI = 1 to THIS.FieldCount
if THIS.arrFields[lnI,2]='@STRING'
THIS.arrFields[lnI,2] = 'LONG' && Not going to be a pointer much longer.
lnPtr = THIS.fld[lnI] && get it as a LONG pointer
GlobalFree(lnPtr) && Now, it really is no longer a pointer
endif
endfor
ENDFUNC
ENDDEFINE
----
天行健，君子以自强不息
|
|