McKirahan
Mon Sep 03 15:30:47 PDT 2007
"CCDEAN100" <CCDEAN100@discussions.microsoft.com> wrote in message
news:DC3CB043-695F-4E9D-A2F3-AA2AA2393B13@microsoft.com...
>
> Thanks guys, it works a treat
Here's a VBScript version: "Pictures.vbs".
"Sub Append(strSTR)" and "Function Concat()" are used
(instead of concatenatination) to build the HTML string.
Also, "strDIR" could be dynamically set to a different directory.
'****
'* This script identifies all pictures under the current directory
'* via a selection list and allows for each to be displayed.
'****
Option Explicit
'*
'* Declare Constants
'*
Const cVBS = "Pictures.vbs"
Const cEXT = ".gif|.jpg|.jpeg|.png"
Const cIMG = "<br><img src=`*?` border=`0` title=`?`>"
'*
'* Declare Variables
'*
Dim i,j,k
Dim booDIR
Dim strDIR
strDIR = WScript.ScriptFullName
strDIR = Left(strDIR,InStrRev(strDIR,"\"))
Dim arrEXT
arrEXT = Split(cEXT,"|")
Dim intEXT
Dim strEXT
Dim arrFIL()
Dim intFIL
intFIL = 0
Dim strFIL
Dim strGFI
Dim strIMG
Dim intOPT
Dim intSIZ
intSIZ = 1
Dim arrSTR()
ReDim arrSTR(100)
Dim intSTR
intSTR = 0
Dim strSTR
'*
'* Declare Objects
'*
Dim objFSO
Dim objGFO
Dim objIEA
Dim objWSS
'*
'* Pictures()
'*
MsgBox "Click 'OK' to find pictures. Please be
patient.",vbInformation,cVBS
Call Pictures()
Sub Append(strSTR)
'****
'* Appends strings to array entries ReDim as needed; (see "Concat()").
'****
strSTR = strSTR & ""
If intSTR > UBound(arrSTR) Then
ReDim Preserve arrSTR(UBound(arrSTR) + 100)
End If
arrSTR(intSTR) = strSTR & vbCrLf
intSTR = intSTR + 1
End Sub
Function Concat()
'****
'* Concatenates array entries into a single string; (see "Append()").
'****
Redim Preserve arrSTR(intSTR)
Concat = Replace(Join(arrSTR, ""),"`",Chr(34))
Erase arrSTR
ReDim arrSTR(100)
intSTR = 0
End Function
Sub Pictures()
'****
'* Pictures()
'****
'*
'* Find Pictures
'*
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objGFO = objFSO.GetFolder(strDIR)
For Each strGFI in objGFO.Files
strFIL = strGFI.Name
For intEXT = 0 To UBound(arrEXT)
strEXT = arrEXT(intEXT)
If Right(LCase(strFIL),Len(strEXT)) = strEXT Then
ReDim Preserve arrFIL(intFIL)
arrFIL(intFIL) = LCase(strFIL) & "=" & strFIL
intFIL = intFIL + 1
If intSIZ < 47 Then intSIZ = intSIZ + 1
End If
Next
Next
Set objGFO = Nothing
Set objFSO = Nothing
'*
If intFIL = 0 Then
MsgBox "No pictures in " & strDIR,vbExclamation,cVBS
Exit Sub
End If
'*
'* Sort Pictures
'*
For i = UBound(arrFIL) - 1 To 0 Step -1
For j = 0 To i
If arrFIL(j) > arrFIL(j+1) Then
k = arrFIL(j+1)
arrFIL(j+1) = arrFIL(j)
arrFIL(j) = k
End If
Next
Next
'*
'* Show Picture (first)
'*
strFIL = Split(arrFIL(0),"=")(1)
strIMG = Replace(cIMG,"*",strDIR)
strIMG = Replace(strIMG,"?",strFIL)
'*
'* Make Page
'*
Append "<form style=`margin:0px; padding:0px` name=`form1`>"
Append "<table border=`0` cdellpadding=`0` cellspacing=`0`
width=`100%`>"
Append "<tr valign=`top`>"
Append " <td width=`2`> </td>"
Append " <td width=`200` style=`font-family:Arial; font-size:8pt`>"
Append " <span><b>≡ " & intFIL & " Pictures</b></span>"
Append " <br>"
Append " <select id=`Pictures` onchange=`Picture()` size=`" & intSIZ
& "`"
Append " style=`font-family:Arial; font-size:8pt`>"
For intFIL = 0 To UBound(arrFIL)
strFIL = Split(arrFIL(intFIL),"=")(1)
Append " <option value=`" & strFIL & "`>" & strFIL
Next
Append " </select>"
Append " </td>"
Append " <td width=`2`> </td>"
Append " <td>"
Append " <span id=`Pictured`>" & strIMG & "</span>"
Append " </td>"
Append "</tr>"
Append "</table>"
Append "</form>"
Append "<script type=`text/vbscript`>"
Append "Sub Picture()"
Append " Const cIMG = `<br><img src='*?' border='0' title='?'>`"
Append " Dim strDIR"
Append " strDIR = " & Chr(34) & strDIR & Chr(34)
Append " Dim strFIL"
Append " strFIL = document.getElementById(`Pictures`).value"
Append " Dim strIMG"
Append " strIMG = Replace(cIMG,`*`,strDIR)"
Append " strIMG = Replace(strIMG,`?`,strFIL)"
Append " document.getElementById(`Pictured`).InnerHTML = strIMG"
Append " window.status = strFIL"
Append "End Sub"
Append "window.status = " & Chr(34) & Split(arrFIL(0),"=")(1) & Chr(34)
Append "document.getElementById(`Pictures`).selectedIndex = 0"
Append "document.getElementById(`Pictures`).focus()"
Append "</script>"
'*
'* Show Page
'*
Set objIEA = CreateObject("InternetExplorer.Application")
objIEA.ToolBar = 0
objIEA.StatusBar = 1
objIEA.Width = 1024
objIEA.Height = 740
objIEA.Left = 0
objIEA.Top = 0
objIEA.Visible = True
objIEA.Navigate "about:blank"
While objIEA.Busy
Wend
objIEA.Document.Write(Concat())
objIEA.Document.Title = cVBS & " -- " & strDIR
End Sub