
常用软件类: |
|杀毒安全 | |联络聊天 | |网络软件 | |多媒体类 | |系统工具 | |图形图像 | |系统工具 | |应用软件 | |行业软件 |
开发设计类: |
|动画制作 | |图像处理 | |3D设计 | |操作系统 | |站长学院 | |网络相关 | |WEB设计 | |数据库类 | |程序开发 |
| 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 |
| 在注册档 HKEY_LOCAL_MACHINE 中找到以下机码 \Software\Microsoft\Windows\CurrentVersion\Run 新增一个字串值,包括二个部份 1. 名称部份:自己取名,可设定为 AP 名称。 2. 资料部份:则是包含 ’全路径档案名称’ 及 ’执行参数’ 例如: Value Name = Notepad Value Data = c:\windows\notepad.exe |
| Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub |
| 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 "set cdaudio door open" ’弹出光驱 Label2.Caption = "弹 出" End Sub Private Sub Command2_Click() Label2.Caption = "关 闭" mciExecute "set 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 |
| ’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 |
| ’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, Shift 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, Shift 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 |
| 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 |
| 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 |
| 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 |
| dim conn as new adodb.connection dim rs as new adodb.recordset 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,adopenkeyset.adlockpessimistic 用完之后关闭数据库: conn.close set conn=nothing |
| Dim Statement As String Statement = "X=" + Text1.Text + vbCrLf + _ "Y=" + Text2.Text + vbCrLf + _ "MsgBox ""计算结果="" & Y " ScriptControl1.ExecuteStatement( Statement |
| 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 SWP_NOMOVE = &H2 ’不更动目前视窗位置 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 |
| 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 |