visualbasic编程:Visual Basic编程常见问题及解答

来源:http://dev.yesky.com

　　各位朋友大家好如果你在论坛时间够长那么你会发现很多帖子问题是相同既然这样不如整理总结到起让初学者来翻看再热心大虾也不愿意把个答案重复几十遍
　　若朋友您想要问如何才能学好vb或者入门需要看什么教材类问题建议你抱着颗刻苦钻研心去面对这门学问多动脑少提问遇到不知道多查msdn多看老贴或者用断点来亲自试验实在不会了请在此贴中查找您常见问题如果还没有那请您发出新贴向各位高手讨教

　　查找思路方法:按ctrl+f输入要查找问题关键字即可本人只是稍微编辑了下

　　如何用VB建立快捷方式

Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Sub Command1_Click
　Dim lReturn As Long
　’添加到桌面
　lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\calc.exe", "")
　’添加到组
　lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")
　’添加到启动组
　lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")
End Sub

　　如何让在 Windows 启动时自动执行？

　　有以下 2个思路方法:

　　思路方法1: 直接将快捷方式放到启动群组中

　　思路方法2:

在注册档 HKEY_LOCAL_MACHINE 中找到以下机码
\Software\Microsoft\Windows\CurrentVersion\Run
新增个字串值包括 2个部份
1. 名称部份:自己取名可设定为 AP 名称
2. 资料部份:则是包含 ’全路径档案名称’ 及 ’执行参数’

例如:
Value Name = Notepad
Value Data = c:\windows\notepad.exe

　　在 TextBox 中如何限制只能输入数字？

　　参考下列:

Sub Text1_KeyPress(KeyAscii As Integer)
　If KeyAscii < 48 Or KeyAscii > 57 Then
　　KeyAscii = 0
　End If
End Sub

　　我希望 TextBox 中能不接受某些特定例如 ’@#$%"有没有简单点写法？

　　思路方法有好几种, 以下列举 2种:

　　思路方法1: 可以使用 IF 或 Select Case 个个判断, 但如果不接受多时, 较麻烦!

　　思路方法2: 将要剔除统统放在个字串中只要个 IF 判断即可 !! 如下:

Private Sub Text1_KeyPress(KeyAscii As Integer)
　Dim sTemplate As String
　sTemplate = "!@#$%^&*_+-=" ’用来存放不接受
　If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then
　　KeyAscii = 0
　End If
End Sub

　　如何让鼠标进入 TextBox 时自动选定 TextBox 中的整串文字？

　　这个自动选定反白整串文字动作会使得输入资料完全取代的前在 TextBox 中所有

Private Sub Text1_GotFocus
　Text1.SelStart = 0
　Text1.SelLength = Len(Text1)
End Sub

　　如何检查软盘驱动器里是否有软盘？

　　使用:

Dim Flag As Boolean
Flag = Fun_FloppyDrive("A:")
If Flag = False Then MsgBox "A:驱没有准备好请将磁盘插入驱动器！", vbCritical

’-------------------------------
’:检查软驱中是否有盘存在
’-------------------------------
Private Function Fun_FloppyDrive(sDrive As String) As Boolean
On Error Resume Next
Fun_FloppyDrive = Dir(sDrive) <> ""
End Function

　　如何弹出和关闭光驱托盘？

Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub Command1_Click
　mciExecute " cdaudio door open" ’弹出光驱
　Label2.Caption = "弹 出"
End Sub

Private Sub Command2_Click
　Label2.Caption = "关 闭"
　mciExecute " cdaudio door closed" ’合上光驱
　Unload Me
　End
End Sub

　　如何让你在任务列表隐藏

Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" As Long

’请你试试 Ctrl+Alt+Del 是不是你隐藏了
Private Sub Command1_Click
　i = RegisterServiceProcess(GetCurrentProcessId, 1)
End Sub  

　　如何用控制滑鼠游标 (Mouse Cursor) 到指定位置？

　　以下这个例子当 User 在 Text1 中按下 ’Enter’ 键后滑鼠游标会自动移到 Command2 按钮上方

　　请在声明区中加入以下声明:

’16 位版本: ( Sub 无传回值 )
Declare Sub SetCursorPos Lib "User" (ByVal X As Integer, ByVal Y As Integer)

’32 位版本: ( Function 有传回值Integer 改成 Long )
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

’在 Form1 中加入以下码:
Private Sub Text1_KeyPress(KeyAscii As Integer)
　If KeyAscii = 13 Then
　　x% = (Form1.Left + Command2.Left + Command2.Width / 2 + 60) / Screen.TwipsPerPixelX
　　y% = (Form1.Top + Command2.Top + Command2.Height / 2 + 360) / Screen.TwipsPerPixelY
　　SetCursorPos x%, y%
　End If
End Sub

　　如何用鼠标移动没有标题 Form或移动 Form 中控制项？

　　在声明区中放入以下声明:

’16 位版本: ( Sub 无返回值 )
Private Declare Sub ReleaseCapture Lib "User"
Private Declare Sub SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)

’32 位版本: ( Function 有返回值Integer 改成 Long )
Private Declare Function ReleaseCapture Lib "user32" As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

’共用常数:
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012

’若要移动 Form码如下:
Private Sub Form_MouseDown(Button As Integer, Sht As Integer, X As Single, Y As Single)
　Dim i As Long
　i = ReleaseCapture
　i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)
End Sub

’以上功能也适用于用鼠标在 Form 中移动控制项码如下:
Private Sub Command1_MouseDown(Button As Integer, Sht As Integer, X As Single, Y As Single)
　Dim i As Long
　i = ReleaseCapture
　i = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)
End Sub

　　检查文件是否存在？

Function FileExists(filename As String) As Integer
　Dim i As Integer
　On Error Resume Next
　i = Len(Dir$(filename))
　If Err Or i = 0 Then FileExists = False Else FileExists = True
End Function  

　　如何设置对VB数据库连接动态路径

　　我个人经常作些数据库方面对于间如何和数据库进行接口问题的烦是深有体会VB在数据库链接时候般是静态即数据库存放路径是固定如用VBDATAadodc,DataEnvironment 等到作数据库链接时如果存放数据库路径被改变话就会找不到路经真是个特别烦事

　　笔者解决思路方法是利用app.path 来解决这个问题

　　、用dataControl控件进行数据库链接可以这样:

　　在form_load过程中放入:

private form_load
Dim str As String ’定义
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
data1.databasename=str & "\数据库名"
data1.recordsource="数据表名"
data1.refresh
sub end

　　这几句话意为打开当前运行目录下数据库你只要保证你数据库在你所在目录的下就行了

　　 2、利用adodc(ADO Data Control)进行数据库链接:

private form_load
Dim str As String ’定义
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
Adodc1.ConnectionString = str
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from table3"
Adodc1.Refresh
end sub

　　 3、利用DataEnvironment进行数据库链接

　　可在过程中放入:

On Error Resume Next
If DataEnvironment1.rsCommand1.State <> adStateClosed Then
　DataEnvironment1.rsCommand1.Close ’如果打开则关闭
End If
’i = InputBox("请输入友人编号:", "输入")
’If i = "" Then Exit Sub
DataEnvironment1.Connection1.Open App.Path & "\userdatabase\tsl.mdb"
DataEnvironment1.rsCommand1.Open "select * from table3 where 编号=’" & i & "’"
’Set DataReport2.DataSource = DataEnvironment1
’DataReport2.DataMember = "command1"
’DataReport2.show
end sub

　　 4、利用ADO(ActiveX Data Objects)进行编程:

　　建立连接:

dim conn as adodb.connection
dim rs as adodb.record
dim str
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
conn.open str
rs.cursorlocation=aduseclient
rs.open "数据表名",conn,adopenkey.adlockpessimistic
用完的后关闭数据库:
conn.close
conn=nothing

　　如何让用户自行输入方程式并计算其结果？

　　假设我们要让使用者在“方程式”栏位中自由输入方程式然后利用方程式进行计算则引用ScriptControlControl控件可以很方便地做到
( ScriptControl Control控件附属于VB 6.0如果安装后没有看到此Control控件可在光盘 \Common\Tools\VB\Script 目录底下找此Control控件 其.文件名为Msscript.ocx) 假设放在窗体上ScriptControlControl控件名称为ScriptControl1则在“计算”按钮Click事件中编写如下代码:

Dim Statement As String Statement = "X=" + Text1.Text + vbCrLf + _ "Y=" + Text2.Text + vbCrLf + _ "MsgBox ""计算结果="" & Y " ScriptControl1.ExecuteStatement( Statement  

　　如何让个 App 永远保持在最上层 ( Always _disibledevent=> Const SWP_NOSIZE = &H1 ’不更动目前视窗大小
Const HWND_TOPMOST = -1 ’设定为最上层
Const HWND_NOTOPMOST = -2 ’取消最上层设定
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

’将 APP 视窗设定成永远保持在最上层
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS

’取消最上层设定
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS

　　我要如何在中开启网页？

　　在声明区中声明如下 (在 .bas 档中用 Public, 在 Form 中用 Private)

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

　　在中

Intranet:
ShellExecute Me.hWnd, "open", "http://Intranet主机/目录", "", "", 5
Internet:
ShellExecute Me.hWnd, "open", "http://www.ruentex.com.tw", "", "", 5

　VB可以产生 4角形以外其他形状 Form 吗？

　　这个问题您定无法想像有多容易您可以产生任何形状 Form但必须借助 CreateEllipticRgn 及 SetWindowRgn 2个 API 例如:

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load
Dim lReturn As Long
Me.Show
lReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10, 10, 340, 150), True)
End Sub

　　CreateEllipticRgn 的 4个参数介绍说明如下:

　　X1:椭圆中心点的X轴位置但以 Form 实№边界为限

　　Y1:椭圆中心点的Y轴位置但以 Form 实№边界为限

　　X2:椭圆长边长度

　　Y2:椭圆短边长度

　　如何移除 Form 右上方的『X』按钮？

　　其实 Form 右上方的 3个按钮分别对应到 Form 左上方控制盒 (ControlBox) 中几个选项 (缩到最小 / 放到最大 / 关闭)而其中最大化 (MaxButton) 及最小化 (Minbutton) 都可以直接在 Form 属性中设定但是 VB 并没有提供设定『X』按钮功能！要达到这个功能必须借助 API:

　　由于『X』按钮对应到 ControlBox 关闭选项所以我们只要移除系统 Menu (就是ControlBox) 关闭选项即可！您自己可以先看看您现在使用 Browser 左上方系统 Menu【关闭】选项是在第几个不是第 6 个！是第 7 个分隔线也算个！分隔线才是第 6 个！

　　当我们移除了关闭选项的後会留下条很奇怪分隔线所以最好连分隔线也并移除而 Menu Index 是从 0 开始分隔线是第 6 个所以 Index = 5

　　修正:为了让码在 Windows NT 也能运作正常将各 Integer 型态改成 Long 89.05.04

’抓取系统 Menu hwnd
Private Declare Function GetMenu Lib "user32" Alias "GetMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

’移除系统 Menu API
Private Declare Function RemoveMenu Lib "user32" Alias "RemoveMenu" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
’第个参数是系统 Menu hwnd
’第 2个参数是要移除选项 Index

　　如何制作透明表单 (Form)？

　　请在声明区中放入以下声明

Const GWL_EXSTYLE = (-20)
Const WS_EX_TRANSPARENT = &H20&
Const SWP_FRAMECHANGED = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE
Const HWND_NOTOPMOST = -2

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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

　　在 Form_Load 使用范例如下:

Private Sub Form_Load
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME
Me.Refresh
End Sub

　　如何在 Menu 中加入美美图案？

　　在模组中加入以下码:

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Public Const MF_BITMAP = &H4&

Type MENUITEMINFO
　cbSize As Long
　fMask As Long
　fType As Long
　fState As Long
　wID As Long
　hSubMenu As Long
　hbmpChecked As Long
　hbmpUnchecked As Long
　dwItemData As Long
　dwTypeData As String
　cch As Long
End Type

Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean

Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&

　　在 Form 中加入个 PictureBox属性设定为:

AutoSize = True
Picture = .bmp (尺寸大小为 13x13不可设定为 .ico)

　　在 Form_Load 中码如下:

Private Sub Form_Load
　’取得中 Mennu handle
　hMenu& = GetMenu(Form1.hWnd)
　’取得第个 submenu handle
　hSubMenu& = GetSubMenu(hMenu&, 0)
　’取得 Submenu 第个选项 menuId
　hID& = GetMenuItemID(hSubMenu&, 0)
　’加入图片
　SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
　’在个 Menu 选项中您共可以加入 2张图片
　’张是 checked 状态用张是 unchecked 状态用
End Sub

　　如何把小图片填满 Form 成为背景图？

　　对于这个问题我看过很多思路方法有思路方法很麻烦要声明大堆 Type用大堆 API但是有个最笨但我认为最好思路方法如下: (就好像拼磁砖样不用任何 API, 不必声明任何 Type)

　　在 Form 中放个 PictureBoxPicture 属性设定为某张小图AutoSize 属性性设定 True完成模组如下:

Sub PictureTile(Frm As Form, Pic As PictureBox)
　Dim i As Integer
　Dim t As Integer
　Frm.AutoRedraw = True
　Pic.BorderStyle = 0
　For t = 0 To Frm.Height Step Pic.ScaleHeight
　　For i = 0 To Frm.Width Step Pic.ScaleWidth
　　　Frm.PaPicture Pic.Picture, i, t
　　Next i
　Next t
End Sub

　　PictureTile 这个模组共有 2个参数第个是表单名称第 2个则是 PictureBox 名称以下为应用例子:

Private Sub Form_Load
　PictureTile Me, Picture1
End Sub

　　如何把小图片填满 MDIForm 成为背景图？

　　以下这个范例要:

　　1、个 MDIForm:不必设定任何属性

　　2、个 Form1:不定是 MDIChild最好 MDIChild 为 False但是 AutoRedraw 设成 True

　　3、Form1 上面放个隐藏 PictureBox:名称为 Picture1不必设定 Picture 属性

　　4、张图片完整路径

’将以下模组放入 MDIForm 声明区中:

Sub TileMDIBkgd(MDIForm As Form, bkgdtiler As Form, bkgdfile As String)
If bkgdfile = "" Then Exit Sub
Dim ScWidth%, ScHeight%
ScWidth% = Screen.Width / Screen.TwipsPerPixelX
ScHeight% = Screen.Height / Screen.TwipsPerPixelY
Load bkgdtiler
bkgdtiler.Height = Screen.Height
bkgdtiler.Width = Screen.Width
bkgdtiler.ScaleMode = 3
bkgdtiler!Picture1.Top = 0
bkgdtiler!Picture1.Left = 0
bkgdtiler!Picture1.Picture = LoadPicture(bkgdfile)
bkgdtiler!Picture1.ScaleMode = 3

For n% = 0 To ScHeight% Step bkgdtiler!Picture1.ScaleHeight
For o% = 0 To ScWidth% Step bkgdtiler!Picture1.ScaleWidth
bkgdtiler.PaPicture bkgdtiler!Picture1.Picture, o%, n%
Next o%
Next n%

MDIForm.Picture = bkgdtiler.Image
Unload bkgdtiler
End Sub

　　以下为应用例子:

Private Sub MDIForm_Load
TileMDIBkgd Me, Form1, "c:\windows\Tiles.bmp"
End Sub

　　关闭指定

　　要做到像 Task Manager 样可以关闭指定思路方法如下:

　　在声明区中放入以下声明:(16位　改成 win31 API)

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_CLOSE = &H10

　　以下的范例示范如何关闭个视窗标题 (Caption) 为 【小算盘】:

Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "小算盘")
Debug.Pr winHwnd
If winHwnd <> 0 Then
　RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
　If RetVal = 0 Then
　　MsgBox "Error posting message."
　End If
Else
　MsgBox "并未开启小算盘."
End If

　　如何隐藏及再显示鼠标

　　很简单只用到了个 ShowCursor API参数也很简单只有个 bShow设定值如下:

True:显示鼠标 / False:隐藏鼠标

Declare Function ShowCursor Lib "user32" Alias "ShowCursor" (ByVal bShow As Long) As Long

　　如何从您应中结束 Windows 重开机？

　　很多软件Software在 Setup 完的后都会自动关机重开机以便让某些设定值可以生效其实这个功能很简单只要几行指令就可以做到了！

　　关键就是要使用 ExitWindowsEx 这个 API这个 API 只有 2个参数第个参数是个 Flag目是要告诉 Windows 要以什么方式关机在下面声明中会列出可用 Flag 常数值至于第 2个参数则是个保留值只要设定成 0 就可以了

　　很重要点是:如果您想要让关机动作更顺利记得要 Unload 您！

’在声明区中 (Bas Module / Form Module) 加入以下声明:

Public Const EWX_LOGOFF = 0 ’这 4个常数值可以并用
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

’例子:如果您想强迫关机重开机码如下:

ret = ExitWindowsEx(EWX_FORCE OR EWX_REBOOT, 0)

　　如何用 VB 启动其他或开启各类文件？

　　要在 VB 中启动其他或开启各类文件最简单思路方法就是使用 Shell 例如:要开启 C:\Test.txt 这个文字文件则要启动记事本来开启这个文件案如下:

Dim RetVal As Long
RetVal = Shell("C:\Windows\Notepad.exe C:\Test.txt", 3) ’3代表视窗会最大化并具有驻点细节请查 Help

　　以上语法虽然很简单但有个风险若是我们不知道开启文件执行文件位置则便会有产生尤其般软件Software在安装时候都可以让使用者自行选择安装目录所以执行文件路径不能写死在中要解决这个问题就是在注册文件中找到该副文件名的启动位置再放入 Shell 中

　　但是以上作法必须熟悉注册文件而且必须使用 Windows API 来 Call (注册文件存取以后会有专文来介绍说明)如果您对注册文件存取及 API 使用都很纯熟话当然没问题但是有些人对于注册文件会有畏惧这时候您可以使用下面思路方法: Shell("Start C:\Test.txt")

　　您完全不用知道这份文件启动是什么？它放在什么地方？参数 Start 便会自动依照附文件名到注册文件中找到启动来开启该份文件案！ 不赖吧！

　　注:在 Windows 95/98/NT 平台中, 什么副文件名的文件案, 该由什么执行文件来启动, 都设在关联中,

　　代码为 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions

　　例如: 名称为 ".DOC" 的资料为 "C:\Progra~1\Micros~2\Office\WINWORD.EXE ^.DOC"

　　名称为 ".TXT" 的资料为 "notepad.exe ^.txt"

　　注 2:使用 Start 的唯缺点为 "会比直接指定执行文件稍为慢 0.5-1 秒钟."

　　如何找出 Windows 目录正确路径？

　　有时候我们在中必须用到 Windows 目录以存取 Windows 目录下文件照理说这应该是最简单功能前提是每个人在 Setup Windows 必须采用 Windows 预设目录名称也就是 C:\Windows但是常常不是这样有时候由於要使新旧版本共存或者其他原因有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......

　　若是中必须用到 Windows 目录要找到正确路径做法如下:

’在声明区中加入以下声明:

Const MAX_PATH = 260

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function GetWinPath
　Dim strFolder As String
　Dim lngResult As Long
　strFolder = String(MAX_PATH, 0)
　lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
　If lngResult <> 0 Then
　　GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
　Else
　　GetWinPath = ""
　End If
End Function

’在中使用思路方法如下:

Private Sub Command1_Click
　Call MsgBox("您电脑中 Windows 目录正确路径是: " & GetWinPath, vbInformation)
End Sub

　　让您文字框有 Undo / Redo 功能

　　很多软件Software都有提供 Undo / Redo 功能Microsoft 产品都可以提供多次 Undo 反悔功能更强大！

　　在 VB 中我们也可以提供这样功能！不过只能 Undo / Redo 次

’在声明区中加入以下声明: ’32位元
’Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
’Const EM_UNDO = &HC7

’16位元
Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Const WM_USER = &H400
Const EM_UNDO = WM_USER + 23

’在中使用方式如下: ( Undo Text1 中输入 )

Private Sub Command1_Click
　Dim UndoResult As Long
　UndoResult = SendMessage(Text1.hwnd, EM_UNDO, 0, 0)
　’传回值 UndoResult = -1 表示 Undo 不成功
End Sub
’使用以上思路方法第次是 Undo 第 2次就等于是 Redo

　　如何得到某年每个月第天是星期几

Private Sub Command1_Click
Dim i As Integer, A As Integer, B As Integer, C As String
A = InputBox("请输入年份", "某年每个月第天是星期几")
Form1.Cls
For i = 1 To 12
C = A & "-" & i & "-1"
B = Weekday(C)
Select Case B
Case vbSunday
Pr A & "年" & i & "月1日是 星期日"
Case vbMonday
Pr A & "年" & i & "月1日是 星期"
Case vbTuesday
Pr A & "年" & i & "月1日是 星期 2"
Case vbWednesday
Pr A & "年" & i & "月1日是 星期 3"
Case vbThursday
Pr A & "年" & i & "月1日是 星期 4"
Case vbFriday
Pr A & "年" & i & "月1日是 星期 5"
Case vbSaturday
Pr A & "年" & i & "月1日是 星期 6"
End Select
Next i

End Sub

　　如何隐藏及显示任务栏？

　　有时候我们希望在我们执行中将任务栏隐藏让桌面变得比较清爽等到我们执行完毕的后再将任务栏显示出来这时就要用到 SetWindowPos 这个 API 了！

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 Command1_Click
　Dim Thwnd As Long
　Thwnd = FindWindow("Shell_traywnd", "")
　Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub

’在中若要再显示任务栏

Private Sub Command2_Click
　Dim Thwnd As Long
　Thwnd = FindWindow("Shell_traywnd", "")
　Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub

　　模拟 Windows 资源回收站！

　　您现在将屏幕上所有视窗全部缩小找到资源回收站按鼠标右键选择【属性】便会出现【资源回收站】属性问话框

　　其中有几个选项如下:

　　1、不要将文件移到资源回收站删除时立即移除文件

　　2、显示删除确认对话框？

　　根据以上的状况文件的删除有 3种情形:

　　1、删除文件出现确认对话框文件移到资源回收站

　　2、删除文件出现确认对话框文件不移到资源回收站

　　3、删除文件不出现确认对话框文件也不移到资源回收站

　　模拟如下:

’在模组声明区中加入以下声明:

Public Type SHFILEOPSTRUCT
　hwnd As Long
　wFunc As Long
　pFrom As String
　pTo As String
　fFlags As Integer
　fAnyOperationsAborted As Long
　hNameMappings As Long
　lpszProgressTitle As Long
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40 ’可以还原
Public Const FOF_NOCONFIRMATION = &H10 ’不出现确认对话框
Public Const FOF_SILENT = &H4

’在中的使用思路方法如下:
’以下的例子会出现确认对话框文件也会移到资源回收站

Private Sub Command1_Click
　Dim SHop As SHFILEOPSTRUCT
　Dim strFile As String ’要删除文件(含全路径)
　strFile = "c:\test.txt"

　With SHop
　　.wFunc = FO_DELETE
　　.pFrom = strFile
　　.fFlags = FOF_ALLOWUNDO
　End With

　SHFileOperation SHop
End Sub

’若要调整只要更改 fFlags 的值即可如下:
.fFlags = FOF_SILENT ’删除文件出现确认对话框文件不移到资源回收站
.fFlags = FOF_NOCONFIRMATION ’删除文件不出现确认对话框文件也不移到资源回收站

　　如何得到文件路径文件名

Dim sFilePath As String
sFilePath = "C:\Windows\\sytem.dll"

Dim lGetLen As Long, lNum As Long
Dim sGetFile As String, sTemp As String
lGetLen = Len(sFilePath) ’得到文件路径长度
sTemp = lGetLen
For lNum = 1 To lGetLen
　If Left(sGetFile, 1) = "\" Then Exit For
　sGetFile = Mid(sFilePath, sTemp, lNum)
　sTemp = sTemp - 1
Next lNum
sGetFile = Mid(sGetFile, 2) ’得到文件名
MsgBox sGetFile

　　如何防止使用者按下 CTRL + ALT + DEL

　　有些时候我们应用执行时不希望使用者按下 CTRL + ALT + DEL 来异常结束或关机这时候我们可以在启动时将 CTRL + ALT + DEL 功能键的功能取消然后在结束的前再从新恢复 CTRL + ALT + DEL 的功能

　　在模组声明区中加入以下声明及模组:

Declare Function ParametersInfo Lib "user32" Alias "ParametersInfoA" (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 = ParametersInfo(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 = ParametersInfo(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

　　如何取得文件大小？

　　VB6 提供了个新物件模型叫做 FSO (File Object) 物件模型运用它我们可以很方便处理磁盘、资料夹和文件些动作

　　FSO 物件模型含有好几个物件其中有个 File 物件是用来求得文件相关资讯在目前这个主题我们就可以使用 File 物件！它有个属性是 Size对文件来说就是指文件大小 (单位为位元组) (注)

　　虽然使用 File 物件 Size 属性就可以求得文件大小但是它有以下 2个缺点:

　　1、只能用于 VB6 以后版本

　　2、它不是 VB6 内定功能必须另外引用 Scrrun.dll (Microsoft Scripting Runtime) 才可以！

　　以下 2个思路方法就可以使用在所有 VB 版本中 (含 VB6)而且是 VB 内定功能:

　　1、FileLen :返回个 Long代表个文件长度单位是位元组

　　语法:FileLen(pathname) ’ pathname 是全路径的文件名称

　　适用:取得个尚未开启文件长度大小 (注 2)

　　2、LOF :返回个 Long 单位为位元组用来代表由 Open 陈述式所开启文件的大小

　　语法:LOF(filenumber) ’ filenumber 是个文件代码

　　适用:取得个已开启文件长度大小

　　注:File 物件 Size 属性除了可以求得个文件大小也可以用来取得整个目录所有文件大小！

　　注 2:使用 FileLen 时如果所指定文件正在开启中则所返回值是这个文件在开启前大小

　　如何移除或更改桌面背景底色图案 (Wallpaper)？

　　ParametersInfo 这个 API 可以设定许多 Windows 系统功能参数而其中个参数就是桌面底图！通常般使用者会透过控制面板中【显示器】来设定桌面底图

　　在底下范例中我们使用 SPI_SETDESKWALLPAPER 这个参数及图片文件名称来设定新桌面底图同时使用 SPIF_SENDWININICHANGE 来通知各个视窗这个改变

’在表单声明区中加入以下声明及常数:

Private Declare Function ParametersInfo Lib "user32" Alias "ParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long

Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2

’在表单上加入个 CommandButton (Command1) 来移除桌面底图码如下:

Private Sub Command1_Click
　Dim X As Long
　X = ParametersInfo(SPI_SETDESKWALLPAPER, 0&, "(None)", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
　MsgBox "桌面底图 (Wallpaper) 已经被移除"
End Sub

’在表单上加入另个 CommandButton (Command2) 来更改桌面底图码如下:

Private Sub Command2_Click
　Dim FileName As String
　Dim X As Long
　FileName = "c:\windows\test.bmp"
　X = ParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
　MsgBox "桌面底图 (Wallpaper) 已经被更改"
End Sub  

　　个快速注册 DLL 及 OCX 思路方法

　　有时候我们在 VB 中要引用某个 DLL 或 OCX 时会出现文件未注册讯息这时我们可以使用人工注册思路方法也就是直接在命令列中使用 regsvr32.exe 来做做法如下:

　　文件注册:C:\Windows\\Regsvr32.exe C:\Windows\\Test.ocx

　　取消注册:C:\Windows\\Regsvr32.exe /u C:\Windows\\Test.ocx

　　这些动作我们也可以直接写到中使用 Shell 来执行但是我现在要说都不是上面提到思路方法！

　　注意看罗！思路方法如下:

　　1、在资源管理器中找到 C:\Windows\\Regsvr32.exe 并【复制】 ( 按鼠标右键选复制 )

　　2、将目录移到 C:\Windows\SendTo 后执行【贴上快捷方式】 ( 按鼠标右键选贴上快捷方式 )

　　3、将快捷方式名称改成【REGISTER】

　　4、OK

　　现在如果您想替某个文件做注册动作例如:C:\Windows\\Test.ocx您只要打开资源管理器找到 C:\Windows\\Test.ocx按鼠标右键选【传送到】【REGISTER】即可完成注册动作了！

　　注:有个地方要注意是Regsvr32.exe 只能注册 32 位文件！如果要用它来注册 16 位文件会有讯息产生

　　如何用TextBox打开和保存文件

　　作为轻量级Control控件TextBoxControl控件使用率很高但相关资料极少谈及如何用TextBoxControl控件打开和保存文件大都采用回避态度对VB初学者带来很多不便笔者近日为友人做个英文朗读软件Software按友人要求软件Software要能象MS记事本那样能打开和保存文档其实实现思路方法并不复杂现将心得体会写出来希望对大家有帮助如果您有更好思路方法请来信:[email protected]

’新建标准EXE加入个TextBoxControl控件个公共对话框两个菜单

’打开
Private Sub mnuOpen_Click
　CommonDialog1.Filter = "文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"
　CommonDialog1.ShowOpen
　Open CommonDialog1.FileName For Input As #1
　Text1.Text = StrConv(InputB$(LOF(1), 1), vbUnicode)
　Close #1
End Sub

’保存
Private Sub mnuSave_Click
　On Error Resume Next
　CommonDialog1.Filter ="文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"
　CommonDialog1.ShowSave
　Open CommonDialog1.FileName For Output As #1
　Pr #1, Text1.Text
　Close 1
End Sub

　　TextBox只支持打开64K以下文件建议最好设置出错处理以上在PWin98、VB6.0下调试通过

　　如何判断目前文件资源管理器中文件名称的扩展文件名是显示或隐藏？

　　由于我在集团性资讯处工作所负责公司系统有是属于外点例如润泰建设有个单位是行销业务处他们工作是卖公司盖房子所以他们业务人员平常都是待在各工地接待中心我替他们开发销售系统在工地部份是属于单机作业使用 Access 资料库每个星期资料回传总公司次

　　业务人员由于流动性大不太了解系统有时候系统出了问题业务人员又搞不清楚状况于是我会要求他们将资料库 sale.mdb 回传公司结果常闹笑话原来他们回传公司常常不是 sale.ldb 就是 sale.exe为什么呢？ 原因很简单他们文件资源管理器中设定了将扩展文件名隐藏起来结果只看到 3个区别图示 sale 文件 (分别是 Sale.mdb、Sale.ldb、Sale.exe)不太会操作业务人员根本分不清楚那个图示 sale 文件才是资料库文件案！

　　我们在 VB 中要如何判断目前文件资源管理器中设定是否显示扩展文件名呢？

Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Private Function HasExtension(sFileName As String) As Long
　Dim sTemp As String
　Dim lTemp As Long

　sTemp = String(1, 0)
　lTemp = GetFileTitle(sFileName, sTemp, Len(sTemp))
　If lTemp < 0 Then HasExtension = -1: Exit Function
　sTemp = String(lTemp, 0)
　Call GetFileTitle(sFileName, sTemp, Len(sTemp))

　If (Left$(Right$(Left$(sTemp, lTemp - 1), 4), 1)) = "." Then
　　HasExtension = 1
　Else
　　HasExtension = 0
　End If
End Function

　　若有显示扩展文件名返回值是 1否则返回0

上篇文章: 扫描ftp密码代码

下篇文章: 利用OllyDbg找出旋风中文编辑器注册码

延伸阅读

• 2009-1-15-- visualbasic:Visual Basic 编码
• 2009-1-15-- visualbasic:Visual Basic模块和过程设计
• 2009-1-15-- visualbasic:Visual Basic 概述
• 2009-1-15-- visualbasic6.0:用Visual Basic6.0实现电影特效
• 2009-1-15-- visualbasic6.o:Visual Basic实现对I/O端口操作
• 2009-1-15-- visualbasic:Visual Basic中如何处理HTML文档和剪贴板
• 2009-1-15-- visualbasic:Visual Basic 属性、思路方法和事件 6
• 2009-1-15-- visualbasic编程:Visual Basic中的界面设计原则和编程窍门技巧
• 2009-1-15-- visualbasic:Visual Basic COM基础讲座的类的建立
• 2009-1-15-- visualbasic:利用Visual Basic常用Control控件操作文件