vb学习3

加密文件
本例介绍如何加密文件。
Private Sub CodedFile(InputFile As String, OutputFile As String, PasswordKey As Integer)
    Dim Char As String * 1
    '打开要加密/解密的文件
    Open InputFile For Binary As #1
    '打开加密/解密后生成的文件
    Open OutputFile For Binary As #2
    For z = 1 To FileLen(InputFile)
        '读取文件中的字符
        Get 1, , Char
        '与密钥进行异或运算
        Char = Chr$((Asc(Char) Xor PasswordKey))
        '将运算结果写入文件
        Put 2, , Char
    Next z
    '关闭文件
    Close #1
    Close #2
End Sub
Private Sub Command1_Click()
    Dim InputFile As String
    Dim OutputFile As String
    Dim PasswordKey As Integer
    InputFile = InputBox("输入要加密/解密的文件名", "加密/解密")
    OutputFile = InputBox("输入加密/解密后的文件名", "加密 / 解密到")
    PasswordKey = InputBox("输入密钥（整数）", "输入密钥")
    Call CodedFile(InputFile, OutputFile, PasswordKey)
    MsgBox "文件已加密/解密到： " + OutputFile, , "完成"
    End
End Sub

从Excel中读取数据到数据库 本程序可以从Excel中读取数据到Access数据库中。 Option Explicit Private Sub cmdLoad_Click() Dim excel_app As Object Dim excel_sheet As Object Dim db As Database Dim new_value As String Dim row As Integer Screen.MousePointer = vbHourglass DoEvents '建立Excel application对象 Set excel_app = CreateObject("Excel.Application") '打开指定的工作薄 excel_app.Workbooks.Open FileName:=txtExcelFile.Text '判断版本 If Val(excel_app.Application.Version) >= 8 Then Set excel_sheet = excel_app.ActiveSheet Else Set excel_sheet = excel_app End If '打开Access数据库 Set db = OpenDatabase(txtAccessFile.Text) '删除表中原有记录 db.Execute "delete from TestValues" ' 从Excel工作表中获取数据并插入到数据库的TestValues表中 row = 1 Do ' 得到工作表中的值 new_value = Trim$(excel_sheet.Cells(row, 1)) '如果某行空，则停止 If Len(new_value) = 0 Then Exit Do '将获取的值插入到数据库的表TestValues中 db.Execute "INSERT INTO TestValues VALUES (" & new_value & ")" '下一行 row = row + 1 Loop ' 关闭数据库 db.Close '释放内存 Set db = Nothing '关闭工作表，不重新保存 excel_app.ActiveWorkbook.Close False '关闭Excel excel_app.Quit '释放内存 Set excel_sheet = Nothing Set excel_app = Nothing '鼠标指针形状还原 Screen.MousePointer = vbDefault '弹出提示框 MsgBox "Copied " & Format$(row - 1) & " values.", , "Finished" End Sub Private Sub Form_Load() '初始化文件路径 Dim file_path As String file_path = App.Path If Right$(file_path, 1) <> "\" Then file_path = file_path & "\" txtExcelFile.Text = file_path & "XlsToMdb.xls" txtAccessFile.Text = file_path & "XlsToMdb.mdb" End Sub

使用MMControl控件播放媒体文件
本例设计了一个多媒体播放器，它能够播放WAV、MIDI和AVI文件。
Private Sub Check2_Click()
    If Check2.Value = 1 Then
        '关闭AVI文件的声音
        MMControl1.Silent = True
    Else
        '打开AVI文件的声音
        MMControl1.Silent = False
    End If
End Sub
Private Sub ComClose_Click()
    MMControl1.Command = "close"
End Sub

Private Sub ComPlay_Click()
    MMControl1.Command = "close"
    DiaOpen.Filter = "Wav文件|*.wav|MIDI文件|*.mid|AVI文件|*.avi"
    DiaOpen.ShowOpen
    MMControl1.FileName = DiaOpen.FileName
    MMControl1.Command = "open"
    MMControl1.Command = "play"
    LabFile.Caption = DiaOpen.FileName
End Sub

Private Sub Form_Load()
    '初始化
    MMControl1.Visible = False
    MMControl1.Notify = True
    MMControl1.Shareable = False
    MMControl1.TimeFormat = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
    MMControl1.Command = "close"
End Sub
Private Sub MMControl1_StatusUpdate()
    '计算文件总长度，单位为秒
    LabLen.Caption = MMControl1.Length / 1000
    '动态显示当前的播放位置
    LabPlay.Caption = MMControl1.Position / 1000
End Sub
Private Sub MMControl1_Done(NotifyCode As Integer)
    '如果文件播放结束
    If MMControl1.Position = MMControl1.Length Then
        '倒回止文件的起点
        MMControl1.Command = "prev"
        '如果选择了自动重复播放
        If Check1.Value = 1 Then
            MMControl1.Command = "play"
        End If
    End If
End Sub

制作自己的浏览器 本例介绍如何使用VB来编写一个自己的浏览器。 '初始化 Private Sub Form_Load() ComSite.AddItem "清华大学" ComSite.AddItem "首都在线" ComSite.AddItem "中央电视台" ComSite.AddItem "网易" ComSite.AddItem "搜狐" ComSite.Text = "清华大学" '链接到主页 WebBrowser1.GoHome End Sub '设置各控件的位置 Private Sub Form_Resize() If Form1.WindowState = 1 Then Exit Sub End If WebBrowser1.Left = 200 WebBrowser1.Top = 900 WebBrowser1.Width = Form1.ScaleWidth - 400 WebBrowser1.Height = Form1.ScaleHeight - 1500 ProgressBar1.Top = Form1.ScaleHeight - 300 ProgressBar1.Left = Form1.ScaleWidth - 2200 End Sub '链接到主页 Private Sub Comhome_Click() WebBrowser1.GoHome End Sub '后退 Private Sub Comback_Click() On Error GoTo ww WebBrowser1.GoBack Exit Sub ww: MsgBox "没有历史记录", 64, "提示" End Sub '前进 Private Sub ComForward_Click() On Error GoTo ww WebBrowser1.GoForward Exit Sub ww: MsgBox "没有历史记录", 64, "提示" End Sub '选择网址 Private Sub ComSite_Click() Select Case ComSite.Text Case "清华大学" WebBrowser1.Navigate "http://www.tsinghua.edu.cn" '链接到清华大学主页 Case "首都在线" WebBrowser1.Navigate "http://www.263.net" '链接到清华大学主页 Case "中央电视台" WebBrowser1.Navigate "http://www.cctv.com" '链接到清华大学主页 Case "网易" WebBrowser1.Navigate "http://www.163.com" '链接到清华大学主页 Case "搜狐" WebBrowser1.Navigate "http://www.sohu.com" '链接到清华大学主页 Case Else '链接到其他 WebBrowser1.Navigate ComSite.Text End Select End Sub '在地址栏输入地址 Private Sub ComSite_KeyDown(KeyCode As Integer, Shift As Integer) Dim i As Long Dim existed As Boolean '当按下回车键 If KeyCode = 13 Then If Left(ComSite.Text, 7) <> "http://" Then ComSite.Text = "http://" + ComSite.Text End If WebBrowser1.Navigate ComSite.Text For i = 0 To ComSite.ListCount - 1 If ComSite.List(i) = ComSite.Text Then existed = True Exit For Else existed = False End If Next If Not existed Then ComSite.AddItem (ComSite.Text) End If End If End Sub 'web页的标题变化 Private Sub WebBrowser1_TitleChange(ByVal Text As String) '在窗体标题栏上显示web页的标题 Form1.Caption = WebBrowser1.LocationURL '在地址栏中显示web页的标题 ComSite.Text = WebBrowser1.LocationURL End Sub '开始下载 Private Sub WebBrowser1_DownloadBegin() '状态栏显示“Now Linking...” StatusBar1.SimpleText = "Now Linking..." End Sub '下载完成 Private Sub WebBrowser1_DownloadComplete() '状态栏显示Link Finished StatusBar1.SimpleText = "Link Finished" '清除进度条 ProgressBar1.Value = 0 End Sub '下载过程 Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long) '下载进行时进度条变化 If ProgressMax = 0 Then Exit Sub ProgressBar1.Max = ProgressMax If Progress <> -1 And Progress <= ProgressMax Then ProgressBar1.Value = Progress End If End Sub