home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Cachinator4112512112001.psc / frmMain.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-12-11  |  14.5 KB  |  423 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form frmMain 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "The Cachinator"
  6.    ClientHeight    =   6135
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   9165
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   6135
  14.    ScaleWidth      =   9165
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.CommandButton cmdDestroyAll 
  17.       Caption         =   "Destroy All!"
  18.       BeginProperty Font 
  19.          Name            =   "Tahoma"
  20.          Size            =   8.25
  21.          Charset         =   0
  22.          Weight          =   400
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   345
  28.       Left            =   2460
  29.       TabIndex        =   5
  30.       Top             =   5610
  31.       Width           =   1065
  32.    End
  33.    Begin VB.CommandButton cmdFindIt 
  34.       Caption         =   "Find Them!"
  35.       BeginProperty Font 
  36.          Name            =   "Tahoma"
  37.          Size            =   8.25
  38.          Charset         =   0
  39.          Weight          =   400
  40.          Underline       =   0   'False
  41.          Italic          =   0   'False
  42.          Strikethrough   =   0   'False
  43.       EndProperty
  44.       Height          =   345
  45.       Left            =   180
  46.       TabIndex        =   4
  47.       Top             =   5610
  48.       Width           =   1065
  49.    End
  50.    Begin VB.CommandButton cmdDestroyIt 
  51.       Caption         =   "Destroy It!"
  52.       BeginProperty Font 
  53.          Name            =   "Tahoma"
  54.          Size            =   8.25
  55.          Charset         =   0
  56.          Weight          =   400
  57.          Underline       =   0   'False
  58.          Italic          =   0   'False
  59.          Strikethrough   =   0   'False
  60.       EndProperty
  61.       Height          =   345
  62.       Left            =   1320
  63.       TabIndex        =   3
  64.       Top             =   5610
  65.       Width           =   1065
  66.    End
  67.    Begin MSComctlLib.ListView lvCache 
  68.       Height          =   3915
  69.       Left            =   3660
  70.       TabIndex        =   2
  71.       Top             =   1590
  72.       Width           =   5415
  73.       _ExtentX        =   9551
  74.       _ExtentY        =   6906
  75.       View            =   3
  76.       LabelEdit       =   1
  77.       LabelWrap       =   -1  'True
  78.       HideSelection   =   0   'False
  79.       FullRowSelect   =   -1  'True
  80.       _Version        =   393217
  81.       ForeColor       =   -2147483640
  82.       BackColor       =   12648447
  83.       BorderStyle     =   1
  84.       Appearance      =   1
  85.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  86.          Name            =   "Tahoma"
  87.          Size            =   8.25
  88.          Charset         =   0
  89.          Weight          =   400
  90.          Underline       =   0   'False
  91.          Italic          =   0   'False
  92.          Strikethrough   =   0   'False
  93.       EndProperty
  94.       NumItems        =   4
  95.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  96.          Key             =   "FILENAME"
  97.          Text            =   "File Name"
  98.          Object.Width           =   2540
  99.       EndProperty
  100.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  101.          SubItemIndex    =   1
  102.          Key             =   "URL"
  103.          Text            =   "Source URL"
  104.          Object.Width           =   2540
  105.       EndProperty
  106.       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  107.          SubItemIndex    =   2
  108.          Key             =   "EXPIRES"
  109.          Text            =   "Expires"
  110.          Object.Width           =   2540
  111.       EndProperty
  112.       BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  113.          SubItemIndex    =   3
  114.          Key             =   "LASTACCESS"
  115.          Text            =   "Last Accessed"
  116.          Object.Width           =   2540
  117.       EndProperty
  118.    End
  119.    Begin VB.PictureBox Picture1 
  120.       Height          =   5325
  121.       Left            =   180
  122.       Picture         =   "frmMain.frx":0000
  123.       ScaleHeight     =   5265
  124.       ScaleWidth      =   3315
  125.       TabIndex        =   0
  126.       Top             =   180
  127.       Width           =   3375
  128.       Begin VB.Label lblCaption 
  129.          BackStyle       =   0  'Transparent
  130.          Caption         =   "Vote"
  131.          BeginProperty Font 
  132.             Name            =   "Tahoma"
  133.             Size            =   24
  134.             Charset         =   0
  135.             Weight          =   400
  136.             Underline       =   0   'False
  137.             Italic          =   0   'False
  138.             Strikethrough   =   0   'False
  139.          EndProperty
  140.          ForeColor       =   &H0080FFFF&
  141.          Height          =   495
  142.          Left            =   60
  143.          TabIndex        =   1
  144.          Top             =   4650
  145.          Width           =   4095
  146.       End
  147.    End
  148.    Begin VB.Label lblStatus 
  149.       BeginProperty Font 
  150.          Name            =   "Tahoma"
  151.          Size            =   8.25
  152.          Charset         =   0
  153.          Weight          =   400
  154.          Underline       =   0   'False
  155.          Italic          =   0   'False
  156.          Strikethrough   =   0   'False
  157.       EndProperty
  158.       Height          =   255
  159.       Left            =   3660
  160.       TabIndex        =   14
  161.       Top             =   5655
  162.       Width           =   5415
  163.    End
  164.    Begin VB.Label lblLastAccessed 
  165.       BeginProperty Font 
  166.          Name            =   "Tahoma"
  167.          Size            =   8.25
  168.          Charset         =   0
  169.          Weight          =   400
  170.          Underline       =   0   'False
  171.          Italic          =   0   'False
  172.          Strikethrough   =   0   'False
  173.       EndProperty
  174.       Height          =   225
  175.       Left            =   5280
  176.       TabIndex        =   13
  177.       Top             =   1170
  178.       Width           =   3675
  179.    End
  180.    Begin VB.Label Label6 
  181.       Caption         =   "Last Accessed:"
  182.       BeginProperty Font 
  183.          Name            =   "Tahoma"
  184.          Size            =   8.25
  185.          Charset         =   0
  186.          Weight          =   700
  187.          Underline       =   0   'False
  188.          Italic          =   0   'False
  189.          Strikethrough   =   0   'False
  190.       EndProperty
  191.       Height          =   225
  192.       Left            =   3750
  193.       TabIndex        =   12
  194.       Top             =   1170
  195.       Width           =   1335
  196.    End
  197.    Begin VB.Label lblExpires 
  198.       BeginProperty Font 
  199.          Name            =   "Tahoma"
  200.          Size            =   8.25
  201.          Charset         =   0
  202.          Weight          =   400
  203.          Underline       =   0   'False
  204.          Italic          =   0   'False
  205.          Strikethrough   =   0   'False
  206.       EndProperty
  207.       Height          =   225
  208.       Left            =   5280
  209.       TabIndex        =   11
  210.       Top             =   850
  211.       Width           =   3675
  212.    End
  213.    Begin VB.Label Label4 
  214.       Caption         =   "Expires:"
  215.       BeginProperty Font 
  216.          Name            =   "Tahoma"
  217.          Size            =   8.25
  218.          Charset         =   0
  219.          Weight          =   700
  220.          Underline       =   0   'False
  221.          Italic          =   0   'False
  222.          Strikethrough   =   0   'False
  223.       EndProperty
  224.       Height          =   225
  225.       Left            =   3750
  226.       TabIndex        =   10
  227.       Top             =   850
  228.       Width           =   1335
  229.    End
  230.    Begin VB.Label lblSourceUrl 
  231.       BeginProperty Font 
  232.          Name            =   "Tahoma"
  233.          Size            =   8.25
  234.          Charset         =   0
  235.          Weight          =   400
  236.          Underline       =   0   'False
  237.          Italic          =   0   'False
  238.          Strikethrough   =   0   'False
  239.       EndProperty
  240.       Height          =   225
  241.       Left            =   5280
  242.       TabIndex        =   9
  243.       Top             =   530
  244.       Width           =   3675
  245.    End
  246.    Begin VB.Label Label2 
  247.       Caption         =   "Source URL:"
  248.       BeginProperty Font 
  249.          Name            =   "Tahoma"
  250.          Size            =   8.25
  251.          Charset         =   0
  252.          Weight          =   700
  253.          Underline       =   0   'False
  254.          Italic          =   0   'False
  255.          Strikethrough   =   0   'False
  256.       EndProperty
  257.       Height          =   225
  258.       Left            =   3750
  259.       TabIndex        =   8
  260.       Top             =   530
  261.       Width           =   1335
  262.    End
  263.    Begin VB.Label lblFileName 
  264.       BeginProperty Font 
  265.          Name            =   "Tahoma"
  266.          Size            =   8.25
  267.          Charset         =   0
  268.          Weight          =   400
  269.          Underline       =   0   'False
  270.          Italic          =   0   'False
  271.          Strikethrough   =   0   'False
  272.       EndProperty
  273.       Height          =   225
  274.       Left            =   5280
  275.       TabIndex        =   7
  276.       Top             =   210
  277.       Width           =   3675
  278.    End
  279.    Begin VB.Label Label1 
  280.       Caption         =   "File Name:"
  281.       BeginProperty Font 
  282.          Name            =   "Tahoma"
  283.          Size            =   8.25
  284.          Charset         =   0
  285.          Weight          =   700
  286.          Underline       =   0   'False
  287.          Italic          =   0   'False
  288.          Strikethrough   =   0   'False
  289.       EndProperty
  290.       Height          =   225
  291.       Left            =   3750
  292.       TabIndex        =   6
  293.       Top             =   210
  294.       Width           =   1335
  295.    End
  296. Attribute VB_Name = "frmMain"
  297. Attribute VB_GlobalNameSpace = False
  298. Attribute VB_Creatable = False
  299. Attribute VB_PredeclaredId = True
  300. Attribute VB_Exposed = False
  301. Option Explicit
  302. Private Sub FindCacheEntries()
  303.     '' First clear the cache list view
  304.     lvCache.ListItems.Clear
  305.     ''disable our buttons
  306.     cmdFindIt.Enabled = False
  307.     cmdDestroyIt.Enabled = False
  308.     cmdDestroyAll.Enabled = False
  309.     ''and put up an hourglass mousepointer
  310.     MousePointer = vbHourglass
  311.     '' Next we want to enumerate all the things in the cache
  312.     '' we have to call the FindFirstCacheEntry function once and then
  313.     '' the FindNextCacheEntry until it returns false
  314.     If FindFirstCacheEntry() Then
  315.         '' add our item the first column is also the text field in a listview
  316.         lvCache.ListItems.Add , , Cache.CachedEntryFileName
  317.         
  318.         '' now add the subitems to the listview
  319.         With lvCache.ListItems(lvCache.ListItems.Count)
  320.             .SubItems(1) = Cache.CachedEntrySourceURL
  321.             .SubItems(2) = Cache.CachedEntryExpireTime
  322.             .SubItems(3) = Cache.CachedEntryLastAccessTime
  323.             
  324.         End With
  325.                 
  326.         '' now loop through the rest of the cache
  327.         Do While Cache.FindNextCacheEntry
  328.             '' add our item the first column is also the text field in a listview
  329.             '' only add if the filename is valid
  330.             If Cache.CachedEntryCacheType And &H1 Then
  331.                 lvCache.ListItems.Add , , IIf(Cache.CachedEntryFileName = vbNullString, Cache.CachedEntrySourceURL, Cache.CachedEntryFileName)
  332.                 
  333.                 '' now add the subitems to the listview
  334.                 With lvCache.ListItems(lvCache.ListItems.Count)
  335.                     .SubItems(1) = Cache.CachedEntrySourceURL
  336.                     .SubItems(2) = Cache.CachedEntryExpireTime
  337.                     .SubItems(3) = Cache.CachedEntryLastAccessTime
  338.                     
  339.                 End With
  340.             End If
  341.         Loop
  342.         
  343.     End If
  344.     '' always remember to release the cache if you have used the findfirst / findnext
  345.     '' functions
  346.     Cache.ReleaseCache
  347.     '' enable our buttons
  348.     cmdFindIt.Enabled = True
  349.     cmdDestroyIt.Enabled = True
  350.     cmdDestroyAll.Enabled = True
  351.     '' and show our mousepointer again
  352.     MousePointer = vbArrow
  353.     lblStatus = "Found " & lvCache.ListItems.Count & " cache entries"
  354.     '' highlight first item
  355.     If lvCache.ListItems.Count > 0 Then
  356.         lvCache.ListItems(1).Selected = True
  357.         Call RefreshCacheList
  358.     End If
  359. End Sub
  360. Private Sub RefreshCacheList()
  361.     '' set our tooltip text and labels
  362.     lvCache.ToolTipText = lvCache.SelectedItem.Text
  363.     lblFileName = lvCache.SelectedItem.Text
  364.     lblSourceUrl = lvCache.SelectedItem.SubItems(1)
  365.     lblExpires = lvCache.SelectedItem.SubItems(2)
  366.     lblLastAccessed = lvCache.SelectedItem.SubItems(3)
  367. End Sub
  368. Private Sub cmdDestroyAll_Click()
  369.     '' first prompt to make sure that the user wants to do this
  370.     If MsgBox("Are you sure you want to delete all these cache items?", vbQuestion Or vbYesNoCancel, "Delete Entire Cache?") = vbYes Then
  371.         cmdFindIt.Enabled = False
  372.         cmdDestroyAll.Enabled = False
  373.         cmdDestroyIt.Enabled = False
  374.         MousePointer = vbHourglass
  375.         
  376.         Do While lvCache.ListItems.Count > 0
  377.             Cache.DeleteCacheEntry lvCache.ListItems(1).SubItems(1)
  378.             lvCache.ListItems.Remove 1
  379.         Loop
  380.         
  381.         lblCaption = "Terminated"
  382.         cmdFindIt.Enabled = True
  383.         cmdDestroyAll.Enabled = True
  384.         cmdDestroyIt.Enabled = True
  385.         MousePointer = vbHourglass
  386.     End If
  387. End Sub
  388. Private Sub cmdDestroyIt_Click()
  389.     '' if there is something selected then
  390.     If Not lvCache.SelectedItem Is Nothing Then
  391.         Cache.DeleteCacheEntry lvCache.SelectedItem.SubItems(1)
  392.         lvCache.ListItems.Remove lvCache.SelectedItem.Index
  393.         lblStatus = "Cache entry removed"
  394.         lblCaption = "Terminated"
  395.     End If
  396.     If lvCache.ListItems.Count > 0 Then
  397.         lvCache.ListItems(1).Selected = True
  398.         Call RefreshCacheList
  399.     End If
  400. End Sub
  401. Private Sub cmdFindIt_Click()
  402.     Call FindCacheEntries
  403. End Sub
  404. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  405.     Dim lWait As Long
  406.     '' give a goodbye treat
  407.     lblCaption = "I'll be back"
  408.     lWait = Timer + 1
  409.     Do While Timer < lWait
  410.         DoEvents
  411.     Loop
  412. End Sub
  413. Private Sub Form_Unload(Cancel As Integer)
  414.     ''don't forget to release our data allocations and stuff
  415.     Call Cache.ReleaseCache
  416. End Sub
  417. Private Sub lblFileName_Change()
  418.     lblFileName.ToolTipText = lblFileName.Caption
  419. End Sub
  420. Private Sub lvCache_ItemClick(ByVal Item As MSComctlLib.ListItem)
  421.     Call RefreshCacheList
  422. End Sub
  423.