home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
- Begin VB.Form frmPutDocs
- BorderStyle = 3 'Fixed Dialog
- Caption = "Save Local Disk Documents to Web"
- ClientHeight = 3420
- ClientLeft = 2490
- ClientTop = 2325
- ClientWidth = 5085
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- PaletteMode = 1 'UseZOrder
- ScaleHeight = 3420
- ScaleWidth = 5085
- ShowInTaskbar = 0 'False
- Begin VB.CommandButton btnPutMany
- Caption = "Upload Many Files"
- Height = 375
- Left = 1680
- TabIndex = 3
- Top = 2100
- Width = 1635
- End
- Begin VB.CommandButton btnPutOne
- Caption = "Upload One File"
- Height = 375
- Left = 1680
- TabIndex = 2
- Top = 1080
- Width = 1635
- End
- Begin MSComDlg.CommonDialog dlgOpen
- Left = 4500
- Top = 960
- _ExtentX = 847
- _ExtentY = 847
- _Version = 327680
- CancelError = -1 'True
- End
- Begin VB.Label Label2
- Caption = $"putdocs.frx":0000
- Height = 795
- Left = 120
- TabIndex = 5
- Top = 2520
- Width = 4815
- WordWrap = -1 'True
- End
- Begin VB.Label Label1
- Caption = $"putdocs.frx":00F2
- Height = 495
- Left = 120
- TabIndex = 4
- Top = 1500
- Width = 4815
- WordWrap = -1 'True
- End
- Begin VB.Label Label5
- Caption = "This form uses the following FrontPage Explorer methods:"
- Height = 255
- Left = 120
- TabIndex = 1
- Top = 120
- Width = 4815
- End
- Begin VB.Label Label6
- Alignment = 2 'Center
- Caption = "vtiPutDocument, vtiPutDocuments, vtiRefreshWebFromServer"
- Height = 315
- Left = 120
- TabIndex = 0
- Top = 480
- Width = 4815
- WordWrap = -1 'True
- End
- Begin VB.Line Line1
- X1 = 120
- X2 = 4980
- Y1 = 900
- Y2 = 900
- End
- Attribute VB_Name = "frmPutDocs"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub btnPutMany_Click()
- MousePointer = 11
- Dim webber As Object
- Dim webURL As String
- Dim canceled As Boolean
- Dim ret As Long
- Dim tmpfile As String
- Dim dir As String
- Dim files As String
- Dim urls As String
- Dim idx As Integer
- Dim count As Integer
- Dim basename As String
- canceled = False
- Set webber = CreateObject("FrontPage.Explorer")
- webURL = webber.vtiGetWebURL
- If Len(webURL) = 0 Then
- MsgBox "There is no web open in the FrontPage Explorer."
- Else
- On Error GoTo FileCancel
- dlgOpen.Filter = "All Files (*.*)|*.*"
- dlgOpen.filename = ""
- dlgOpen.Flags = &H200
- dlgOpen.DialogTitle = "Upload Files to Web"
- dlgOpen.ShowOpen
- If Not canceled And Len(dlgOpen.filename) > 0 Then
- MousePointer = 11
- tmpfile = dlgOpen.filename
- idx = InStr(tmpfile, " ")
- If idx > 0 Then
- ' remove initial dir
- dir = Left$(tmpfile, idx - 1)
- tmpfile = Mid$(tmpfile, idx + 1)
- count = 0
- While Len(tmpfile) > 0
- idx = InStr(tmpfile, " ")
- If idx > 0 Then
- basename = Left$(tmpfile, idx - 1)
- tmpfile = Mid$(tmpfile, idx + 1)
- files = files & dir & "\" & basename & Chr$(10)
- If IsImageFile(basename) Then basename = "images/" & basename
- urls = urls & basename & Chr$(10)
- Else
- ' last one
- basename = tmpfile
- tmpfile = ""
- files = files & dir & "\" & basename & Chr$(10)
- If IsImageFile(basename) Then basename = "images/" & basename
- urls = urls & basename & Chr$(10)
- End If
- Wend
- MousePointer = 11
- ret = webber.vtiPutDocuments(files, urls)
- webber.vtiRefreshWebFromServer
- Else
- ' must be a single file with full path
- files = dlgOpen.filename
- urls = dlgOpen.FileTitle
- If IsImageFile(urls) Then urls = "images/" & urls
- ret = webber.vtiPutDocument(files, urls, True)
- End If
- End If
- End If
- Set webber = Nothing
- MousePointer = 0
- Exit Sub
- FileCancel:
- canceled = True
- Resume Next
- End Sub
- Private Sub btnPutOne_Click()
- MousePointer = 11
- Dim webber As Object
- Dim webURL As String
- Dim canceled As Boolean
- Dim ret As Long
- Dim file As String
- Dim url As String
- canceled = False
- Set webber = CreateObject("FrontPage.Explorer")
- webURL = webber.vtiGetWebURL
- If Len(webURL) = 0 Then
- MsgBox "There is no web open in the FrontPage Explorer."
- Else
- On Error GoTo FileCancel
- dlgOpen.Filter = "All Files (*.*)|*.*"
- dlgOpen.DialogTitle = "Upload File to Web"
- dlgOpen.filename = ""
- dlgOpen.ShowOpen
- If Not canceled And Len(dlgOpen.filename) > 0 Then
- MousePointer = 11
- file = dlgOpen.filename
- url = dlgOpen.FileTitle
- If IsImageFile(url) Then url = "images/" & url
- ret = webber.vtiPutDocument(file, url, True)
- End If
- End If
- Set webber = Nothing
- MousePointer = 0
- Exit Sub
- FileCancel:
- canceled = True
- Resume Next
- End Sub
- Public Function IsImageFile(filename As String) As Boolean
- Dim tmp As String
- IsImageFile = False
- tmp = LCase$(filename)
- If Right$(tmp, 4) = ".gif" Then IsImageFile = True
- If Right$(tmp, 4) = ".jpg" Then IsImageFile = True
- If Right$(tmp, 5) = ".jpeg" Then IsImageFile = True
- End Function
-