.386
.model flat,stdcall
option casemap:none
include windows.inc
include kernel32.inc
include user32.inc
includelib kernel32.lib
includelib user32.lib

.data
szMsg db 'Hello,World!',0
szTil db 'ASM Hello World.',0
.code

start:
invoke MessageBox, NULL, offset szMsg, offset szTil, MB_OK or MB_ICONINFORMATION
call ExitProcess
end start

1、常规运用：（直接看代码）

Dim TestDateTime As Date = #1/27/2001 5:04:23 PM#
Dim TestStr As String
' Returns current system time in the system-defined long time format.
TestStr = Format(Now(), "Long Time")
' Returns current system date in the system-defined long date format.
TestStr = Format(Now(), "Long Date")
' Also returns current system date in the system-defined long date
' format, using the single letter code for the format.
TestStr = Format(Now(), "D")
' Returns the value of TestDateTime in user-defined date/time formats.
' Returns "5:4:23".
TestStr = Format(TestDateTime, "h:m:s")
' Returns "05:04:23 PM".
TestStr = Format(TestDateTime, "hh:mm:ss tt")
' Returns "Saturday, Jan 27 2001".
TestStr = Format(TestDateTime, "dddd, MMM d yyyy")
' Returns "17:04:23".
TestStr = Format(TestDateTime, "HH:mm:ss")
' Returns "23".
TestStr = Format(23)
' User-defined numeric formats.
' Returns "5,459.40".
TestStr = Format(5459.4, "##,##0.00")
' Returns "334.90".
TestStr = Format(334.9, "###0.00")
' Returns "500.00%".
TestStr = Format(5, "0.00%")

补充：
在日期Text控件中,显示金额时,都是100000 不便于判断是否对错,可以使用Fromat函数格式化显示
text1.text=fromat(text1.text,###,##0.00) 显示为100,000 .00 可以把真实的值存在.tag中

2、不同数值的不同格式
第一部分定义正值和零的格式，第二部分定义负值的格式。由于 Format 函数的 Style 参数采用字符串形式，因此在其两边加上引号。

Dim Style1 As String = "$#,##0;($#,##0)"

如果有几个分号，但分号之间没有任何内容，则缺少的部分使用正值的格式显示。例如，下列格式使用第一部分中的格式显示正值和负值，如果值为零，则显示 Zero。

Dim Style2 As String = "$#,##0;;\Z\e\r\o"

窗体部分代码：

Option Explicit

Private Sub cmdLock_Click()
If LockKeyboard(True) Then
cmdLock.Enabled = False
cmdUnLock.Enabled = True
End If
End Sub

Private Sub cmdUnLock_Click()
If LockKeyboard(False) Then
cmdLock.Enabled = True
cmdUnLock.Enabled = False
End If
End Sub

Private Sub Form_Load()
Dim bIsLock As Boolean
bIsLock = GetKeyboardState
cmdLock.Enabled = Not bIsLock
cmdUnLock.Enabled = bIsLock
End Sub

模块部分代码：

Option Explicit
'是否包含处理其它键盘消息，True表示处理.
#Const INC_OTHER_KEY = True
'注意，以下所有双版本的API均声明成了 UNICODE 版。 并且许多地方与VB的API浏览器生成的代码有所不同。
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomW" (ByVal lpString As Long) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function GlobalFindAtom Lib "kernel32" Alias "GlobalFindAtomW" (ByVal lpString As Long) As Integer
Private Const TH32CS_SNAPPROCESS = 2
Private Type PROCESSENTRY32W
dwSize As Long
cntUsage As Long
h32ProcessID As Long ' // this process
th32DefaultHeapID As Long '
h32ModuleID As Long ' // associated exe
cntThreads As Long '
th32ParentProcessID As Long ' // this process's parent process
pcPriClassBase As Long ' // Base priority of process's threads
dwFlags As Long '
szExeFile(1 To 260) As Integer ' // Path
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" Alias "Process32FirstW" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32W) As Long
Private Declare Function Process32Next Lib "kernel32" Alias "Process32NextW" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32W) As Long
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiW" (lpString1 As Integer, ByVal lpString2 As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
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 As LUID_AND_ATTRIBUTES
End Type
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const TOKEN_QUERY As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueW" (ByVal lpSystemName As Long, ByVal lpName As Long, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PrevState As Long, ByVal N As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpwModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_DECOMMIT As Long = &H4000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType lor="#0000FF">As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private 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
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
#If INC_OTHER_KEY Then
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExW" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
Private Const ATOM_FLAG As String = "HookSysKey"
Private Const SHELL_FALG As String = "Winlogon"
Private Const SHELL_CODE_DWORDLEN = 317 '注入代码所占的双字数
Private Const SHELL_CODE_LENGTH = (SHELL_CODE_DWORDLEN * 4) '字节数
Private Const SHELL_FUNCOFFSET = &H8 '注入代码线程函数偏移量
Private mlShellCode(SHELL_CODE_DWORDLEN - 1) As Long
#If INC_OTHER_KEY Then
Private m_lHookID As Long '键盘钩子句柄
Private Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
'============================================
' 锁定/解锁键盘
' 参数：布尔型，真表示锁定
' 返回：布尔型, 真表示成功
' 注意：非 Ctrl+Alt+Del 键使用普通钩子技术，因此
' 程序在退出时注意要卸载钩子。
'============================================
Public Function LockKeyboard(ByVal r="#000000">bLock As Boolean) As Boolean
Dim lResult As Long
Dim lStrPtr As Long
Dim iAtom As Integer
lStrPtr = StrPtr(SHELL_FALG)
iAtom = GlobalFindAtom(lStrPtr)
If iAtom = 0 Then
lResult = InsertAsmCode
Debug.Assert lResult = 0
If lResult Then Exit Function
End If
lStrPtr = StrPtr(ATOM_FLAG)
iAtom = GlobalFindAtom(lStrPtr)
If bLock Then
#If INC_OTHER_KEY Then
'强烈建议：使用了SetWindowsHookEx的话，请编译后再运行！
m_lHookID = SetWindowsHookEx(13, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
#End If
If iAtom = 0 Then iAtom = GlobalAddAtom(lStrPtr)
LockKeyboard = (iAtom <> 0)
Debug.Assert LockKeyboard
Else
#If INC_OTHER_KEY Then
If m_lHookID Then Call UnhookWindowsHookEx(m_lHookID)
#End If
If iAtom Then iAtom = GlobalDeleteAtom(iAtom)
LockKeyboard = iAtom = 0
End If
End Function
Public Function GetKeyboardState() As Boolean
GetKeyboardState = GlobalFindAtom(StrPtr(ATOM_FLAG)) <> 0
End Function
#If INC_OTHER_KEY Then
Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim KBEvent As KBDLLHOOKSTRUCT
If nCode >= 0 Then
'在这里可以加入实际的过滤条件
CopyMemory KBEvent, ByVal lParam, 20& 'sizeof KBDLLHOOKSTRUCT=20
'wParam = 消息，如WM_KEYDOWN, WM_KEYUP等
Debug.Print Hex$(KBEvent.vkCode) 'VK_??? 定义的键码
LowLevelKeyboardProc = 1 '１屏蔽,否则应调用CallNextHookEx
Else
LowLevelKeyboardProc = CallNextHookEx(m_lHookID, nCode, wParam, lParam)
End If
End Function
#End If
'----------------------------------------------
' 远程线程插入函数
' 功能：向 Winlogon 进程插入远程线程代码，并执行
' 返回：0表示成功，非0表示标准的系统错误代号
'----------------------------------------------
Private Function InsertAsmCode() As Long
Const WINLOGON As String = "Winlogon.exe"
Dim hProcess As Long '远端进程句柄
Dim hPId As Long '远端进程ID
Dim lResult As Long '一般返回变量
Dim pToken As TOKEN_PRIVILEGES
Dim hToken As Long
Dim hRemoteThread As Long
Dim hRemoteThreadID As Long
Dim lDbResult(1) As Long
Dim lRemoteAddr As Long
'------------------------------------
'取winlogon进程ID
'------------------------------------
hPId = GetProcessIdFromName(WINLOGON)
If hPId = 0 Then
InsertAsmCode = GetLastError
Debug.Assert False
Exit Function
End If
'------------------------------------
'提升本进程权限，以取得对winlogon进程操作的许可
'------------------------------------
lResult = OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
hToken)
Debug.Assert lResult
lResult = LookupPrivilegeValue(0, StrPtr(SE_DEBUG_NAME), pToken.Privileges.pLuid)
Debug.Assert lResult
pToken.PrivilegeCount = 1
pToken.Privileges.Attributes = SE_PRIVILEGE_ENABLED
lResult = AdjustTokenPrivileges(hToken, False, pToken, Len(pToken), 0, 0)
Debug.Assert lResult
'------------------------------------
'打开winlogon进程
'------------------------------------
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hPId)
Debug.Assert hProcess
If hProcess Then
'-------
-----------------------------
'初始注入代码
'------------------------------------
Call InitShellCode
'------------------------------------
'远端进程分配内存
'------------------------------------
lRemoteAddr = VirtualAllocEx(hProcess, 0, SHELL_CODE_LENGTH, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
Debug.Assert lRemoteAddr
'------------------------------------
'写入 shell 代码
'------------------------------------
If lRemoteAddr Then
InsertAsmCode = WriteProcessMemory(hProcess, lRemoteAddr, mlShellCode(0), SHELL_CODE_LENGTH, 0)
Else
InsertAsmCode = GetLastError
Exit Function
End If
'------------------------------------
'创建远程线程
'------------------------------------
hRemoteThread = CreateRemoteThread(hProcess, 0, 0, lRemoteAddr + SHELL_FUNCOFFSET, 0, 0, hRemoteThreadID)
If hRemoteThread = 0 Then
InsertAsmCode = GetLastError
Debug.Assert hRemoteThread
Exit Function
End If
'------------------------------------
'等待远程线程
'------------------------------------
Call WaitForSingleObject(hRemoteThread, -1)
Call GetExitCodeThread(hRemoteThread, InsertAsmCode)
Call CloseHandle(hRemoteThread)
'------------------------------------
'释放远端进程内存
'------------------------------------
Call VirtualFreeEx(hProcess, lRemoteAddr, SHELL_CODE_LENGTH, MEM_DECOMMIT)
Else
InsertAsmCode = GetLastError
End If
End Function
'============================================
' 初始线程代码
'============================================
Private Function InitShellCode() As Long
Const kernel32 As String = "kernel32.dll"
Dim hDll As Long
'------------------------------------
'提取注入代码所需的API函数
'------------------------------------
hDll = GetModuleHandle(StrPtr(kernel32)): Debug.Assert hDll
mlShellCode(0) = GetProcAddress(hDll, "GetModuleHandleW")
mlShellCode(1) = GetProcAddress(hDll, "GetProcAddress")
'---------------------------
' 以下代码由 MASM32 产生
mlShellCode(2) = &HE853&
mlShellCode(3) = &H815B0000
mlShellCode(4) = &H40100EEB
mlShellCode(5) = &H238E800
mlShellCode(6) = &HC00B0000
mlShellCode(7) = &H838D5075
mlShellCode(8) = &H4010B0
mlShellCode(9) = &HD093FF50
mlShellCode(10) = &HF004013
mlShellCode(11) = &HC00BC0B7
mlShellCode(12) = &H683A75
mlShellCode(13) = &H6A020000
mlShellCode(14) = &H8D006A00
mlShellCode(15) = &H4010B083
mlShellCode(16) = &H93FF5000
mlShellCode(17) = &H401090
mlShellCode(18) = &H1874C00B
mlShellCode(19) = &H10C2938D
mlShellCode(20) = &H6A0040
mlShellCode(21) = &H93FF5052
mlShellCode(22) = &H401094
mlShellCode(23) = &H474C00B
mlShellCode(24) = &HAEB0AEB
mlShellCode(25) = &H108C93FF
mlShellCode(26) = &H2EB0040
mlShellCode(27) = &HC25BC033
mlShellCode(28) = >&HFF8B0004
mlShellCode(38) = &H410053
mlShellCode(39) = &H200053
mlShellCode(40) = &H690077
mlShellCode(41) = &H64006E
mlShellCode(42) = &H77006F
mlShellCode(43) = &HFF8B0000
mlShellCode(44) = &H690057
mlShellCode(45) = &H6C006E
mlShellCode(46) = &H67006F
mlShellCode(47) = &H6E006F
mlShellCode(48) = &H8B550000
mlShellCode(49) = &HF0C481EC
mlShellCode(50) = &H53FFFFFD
mlShellCode(51) = &HE8&
mlShellCode(52) = &HEB815B00
mlShellCode(53) = &H4010D1
mlShellCode(54) = &H10468
mlShellCode(55) = &HF8858D00
mlShellCode(56) = &H50FFFFFD
mlShellCode(57) = &HFF0875FF
mlShellCode(58) = &H40108093
mlShellCode(59) = &HF8858D00
mlShellCode(60) = &H50FFFFFD
mlShellCode(61) = &H1098838D
mlShellCode(62) = &HFF500040
mlShellCode(63) = &H40107C93
mlShellCode(64) = &H75C00B00
mlShellCode(65) = &H68406A69
mlShellCode(66) = &H1000&
mlShellCode(67) = &H7668&
mlShellCode(68) = &HFF006A00
mlShellCode(69) = &H40107493
mlShellCode(70) = &H74C00B00
mlShellCode(71) = &H85896054
mlShellCode(72) = &HFFFFFDF0
mlShellCode(73) = &H75FFFC6A
mlShellCode(74) = &H8493FF08
mlShellCode(75) = &H8D004010
mlShellCode(76) = &H4013C893
mlShellCode(77) = &HFC028900
mlShellCode(78) = &HFDF0BD8B
mlShellCode(79) = &H76B9FFFF
mlShellCode(80) = &H8D000000
mlShellCode(81) = &H401374B3
mlShellCode(82) = &H8DA4F300
mlShellCode(83) = &H4010B083
mlShellCode(84) = &H93FF5000
mlShellCode(85) = &H401078
mlShellCode(86) = &HFDF0B5FF
mlShellCode(87) = &HFC6AFFFF
mlShellCode(88) = &HFF0875FF
mlShellCode(89) = &H40108893
mlShellCode(90) = &HC0336100
mlShellCode(91) = &HC03303EB
mlShellCode(92) = &HC2C95B40
or="#000000">mlShellCode(93) = &H6B0008
mlShellCode(94) = &H720065
mlShellCode(95) = &H65006E
mlShellCode(96) = &H33006C
mlShellCode(97) = &H2E0032
mlShellCode(98) = &H6C0064
mlShellCode(99) = &H6C&
mlShellCode(100) = &H730075
mlShellCode(101) = &H720065
mlShellCode(102) = &H320033
mlShellCode(103) = &H64002E
mlShellCode(104) = &H6C006C
mlShellCode(105) = &H69560000
mlShellCode(106) = &H61757472
mlShellCode(107) = &H6572466C
mlShellCode(108) = &H6C470065
mlShellCode(109) = &H6C61626F
mlShellCode(110) = &H646E6946
mlShellCode(111) = &H6D6F7441
mlShellCode(112) = &H6C470057
mlShellCode(113) = &H6C61626F
mlShellCode(114) = &H41646441
mlShellCode(115) = &H576D6F74
mlShellCode(116) = &H74736C00
mlShellCode(117) = &H706D6372
mlShellCode(118) = &H4F005769
mlShellCode(119) = &H446E6570
mlShellCode(120) = &H746B7365
mlShellCode(121) = &H57706F
mlShellCode(122) = &H6D756E45
mlShellCode(123) = &H6B736544
mlShellCode(124) = &H57706F74
mlShellCode(125) = &H6F646E69
mlShellCode(126) = &H47007377
mlShellCode(127) = &H69577465
mlShellCode(128) = &H776F646E
mlShellCode(129) = &H74786554
mlShellCode(130) = &H65470057
mlShellCode(131) = &H6E695774
mlShellCode(132) = &H4C776F64
mlShellCode(133) = &H57676E6F
mlShellCode(134) = &H74655300
mlShellCode(135) = &H646E6957
mlShellCode(136) = &H6F4C776F
mlShellCode(137) = &H57676E
mlShellCode(138) = &H6C6C6143
mlShellCode(139) = &H646E6957
mlShellCode(140) = &H7250776F
mlShellCode(141) = &H57636F
mlShellCode(142) = &H4C746547
mlShellCode(143) = &H45747361
mlShellCode(144) = &H726F7272
mlShellCode(145) = &H72695600
mlShellCode(146) = &H6C617574
mlShellCode(147) = &H6F6C6C41 r/>mlShellCode(148) = &H8B550063
mlShellCode(149) = &HFCC483EC
mlShellCode(150) = &H48C03360
mlShellCode(151) = &H8DFC4589
mlShellCode(152) = &H40117683
mlShellCode(153) = &H93FF5000
mlShellCode(154) = &H401000
mlShellCode(155) = &H840FC00B
mlShellCode(156) = &HFA&
mlShellCode(157) = &H838DF88B
mlShellCode(158) = &H401190
mlShellCode(159) = &H93FF50
mlShellCode(160) = &HB004010
mlShellCode(161) = &HE3840FC0
mlShellCode(162) = &H8B000000
mlShellCode(163) = &H45838DF0
mlShellCode(164) = &H50004012
mlShellCode(165) = &H493FF57
mlShellCode(166) = &H89004010
mlShellCode(167) = &H40107483
mlShellCode(168) = &H38838D00
mlShellCode(169) = &H50004012
mlShellCode(170) = &H493FF57
mlShellCode(171) = &H89004010
mlShellCode(172) = &H40108C83
mlShellCode(173) = &HC2838D00
mlShellCode(174) = &H50004011
mlShellCode(175) = &H493FF57
mlShellCode(176) = &H89004010
mlShellCode(177) = &H40107883
mlShellCode(178) = &HB2838D00
mlShellCode(179) = &H50004011
mlShellCode(180) = &H493FF57
mlShellCode(181) = &H89004010
mlShellCode(182) = &H4013D083
mlShellCode(183) = &HD1838D00
mlShellCode(184) = &H50004011
mlShellCode(185) = &H493FF57
mlShellCode(186) = &H89004010
mlShellCode(187) = &H40107C83
mlShellCode(188) = &HDB838D00
mlShellCode(189) = &H50004011
mlShellCode(190) = &H493FF56
mlShellCode(191) = &H89004010
mlShellCode(192) = &H40109083
mlShellCode(193) = &HE8838D00
mlShellCode(194) = &H50004011
mlShellCode(195) = &H493FF56
mlShellCode(196) = &H89004010
mlShellCode(197) = &H40109483
mlShellCode(198) = &HFB838D00
mlShellCode(199) = &H50004011
mlShellCode(200) = &H493FF56
mlShellCode(201) = &H89004010
mlShellCode(202) = font>&H40108083
mlShellCode(203) = &HA838D00
mlShellCode(204) = &H50004012
mlShellCode(205) = &H493FF56
mlShellCode(206) = &H89004010
mlShellCode(207) = &H40108483
mlShellCode(208) = &H19838D00
mlShellCode(209) = &H50004012
mlShellCode(210) = &H493FF56
mlShellCode(211) = &H89004010
mlShellCode(212) = &H40108883
mlShellCode(213) = &H28838D00
mlShellCode(214) = &H50004012
mlShellCode(215) = &H493FF56
mlShellCode(216) = &H89004010
mlShellCode(217) = &H4013CC83
mlShellCode(218) = &H89C03300
mlShellCode(219) = &H8B61FC45
mlShellCode(220) = &HC3C9FC45
mlShellCode(221) = &H53EC8B55
mlShellCode(222) = &HE8&
mlShellCode(223) = &HEB815B00
mlShellCode(224) = &H40137D
mlShellCode(225) = &H120C7D81
mlShellCode(226) = &H75000003
mlShellCode(227) = &HD4838D1C
mlShellCode(228) = &H50004013
mlShellCode(229) = &H13D093FF
mlShellCode(230) = &HB70F0040
mlShellCode(231) = &H74C00BC0
mlShellCode(232) = &H40C03308
mlShellCode(233) = &H10C2C95B
mlShellCode(234) = &H1475FF00
mlShellCode(235) = &HFF1075FF
mlShellCode(236) = &H75FF0C75
mlShellCode(237) = &HC8B3FF08
mlShellCode(238) = &HFF004013
mlShellCode(239) = &H4013CC93
mlShellCode(240) = &HC2C95B00
mlShellCode(241) = &HFF8B0010
mlShellCode(245) = &H6F0048
mlShellCode(246) = &H6B006F
mlShellCode(247) = &H790053
mlShellCode(248) = &H4B0073
mlShellCode(249) = &H790065
mlShellCode(250) = &H8B550000
mlShellCode(251) = &HD8C481EC
mlShellCode(252) = &HE8FFFFFD
mlShellCode(253) = &H226&
mlShellCode(254) = &H8DE84589
mlShellCode(255) = &H6A50EC45
mlShellCode(256) = &HE875FF28
mlShellCode(257) = &H24BE8
mlShellCode(258) = &HFC00B00
mlShellCode(259) = &H11584
mlShellCode(260<
font color="#000000">) = &HF4458D00
mlShellCode(261) = &H20606850
mlShellCode(262) = &H6A0040
mlShellCode(263) = &H22DE8
mlShellCode(264) = &H74C00B00
mlShellCode(265) = &HF045C722
mlShellCode(266) = &H1&
mlShellCode(267) = &H2FC45C7
mlShellCode(268) = &H6A000000
mlShellCode(269) = &H6A006A00
mlShellCode(270) = &HF0458D00
mlShellCode(271) = &HFF006A50
mlShellCode(272) = &H1E8EC75
mlShellCode(273) = &HFF000002
mlShellCode(274) = &H6A0875
mlShellCode(275) = &H1F0FFF68
mlShellCode(276) = &H1CEE800
mlShellCode(277) = &H45890000
mlShellCode(278) = &H68046AE8
mlShellCode(279) = &H1000&
mlShellCode(280) = &H4F268
mlShellCode(281) = &HFF006A00
mlShellCode(282) = &HC1E8E875
mlShellCode(283) = &H89000001
mlShellCode(284) = &H6AE445
mlShellCode(285) = &H4F268
mlShellCode(286) = &H10006800
mlShellCode(287) = &H75FF0040
mlShellCode(288) = &HE875FFE4
mlShellCode(289) = &H1B9E8
mlShellCode(290) = &H30186800
mlShellCode(291) = &H86A0040
mlShellCode(292) = &H40300068
mlShellCode(293) = &HE475FF00
mlShellCode(294) = &HE8E875FF
mlShellCode(295) = &H1A2&
mlShellCode(296) = &H81E4558B
mlShellCode(297) = &H8C2&
mlShellCode(298) = &H6A006A00
mlShellCode(299) = &H52006A00
mlShellCode(300) = &H6A006A
mlShellCode(301) = &HE8E875FF
mlShellCode(302) = &H156&
mlShellCode(303) = &H144E850
mlShellCode(304) = &H18680000
mlShellCode(305) = &H6A004030
mlShellCode(306) = &H30006808
mlShellCode(307) = &H75FF0040
mlShellCode(308) = &HE875FFE4
mlShellCode(309) = &H151E8
mlShellCode(310) = &H58D00
mlShellCode(311) = &H8B004030
mlShellCode(312) = &H4408B10
mlShellCode(313) = &HCB685250
mlShellCode(314) = &H8D004020
mlShellCode(315 font>) = &HFFFDD885
mlShellCode(316) = &H909050FF
End Function
'-------------------------------------------
' 根据可执行文件的名称取回进程ID
' 参数：可执行文件名(含扩展名)
' 返回：进程ID。0表示无
'-------------------------------------------
Private Function GetProcessIdFromName(ByVal sName As String) As Long
Dim hSnapshot As Long
Dim lpPE As PROCESSENTRY32W
Dim lpWinlogon As Long
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Debug.Assert hSnapshot
lpPE.dwSize = Len(lpPE)
If Process32First(hSnapshot, lpPE) Then
lpWinlogon = StrPtr(sName)
Do
If lstrcmpi(lpPE.szExeFile(1), lpWinlogon) = 0 Then
GetProcessIdFromName = lpPE.h32ProcessID
Exit Do
End If
If Process32Next(hSnapshot, lpPE) = 0 Then Exit Do
Loop
End If
Call CloseHandle(hSnapshot)
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