home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 January / dppcpro0199a.iso / January / Fp98 / SDK / Utility / Apitests / Savedoc.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-09-18  |  5.0 KB  |  173 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmSaveDoc 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Save Web Document to Local Disk"
  6.    ClientHeight    =   2310
  7.    ClientLeft      =   1335
  8.    ClientTop       =   2010
  9.    ClientWidth     =   5340
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   2310
  15.    ScaleWidth      =   5340
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton btnBrowse 
  18.       Caption         =   "Browse..."
  19.       Height          =   375
  20.       Left            =   4200
  21.       TabIndex        =   2
  22.       Top             =   1320
  23.       Width           =   975
  24.    End
  25.    Begin VB.TextBox lblURL 
  26.       Height          =   375
  27.       Left            =   240
  28.       TabIndex        =   1
  29.       Top             =   1320
  30.       Width           =   3855
  31.    End
  32.    Begin VB.CommandButton btnSave 
  33.       Caption         =   "Save Web Page"
  34.       Default         =   -1  'True
  35.       Enabled         =   0   'False
  36.       Height          =   375
  37.       Left            =   240
  38.       TabIndex        =   0
  39.       Top             =   1800
  40.       Width           =   1575
  41.    End
  42.    Begin MSComDlg.CommonDialog dlgSave 
  43.       Left            =   4680
  44.       Top             =   1800
  45.       _ExtentX        =   847
  46.       _ExtentY        =   847
  47.       _Version        =   327680
  48.       CancelError     =   -1  'True
  49.       DefaultExt      =   ".htm"
  50.       DialogTitle     =   "Save As..."
  51.       FileName        =   "download.htm"
  52.       Filter          =   "*.htm"
  53.    End
  54.    Begin VB.Line Line1 
  55.       X1              =   240
  56.       X2              =   5160
  57.       Y1              =   840
  58.       Y2              =   840
  59.    End
  60.    Begin VB.Label Label6 
  61.       Alignment       =   2  'Center
  62.       Caption         =   "vtiIsPageInWeb, vtiGetDocToFile"
  63.       Height          =   255
  64.       Left            =   240
  65.       TabIndex        =   5
  66.       Top             =   480
  67.       Width           =   4815
  68.       WordWrap        =   -1  'True
  69.    End
  70.    Begin VB.Label Label5 
  71.       Caption         =   "This form uses the following FrontPage Explorer methods:"
  72.       Height          =   255
  73.       Left            =   240
  74.       TabIndex        =   4
  75.       Top             =   120
  76.       Width           =   4815
  77.    End
  78.    Begin VB.Label Label1 
  79.       Caption         =   "Page URL:"
  80.       Height          =   255
  81.       Left            =   240
  82.       TabIndex        =   3
  83.       Top             =   1080
  84.       Width           =   1935
  85.    End
  86. Attribute VB_Name = "frmSaveDoc"
  87. Attribute VB_GlobalNameSpace = False
  88. Attribute VB_Creatable = False
  89. Attribute VB_PredeclaredId = True
  90. Attribute VB_Exposed = False
  91. Option Explicit
  92. Private Sub btnBrowse_Click()
  93.     MousePointer = 11
  94.     frmGetURL.Tag = ""
  95.     frmGetURL.Show 1
  96.     If frmGetURL.Tag <> "" Then
  97.         lblURL = frmGetURL.Tag
  98.     End If
  99.     frmGetURL.Tag = ""
  100.     MousePointer = 0
  101. End Sub
  102. Private Sub btnSave_Click()
  103.     MousePointer = 11
  104.     Dim webber As Object
  105.     Dim ret As Long
  106.     Dim prefix As String
  107.     Dim fn As String
  108.     Dim ext As String
  109.     Dim idx As Integer
  110.     Dim savename As String
  111.     Dim canceled As Boolean
  112.     canceled = False
  113.     On Error GoTo CancelFile
  114.         
  115.     ' prefix for absolute URLs
  116.     prefix = "http://"
  117.     fn = ""
  118.         
  119.     ' get last path component
  120.     savename = lblURL
  121.     ' strip prefix if any
  122.     If InStr(savename, prefix) = 1 Then
  123.         savename = Mid$(savename, Len(prefix) + 1)
  124.     End If
  125.     idx = InStr(savename, "/")
  126.     While idx > 0
  127.         savename = Mid$(savename, idx + 1)
  128.         idx = InStr(savename, "/")
  129.     Wend
  130.     ' if empty name, call it 'index.htm'
  131.     If savename = "" Then
  132.         savename = "index.htm"
  133.     End If
  134.     dlgSave.filename = savename
  135.     ' get last dot extension
  136.     ext = ""
  137.     idx = InStr(savename, ".")
  138.     If idx > 0 Then
  139.         ext = Mid$(savename, idx + 1)
  140.         idx = InStr(ext, ".")
  141.         While idx > 0
  142.             ext = Mid$(ext, idx + 1)
  143.             idx = InStr(ext, ".")
  144.         Wend
  145.     End If
  146.     If ext <> "" Then
  147.         dlgSave.DefaultExt = "." & ext
  148.     End If
  149.     dlgSave.Filter = "Any (*.*)|*.*"
  150.     Set webber = CreateObject("FrontPage.Explorer")
  151.     If webber.vtiIsPageInWeb(lblURL) Then
  152.         dlgSave.ShowSave
  153.         fn = dlgSave.filename
  154.     ElseIf InStr(lblURL, prefix) = 1 Then
  155.         dlgSave.ShowSave
  156.         fn = dlgSave.filename
  157.     Else
  158.         MsgBox "URL is not in current web and does not begin with " & prefix & "."
  159.     End If
  160.     If Not canceled And fn <> "" Then
  161.         ret = webber.vtiGetDocToFile(lblURL, fn)
  162.     End If
  163.     Set webber = Nothing
  164.     MousePointer = 0
  165. CancelFile:
  166.     canceled = True
  167.     Resume Next
  168.             
  169. End Sub
  170. Private Sub lblURL_Change()
  171.     btnSave.Enabled = Len(lblURL.Text) > 0
  172. End Sub
  173.