Net Grab Test
May 9, 2008
Option Explicit
Private Sub Command1_Click()
Text2.Text = “”
NetGrab1.DownloadStart Trim$(Text1.Text), vbAsyncReadForceUpdate
End Sub
Private Sub Form_Load()
Text1.Text = “http://www.yahoo.com/samples“
Text2.Text = “”
Label2.Caption = “”
End Sub
Private Sub NetGrab1_DownloadComplete(ByVal nBytes As Long)
Dim Kbps As Double
With NetGrab1
If optType(0).Value Then
Text2.Text = StrConv(.Bytes, vbUnicode)
End If
Kbps = ((nBytes *
/ 1000) / (.Duration / 1000)
Label2.Caption = Format$(nBytes, “#,##0″) & ” bytes (” & _
Format$(Kbps, “0.0″) & ” kbps)”
End With
End Sub
Private Sub NetGrab1_DownloadFailed(ByVal ErrNum As Long, ByVal ErrDesc As String)
Debug.Print “WaaahhhhhH!”, ErrDesc
End Sub
Private Sub NetGrab1_DownloadProgress(ByVal nBytes As Long)
‘ This will never fire in VB5…
Debug.Print “Progress: “; nBytes
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Task Manager
May 9, 2008
Option Explicit
Private Declare Function GetWindowThreadProcessId Lib “user32″ (ByVal hWnd As Long, lpdwProcessId As Long) As Long
‘ Used to cache owner window handle:
Private Declare Function GetWindowLong Lib “user32″ Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HWNDPARENT = (-
Private tasks As CTaskList
Private m_hWndOwner As Long
‘ Control indices
Private Const cEndTask = 0
Private Const cSwitchTo = 1
Private Const cNewTask = 2
‘ Subitem fields
Private Const iStatus = 1
Private Const iHandle = 2
Private Const iProcess = 3
Private Sub Command1_Click(Index As Integer)
Dim hWnd As Long
Dim PID As Long
Dim ndx As Long
Const RunCaption = “Create New Task”
‘ Retrieve hWnd for selected item
If Not ListView1.SelectedItem Is Nothing Then
hWnd = CLng(ListView1.SelectedItem.SubItems(2))
End If
‘ Act on user request
Select Case Index
Case cEndTask
If hWnd Then
‘ Disable this form, and attempt
‘ to shutdown requested task.
Me.Enabled = False
tasks.Activate hWnd:=hWnd
tasks.Terminate hWnd:=hWnd, DialogDelay:=3000
Me.Enabled = True
Me.SetFocus
End If
Case cSwitchTo
If hWnd Then
tasks.Activate hWnd:=hWnd
Me.WindowState = vbMinimized
End If
Case cNewTask
Call ShowRunDialog1( _
hWndOwner:=Me.hWnd, _
Caption:=RunCaption, _
Description:=”Type the name of a folder, program, Internet resource, or document, and Visual Basic will open it for you.”, _
hIcon:=Image2.Picture.Handle)
‘Call ShowRunDialog2( _
hWndOwner:=Me.hWnd, _
Caption:=RunCaption, _
Description:=”Type the name of a folder, program, Internet resource, or document, and Visual Basic will open it for you.”, _
hIcon:=Image2.Picture.Handle)
End Select
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Dim clm As ColumnHeader
With ImageList1
.ImageHeight = 16
.ImageWidth = 16
.UseMaskColor = False
.ListImages.Add , “null”, Image1.Picture
End With
With ListView1
.View = lvwReport
Set clm = .ColumnHeaders.Add(, , “Task”)
Set clm = .ColumnHeaders.Add(, , “Status”, .Width / 5)
Set clm = .ColumnHeaders.Add(, , “hWnd”)
Set clm = .ColumnHeaders.Add(, , “ProcessID”)
.SortOrder = lvwDescending
Set .SmallIcons = ImageList1
.HideSelection = False
End With
Set tasks = New CTaskList
tasks.HungTimeout = 250
Frame1.BackColor = Me.BackColor
Call ResetButtons(False)
App.Title = Me.Caption
m_hWndOwner = GetWindowLong(Me.hWnd, GWL_HWNDPARENT)
Call ProcessPrioritySet(hWnd:=Me.hWnd, Priority:=High)
Me.Show
With ListView1
.ColumnHeaders(1).Width = .Width * 0.65
.ColumnHeaders(2).Width = .Width * 0.25
.ColumnHeaders(3).Width = .Width * 0.25
.ColumnHeaders(4).Width = .Width * 0.25
End With
Call RefreshTaskList
Set ListView1.SelectedItem = Nothing
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub
Private Sub Form_Resize()
Dim Margin As Long
Dim BtnWidth As Long
Margin = ListView1.Left
BtnWidth = Command1(cEndTask).Width
On Error Resume Next
With TabStrip1
.Move .Left, .Left, Me.ScaleWidth - .Left * 2, Me.ScaleHeight - .Left * 2
Frame1.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
End With
With Frame1
ListView1.Move Margin, Margin, .Width - Margin * 2, .Height - Margin * 3 - Command1(cEndTask).Height
Command1(cNewTask).Move .Width - BtnWidth - Margin, .Height - Margin - Command1(cNewTask).Height
Command1(cSwitchTo).Move Command1(cNewTask).Left - BtnWidth - Margin \ 2, Command1(cNewTask).Top
Command1(cEndTask).Move Command1(cSwitchTo).Left - BtnWidth - Margin \ 2, Command1(cNewTask).Top
End With
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
Select Case ColumnHeader.Index
Case 1
With ListView1
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
.Sorted = True
.Sorted = False
End With
Case 2
Call RefreshTaskList
End Select
End Sub
Private Sub ListView1_DblClick()
‘ Switch to selected task.
Call Command1_Click(cSwitchTo)
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim itm As ListItem
With ListView1
Set itm = .HitTest(x, y)
If itm Is Nothing Then
Set .SelectedItem = Nothing
End If
Call ResetButtons(Not (.SelectedItem Is Nothing))
End With
End Sub
Private Sub Timer1_Timer()
Call RefreshTaskList
End Sub
Private Sub RefreshTaskList()
Dim i As Long
Dim key As String
Dim itm As ListItem
Dim nStatus As TaskStatus
With ListView1.ListItems
For i = .Count To 1 Step -1
If tasks.Valid(hWnd:=CLng(.Item(i).SubItems(iHandle))) = False Then
If .Item(i).Selected Then
Set ListView1.SelectedItem = Nothing
Call ResetButtons(False)
End If
.Remove i
End If
Next i
End With
tasks.Refresh
For i = 1 To tasks.Count
If tasks.hWnd(i) <> Me.hWnd Then
key = “h” & Hex(tasks.hWnd(i))
On Error Resume Next
Set itm = ListView1.ListItems.Add(, key, tasks.Caption(i))
If Err.Number Then
Set itm = ListView1.ListItems(key)
End If
On Error GoTo 0
If itm.SmallIcon = “” Then
On Error Resume Next
ImageList1.ListImages.Add , key, CreatePicture(tasks.hIconSm(i), vbPicTypeIcon)
On Error GoTo 0
itm.SmallIcon = key
itm.SubItems(iHandle) = “&” & key
itm.SubItems(iProcess) = CStr(tasks.ProcessID(i))
End If
nStatus = tasks.Status(i)
If itm.Text <> tasks.Caption(i) Then
itm.Text = tasks.Caption(i)
End If
If itm.Tag <> CStr(nStatus) Then
If nStatus = tlStatusOK Then
itm.SubItems(iStatus) = “Running”
Else
itm.SubItems(iStatus) = “Not Responding”
End If
itm.Tag = CStr(nStatus)
End If
End If
Next i
End Sub
Private Sub ResetButtons(ByVal Enabled As Boolean)
Command1(cEndTask).Enabled = Enabled
Command1(cSwitchTo).Enabled = Enabled
End Sub