home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 January / dppcpro0199a.iso / January / Fp98 / SDK / Utility / Apitests / Putdocs.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-09-18  |  6.8 KB  |  201 lines

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmPutDocs 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Save Local Disk Documents to Web"
  6.    ClientHeight    =   3420
  7.    ClientLeft      =   2490
  8.    ClientTop       =   2325
  9.    ClientWidth     =   5085
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   3420
  15.    ScaleWidth      =   5085
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton btnPutMany 
  18.       Caption         =   "Upload Many Files"
  19.       Height          =   375
  20.       Left            =   1680
  21.       TabIndex        =   3
  22.       Top             =   2100
  23.       Width           =   1635
  24.    End
  25.    Begin VB.CommandButton btnPutOne 
  26.       Caption         =   "Upload One File"
  27.       Height          =   375
  28.       Left            =   1680
  29.       TabIndex        =   2
  30.       Top             =   1080
  31.       Width           =   1635
  32.    End
  33.    Begin MSComDlg.CommonDialog dlgOpen 
  34.       Left            =   4500
  35.       Top             =   960
  36.       _ExtentX        =   847
  37.       _ExtentY        =   847
  38.       _Version        =   327680
  39.       CancelError     =   -1  'True
  40.    End
  41.    Begin VB.Label Label2 
  42.       Caption         =   $"putdocs.frx":0000
  43.       Height          =   795
  44.       Left            =   120
  45.       TabIndex        =   5
  46.       Top             =   2520
  47.       Width           =   4815
  48.       WordWrap        =   -1  'True
  49.    End
  50.    Begin VB.Label Label1 
  51.       Caption         =   $"putdocs.frx":00F2
  52.       Height          =   495
  53.       Left            =   120
  54.       TabIndex        =   4
  55.       Top             =   1500
  56.       Width           =   4815
  57.       WordWrap        =   -1  'True
  58.    End
  59.    Begin VB.Label Label5 
  60.       Caption         =   "This form uses the following FrontPage Explorer methods:"
  61.       Height          =   255
  62.       Left            =   120
  63.       TabIndex        =   1
  64.       Top             =   120
  65.       Width           =   4815
  66.    End
  67.    Begin VB.Label Label6 
  68.       Alignment       =   2  'Center
  69.       Caption         =   "vtiPutDocument, vtiPutDocuments, vtiRefreshWebFromServer"
  70.       Height          =   315
  71.       Left            =   120
  72.       TabIndex        =   0
  73.       Top             =   480
  74.       Width           =   4815
  75.       WordWrap        =   -1  'True
  76.    End
  77.    Begin VB.Line Line1 
  78.       X1              =   120
  79.       X2              =   4980
  80.       Y1              =   900
  81.       Y2              =   900
  82.    End
  83. Attribute VB_Name = "frmPutDocs"
  84. Attribute VB_GlobalNameSpace = False
  85. Attribute VB_Creatable = False
  86. Attribute VB_PredeclaredId = True
  87. Attribute VB_Exposed = False
  88. Option Explicit
  89. Private Sub btnPutMany_Click()
  90.     MousePointer = 11
  91.     Dim webber As Object
  92.     Dim webURL As String
  93.     Dim canceled As Boolean
  94.     Dim ret As Long
  95.     Dim tmpfile As String
  96.     Dim dir As String
  97.     Dim files As String
  98.     Dim urls As String
  99.     Dim idx As Integer
  100.     Dim count As Integer
  101.     Dim basename As String
  102.     canceled = False
  103.     Set webber = CreateObject("FrontPage.Explorer")
  104.     webURL = webber.vtiGetWebURL
  105.     If Len(webURL) = 0 Then
  106.         MsgBox "There is no web open in the FrontPage Explorer."
  107.     Else
  108.         On Error GoTo FileCancel
  109.         dlgOpen.Filter = "All Files (*.*)|*.*"
  110.         dlgOpen.filename = ""
  111.         dlgOpen.Flags = &H200
  112.         dlgOpen.DialogTitle = "Upload Files to Web"
  113.         dlgOpen.ShowOpen
  114.         If Not canceled And Len(dlgOpen.filename) > 0 Then
  115.             MousePointer = 11
  116.             tmpfile = dlgOpen.filename
  117.             idx = InStr(tmpfile, " ")
  118.             If idx > 0 Then
  119.                 ' remove initial dir
  120.                 dir = Left$(tmpfile, idx - 1)
  121.                 tmpfile = Mid$(tmpfile, idx + 1)
  122.                 count = 0
  123.                 While Len(tmpfile) > 0
  124.                     idx = InStr(tmpfile, " ")
  125.                     If idx > 0 Then
  126.                         basename = Left$(tmpfile, idx - 1)
  127.                         tmpfile = Mid$(tmpfile, idx + 1)
  128.                         files = files & dir & "\" & basename & Chr$(10)
  129.                         If IsImageFile(basename) Then basename = "images/" & basename
  130.                         urls = urls & basename & Chr$(10)
  131.                     Else
  132.                         ' last one
  133.                         basename = tmpfile
  134.                         tmpfile = ""
  135.                         files = files & dir & "\" & basename & Chr$(10)
  136.                         If IsImageFile(basename) Then basename = "images/" & basename
  137.                         urls = urls & basename & Chr$(10)
  138.                     End If
  139.                 Wend
  140.                 MousePointer = 11
  141.                 ret = webber.vtiPutDocuments(files, urls)
  142.                 webber.vtiRefreshWebFromServer
  143.             Else
  144.                 ' must be a single file with full path
  145.                 files = dlgOpen.filename
  146.                 urls = dlgOpen.FileTitle
  147.                 If IsImageFile(urls) Then urls = "images/" & urls
  148.                 ret = webber.vtiPutDocument(files, urls, True)
  149.             End If
  150.         End If
  151.     End If
  152.     Set webber = Nothing
  153.     MousePointer = 0
  154.     Exit Sub
  155. FileCancel:
  156.     canceled = True
  157.     Resume Next
  158. End Sub
  159. Private Sub btnPutOne_Click()
  160.     MousePointer = 11
  161.     Dim webber As Object
  162.     Dim webURL As String
  163.     Dim canceled As Boolean
  164.     Dim ret As Long
  165.     Dim file As String
  166.     Dim url As String
  167.     canceled = False
  168.     Set webber = CreateObject("FrontPage.Explorer")
  169.     webURL = webber.vtiGetWebURL
  170.     If Len(webURL) = 0 Then
  171.         MsgBox "There is no web open in the FrontPage Explorer."
  172.     Else
  173.         On Error GoTo FileCancel
  174.         dlgOpen.Filter = "All Files (*.*)|*.*"
  175.         dlgOpen.DialogTitle = "Upload File to Web"
  176.         dlgOpen.filename = ""
  177.         dlgOpen.ShowOpen
  178.         If Not canceled And Len(dlgOpen.filename) > 0 Then
  179.             MousePointer = 11
  180.             file = dlgOpen.filename
  181.             url = dlgOpen.FileTitle
  182.             If IsImageFile(url) Then url = "images/" & url
  183.             ret = webber.vtiPutDocument(file, url, True)
  184.         End If
  185.     End If
  186.     Set webber = Nothing
  187.     MousePointer = 0
  188.     Exit Sub
  189. FileCancel:
  190.     canceled = True
  191.     Resume Next
  192. End Sub
  193. Public Function IsImageFile(filename As String) As Boolean
  194.     Dim tmp As String
  195.     IsImageFile = False
  196.     tmp = LCase$(filename)
  197.     If Right$(tmp, 4) = ".gif" Then IsImageFile = True
  198.     If Right$(tmp, 4) = ".jpg" Then IsImageFile = True
  199.     If Right$(tmp, 5) = ".jpeg" Then IsImageFile = True
  200. End Function
  201.