vb6 mysql源码,VB 精典适用源代码

查找方法：按ctrl+f，输入要查找的问题关键字即可

每个问题中间用///分隔，这只是一部分最常见到的问题，以后会逐渐更新。

如何用VB建立快捷方式

Private Declare FunctionfCreateShellLinkLib"STKIT432.DLL"(ByVallpstrFolderNameAs String,ByVallpstrLinkNameAs String,ByVallpstrLinkPathAs String,ByVallpstrLinkArgsAs String)As Long

SubCommand1_Click()DimlReturnAs 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 启动时自动执行？

有以下二个方法：

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

方法2:

在注册档 HKEY_LOCAL_MACHINE 中找到以下机码

\Software\Microsoft\Windows\CurrentVersion\Run

新增一个字串值，包括二个部份1.名称部份：自己取名，可设定为 AP 名称。2.资料部份：则是包含'全路径档案名称' 及 '执行参数'例如：

Value Name = Notepad

Value Data = c:\windows\notepad.exe

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

参考下列程序：SubText1_KeyPress(KeyAsciiAs Integer)IfKeyAscii <48orKeyAscii >57ThenKeyAscii =0End If

End Sub

我希望 TextBox 中能不接受某些特定字符，例如'@#$%"，有没有简单一点的写法？方法有好几种, 以下列举二种：

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

方法2: 将要剔除的字符统统放在一个字串中，只要一个IF判断即可 !! 如下：Private SubText1_KeyPress(KeyAsciiAs Integer)DimsTemplateAs StringsTemplate ="!@#$%^&*()_+-="'用来存放不接受的字符IfInStr(1, sTemplate, Chr(KeyAscii)) >0ThenKeyAscii =0End If

End Sub

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

这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox 中的所有字符。Private SubText1_GotFocus()

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

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

使用：DimFlagAs BooleanFlag = Fun_FloppyDrive("A:")IfFlag =False ThenMsgBox"A:驱没有准备好，请将磁盘插入驱动器！", vbCritical'-------------------------------

'函数:检查软驱中是否有盘的存在

'-------------------------------Private FunctionFun_FloppyDrive(sDriveAs String)As Boolean

On Error Resume NextFun_FloppyDrive = Dir(sDrive) <>""End Function

如何弹出和关闭光驱托盘？OptionExplicitPrivate Declare FunctionmciSendStringLib"winmm.dll"Alias"mciSendStringA"(ByVallpstrCommandAs String,ByVallpstrReturnStringAs String,ByValuReturnLengthAs Long,ByValhwndCallbackAs Long)As Long

Private SubCommand1_Click()

mciExecute"set cdaudio door open"'弹出光驱Label2.Caption ="弹 出"End Sub

Private SubCommand2_Click()

Label2.Caption ="关 闭"mciExecute"set cdaudio door closed"'合上光驱UnloadMe

End

End Sub

如何让你的程序在任务列表隐藏Private Declare FunctionRegisterServiceProcessLib"kernel32"(ByValProcessIDAs Long,ByValServiceFlagsAs Long)As Long

Private Declare FunctionGetCurrentProcessIdLib"kernel32"()As Long'请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了Private SubCommand1_Click()

i = RegisterServiceProcess(GetCurrentProcessId,1)End Sub

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

以下这个例子，当 User 在 Text1 中按下'Enter' 键后，滑鼠游标会自动移到 Command2 按钮上方请在声明区中加入以下声明：'16 位版本： ( Sub 无传回值 )Declare SubSetCursorPosLib"User"(ByValXAs Integer,ByValYAs Integer)'32 位版本： ( Function 有传回值，Integer 改成 Long )Declare FunctionSetCursorPosLib"user32"(ByValxAs Long,ByValyAs Long)As Long'在 Form1 中加入以下程序码：Private SubText1_KeyPress(KeyAsciiAs Integer)IfKeyAscii =13Thenx% = (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 SubReleaseCaptureLib"User"()Private Declare SubSendMessageLib"User"(ByValhwndAs Integer,ByValwMsgAs Integer,ByValwParamAs Integer, lParamAs Long)'32 位版本： ( Function 有返回值，Integer 改成 Long )Private Declare FunctionReleaseCaptureLib"user32"()As Long

Private Declare FunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAs Long,ByValwMsgAs Long,ByValwParamAs Long, lParamAsAny)As Long'共用常数：ConstWM_SYSCOMMAND =&H112ConstSC_MOVE =&HF012'若要移动 Form，程序码如下：Private SubForm_MouseDown(ButtonAs Integer, ShiftAs Integer, XAs Single, YAs Single)DimiAs Longi = ReleaseCapture

i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE,0)End Sub'以上功能也适用于用鼠标在 Form 中移动控制项，程序码如下：Private SubCommand1_MouseDown(ButtonAs Integer, ShiftAs Integer, XAs Single, YAs Single)DimiAs Longi = ReleaseCapture

i = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE,0)End Sub

检查文件是否存在？FunctionFileExists(filenameAs String)As Integer

DimiAs Integer

On Error Resume Nexti = Len(Dir$(filename))IfErrori =0ThenFileExists =False ElseFileExists =True

End Function

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

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

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

一、用data控件进行数据库链接，可以这样：

在form_load()过程中放入：privateform_load()DimstrAs String'定义str = App.PathIfRight(str,1) <>"\"Thenstr = str +"\"End Ifdata1.databasename=str &"\数据库名"data1.recordsource="数据表名"data1.refreshsub end这几句话的意为，打开当前程序运行的目录下的数据库。

你只要保证你的数据库在你程序所在的目录之下就行了。

二、利用adodc(ADO Data Control)进行数据库链接：privateform_load ()DimstrAs String'定义str = App.PathIfRight(str,1) <>"\"Thenstr = str +"\"End Ifstr ="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.Refreshend sub三、利用DataEnvironment进行数据库链接

可在过程中放入：On Error Resume Next

IfDataEnvironment1.rsCommand1.State <> adStateClosedThenDataEnvironment1.rsCommand1.Close'如果打开，则关闭End If'i = InputBox("请输入友人编号:", "输入")

'If i = "" Then Exit SubDataEnvironment1.Connection1.Open App.Path &"\userdatabase\tsl.mdb"DataEnvironment1.rsCommand1.Open"select * from table3 where 编号='"& i &"'"'Set DataReport2.DataSource = DataEnvironment1

'DataReport2.DataMember = "command1"

'DataReport2.showend sub四、利用ADO(ActiveX Data Objects)进行编程：

建立连接：dimconnas newadodb.connectiondimrsas newadodb.recordsetdimstr

str = App.PathIfRight(str,1) <>"\"Thenstr = str +"\"End Ifstr ="Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source="& str &"\tsl.mdb"conn.open str

rs.cursorlocation=aduseclient

rs.open"数据表名",conn,adopenkeyset.adlockpessimistic

用完之后关闭数据库：

conn.closesetconn=nothing

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

假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。

( ScriptControl 控件附属于VB6.0，如果安装后没有看到此一控件，可在光盘的 \Common\Tools\VB\Script 目录底下找此一控件， 其.文件名为Msscript.ocx。) 假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click事件中编写如下代码：DimStatementAs StringStatement ="X="+ Text1.Text + vbCrLf + _"Y="+ Text2.Text + vbCrLf + _"MsgBox ""计算结果="" & Y "ScriptControl1.ExecuteStatement( Statement

如何让一个 App 永远保持在最上层 ( AlwaysonTop )

请在声明区中加入以下声明Private Declare FunctionSetWindowPosLib"user32"(ByValhwndAs Long,ByValhWndInsertAfterAs Long,ByValxAs Long,ByValyAs Long,ByValcxAs Long,ByValcyAs Long,ByValwFlagsAs Long)As Long

ConstSWP_NOMOVE =&H2'不更动目前视窗位置ConstSWP_NOSIZE =&H1'不更动目前视窗大小ConstHWND_TOPMOST = -1'设定为最上层ConstHWND_NOTOPMOST = -2'取消最上层设定ConstFLAGS = SWP_NOMOVEorSWP_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 FunctionShellExecuteLib"shell32.dll"Alias"ShellExecuteA"(ByValhWndAs Long,ByVallpOperationAs String,ByVallpFileAs String,ByVallpParametersAs String,ByVallpDirectoryAs String,ByValnShowCmdAs Long)As Long在程序中

Intranet：

ShellExecute Me.hWnd,"open","http://Intranet主机/目录","","",5Internet：

ShellExecute Me.hWnd,"open","http://www.ruentex.com.tw","","",5

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

这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个 API ，例如：Private Declare FunctionCreateEllipticRgnLib"gdi32"(ByValX1As Long,ByValY1As Long,ByValX2As Long,ByValY2As Long)As Long

Private Declare FunctionSetWindowRgnLib"user32"(ByValhWndAs Long,ByValhRgnAs Long,ByValbRedrawAs Boolean)As Long

Private SubForm_Load()DimlReturnAs LongMe.Show

lReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10,10,340,150),True)End Sub执行结果图片

CreateEllipticRgn 之四个参数说明如下：

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

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

X2：椭圆长边的长度

Y2：椭圆短边的长度的

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

其实 Form 右上方之三个按钮分别对应到 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 的 hwndPrivate Declare FunctionGetSystemMenuLib"user32"Alias"GetSystemMenu"(ByValhwndAs Long,ByValbRevertAs Long)As Long'移除系统 Menu 的 APIPrivate Declare FunctionRemoveMenuLib"user32"Alias"RemoveMenu"(ByValhMenuAs Long,ByValnPositionAs Long,ByValwFlagsAs Long)As Long'第一个参数是系统 Menu 的 hwnd

'第二个参数是要移除选项的 Index

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

请在声明区中放入以下声明ConstGWL_EXSTYLE = (-20)ConstWS_EX_TRANSPARENT =&H20&ConstSWP_FRAMECHANGED =&H20ConstSWP_NOMOVE =&H2ConstSWP_NOSIZE =&H1ConstSWP_SHOWME = SWP_FRAMECHANGEDorSWP_NOMOVEorSWP_NOSIZEConstHWND_NOTOPMOST = -2Private Declare FunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhwndAs Long,ByValnIndexAs Long,ByValdwNewLongAs Long)As Long

Private Declare FunctionSetWindowPosLib"user32"(ByValhwndAs Long,ByValhWndInsertAfterAs Long,ByValxAs Long,ByValyAs Long,ByValcxAs Long,ByValcyAs Long,ByValwFlagsAs Long)As Long在 Form_Load 使用的范例如下：Private SubForm_Load()

SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT

SetWindowPos Me.hwnd, HWND_NOTOPMOST,0&,0&,0&,0&, SWP_SHOWME

Me.RefreshEnd Sub

如何在 Menu 中加入MM的图案？

在模组中加入以下程序码：Declare FunctionGetMenuLib"user32"(ByValhwndAs Long)As Long

Declare FunctionGetSubMenuLib"user32"(ByValhMenuAs Long,ByValnPosAs Long)As Long

Declare FunctionGetMenuItemIDLib"user32"(ByValhMenuAs Long,ByValnPosAs Long)As Long

Declare FunctionSetMenuItemBitmapsLib"user32"(ByValhMenuAs Long,ByValnPositionAs Long,ByValwFlagsAs Long,ByValhBitmapUncheckedAs Long,ByValhBitmapCheckedAs Long)As Long

Public ConstMF_BITMAP =&H4&

Type MENUITEMINFO

cbSizeAs LongfMaskAs LongfTypeAs LongfStateAs LongwIDAs LonghSubMenuAs LonghbmpCheckedAs LonghbmpUncheckedAs LongdwItemDataAs LongdwTypeDataAs StringcchAs Long

EndTypeDeclare FunctionGetMenuItemCountLib"user32"(ByValhMenuAs Long)As Long

Declare FunctionGetMenuItemInfoLib"user32"Alias"GetMenuItemInfoA"(ByValhMenuAs Long,ByValunAs Long, _ByValbAs Boolean, lpMenuItemInfoAsMENUITEMINFO)As Boolean

Public ConstMIIM_ID =&H2Public ConstMIIM_TYPE =&H10Public ConstMFT_STRING =&H0&

在 Form 中加入一个 PictureBox，属性设定为：

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

在 Form_Load 中的程序码如下：Private SubForm_Load()'取得程序中 Mennu 的 handlehMenu& = GetMenu(Form1.hWnd)'取得第一个 submenu 的 handlehSubMenu& = GetSubMenu(hMenu&,0)'取得 Submenu 第一个选项的 menuIdhID& = GetMenuItemID(hSubMenu&,0)'加入图片SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture'在一个 Menu 选项中您一共可以加入二张图片

'一张是 checked 状态用，一张是 unchecked 状态用End Sub89、如何把小图片填满 Form 成为背景图？

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

在 Form 中放一个 PictureBox，Picture 属性设定为某一张小图，AutoSize 属性性设定 True，完成的模组如下：SubPictureTile(FrmAsForm, PicAsPictureBox)DimiAs Integer

DimtAs IntegerFrm.AutoRedraw =TruePic.BorderStyle =0Fort =0ToFrm.HeightStepPic.ScaleHeightFori =0ToFrm.WidthStepPic.ScaleWidth

Frm.PaintPicture Pic.Picture, i, tNextiNexttEnd SubPictureTile 这个模组共有二个参数，第一个是表单名称，第二个则是 PictureBox 的名称。以下为一应用实例：Private SubForm_Load()

PictureTileMe, Picture1End Sub90、如何把小图片填满 MDIForm 成为背景图？

以下这个范例，　要：1、一个 MDIForm：不必设定任何属性。2、一个 Form1：不一定是 MDIChild，最好 MDIChild 为 False，但是 AutoRedraw 设成 True。3、Form1 上面放一个隐藏的 PictureBox：名称为 Picture1，不必设定 Picture 属性。4、一张图片的完整路径。'将以下模组放入 MDIForm 的声明区中：SubTileMDIBkgd(MDIFormAsForm, bkgdtilerAsForm, bkgdfileAs String)Ifbkgdfile =""Then Exit Sub

DimScWidth%, ScHeight%

ScWidth% = Screen.Width / Screen.TwipsPerPixelX

ScHeight% = Screen.Height / Screen.TwipsPerPixelY

Load bkgdtiler

bkgdtiler.Height = Screen.Height

bkgdtiler.Width = Screen.Width

bkgdtiler.ScaleMode =3bkgdtiler!Picture1.Top =0bkgdtiler!Picture1.Left =0bkgdtiler!Picture1.Picture = LoadPicture(bkgdfile)

bkgdtiler!Picture1.ScaleMode =3Forn% =0ToScHeight%Stepbkgdtiler!Picture1.ScaleHeightForo% =0ToScWidth%Stepbkgdtiler!Picture1.ScaleWidth

bkgdtiler.PaintPicture bkgdtiler!Picture1.Picture, o%, n%Nexto%Nextn%

MDIForm.Picture = bkgdtiler.Image

Unload bkgdtilerEnd Sub以下为一应用实例：Private SubMDIForm_Load()

TileMDIBkgdMe, Form1,"c:\windows\Tiles.bmp"End Sub

关闭指定的程序

要做到像 Task Manager 一样，可以关闭指定的程序，方法如下：

在声明区中放入以下声明：(16位　改成 win31 API)Declare FunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAs String,ByVallpWindowNameAs String)As Long

Declare FunctionPostMessageLib"user32"Alias"PostMessageA"(ByValhwndAs Long,ByValwMsgAs Long,ByValwParamAs Long, lParamAsAny)As Long

Public ConstWM_CLOSE =&H10以下之范例示范如何关闭一个视窗标题 (Caption) 为 【小算盘】的程序：DimwinHwndAs Long

DimRetValAs LongwinHwnd = FindWindow(vbNullString,"小算盘")

Debug.Print winHwndIfwinHwnd <>0ThenRetVal = PostMessage(winHwnd, WM_CLOSE,0&,0&)IfRetVal =0ThenMsgBox"Error posting message."End If

ElseMsgBox"并未开启小算盘程序."End If

如何隐藏及再显示鼠标

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

True：显示鼠标 / False：隐藏鼠标Declare FunctionShowCursorLib"user32"Alias"ShowCursor"(ByValbShowAs Long)As Long

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

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

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

很重要的一点是：如果您想要让关机动作更顺利，记得要 Unload 您的程序！'在声明区中 (Bas Module / Form Module) 加入以下声明：Public ConstEWX_LOGOFF =0'这四个常数值可以并用Public ConstEWX_SHUTDOWN =1Public Constcolo