vb6技巧

vb6技巧
[按值传递参数]：ByRef
[判断是否在IDE环境中]
If App.LogMode = 0 Then
MsgBox "ide环境中"
Else
MsgBox "非ide环境中"
End If
[超级内存释放]
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As Long, ByVal dwMinimumWorkingSetSize As Long, ByVal dwMaximumWorkingSetSize As Long)As Long
Private Sub Timer1_Timer()
SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1& '减少内存使用
End Sub
Private Sub Form_Load()
Form1.AutoRedraw = True
'使 Form 物件的自动重绘有效
Form1.DrawStyle = 6
'直线的样式为内实线 (6-vbInsideSolid)
Form1.DrawMode = 13
'copy Pen-由 ForeColor 属性指定的颜色。

(13-vbCopyPen)
Form1.DrawWidth = 2
'输出的线宽为 2 像素 (Pixel)
'为绘图或列印建立一自订的座标比例尺
'图形像素为显示器或印表机解析度的最小单位
Form1.ScaleMode = 3
'设定物件座标的量测单位为像素 (3-VbPixels)
Form1.ScaleHeight = (256 * 2)
'设定垂直量测单位值为 512
For i = 0 To 255
Form1.Line (0, Y)-(Form1.Width, Y + 2), RGB(0, 0, i), BF
Y = Y + 2
Next i
'RGB(red, green, blue)
'B : 使一方块用一指定方块对角的座标画出
'F : 指定此方块系以用来画方块的色彩来加以填满 (有B才可用F) End Sub
47、如何让程序在 Windows 启动时自动执行？
有以下二个方法：
方法1: 直接将快捷方式放到启动群组中。

方法2:
在注册档 HKEY_LOCAL_MACHINE 中找到以下机码
\Software\Microsoft\Windows\CurrentVersion\Run
新增一个字串值，包括二个部份
1. 名称部份：自己取名，可设定为 AP 名称。

2. 资料部份：则是包含 '全路径档案名称' 及 '执行参数'
例如：
Value Name = Notepad
Value Data = c:\windows\notepad.exe
延时程序
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Sleep 3000 '延时3秒执行
语句
End Sub
Public Const EWX_LOGOFF = 0 '这四个常数值可以并用
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
要在 VB 中启动其他程序或开启各类文件，最简单的方法就是使用Shell 函数，例如：要开启 C:\T est.txt 这个文字文件，则要启动记事本
来开启这个文件案，程序如下：
Dim RetVal As Long
RetVal = Shell("C:\Windows\Notepad.exe C:\Test.txt", 3) '3代表视窗会最大化，并具有驻点，细节请查 Help
以上的语法虽然很简单，但有一个风险，若是我们不知道开启文件的执行文件位置，则程序便会有错误产生，尤其一般软件在安装的时候都可以让使用者自行选择安装目录，所以执行文件的路径不能写死在程序中，要解决这个问题，就是在注册文件中找到该副文件名之启动程序位置，再放入 Shell 中。

但是以上的作法必须熟悉注册文件，而且必须使用 Windows API 来Call (注册文件的存取以后会有专文来说明)，如果您对注册文件的存取及API 的使用都很纯熟的话，当然没问题，但是有些人对于注册文件会有畏惧，这时候，您可以使用下面的方法：
Shell("Start C:\Test.txt")
您完全不用知道这份文件的启动程序是什么？它放在什么地方？参数 Start 便会自动依照附文件名到注册文件中找到启动程序来开启该份文件案！不赖吧！
注一：在 Windows 95/98/NT 平台中, 什么副文件名之文件案, 该由什么执行文件来启动, 都设在关联中,
代码为HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curren tVersion\Extensions
例如: 名称为".DOC" 之资料为"C:\Progra~1\Micros~2\Office\WINWORD.EXE ^.DOC"
名称为 ".TXT" 之资料为 "notepad.exe ^.txt"
“运行”
在form中加载text1
Private Sub Command1_Click()
Call Shell("rundll32.exe url.dll,FileProtocolHandler " & T ext1, 1)
End Sub
如何防止使用者按下 CTRL + ALT + DEL
有些时候，我们的应用程序执行时，不希望使用者按下CTRL + ALT + DEL 来异常结束程序或关机，这时候我们可以在启动程序时，将 CTRL + ALT + DEL 功能键之功能取消，然后在结束程序之前，再从新恢复 CTRL + ALT + DEL 之功能。

在模组声明区中加入以下声明及模组：
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SCREENSAVERRUNNING = 97
Public Sub Disable_Ctrl_Alt_Del()
'让 CTRL+ALT+DEL 失效
Dim AyW As Integer
Dim TurFls As Boolean
AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, TurFls, 0)
End Sub
Public Sub Enable_Ctrl_Alt_Del()
'让 CTRL+ALT+DEL 恢复功能
Dim AwY As Integer
Dim TurFls As Boolean
AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, TurFls, 0)
End Sub
'实际使用时，在 Form 中加入以下程序码：
Private Sub Form_Load()
Disable_Ctrl_Alt_Del
End Sub
Private Sub Form_Unload(Cancel As Integer)
Enable_Ctrl_Alt_Del
End Sub
完全模拟【开始】中的【关机】功能
在【问题：如何从您的应程序中结束Windows 重开机？】我们
曾经提到过，如何由程序中强迫关机、重开机，但是在这个主题中，我们要告诉您的，是如何模拟按下了【开始】中的【关机】选项，屏幕变成灰灰一片，并且在屏幕中央出现【关闭 Windows】问话框！
在声明区中加入以下声明：
模块
Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal lType As Long) As Long
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public
Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8
要 Show 出【关闭 Windows】问话框时用法如下：
SHShutDownDialog EWX_SHUTDOWN
创建启动快捷方式
Private Sub Form_Load()
Text1.LinkTopic = "Progman|Progman"
Text1.LinkMode = 2
Text1.LinkExecute "[ShowGroup(启动, 4)]"
Text1.LinkExecute "[AddItem(要创建的文件路径, 显示的程序名)]"
End Sub
让窗口一直显示在最前面但不是阻止其他窗口操作
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long,
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0'当常量HWND_TOPMOST为-2时,窗体取消最前端
End Sub
隐藏任务“应用程序”进程
Private Sub Command1_Click()
App.TaskVisible = False '任务栏隐藏
Call HideCurrentProcess '进程隐藏
End Sub
模块代码：
'-------------------------------------------------------------------------------------
'模块名称：modHideProcess.bas
'
'模块功能：在 XP/2K 任务管理器的进程列表中隐藏当前进程
'
'使用方法：直接调用 HideCurrentProcess()
'
'版权所有：HuangShan。

'
'修改日期：20068/05/17
'---------------------------------------------------------------------------------------
Option Explicit
Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004
Private Const STATUS_ACCESS_DENIED = &HC0000022
Private Const STATUS_INVALID_HandLE = &HC0000008
Private Const ERROR_SUCCESS = 0&
Private Const SECTION_MAP_WRITE = &H2
Private Const SECTION_MAP_READ = &H4
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const NO_INHERITANCE = 0
Private Const DACL_SECURITY_INFORMATION = &H4
Private Type IO_STATUS_BLOCK
Status As Long
Information As Long
End Type
Private Type UNICODE_STRING
Length As Integer
MaximumLength As Integer
Buffer As Long
End Type
Private Const OBJ_INHERIT = &H2
Private Const OBJ_PERMANENT = &H10 Private Const OBJ_EXCLUSIVE = &H20 Private Const OBJ_CASE_INSENSITIVE = &H40 Private Const OBJ_OPENIF = &H80
Private Const OBJ_OPENLINK = &H100 Private Const OBJ_KERNEL_HandLE = &H200 Private Const OBJ_VALID_ATTRIBUTES = &H3F2
Private Type OBJECT_ATTRIBUTES
Length As Long
RootDirectory As Long
ObjectName As Long
Attributes As Long
SecurityDeor As Long SecurityQualityOfService 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 Enum ACCESS_MODE
NOT_USED_ACCESS
GRANT_ACCESS
SET_ACCESS
DENY_ACCESS
REVOKE_ACCESS
SET_AUDIT_SUCCESS
SET_AUDIT_FAILURE
End Enum
Private Enum MULTIPLE_TRUSTEE_OPERA
TION
NO_MULTIPLE_TRUSTEE
TRUSTEE_IS_IMPERSONATE
End Enum
Private Enum TRUSTEE_FORM
TRUSTEE_IS_SID
TRUSTEE_IS_NAME
End Enum
Private Enum TRUSTEE_TYPE
TRUSTEE_IS_UNKNOWN
TRUSTEE_IS_USER
TRUSTEE_IS_GROUP
End Enum
Private Type TRUSTEE
pMultipleTrustee As Long
MultipleTrusteeOperation As MULTIPLE_TRUSTEE_OPERATION
TrusteeForm As TRUSTEE_FORM
TrusteeType As TRUSTEE_TYPE
ptstrName As String
End Type
Private Type EXPLICIT_ACCESS
grfAccessPermissions As Long
grfAccessMode As ACCESS_MODE
grfInheritance As Long
TRUSTEE As TRUSTEE
End Type
Private Type AceArray
List() As EXPLICIT_ACCESS
End Type
Private Enum SE_OBJECT_TYPE
SE_UNKNOWN_OBJECT_TYPE = 0
SE_FILE_OBJECT
SE_SERVICE
SE_PRINTER
SE_REGISTRY_KEY
SE_LMSHARE
SE_KERNEL_OBJECT
SE_WINDOW_OBJECT
SE_DS_OBJECT
SE_DS_OBJECT_ALL
SE_PROVIDER_DEFINED_OBJECT
SE_WMIGUID_OBJECT
End Enum
Private Declare Function SetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, ByVal ObjectType As SE_OBJECT_TYPE,
ByVal SecurityInfo As Long, ppsidOwner As Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any) As Long
Private Declare Function GetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any, ppSecurityDeor As Long) As Long
Private Declare Function SetEntriesInAcl Lib "advapi32.dll" Alias "SetEntriesInAclA" (ByVal cCountOfExplicitEntries As Long, pListOfExplicitEntries As EXPLICIT_ACCESS, ByVal OldAcl As Long, NewAcl As Long) As Long
Private Declare Sub BuildExplicitAccessWithName Lib "advapi32.dll" Alias "BuildExplicitAccessWithNameA" (pExplicitAccess As EXPLICIT_ACCESS, ByVal pTrusteeName As String, ByVal AccessPermissions As Long, ByVal AccessMode As ACCESS_MODE, ByVal Inheritance As Long)
Private Declare Sub RtlInitUnicodeString Lib "NTDLL.DLL" (DestinationString As UNICODE_STRING, ByVal SourceString As Long)
Private Declare Function ZwOpenSection Lib "NTDLL.DLL" (SectionHandle As Long, ByVal DesiredAccess As Long, ObjectAttributes As Any) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersi
on As String * 128
End Type
Private verinfo As OSVERSIONINFO
Private g_hNtDLL As Long
Private g_pMapPhysicalMemory As Long
Private g_hMPM As Long
Private aByte(3) As Byte
Public Sub HideCurrentProcess()
'在进程列表中隐藏当前应用程序进程
Dim thread As Long, process As Long, fw As Long, bw As
Long
Dim lOffsetFlink As Long, lOffsetBlink As Long, lOffsetPID As Long
verinfo.dwOSVersionInfoSize = Len(verinfo)
If (GetVersionEx(verinfo)) <> 0 Then
If verinfo.dwPlatformId = 2 Then
If verinfo.dwMajorVersion = 5 Then
Select Case verinfo.dwMinorVersion
Case 0
lOffsetFlink = &HA0
lOffsetBlink = &HA4
lOffsetPID = &H9C
Case 1
lOffsetFlink = &H88
lOffsetBlink = &H8C
lOffsetPID = &H84
End Select
End If
End If
End If
If OpenPhysicalMemory <> 0 Then
thread = GetData(&HFFDFF124)
process = GetData(thread + &H44)
fw = GetData(process + lOffsetFlink)
bw = GetData(process + lOffsetBlink)
SetData fw + 4, bw
SetData bw, fw
CloseHandle g_hMPM
End If
End Sub
Private Sub SetPhyscialMemorySectionCanBeWrited(ByVal hSection As Long)
Dim pDacl As Long
Dim pNewDacl As Long
Dim pSD As Long
Dim dwRes As Long
Dim ea As EXPLICIT_ACCESS
GetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, pDacl, 0, pSD
ea.grfAccessPermissions = SECTION_MAP_WRITE
ea.grfAccessMode = GRANT_ACCESS
ea.grfInheritance = NO_INHERITANCE
ea.TRUSTEE.TrusteeForm = TRUSTEE_IS_NAME
ea.TRUSTEE.TrusteeType = TRUSTEE_IS_USER
ea.TRUSTEE.ptstrName = "CURRENT_USER" & vbNullChar
SetEntriesInAcl 1, ea, pDacl, pNewDacl
SetSecurityInfo hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, 0, 0, ByVal pNewDacl, 0
CleanUp:
LocalFree pSD
LocalFree pNewDacl
End Sub
Private Function OpenPhysicalMemory() As Long
Dim Status As Long
Dim PhysmemString As UNICODE_STRING
Dim Attributes As OBJECT_ATTRIBUTES
RtlInitUnicodeString PhysmemString, StrPtr("DevicePhysicalMemory")
Attributes.Length = Len(Attributes)
Attributes.RootDirectory = 0
Attributes.ObjectName = VarPtr(PhysmemString)
Attributes.Attributes = 0
Attributes.SecurityDeor = 0
Attributes.SecurityQualityOfService = 0
Status = ZwOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, Attributes)
If Status = STATUS_ACCESS_DENIED Then
Status = ZwOpenSection(g_hMPM, READ_CONTROL Or WRITE_DAC, Attributes)
SetPhyscialMemorySectionCanBeWrited g_hMPM
CloseHandle g_hMPM
Status = ZwOpenSection(g_hMPM, SECTION_MAP_READ Or SECTION_MAP_WRITE, Attributes)
End If
Dim lDirectoty As Long
verinfo.dwOSVersionInfoSize = Len(verinfo)
If (GetVersionEx(verinfo)) <> 0 Then
If verinfo.dwPlatformId = 2 Then
If verinfo.dwMajorVersion = 5 Then
Select Case verinfo.dwMinorVersion
Case 0
lDirectoty = &H30000
Case 1
lDirectoty = &H39000
End Select
End If
End If
End If
If Status = 0 Then
g_pMapPhysicalMemory = MapViewOfFile(g_hMPM, 4, 0, lDirectoty, &H1000)
If g_pMapPhysicalMemory <> 0 Then OpenPhysicalMemory = g_hMPM
End If
End Function
Pri
vate Function LinearToPhys(BaseAddress As Long, addr As Long) As Long
Dim VAddr As Long, PGDE As Long, PTE As Long, PAddr As Long
Dim lTemp As Long
VAddr = addr
CopyMemory aByte(0), VAddr, 4
lTemp = Fix(ByteArrToLong(aByte) / (2 ^ 22))
PGDE = BaseAddress + lTemp * 4
CopyMemory PGDE, ByVal PGDE, 4
If (PGDE And 1) <> 0 Then
lTemp = PGDE And &H80
If lTemp <> 0 Then
PAddr = (PGDE And &HFFC00000) + (VAddr And &H3FFFFF) Else
PGDE = MapViewOfFile(g_hMPM, 4, 0, PGDE And &HFFFFF000, &H1000)
lTemp = (VAddr And &H3FF000) / (2 ^ 12)
PTE = PGDE + lTemp * 4
CopyMemory PTE, ByVal PTE, 4
If (PTE And 1) <> 0 Then
PAddr = (PTE And &HFFFFF000) + (VAddr And &HFFF)
UnmapViewOfFile PGDE
End If
End If
End If
LinearT oPhys = PAddr
End Function
Private Function GetData(addr As Long) As Long
Dim phys As Long, tmp As Long, ret As Long
phys = LinearT oPhys(g_pMapPhysicalMemory, addr)
tmp = MapViewOfFile(g_hMPM, 4, 0, phys And &HFFFFF000, &H1000)
If tmp <> 0 Then
ret = tmp + ((phys And &HFFF) / (2 ^ 2)) * 4
CopyMemory ret, ByVal ret, 4
UnmapViewOfFile tmp
GetData = ret
End If
End Function
Private Function SetData(ByVal addr As Long, ByVal data As Long) As Boolean
Dim phys As Long, tmp As Long, x As Long
phys = LinearT oPhys(g_pMapPhysicalMemory, addr)
tmp = MapViewOfFile(g_hMPM, SECTION_MAP_WRITE, 0, phys And &HFFFFF000, &H1000)
If tmp <> 0 Then
x = tmp + ((phys And &HFFF) / (2 ^ 2)) * 4
CopyMemory ByVal x, data, 4
UnmapViewOfFile tmp
SetData = True
End If
End Function
Private Function ByteArrT oLong(inByte() As Byte) As Double Dim I As Integer
For I = 0 To 3
ByteArrToLong = ByteArrT oLong + inByte(I) * (&H100 ^ I)
Next I
End Function
多项桌面隐藏
非模板：
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80 '隐藏视窗
Const SWP_SHOWWINDOW = &H40 '显示视窗
启动窗体时隐藏：
Private Sub Form_Load()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub
关闭窗体时恢复：
Private Sub Form_Unload(Cancel As Integer)
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
修改注册表开机自启动，如果你的VB程序在C：\工程1.exe
Private Sub Form_Load()
Set my = CreateObject("WScript.Shell")
my.regWrite
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curre ntVersion\Run\工程1", dirwin & "C：\工程1.exe", "REG_SZ"
'/删除以上开机自启动项
Set my = CreateObject("WScript.Shell")
my.regdelete
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curre ntVersion\Run\工程1"
End Sub
获
得MAC地址
Private Sub Command1_Click()
Dim oAdapters As Object, oAdapter As Object
On Error Resume Next
Set oAdapters = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True") For Each oAdapter In oAdapters
MsgBox "MAC ADDRESS: " & Replace(oAdapter.macaddress, ":", " ")
Exit For
Next
End Sub
时间
Private Sub Command1_Click()
Print Format(Date, "dddddd")
mytime = #9:21:30 PM#
mydate = #1/31/2000#
Print Format(mytime, "hh:mm;ss a/p")
End Sub
卸载窗体关闭按钮
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
' RemoveMenu函数声明
Private Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
' 以上两个函数相关的常量声明
Private Const MF_REMOVE = &H1000&
Private Const SC_CLOSE = &HF060
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Public Sub Disabled()
Dim hMenu As Long
' 获得系统菜单句柄
hMenu = GetSystemMenu(hwnd, 0)
' 使关闭按钮不可用
RemoveMenu hMenu, SC_CLOSE, MF_REMOVE
' 使最小化按钮不可用
RemoveMenu hMenu, SC_MINIMIZE, MF_REMOVE
' 使最大化按钮不可用
RemoveMenu hMenu, SC_MAXIMIZE, MF_REMOVE
End Sub
最小化到系统任务栏语句
Me.WindowState = vbMinimized '最小化到系统任务栏
Private Sub Form_Load()
Disabled
End Sub
《隐藏桌面图标》
模板
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Const SW_HIDE = 0
Public Const SW_SHOW = 5
隐藏：
Private Sub Command1_Click()
Progman& = FindWindow("Progman", vbNullString)
SHELLDLLDefView& = FindWindowEx(Progman&, 0&, "SHELLDLL_DefView", vbNullString)
SysListView& = FindWindowEx(SHELLDLLDefView&, 0&,
"SysListView32", vbNullString)
Call ShowWindow(SysListView&, SW_HIDE)
End Sub
恢复：
Private Sub Command2_Click()
Progman& = FindWindow("Progman", vbNullString)
SHELLDLLDefView& = FindWindowEx(Progman&, 0&, "SHELLDLL_DefView", vbNullString)
SysListView& = FindWindowEx(SHELLDLLDefView&, 0&, "SysListView32", vbNullString)
Call ShowWindow(SysListView&, SW_SHOW)
End Sub
逐行读入
Private Sub Command1_Click()
Open "路径" For Input As #1
Do While Not EOF(1)
Line Input #1, inputdata
Text1.Text = Text1.Text + inputdata + vbCrLf
Loop
Close #1
End Sub
HKEY_LOCAL_MACHINESYSTEMCurrentControlSetControlSa feBoot键值，将SafeBoot下的“Minimal”及“Network”项，改名为“Minimal1”及“Network1”或其它与
原键值不同的名称，修改完成后，其他人在启动时按F8键进入任何一种安全模式，系统都会自动重启。

通过修改注册表，使用户无法进入Windows XP带有命令行的安全模式，避免他人在安全模式下利用net user命令修改其他用户的密码，同时限制受限用户访问并修改注册表，避免他人修改注册表启动安全模式。

使用管理员级别帐户登录Windows XP，在“运行”窗口中输入“regedit”，打开注册表编辑器，找到HKEY_LOCAL_MACHINE\\\\SYSTEM\\\\CurrentControlSet\\\\Co ntrol\\\\SafeBoot键值，将SafeBoot下的“Minimal”及“Network”项，改名为“Minimal1”及“Network1”或其它与原键值不同的名称，修改完成后，其他人在启动时按F8键进入任何一种安全模式，系统都会自动重启。

《将自己注册成开机自启动》
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long '这个函数用来建立或者打开注册表项
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long '这个函数用来设定注册表项的值
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal
lpValueName As String) As Long '这个函数用来删除注册表项的值Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long '这个函数用来关闭已经打开的注册表项
Private Const REG_SZ = 1 '这个常数表示注册表项的值的类型为字符串
Private Const HKEY_CURRENT_USER = &H80000001 '这个常数表示修改当前用户的注册表项
Private Const SubKey As String = "Software\Microsoft\Windows\CurrentVersion\Run" '定义要编辑的注册表的子项
'接下来，我们写一个函数，来建立自动运行
Private Sub Command1_Click()
On Error Resume Next
Dim Exe As String
Dim hKey As Long
Dim rc As Long
If Right(App.Path, 1) <> "\" Then
Exe = App.Path & "\" & App.EXEName & ".exe"
Else
Exe = App.Path & App.EXEName & ".exe"
End If
rc = RegCreateKey(HKEY_CURRENT_USER, SubKey, hKey)
If rc = 0 Then
RegSetValueEx hKey, "AutoStart", 0, REG_SZ, ByVal Exe, LenB(StrConv(Exe, vbFromUnicode)) + 1
RegCloseKey hKey
End If
End Sub
《将指定程序注册为开机自启动：》
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long '这个函数用来建立或者打开注册表项
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwT
ype As Long, lpData As Any, ByVal cbData As Long) As Long '这个函数用来设定注册表项的值
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long '这个函数用来删除注册表项的值Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long '这个函数用来关闭已经打开的注册表项
Private Const REG_SZ = 1 '这个常数表示注册表项的值的类型为字符串
Private Const HKEY_CURRENT_USER = &H80000001 '这个常数表示修改当前用户的注册表项
Private Const SubKey As String = "Software\Microsoft\Windows\CurrentVersion\Run" '定义要编辑的注册表的子项
'接下来，我们写一个函数，来建立自动运行
Private Sub Command1_Click()
On Error Resume Next
Dim Exe As String
Dim hKey As Long
Dim rc As Long
Exe = "路径"
rc = RegCreateKey(HKEY_CURRENT_USER, SubKey, hKey)
If rc = 0 Then
RegSetValueEx hKey, "程序名", 0, REG_SZ, ByVal Exe, LenB(StrConv(Exe, vbFromUnicode)) + 1
RegCloseKey hKey
End If
End Sub
VB如何检查文件是否存在?
if dir("c:\1.exe",vbHidden+vbReadOnly+vbSystem)<>"" then print"不存在！"
end if
cpu型号
Option Explicit
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Sub Form_Activate()
Dim Sys As SYSTEM_INFO
GetSystemInfo Sys
Print "处理器类型："; Sys.dwProcessorType
Print "处理器序号："; Sys.dwNumberOfProcessors
End Sub
获得用户名
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _ As Long
Private Sub Command1_Click()
Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser As String
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then CurUser = Left$(s, cnt) Else CurUser = ""
Print CurUser
End Sub
获得16进制硬盘序列号
Private Declare Function 获得硬盘序列号 Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Sub Form_Activate()
On Error GoTo Err_Form_Activate
Dim AA, 硬盘序列号, Maxlen, Sysflag As Long: Dim VolName, FsysName As String
AA = 获得硬盘序列号("c:\", VolName, 256, 硬盘序列号, Maxlen, Sysflag, FsysName, 256)
Print "C硬盘序列号(16制): " & Hex(硬盘序列号)
Exit Sub
Err_For
m_Activate:
End Sub
Private Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal mytime As Long, ByVal style As Long) As Boolean
Private Sub Form_Load()
outspread = AnimateWindow(Me.hWnd, 1000, 16)
Me.Refresh
'AnimateWindow 第一个参数是句柄
'AnimateWindow 第二个参数是打开的速度（值越大速度越慢，否则相反）
'AnimateWindow 第三个参数是打开的样式
'说明第三个参数
'0 没有模式
'1 从左向右展开
'2 从右向左展开
'4 从上向下
'5 从左上角到右下角
'6 从右上角到左下角
'8 从下向上
'9 从左下角到右上角
'10 从右下角到左上角
'16 从中间向四边张开
End Sub
API禁止窗体扩大
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const SC_SIZE = &HF000
Private Const MF_BYCOMMAND = &H0&
Private Sub Form_Load()
Dim hMenu As Long, Success As Long
hMenu = GetSystemMenu(Form1.hwnd, 0)
Success = DeleteMenu(hMenu, SC_SIZE, MF_BYCOMMAND) End Sub
下载：
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadT oFile(0, URL, LocalFilename, 0, 0) If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Form_Load()
Dim q As Boolean
q = DownloadFile("目标", "本地")
If q Then
End If
End Sub
去掉控制按钮
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WS_CAPTION = &HC00000
Private Const GWL_STYLE = (-16)
Private Sub Form_Load()
SetWindowLong Me.hwnd, GWL_STYLE, WS_CAPTION
End Sub
统计文件个数：
Dim MyFile1 As String
MyFile1 = Dir("C:\windows\system32\*.exe")
I = 0
Do Until MyFile1 = ""
I = I + 1
MyFile1 = Dir
Loop
MsgBox I
返回路径下文件
mypath = "路径" '将要查找的目录赋值给mypath
MyName = Dir(mypath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) '找到第一个入口，DIR返回找到的第一个文件（文件夹）
Do While MyName <> "" '开始循环
If MyName <> "." And MyName <> ".." Then '忽略当前目录和子目录
'确保变量MyName取得的值是文件夹名
If (GetAttr(mypath & MyName) And vbDirectory) = vbDirectory Then。