FileDownLoader1.0 主要代码-优快云博客

本文介绍了一个使用VB.NET实现的文件下载程序，包括进度显示与取消下载的功能，并实现了剪贴板内容变化的监听，当检测到URL时会自动填入下载框。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

下载操作主要代码

Dim theResponse As HttpWebResponse Dim theRequest As HttpWebRequest Try theRequest = WebRequest.Create(Me.txtFileName.Text) theResponse = theRequest.GetResponse Catch ex As Exception MessageBox.Show("下载出错,文件不存在或远程服务出错!", "系统提示", MessageBoxButtons.OK, MessageBoxIcon.Error) Me.btnDownLoad.Focus() Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End Try Dim length As Long = theResponse.ContentLength '文件大小 Dim safedelegate As New ChangeTextsSafe(AddressOf ChangeTexts) Me.Invoke(safedelegate, length, 0, 0, 0) Using sw As New IO.FileStream(strSavePath, IO.FileMode.Create) Dim nRead As Integer = 0 Dim speedtimer As New Stopwatch Dim currentspeed As Double = -1 Dim readings As Integer = 0 Do If Bgw.CancellationPending Then Exit Do End If speedtimer.Start() Dim readBytes(4095) As Byte Dim bytesread As Integer = theResponse.GetResponseStream.Read(readBytes, 0, 4096) nRead += bytesread Dim percent As Short = (nRead * 100) / length Me.Invoke(safedelegate, length, nRead, percent, currentspeed) If bytesread = 0 Then Exit Do sw.Write(readBytes, 0, bytesread) speedtimer.Stop() readings += 1 If readings >= 5 Then currentspeed = 20480 / (speedtimer.ElapsedMilliseconds / 1000) speedtimer.Reset() readings = 0 End If Loop theResponse.GetResponseStream.Close() sw.Close() End Using If Me.Bgw.CancellationPending Then IO.File.Delete(strSavePath) Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(cancelDelegate, True) Exit Sub End If Dim completeDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete) Me.Invoke(completeDelegate, False)

监视剪贴板主要代码

下面是api函数

Declare Function SetClipboardViewer Lib "user32" (ByVal hWndNewViewer As Integer) As Integer Declare Function ChangeClipboardChain Lib "user32" (ByVal hWndRemove As IntPtr, ByVal hWndNewNext As IntPtr) As Boolean Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer

操作代码

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) Const WM_DRAWCLIPBOARD As Integer = &H308 Const WM_CHANGECBCHAIN As Integer = &H30D Select Case m.Msg Case WM_DRAWCLIPBOARD DisplayClipboardData() SendMessage(nextClipboardViewer, m.Msg, m.WParam, m.LParam) Exit Sub Case WM_CHANGECBCHAIN If m.WParam = nextClipboardViewer Then nextClipboardViewer = m.LParam Else SendMessage(nextClipboardViewer, m.Msg, m.WParam, m.LParam) End If Exit Sub Case Else MyBase.WndProc(m) Exit Sub End Select End Sub Private Sub DisplayClipboardData() Try Dim iData As IDataObject = New DataObject() iData = Clipboard.GetDataObject() If iData.GetDataPresent(DataFormats.Text) Then Me.txtFileName.Text = CType(iData.GetData(DataFormats.Text), String) If Not Me.txtFileName.Text.Trim.ToUpper.StartsWith("HTTP://") Then Me.txtFileName.Text = "" End If End If Catch e As Exception MessageBox.Show(e.ToString()) End Try End Sub

在这个事件中添加ChangeClipboardChain(Me.Handle, nextClipboardViewer) 这句代码

Protected Overrides Sub Dispose(ByVal disposing As Boolean) ChangeClipboardChain(Me.Handle, nextClipboardViewer) Try If disposing AndAlso components IsNot Nothing Then components.Dispose() End If Finally MyBase.Dispose(disposing) End Try End Sub