#include <stdio.h>
#include <windows.h>

typedef DWORD(__stdcall *CPP) (DWORD param1, PWCHAR param2, DWORD param3);
void Disable_WFP()
{
HINSTANCE hmod=LoadLibrary("sfc_os.dll");
CPP SetSfcFileException;
// the function is stored at the fifth ordinal in sfc_os.dll
SetSfcFileException= (CPP)GetProcAddress(hmod,(LPCSTR)5);
SetSfcFileException(0, L"c:\\windows\\system32\\calc.exe",-1);
//Now we can modify the system file in a complete stealth.
}

void main()
{
Disable_WFP();
}

运行后，删除 C:\WINDOWS\SYSTEM32\CALC.EXE 文件，不会自动恢复
Windows2K3 CN SP1 VC6 测试通过
好像说重启后会恢复，这个未测试，所以叫暂停。

VarType() 函数返回的是 integer 型值，这个函数返回的是字符串。

Public Function getDataType(v As Variant) As String
Select Case VarType(v)
Case vbArray
getDataType = "vbArray"
Case vbBoolean
getDataType = "vbBoolean"
Case vbByte
getDataType = "vbByte"
Case vbCurrency
getDataType = "vbCurrency"
Case vbDataObject
getDataType = "vbDataObject"
Case vbDate
getDataType = "vbDate"
Case vbDecimal
getDataType = "vbDecimal"
Case vbDouble
getDataType = "vbDouble"
Case vbEmpty
getDataType = "vbEmpty"
Case vbError
getDataType = "vbError"
Case vbInteger
getDataType = "vbInteger"
Case vbLong
getDataType = "vbLong"
Case vbNull
getDataType = "vbNull"
Case vbObject
getDataType = "vbObject"
Case vbSingle
getDataType = "vbSingle"
Case vbString
getDataType = "vbString"
Case vbUserDefinedType
getDataType = "vbUserDefinedType"
Case vbVariant
getDataType = "vbVariant"
Case Else
getDataType = "Unknown Data Type"
End Select
End Function

函数名称：
1、ParameterValue()
2、ParameterCount()

用法示例：
Dim StrTest as String
StrTest="欢迎;光临;JiaJia;Blog;VB源码"
Debug.Print ParameterCount(";",StrTest)
'返回 5
Debug.Print ParameterValue(";",StrTest,3)
'返回 "JiaJia"

函数源码：

Public Function ParameterCount(ParseCharacter As String, _
tString As Variant) As Integer
Dim CurrentPosition As Integer
Dim ParseToPosition As Integer
Dim CurrentToken As Integer
Dim TempString As String
TempString = Trim(tString) + ParseCharacter
If Len(TempString) = 1 Then Exit Function
CurrentPosition = 1
CurrentToken = 1

Do
ParseToPosition = InStr(CurrentPosition, TempString, _
ParseCharacter)
CurrentToken = CurrentToken + 1
CurrentPosition = ParseToPosition + 1
Loop Until (CurrentPosition >= Len(TempString))
ParameterCount = CurrentToken - 1
End Function


Public Function ParameterValue(ParseCharacter As String, _
tString As Variant, _
Index As Integer) As String
Dim CurrentPosition As Integer
Dim ParseToPosition As Integer
Dim CurrentToken As Integer
Dim TempString As String
TempString = Trim(tString) + ParseCharacter
If Len(TempString) = 1 Then Exit Function
CurrentPosition = 1
CurrentToken = 1

Do
ParseToPosition = InStr(CurrentPosition, TempString, _
ParseCharacter)

If Index = CurrentToken Then
ParameterValue = Mid$(TempString, CurrentPosition, _
ParseToPosition - CurrentPosition)
Exit Function
End If
CurrentToken = CurrentToken + 1
CurrentPosition = ParseToPosition + 1
Loop Until (CurrentPosition >= Len(TempString))
End Function

Option Explicit
'
' APIs needed to manipulate the RAW SID
'
Declare Function AllocateAndInitializeSid Lib "advapi32.dll" _
(pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, _
ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, _
ByVal nSubAuthority7 As Long, lpPSid As Long) As Long

Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)

Declare Function LookupAccountSid Lib "advapi32.dll" _
Alias "LookupAccountSidA" (ByVal lpSystemName As String, _
ByVal Sid As Long, ByVal Name As String, cbName As Long, _
ByVal ReferencedDomainName As String, _
cbReferencedDomainName As Long, peUse As Integer) As Long

Private Declare Function InitializeSid Lib "advapi32.dll" _
(ByVal Sid As Long, ByVal pIndentifierAuthority As Long, _
ByVal nSubAuthorityCount As Byte) As Long

Private Declare Function GetSidSubAuthority Lib "advapi32.dll" _
(ByVal Sid As Long, ByVal nSubAuthority As Long) As Long

Private Declare Function GetSidSubAuthorityCount Lib "advapi32.dll" _
(ByVal Sid As Long) As Long

Private Declare Function GetSidIdentifierAuthority Lib "advapi32.dll" _
(ByVal Sid As Long) As Long

Private Declare Function GetSidLengthRequired Lib "advapi32.dll" _
(ByVal nSubAuthorityCount As Byte) As Long

'
' APIs needed to manipulate pointers in VB
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Declare Sub CopyDWORDFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest As Long, ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Private Declare Sub CopyDWORD Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest As Long, hpvSource As Long, ByVal cbCopy As Long)

Private Declare Function GetProcessHeap Lib "kernel32" <
font color="#000000">() As Long

Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal lpMem As Long) As Long

'
' APIs, structures, and constants necessary to obtain the domain SID
'
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long

Private Declare Function NetUserModalsGet Lib "netapi32" _
(ByVal serverName As Long, ByVal level As Long, _
BufPtr As Long) As Long

Type USER_MODALS_INFO_2
usrmod2_domain_name As Long
usrmod2_domain_id As Long
End Type

Public Const NERR_Success = 0

'
' Constants from WINNT.H for the various well-known SIDs, users and groups
'
Public Const SECURITY_WORLD_SID_AUTHORITY = &H1
Public Const SECURITY_NT_AUTHORITY = &H5

Public Const SECURITY_BUILTIN_DOMAIN_RID = &H20&
Public Const DOMAIN_ALIAS_RID_ADMINS = &H220&
Public Const DOMAIN_ALIAS_RID_USERS = &H221&
Public Const SECURITY_LOCAL_SYSTEM_RID = &H12
Public Const SECURITY_WORLD_RID = &H0

Public Const DOMAIN_USER_RID_ADMIN = &H1F4
Public Const DOMAIN_USER_RID_GUEST = &H1F5

Public Const DOMAIN_GROUP_RID_ADMINS = &H200

Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type

'
' Helper function to lookup a SID and display the name as a test
'
Public Sub DisplayNameOfSid(ByVal lSid As Long)

Dim result As Long
Dim userName As String
Dim cbUserName As Long
Dim domainName As String
Dim cbDomainName As Long
Dim peUse As Integer

' Lookup the constructed SID to get the name
userName = Space(255)
domainName = Space(255)
cbUserName = 255
cbDomainName = 255
result = LookupAccountSid(vbNullString, lSid, userName, cbUserName, _
domainName, cbDomainName, peUse)

If result <> 0 Then
MsgBox userName
End If

End Sub

Public Function GetWellKnownUserSIDFromRID(ByVal Rid As Long) As Long

Dim userInfo As USER_MODALS_INFO_2
Dim wszServerName() As Byte
Dim BufPtr As Long
Dim result As Long
Dim pSid As Long
Dim Index, Count As Long
Dim SubAuthorityCount As Byte
Dim domainName As String
Dim cbDomainName As Long
Dim peUse As Integer
Dim srcPtr As Long
Dim dstPtr As Long

GetWellKnownUserSIDFromRID = 0

' Get the SID of the local machine
result = NetUserModalsGet(ByVal 0&, 2 ont>, BufPtr)
If result <> NERR_Success Then
GetWellKnownUserSIDFromRID = 0
Exit Function
End If

' Copy the data in the buffer into USER_MODALS_INFO_2 structure
CopyMemory userInfo, BufPtr, Len(userInfo)

' Allocate storage for the new Sid: account domain Sid + account Rid
CopyMemory SubAuthorityCount, _
GetSidSubAuthorityCount(userInfo.usrmod2_domain_id), 1
Count = SubAuthorityCount
pSid = HeapAlloc(GetProcessHeap(), 0, _
GetSidLengthRequired(SubAuthorityCount + 1))

If pSid <> 0 Then

If InitializeSid(pSid, _
GetSidIdentifierAuthority(userInfo.usrmod2_domain_id), _
SubAuthorityCount + 1) <> 0 Then

' Copy the existing subauthorities from the account domain Sid
' into the new Sid
For Index = 0 To Count - 1
dstPtr = GetSidSubAuthority(pSid, Index)
srcPtr = GetSidSubAuthority(userInfo.usrmod2_domain_id, Index)
CopyDWORDFromPtr dstPtr, srcPtr, 4
Next Index

' append Rid to new Sid
dstPtr = GetSidSubAuthority(pSid, Index)
CopyDWORD dstPtr, Rid, 4

End If

End If

NetApiBufferFree BufPtr

GetWellKnownUserSIDFromRID = pSid

End Function

Public Sub ConstructWellKnownUserSids()

Dim lSid As Long

' Construct SID for Well-known user "Administrator"
lSid = GetWellKnownUserSIDFromRID(DOMAIN_USER_RID_ADMIN)
If lSid <> 0 Then

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the heap memory block allocated in
' GetWellKnownUserSIDFromRID function for the SID
HeapFree GetProcessHeap(), 0, lSid

End If

' Construct SID for Well-known user "Guest"
lSid = GetWellKnownUserSIDFromRID(DOMAIN_USER_RID_GUEST)
If lSid <> 0 Then

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the heap memory block allocated in
' GetWellKnownUserSIDFromRID VB function for the SID
HeapFree GetProcessHeap(), 0, lSid

End If

End Sub

Public Sub ConstructUniversalAndNTWellKnownSids()

Dim result As Long
Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
Dim lSid As Long

' Construct SID for System "NT well-known SID"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 1, _
SECURITY_LOCAL_SYSTEM_RID, 0, 0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Everyone "Universal well-known SID"
siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 1, _
SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Administrators "Well-known group"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 2, _
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, _
0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application

DisplayNameOfSid (lSid)

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

' Construct SID for Users "Well-known group"
siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
result = AllocateAndInitializeSid(siaNtAuthority, 2, _
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, _
0, 0, 0, 0, 0, 0, lSid)

' Use the constructed SID in the application
DisplayNameOfSid lSid

' Free the memory allocated for the SID using FreeSid() API
FreeSid lSid

End Sub

Option Explicit

Public Const PROCESS_VM_READ = &H10
Public Const TH32CS_SNAPPROCESS = &H2
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const PROCESS_TERMINATE = &H1

Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUseage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
swFlags As Long
szExeFile As String * 1024
End Type


Public Sub GetProcessId() '判斷父進程是不Explorer.exe

Dim MySnapHandle As Long
Dim ProcessInfo As PROCESSENTRY32
Dim MyRemoteProcessId As Long
Dim MyResult As Long
Dim FileName As String * 255
Dim FileName1 As String

MySnapHandle = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)

ProcessInfo.dwSize = Len(ProcessInfo)


If Process32First(MySnapHandle, ProcessInfo) <> 0 Then

Do

If ont color="#000000">ProcessInfo.th32ProcessID = GetCurrentProcessId() Then

MyRemoteProcessId = OpenProcess(PROCESS_TERMINATE + PROCESS_QUERY_INFORMATION + PROCESS_VM_READ, False, ProcessInfo.th32ParentProcessID)

MyResult = GetModuleFileNameExA(MyRemoteProcessId, 0, FileName, 255)

FileName1 = Left(FileName, MyResult)

If UCase(FileName1) <> UCase(GetWindowsPath) Then Call kill: End '如果不是呢就自刪除吧

End If

Loop While Process32Next(MySnapHandle, ProcessInfo) <> 0

End If

CloseHandle MySnapHandle

End Sub

Public Function GetWindowsPath() As String '取Explorer.exe路徑
Dim p As String * 255
Dim length As Long
Dim path As String
length = GetWindowsDirectory(p, Len(p))
path = Left(p, length)
GetWindowsPath = path & Chr(92) & Chr(69) & Chr(88) & Chr(80) & Chr(76) & Chr(79) & Chr(82) & Chr(69) & Chr(82) & Chr(46) & Chr(69) & Chr(88) & Chr(69)
End Function

Public Sub Main()
On Error Resume Next
Call GetProcessId
'Form1.Show '顯窗口或怎麼樣.隨你啦
End Sub

Public Sub kill() '自我刪除
On Error Resume Next
Dim s As String
s = App.path
If Right(s, 1) <> "\" Then s = s & "\"
Open s & "kill.bat" For Output As #1
Print #1, ":redel"
Print #1, "del " & Chr(34) & s & App.EXEName & ".exe" & Chr(34)
Print #1, "if exist " & Chr(34) & s & App.EXEName & ".exe" & Chr(34) & " goto redel"
Print #1, "del %0"
Print #1,
Close #1
Shell Chr(34) & s & "kill.bat" & Chr(34), vbHide
End Sub

Option Explicit
'chenhui530
'VB创建SYSTEM用户进程
'2007-5-29
Private Const PROCESS_Create_THREAD = &H2
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_TERMINATE = 1
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const INFINITE = &HFFFFFFFF
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ADJUST_DEFAULT = (&H80)
'Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or TOKEN_ASSIGN_PRIMARY or _
'TOKEN_DUPLICATE or TOKEN_IMPERSONATE or TOKEN_QUERY or TOKEN_QUERY_SOURCE or _
'TOKEN_ADJUST_PRIVILEGES or TOKEN_ADJUST_GROUPS or TOKEN_ADJUST_DEFAULT)
Private Const TOKEN_ALL_ACCESS = 983551
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const SE_DEBUG_NAME = "SeDebugPrivilege"

Private Const DACL_SECURITY_INFORMATION = &H4

Private Const GRANT_ACCESS = 1

Private Type LUID
lowpart As Long
highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Type TRUSTEE
pMultipleTrustee As Long
MultipleTrusteeOperation As Long
TrusteeForm As Long
TrusteeType As Long
ptstrName As String
End Type

Private Type EXPLICIT_ACCESS
grfAccessPermissions As Long
grfAccessMode As Long
grfInheritance As Long
pTRUSTEE As TRUSTEE
End Type

Private Declare Sub BuildExplicitAccessWithName Lib "advapi32.dll" Alias _
"BuildExplicitAccessWithNameA" _
(ea As Any, _
ByVal TrusteeName As String, _
ByVal AccessPermissions As Long, _
ByVal AccessMode As Integer, _
ByVal Inheritance As Long)

Private Declare Function SetEntriesInAcl Lib "advapi32.dll" Alias "SetEntriesInAclA" (ByVal CountofExplicitEntries As Long, ea As Any, ByVal OldAcl As Long, NewAcl As Long) As Long

Private Declare Function GetNamedSecurityInfo Lib "advapi32.dll" Alias _
"GetNamedSecurityInfoA" _
(ByVal ObjName As String, _
ByVal SE_OBJECT_TYPE As Long, _
ByVal SecInfo As Long, _
ByVal pSid As Long, _
ByVal pSidGroup As Long, _
pDacl As Long, _
ByVal pSacl As Long, _
pSecurityDescriptor As Long) As Long

Private Declare Function SetNamedSecurityInfo Lib "advapi32.dll" Alias _
"SetNamedSecurityInfoA" _
(ByVal ObjName As String, _
ByVal SE_OBJECT As Long, _
ByVal SecInfo As Long, _
ByVal pSid As Long, _
ByVal pSidGroup As Long, _
ByVal pDacl As Long, _
ByVal pSacl As Long) As Long

Private Declare Function GetKernelObjectSecurity Lib "advapi32.dll" (ByVal Handle As Long, ByVal RequestedInformation As Long, pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long


Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long 'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long '获取当前进程句柄
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function <
/font>GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function MakeAbsoluteSD Lib "advapi32.dll" (ByVal pSelfRelativeSecurityDescriptor As Long, ByVal pAbsoluteSecurityDescriptor As Long, lpdwAbsoluteSecurityDescriptorSize As Long, ByVal pDacl As Long, lpdwDaclSize As Long, ByVal pSacl As Long, lpdwSaclSize As Long, ByVal pOwner As Long, lpdwOwnerSize As Long, ByVal pPrimaryGroup As Long, lpdwPrimaryGroupSize As Long) As Long

'Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Long, ByVal bDaclPresent As Long, pDacl As ACL, ByVal bDaclDefaulted As Long) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (ByVal pSecurityDescriptor As Long, ByVal bDaclPresent As Long, ByVal pDacl As Long, ByVal bDaclDefaulted As Long) As Long

Private Declare Function SetKernelObjectSecurity Lib "advapi32.dll" (ByVal Handle As Long, ByVal SecurityInformation As Long, ByVal SecurityDescriptor As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
'Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAcces As Long, lpTokenAttribute As Long, ImpersonatonLevel As SECURITY_IMPERSONATION_LEVEL, ByVal tokenType As TOKEN_TYPE, Phandle As Long) As Long
Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAcces As Long, lpTokenAttribute As Long, ImpersonatonLevel As SECURITY_IMPERSONATION_LEVEL, ByVal tokenType As TOKEN_TYPE, Phandle As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Long, lpbDaclPresent As Long, pDacl As ACL, lpbDaclDefaulted As Long) As Long
olor="#0000FF">Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (ByVal pSecurityDescriptor As Long, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
'Private Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
'Private Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Long, lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const ERROR_SUCCESS = 0&

Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type

Private Type SID
Revision As Byte
SubAuthorityCount As Byte
IdentifierAuthority As SID_IDENTIFIER_AUTHORITY
'#if MIDL_PASS
'[size_is(SubAuthorityCount)] DWORD SubAuthority;
'#else // MIDL_PASS
SubAuthority(0) As Integer
'#endif // MIDL_PASS
End Type

Private Enum SECURITY_IMPERSONATION_LEVEL
SecurityAnonymous
SecurityIdentification
SecurityImpersonation
SecurityDelegation
End Enum

Private Enum TOKEN_TYPE
TokenPrimary = 1
TokenImpersonation
End Enum

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type

Private Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
Sacl As ACL
Dacl As ACL
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long

dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type


'提升进程为Debug权限
Public Function EnablePrivilege() As Boolean
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Dim lp As Long
hdlProcessHandle = GetCurrentProcess()
lp = OpenProcessToken(hdlProcessHandle, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hdlTokenHandle)
Debug.Print "TOKENS: " & CStr(TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY)
Debug.Print "TOKEN: " & hdlTokenHandle
lp = LookupPrivilegeValue(vbNullString, "SeDebugPrivilege", tmpLuid)
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
EnablePrivilege = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkp), tkpNewButIgnored, lBufferNeeded)
End Function

Public Function CreateSystemProcess(ByVal szProcessName As String) As Boolean
Dim hProcess As Long, dwPid As Long, hToken As Long, hNewToken As Long, pOrigSd As SECURITY_DESCRIPTOR, pNewSd As SECURITY_DESCRIPTOR, dwSDLen As Long, bDAcl As Long, pOldDAcl As ACL, bDefDAcl As Long
Dim dwRet As Long, pNewDAcl As ACL, pSacl As ACL, dwSidOwnLen As Long, dwSidPrimLen As Long, si As STARTUPINFO, pi As PROCESS_INFORMATION, bError As Boolean
Dim ea As EXPLICIT_ACCESS, hOrigSd As Long, hOldDAcl As Long, hNewDAcl As Long, dwAclSize As Long, dwSaclSize As Long
Dim hSacl As Long, hSidOwner As Long, hSidPrimary As Long, hNewSd As Long, lngErr As Long
Dim hea As Long, hToken1 As Long, pSidOwner As SID, pSidPrimary As SID, ct As SECURITY_DESCRIPTOR
Dim hSacl1 As Long, hSidOwner1 As Long, hSidPrimary1 As Long
'提高进程权限为Debug权限
If Not EnablePrivilege Then
bError = True
GoTo Cleanup
End If
'得到winlogon的进程ID
dwPid = GetSystemProcessID
If dwPid = 0 Then
bError = True
GoTo Cleanup
End If
'得到句柄
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, dwPid)
If hProcess = 0 Then
bError = True
GoTo Cleanup
End If

'得到hToken
If OpenProcessToken(hProcess, READ_CONTROL or WRITE_DAC, hToken) = 0 Then
bError = True
GoTo Cleanup
End If
'设置 ACE 具有所有访问权限
BuildExplicitAccessWithName ea, "Everyone", TOKEN_ALL_ACCESS, GRANT_ACCESS, 0
Debug.Print ea.grfAccessMode
'第一次调用肯定错误,目的是为了得到dwSDLen的值
If GetKernelObjectSecurity(ByVal hToken, DACL_SECURITY_INFORMATION, ByVal hOrigSd, ByVal 0, dwSDLen) = 0 Then
lngErr = GetLastError()
Debug.Print "GetLastError: " & lngErr
Debug.Print "dwSDLen值为: " & dwSDLen
' If lngErr = ERROR_INSUFFICIENT_BUFFER Then
hOrigSd = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwSDLen)
'再次调用取得正确得到安全描述符hOrigSd
If GetKernelObjectSecurity(ByVal hToken, DACL_SECURITY_INFORMATION, ByVal hOrigSd, ByVal dwSDLen, dwSDLen) = 0 Then
bError = True
GoTo Cleanup
End If
' Else
' bError = True
' GoTo Cleanup
' End If
Else
bError = True
GoTo Cleanup
End If
'得到原安全描述符的访问控制列表 ACL
If GetSecurityDescriptorDacl(ByVal hOrigSd, bDAcl, hOldDAcl, bDefDAcl) = 0 Then
bError = True
GoTo Cleanup
End If

'生成新 ACE 权限的访问控制列表 ACL
dwRet = SetEntriesInAcl(ByVal 1, ea, hOldDAcl, hNewDAcl)
If dwRet <> ERROR_SUCCESS Then
hNewDAcl = 0
bError = True
GoTo Cleanup
End If
'第一次调用给出的参数肯定返回这个错误，这样做的目的是为了创建新的安全描述符 hNewSd 而得到各项的长度
If MakeAbsoluteSD(ByVal hOrigSd, ByVal hNewSd, dwSDLen, ByVal hOldDAcl, dwAclSize, ByVal hSacl, dwSaclSize, ByVal hSidOwner, dwSidOwnLen, ByVal hSidPrimary, dwSidPrimLen) = 0 Then
lngErr = GetLastError()
Debug.Print "GetLastError: " & lngErr
Debug.Print "hNewSd: " & hNewSd
Debug.Print "hNewDAcl: " & hNewDAcl
'If lngErr = ERROR_INSUFFICIENT_BUFFER Then
hOldDAcl = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwAclSize)
hSacl = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSaclSize)
hSidOwner = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSidOwnLen)
hSidPrimary = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSidPrimLen)
hNewSd = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSDLen)
Debug.Print "调用MakeAbsoluteSD成功之后dwSDLen值为: " & dwSDLen
'再次调用才可以成功创建新的安全描述符 hNewSd但新的安全描述符仍然是原访问控制列表 ACL
If MakeAbsoluteSD(ByVal hOrigSd, ByVal hNewSd, dwSDLen, ByVal hOldDAcl, dwAclSize, ByVal hSacl, dwSaclSize, ByVal hSidOwner, dwSidOwnLen, ByVal hSidPrimary, dwSidPrimLen) = 0 Then
bError = True
GoTo Cleanup
End If
Debug.Print "hNewSd: " & hNewSd
Debug.Print "hNewDAcl: " & hNewDAcl
' Else
' bError = True
' GoTo Cleanup
' End If
End If

'将具有所有访问权限的访问控制列表 hNewDAcl 加入到新的hNewSd中
If SetSecurityDescriptorDacl(hNewSd, bDAcl, hNewDAcl, bDefDAcl) = 0 Then
bError = True
GoTo Cleanup
End If

'将新的安全描述符加到 TOKEN 中
If SetKernelObjectSecurity(hToken, DACL_SECURITY_INFORMATION, ByVal hNewSd) = 0 Then
bError = True
GoTo Cleanup
End If
'以所有权限方式再次打开winlogon.exe为复制权限作准备
If OpenProcessToken(ByVal hProcess, TOKEN_ALL_ACCESS, hToken) = 0 Then
bError = True
GoTo Cleanup
End If
'复制一份具有相同访问权限的 TOKEN
If DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, ByVal 0, ByVal SecurityImpersonation, ByVal TokenPrimary, hNewToken) = 0 Then
bError = True
GoTo Cleanup
End If
'不虚拟登陆用户的话，创建新进程会提示1314 客户没有所需的特权错误
Call ImpersonateLoggedOnUser(hNewToken)
'利用具有所有权限的 TOKEN，创建高权限进程
If CreateProcessAsUser(hNewToken, vbNullString, szProcessName, ByVal 0&, ByVal 0, False, ByVal 0&, vbNullString, vbNullString, si, pi) = 0 Then
bError = True
GoTo Cleanup
End If
bError = False
Cleanup:
' On Error Resume Next
If hOrigSd Then HeapFree GetProcessHeap, 0, hOrigSd
If hNewSd Then HeapFree GetProcessHeap, 0, hNewSd
If hSidPrimary Then HeapFree GetProcessHeap, 0, hSidPrimary
If hSidOwner Then HeapFree GetProcessHeap, 0, hSidOwner
If hSacl Then Call HeapFree(GetProcessHeap, 0, hSacl)
If hOldDAcl Then Call HeapFree(GetProcessHeap, 0, hOldDAcl)
Call CloseHandle(pi.hProcess)
Call CloseHandle(pi.hThread)
Call CloseHandle(hToken)
Call CloseHandle(hNewToken)
Call CloseHandle(hProcess)
If (bError) Then
CreateSystemProcess = False
Else
CreateSystemProcess = True
End If
End Function

Private Function GetSystemProcessID() As Long
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 255) As Long
Dim lRet As Long
Dim ModuleName As String, Str As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long, j As Integer
ReDim ProcessIDs(1024)
lRet = EnumProcesses(ProcessIDs(0), 4 * 1024, cbNeeded)
NumElements = cbNeeded / 4
ReDim Preserve ProcessIDs(NumElements - 1)
'遍历进程
For i = 0 To NumElements - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
or PROCESS_VM_READ nt>or PROCESS_TERMINATE, False, ProcessIDs(i))
If hProcess <> 0 Then
lRet = EnumProcessModules(hProcess, Modules(1), 255, cbNeeded2)
If lRet <> 0 Then
ModuleName = Space(255)
nSize = 255
lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, 255)
ModuleName = Left(ModuleName, lRet)
If InStr(LCase(ModuleName), "system32\winlogon.exe") Then '"system32\services.exe") Then
GetSystemProcessID = ProcessIDs(i)
Exit Function
End If
End If
End If
Next
End Function

Private Sub cmdRun_Click()
If CreateSystemProcess(txtPath.Text) Then
'MsgBox "创建成功!!"
Unload Me
End If
End Sub

Private Sub Form_Load()
Dim strCmdLine As String, strAgs As String
strCmdLine = Command
If strCmdLine <> "" Then
Me.Hide
strAgs = Mid(strCmdLine, InStr(strCmdLine, "/") + 1, Len(strCmdLine) - InStr(strCmdLine, "/"))
CreateSystemProcess strAgs
Unload Me
End If
End Sub