home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 January / dppcpro0199a.iso / January / Fp98 / SDK / Utility / Apitests / geturl.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-09-18  |  5.6 KB  |  190 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
  3. Begin VB.Form frmGetURL 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Pick URL from Web"
  6.    ClientHeight    =   4110
  7.    ClientLeft      =   2310
  8.    ClientTop       =   2430
  9.    ClientWidth     =   5925
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   4110
  15.    ScaleWidth      =   5925
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton btnRefresh 
  18.       Caption         =   "Refresh"
  19.       Height          =   375
  20.       Left            =   240
  21.       TabIndex        =   7
  22.       Top             =   3600
  23.       Width           =   1095
  24.    End
  25.    Begin VB.Frame Frame1 
  26.       Caption         =   "Type"
  27.       Height          =   615
  28.       Left            =   240
  29.       TabIndex        =   2
  30.       Top             =   240
  31.       Width           =   5415
  32.       Begin VB.OptionButton optImage 
  33.          Caption         =   "Image"
  34.          Height          =   255
  35.          Left            =   2640
  36.          TabIndex        =   5
  37.          Top             =   240
  38.          Width           =   855
  39.       End
  40.       Begin VB.OptionButton optHTML 
  41.          Caption         =   "HTML Page"
  42.          Height          =   255
  43.          Left            =   1320
  44.          TabIndex        =   4
  45.          Top             =   240
  46.          Width           =   1215
  47.       End
  48.       Begin VB.OptionButton optAny 
  49.          Caption         =   "Any"
  50.          Height          =   255
  51.          Left            =   600
  52.          TabIndex        =   3
  53.          Top             =   240
  54.          Value           =   -1  'True
  55.          Width           =   735
  56.       End
  57.    End
  58.    Begin VB.CommandButton btnCancel 
  59.       Caption         =   "Cancel"
  60.       Height          =   375
  61.       Left            =   3360
  62.       TabIndex        =   1
  63.       Top             =   3600
  64.       Width           =   1095
  65.    End
  66.    Begin VB.CommandButton btnOK 
  67.       Caption         =   "OK"
  68.       Default         =   -1  'True
  69.       Height          =   375
  70.       Left            =   4560
  71.       TabIndex        =   0
  72.       Top             =   3600
  73.       Width           =   1095
  74.    End
  75.    Begin ComctlLib.ListView lstDocs 
  76.       Height          =   2415
  77.       Left            =   240
  78.       TabIndex        =   6
  79.       Top             =   1080
  80.       Width           =   5415
  81.       _ExtentX        =   9551
  82.       _ExtentY        =   4260
  83.       View            =   3
  84.       Sorted          =   -1  'True
  85.       LabelWrap       =   -1  'True
  86.       HideSelection   =   -1  'True
  87.       _Version        =   327680
  88.       ForeColor       =   -2147483640
  89.       BackColor       =   -2147483643
  90.       BorderStyle     =   1
  91.       Appearance      =   1
  92.       MouseIcon       =   "geturl.frx":0000
  93.       NumItems        =   2
  94.       BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
  95.          Key             =   ""
  96.          Object.Tag             =   ""
  97.          Text            =   "Title"
  98.          Object.Width           =   5080
  99.       EndProperty
  100.       BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
  101.          Key             =   ""
  102.          Object.Tag             =   ""
  103.          Text            =   "Page URL"
  104.          Object.Width           =   3087
  105.       EndProperty
  106.    End
  107. Attribute VB_Name = "frmGetURL"
  108. Attribute VB_GlobalNameSpace = False
  109. Attribute VB_Creatable = False
  110. Attribute VB_PredeclaredId = True
  111. Attribute VB_Exposed = False
  112. Option Explicit
  113. Private Sub Label1_Click()
  114. End Sub
  115. Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
  116. End Sub
  117. Private Sub btnCancel_Click()
  118.     Me.Tag = ""
  119.     Me.Hide
  120. End Sub
  121. Private Sub btnOK_Click()
  122.     Me.Hide
  123. End Sub
  124. Private Sub btnRefresh_Click()
  125.     Me.Tag = ""
  126.     MousePointer = 11
  127.     Dim pagelist As String
  128.     Dim idx As Integer
  129.     Dim newline As String
  130.     Dim title As String
  131.     Dim url As String
  132.     Dim itmX As ListItem
  133.     Dim PageType As Integer
  134.     newline = Chr$(10)
  135.     lstDocs.ListItems.Clear
  136.     Dim webber As Object
  137.     Set webber = CreateObject("FrontPage.Explorer")
  138.     PageType = 0
  139.     If optAny Then PageType = 0
  140.     If optHTML Then PageType = 1
  141.     If optImage Then PageType = 2
  142.     pagelist = webber.vtiGetPageList(PageType)
  143.     While Len(pagelist) > 0
  144.         
  145.         idx = InStr(pagelist, newline)
  146.         If idx > 0 Then
  147.             title = Left$(pagelist, idx - 1)
  148.             pagelist = Mid$(pagelist, idx + 1)
  149.         Else
  150.             title = pagelist
  151.         End If
  152.         
  153.         idx = InStr(pagelist, newline)
  154.         If idx > 0 Then
  155.             url = Left$(pagelist, idx - 1)
  156.             pagelist = Mid$(pagelist, idx + 1)
  157.         Else
  158.             url = pagelist
  159.         End If
  160.         
  161.         Set itmX = lstDocs.ListItems.Add(, , title)
  162.         itmX.SubItems(1) = url
  163.         
  164.     Wend
  165.     Set webber = Nothing
  166.     MousePointer = 0
  167. End Sub
  168. Private Sub Form_Load()
  169.     Me.Tag = ""
  170.     btnRefresh_Click
  171. End Sub
  172. Private Sub lstDocs_ColumnClick(ByVal ColumnHeader As ColumnHeader)
  173.     lstDocs.SortKey = ColumnHeader.Index - 1
  174. End Sub
  175. Private Sub lstDocs_DblClick()
  176.     btnOK_Click
  177. End Sub
  178. Private Sub lstDocs_ItemClick(ByVal Item As ListItem)
  179.     Me.Tag = Item.SubItems(1)
  180. End Sub
  181. Private Sub optAny_Click()
  182.     btnRefresh_Click
  183. End Sub
  184. Private Sub optHTML_Click()
  185.     btnRefresh_Click
  186. End Sub
  187. Private Sub optImage_Click()
  188.     btnRefresh_Click
  189. End Sub
  190.