驱动器操作 Private Sub Dir1_Change()File1.Path = Dir1.PathEnd Sub Private Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd Sub--------------------------------判断光驱/软驱中是否有磁盘Private Sub Drive1_Change()'当驱动器发生改变时使Dir1与其保持一致On Error GoTo IFerr    '拦截错误Dir1.Path = Drive1.DriveExit SubIFerr:                 '如果磁盘错误    MsgBox "请确认驱动器是否准备好或者磁盘已经不可用!", _            vbOKOnly + vbExclamation    Drive1.Drive = Dir1.Path  '忽略驱动器改变    Exit SubEnd Sub----------------------------------------------------------打开URL：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 Private Sub Command1_Click()ShellExecute hwnd, "open", "http://stef.programfan.com", "", "", 1End Sub-----------------------------------------------------------VB中引用地址：SavePicture Picture2.Picture, App.Path & "/Frombmp.ico"Data1.DatabaseName = App.Path & "\address.mdb"Data1.DatabaseName = App.Path & "\data\student.mdb"ShockwaveFlash1.Move = App.Path & "\ico\202.swf"MediaPlayer1.FileName = App.Path & "\danshenqingge.mid" ----------------------------------------------------------退出对话框Dim cccc As Stringcccc = MsgBox("您确实要退出吗？", vbOKCancel + vbInformation, "退出系统")If cccc = vbOK ThenCancel = 0    '退出ElseCancel = 1    '反回主程序End If -----------------------------------------------------------进度条制作Private Sub Form_Load()ProgressBar1.Value = ProgressBar1.MinEnd Sub Private Sub Timer1_Timer()ProgressBar1.Value = ProgressBar1.Value + 5If ProgressBar1.Value = 100 ThenTimer1.Enabled = FalseUnload MeEnd IfEnd Sub----------------------------------------------------------- 移动窗体     类模块中代码(Module) Public Declare Function ReleaseCapture Lib "user32" () As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Const HTCAPTION = 2Public Const WM_NCLBUTTONDOWN = &HA1     窗体中代码(Form) Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  Dim r As Long  Dim i  If Button = 1 Then    i = ReleaseCapture()    r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)  End IfEnd Sub------------------------------------------------------------data控件查找 Private Sub command1_Click()         Form1.Data1.Recordset.FindFirst "name='" & Text1.Text & "'"    If Form1.Data1.Recordset.NoMatch Then        MsgBox "无此人信息，请添加！", vbOKOnly        Unload Me    End IfEnd Sub----------------------------------------------------------------状态栏的时间:StatusBar1.Panels.Item(4) = Date & "=" & Time ------------------------------------------- 注册组件regsvr32 aspnet_isapi.dll-------------------------------------------------------------------字幕Private Sub Timer1_Timer()Dim t As Integer     Label1.Caption = Mid$(Label1.Caption, 2, Len(Label1.Caption) - 1) + Left$(Label1.Caption, 1) End Sub-------------------------------------------------------------------时间日期检测If Not IsDate(text1.txt) Then        MsgBox "您输入的时间无效。"    Else                                                    End If-------------------------------------------------------------------删除文件及文件夹 private sub command1_click() kill file1.path + "\" +file1.filenamefile1.refreshend sub private sub command2_click() kill file1.path + "\" +"*.*" RmDir Dir1.pathend sub-------------------------------------------------------移动文件private sub command2_click() name path1 as path2   msgbox"文件移动成功！"End Sub-------------------------------------------------------------------在应用程序中添加卸载命令$(WinPath)\st6unst.exe -n "$(AppPath)\ST6UNST.LOG"

评论