TiltViewer–網站Flash秀圖

<tiltviewergallery>
  <photos>
    <photo imageurl='img/我的植栽/玫瑰11.jpg' linkurl='http://chome.idv.tw/view/pic/我的植栽/玫瑰11.jpg'>
      <title>香水玫瑰－甜心</title>
      <description><![CDATA[2009-01-29 下午 05:47 Panasonic DMC-FZ30<br><font color="#0000ff" size="28"><b>西風<br>　　原是<br>　　偶爾駐足於黃葉的舞動<br>　　那懂<br>　　撐著火輪般玫瑰的吟詠<br>　　只因<br>　　思念竟化成裸身的玫瑰<br>　　竟也<br>　　文字忘形如蝴蝶般飛舞<br>　　舞出了輕盈絢爛<br>　　舞出了狂野繽紛<br>　　舞出了今生今世來生來世</b></font>]]></description>
    </photo>

    <photo imageurl='img/我的植栽/玫瑰20.jpg' linkurl='http://chome.idv.tw/view/pic/我的植栽/玫瑰20.jpg'>
      <title>香水無刺玫瑰</title>
      <description><![CDATA[2003-03-05 OLYMPUS C750UZ<br><font color="#0000ff" size="36"><b>麝炷騰清燎，鮫紗覆綠蒙。<br>宮妝臨曉日，錦段落東風。<br>無力春煙裡，多愁暮雨中。<br>不知何事意，深淺兩般紅。<br>-- 唐彥謙(唐朝)</b></font>]]></description>
    </photo>

    <photo imageurl='img/我的植栽/茶花01.jpg' linkurl='http://chome.idv.tw/view/pic/我的植栽/茶花01.jpg'>
      <title>山茶花</title>
      <description>2009-02-09 下午 03:54 Panasonic DMC-FZ30</description>
    </photo>
  </photos>
</tiltviewergallery>

<%@LANGUAGE="VBscript" CODEPAGE="65001"%>
<%
area=request("area")
IF area="" Then area=11
Session.CodePage=65001
response.CharSet="utf-8"
Set fs = CreateObject("Scripting.FileSystemObject")
oriFolder="img/"&area
oriTestFolder = Server.Mappath(OriFolder)
Set objFolder = FS.GetFolder(OriTestFolder)
Body="<tiltviewergallery>"&vbCrlf
Body=Body&"  <photos>"&vbCrlf
I=1
For Each File in objFolder.Files
   If Lcase(Right(File.Name,3)) = "jpg" Then
      tmp=split(File.Name,".")
      fn=replace(File.Name,"."&tmp(ubound(tmp)),"")
      fd=File.ParentFolder
      Body=Body&"    <photo imageurl='img/"&area&"/"&File.Name&"' linkurl='http://www.chome.idv.tw/view/pic/"&area&"/"&File.Name&"'>"&vbCrlf
      Body=Body&"    <title>Image "&I&"</title>"&vbCrlf
      Body=Body&"    <description><![CDATA["&getAttr(fd,fn,14)&"]]></description>"&vbCrlf
      Body=Body&"    </photo>"&vbCrlf
      I=I+1    
   End IF
Next
Body=Body&"  </photos>"&vbCrlf
Body=Body&"</tiltviewergallery>"&vbCrlf
filepath="xml/"&area&".xml"
SaveToFile Body,filepath,"utf-8"
'newfilepath=Server.Mappath(filepath)
'Set fout=fs.CreateTextFile(newfilepath)
'fout.WriteLine Body
Response.write "寫入　"&area&".xml　成功<br>"
Response.write "<a href=index.asp?area="&area&">瀏覽</a><br>"
Response.End


'讀取文件所有屬性
function getAttr(folder,filename,i)
'function getAttr(folder,filename)
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(folder)
    Set objFile = objFolder.ParseName(filename)
    For Each strFileName in objFolder.Items
        if lcase(strFileName) = lcase(filename) then
            'For i = -1 to 127
            getAttr=objFolder.GetDetailsOf(strFileName, i)
            'getAttr=getAttr& i & ". "& objFolder.GetDetailsOf(objFolder.Items, i) & " = " & Replace(objFolder.GetDetailsOf(strFileName, i),chr(10),"<br>") & "<BR>"
            'Next
        end if
    Next
    set objshell=nothing
    set objFolder=nothing
end function

Function SaveToFile(strBody,File,cSet)
    Dim objStream
    Set objStream = Server.CreateObject("ADODB.Stream")
    With objStream
        .Type = 2
        .Open
        .Charset   = cSet
        .Position  = objStream.Size
        .WriteText = strBody
        .SaveToFile Server.MapPath(File),2
        .Close
    End With
    Set objStream = Nothing
End Function
%>