DreamweaverOnline
織夢線上 beta 2.0

1.這是使用上傳擴充產生的檔案

2.縮圖檔案在最底下

<%@LANGUAGE="VBSCRIPT" CODEPAGE="950"%>
<%
dim Data_5xsoft

Class upload_5xsoft
 dim objForm,objFile
 
 Public function Form(strForm)
  strForm=lcase(strForm)
  if not objForm.exists(strForm) then
   Form=""
  else
   Form=objForm(strForm)
  end if
 end function
 
 Public function File(strFile)
  strFile=lcase(strFile)
  if not objFile.exists(strFile) then
   set File=new FileInfo
  else
   set File=objFile(strFile)
  end if
 end function
 
 Private Sub Class_Initialize
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read
 
  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd
   iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
   tStream.Type = 1
   tStream.Mode =3
   tStream.Open
   Data_5xsoft.Position = iFormStart
   Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
   tStream.Position = 0
   tStream.Type = 2
   tStream.Charset ="big5"
   sInfo = tStream.ReadText
   tStream.Close
   '取得表單項目名稱
   iFormStart = InStrB(iInfoEnd,RequestData,sStart)
   iFindStart = InStr(22,sInfo,"name=""",1)+6
   iFindEnd = InStr(iFindStart,sInfo,"""",1)
   sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
   '如果是文件
   if InStr (45,sInfo,"filename=""",1) > 0 then
    set theFile=new FileInfo
    '取得文件名
    iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
    iFindEnd = InStr(iFindStart,sInfo,"""",1)
    sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    theFile.FileName=getFileName(sFileName)
    theFile.FilePath=getFilePath(sFileName)
    '取得文件類型
    iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
    iFindEnd = InStr(iFindStart,sInfo,vbCr)
    theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    theFile.FileStart =iInfoEnd
    theFile.FileSize = iFormStart -iInfoEnd -3
    theFile.FormName=sFormName
    if not objFile.Exists(sFormName) then
     objFile.add sFormName,theFile
    end if
   else
   '如果是表單項目
    tStream.Type =1
    tStream.Mode =3
    tStream.Open
    Data_5xsoft.Position = iInfoEnd
    Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
    tStream.Position = 0
    tStream.Type = 2
    tStream.Charset ="big5"
    sFormValue = tStream.ReadText
    tStream.Close
    if objForm.Exists(sFormName) then
     objForm(sFormName)=objForm(sFormName)&", "&sFormValue
    else
     objForm.Add sFormName,sFormValue
    end if
   end if
   iFormStart=iFormStart+iStart+1
  wend
  RequestData=""
  set tStream =nothing
 End Sub
 
 Private Sub Class_Terminate
  if Request.TotalBytes>0 then
   objForm.RemoveAll
   objFile.RemoveAll
   set objForm=nothing
   set objFile=nothing
   Data_5xsoft.Close
   set Data_5xsoft =nothing
  end if
 End Sub
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
 End function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
 End function
End Class

Class FileInfo
 dim FormName,FileName,FilePath,FileSize,FileType,FileStart

 Private Sub Class_Initialize
  FileName = ""
  FilePath = ""
  FileSize = 0
  FileStart= 0
  FormName = ""
  FileType = ""
 End Sub
 
 Public function SaveAs(FullPath)
  dim dr,ErrorChar,i
  SaveAs=true
  if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
  set dr=CreateObject("Adodb.Stream")
  dr.Mode=3
  dr.Type=1
  dr.Open
  Data_5xsoft.position=FileStart
  Data_5xsoft.copyto dr,FileSize
  dr.SaveToFile FullPath,2
  dr.Close
  set dr=nothing
  SaveAs=false
 end function
End Class

Class ImgWHInfo
    Dim ASO
    Private Sub Class_Initialize
        Set ASO=Server.CreateObject("ADODB.Stream")
        ASO.Mode=3
        ASO.Type=1
        ASO.Open
    End Sub
    Private Sub Class_Terminate
        Err.Clear
        Set ASO=Nothing
    End Sub

    Private Function Bin2Str(Bin)
        Dim I, Str
        For I=1 To LenB(Bin)
            clow=MidB(Bin,I,1)
            If ASCB(clow)<128 Then
                Str = Str & Chr(ASCB(clow))
            Else
                I=I+1
                If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
            End If
        Next
        Bin2Str = Str
    End Function
     
    Private Function Num2Str(Num,Base,Lens)
        Dim Ret
        Ret = ""
        While(Num>=Base)
            Ret = (Num Mod Base) & Ret
            Num = (Num - Num Mod Base)/Base
        Wend
        Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
    End Function
     
    Private Function Str2Num(Str,Base)
        Dim Ret,I
        Ret = 0
        For I=1 To Len(Str)
            Ret = Ret *base + Cint(Mid(Str,I,1))
        Next
        Str2Num=Ret
    End Function
     
    Private Function BinVal(Bin)
        Dim Ret,I
        Ret = 0
        For I = LenB(Bin) To 1 Step -1
            Ret = Ret *256 + AscB(MidB(Bin,I,1))
        Next
        BinVal=Ret
    End Function
     
    Private Function BinVal2(Bin)
        Dim Ret,I
        Ret = 0
        For I = 1 To LenB(Bin)
            Ret = Ret *256 + AscB(MidB(Bin,I,1))
        Next
        BinVal2=Ret
    End Function
     
    Private Function GetImageSize(filespec)
        Dim bFlag
        Dim Ret(3)
        ASO.LoadFromFile(filespec)
        bFlag=ASO.Read(3)
        Select Case Hex(binVal(bFlag))
        Case "4E5089":
            ASO.Read(15)
            ret(0)="PNG"
            ret(1)=BinVal2(ASO.Read(2))
            ASO.Read(2)
            ret(2)=BinVal2(ASO.Read(2))
        Case "464947":
            ASO.read(3)
            ret(0)="gif"
            ret(1)=BinVal(ASO.Read(2))
            ret(2)=BinVal(ASO.Read(2))
        Case "535746":
            ASO.read(5)
            binData=ASO.Read(1)
            sConv=Num2Str(ascb(binData),2 ,8)
            nBits=Str2Num(left(sConv,5),2)
            sConv=mid(sConv,6)
            While(len(sConv)<nBits*4)
                binData=ASO.Read(1)
                sConv=sConv&Num2Str(AscB(binData),2 ,8)
            Wend
            ret(0)="SWF"
            ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)
            ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)
        Case "FFD8FF":
            Do 
            Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS
            If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2)
            Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS
            Loop While True
            ASO.Read(3)
            ret(0)="JPG"
            ret(2)=binval2(ASO.Read(2))
            ret(1)=binval2(ASO.Read(2))
        Case Else:
            If left(Bin2Str(bFlag),2)="BM" Then
                ASO.Read(15)
                ret(0)="BMP"
                ret(1)=binval(ASO.Read(4))
                ret(2)=binval(ASO.Read(4))
            Else
                    ret(0)=""
            End If
        End Select
        ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
        getimagesize=ret
    End Function
     
    Public Function imgW(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = Server.CreateObject("Scripting.FileSystemObject")
        If (FSO.FileExists(IMGPath)) Then
            Set IMGFile = FSO.GetFile(IMGPath)
            FileExt=FSO.GetExtensionName(IMGPath)
            Select Case FileExt
                Case "gif","bmp","jpg","png":
                Arr=GetImageSize(IMGFile.Path)
                imgW = Arr(1)
            End Select
            Set IMGFile=Nothing
        Else
            imgW = 0
        End If    
        Set FSO=Nothing
    End Function
    
    Public Function imgH(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = server.CreateObject("Scripting.FileSystemObject")
        If (FSO.FileExists(IMGPath)) Then
            Set IMGFile = FSO.GetFile(IMGPath)
            FileExt=FSO.GetExtensionName(IMGPath)
            Select Case FileExt
                Case "gif","bmp","jpg","png":
                Arr=getImageSize(IMGFile.Path)
                imgH = Arr(2)
            End Select
            Set IMGFile=Nothing
        Else
            imgH = 0
        End If    
        Set FSO=Nothing
    End Function
End Class
 
If (Request.QueryString("upload")="true") Then

dim upload,f_folder,file,formPath,iCount,filename,fileExt,filesizemin,filesizemax

set upload=new upload_5xSoft '建立上傳對像
filesizemin=0
filesizemax=upload.form("imgS")
fileuseform=upload.form("useForm")
if (filesizemax="" OR filesizemax=0) Then
 filesizemax=200*1024
End If
f_folder=upload.form("upUrl")

'********************************列出所有上傳文件***************************************************
For each formName in upload.objFile
 set file=upload.file(formName)
 If file.filesize>0 then
  '********************************檢測文件大小***************************************************
  If file.filesize<filesizemin Then
   response.write "你上傳的文件太小了　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]"
  ElseIf file.filesize>filesizemax then
   response.write "文件大小超過了 "&filesizemax&"KB 限制　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]"
  End If
  
  '********************************檢測文件類型****************************************************
  fileExt=ucase(right(file.filename,4))
  uploadsuc=false
  Forum_upload="JPG|JPEG|PNG|GIF"
  Forumupload=split(Forum_upload,"|")
  for i=0 to ubound(Forumupload)
   if fileEXT="."&trim(Forumupload(i)) then
    uploadsuc=true
    exit for
   else
    uploadsuc=false
   end if
  next
  if uploadsuc=false then
   response.write "文件格式不正確　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]"
   response.end
  end if
 
  '********************************保存上傳文件至文件夾*****************************************
  Set upf=Server.CreateObject("Scripting.FileSystemObject")
  filenameStr=f_folder&"/"&file.filename
  For i = LenB(file.filename) To 1 Step -1
   If MidB(file.filename, i, 1) = ChrB(Asc(".")) Then
    hFileName = LeftB(file.filename, i-1)
    rFileName = RightB(file.filename, LenB(file.filename)-i+1)
    Exit For
   End If
  Next
  if upf.FileExists(Server.MapPath(filenameStr)) = True Then
     For i = 1 to 9999
      If upf.FileExists(Server.MapPath(f_folder & "/" & hFileName &"("& i &")"& rFileName)) = False Then
    filename = hFileName &"("& i &")"& rFileName
    filenameStr = f_folder & "/" & hFileName &"("& i &")"& rFileName
    Exit For
   End If
     Next
  end if
  if file.filesize>filesizemin and file.filesize<filesizemax then
   file.SaveAs Server.mappath(filenameStr)  '保存文件
    '取得圖片長寬
    Set showImg = New ImgWHInfo 
    getW = showImg.imgW(Server.Mappath(filenameStr)) 
    getH = showImg.imgH(Server.Mappath(filenameStr))
    Set showImg = Nothing
    '回傳值   
    if f_type="JPG" or f_type="GIF" or f_type="PNG" then
     response.write "<script>window.opener.document."&fileuseform&".showImg.src='"&filenameStr&"'</script>"
     response.write "<script>window.opener.document."&fileuseform&".rePic.value='"&filename&"'</script>"
     response.write "<script>window.opener.document."&fileuseform&".rePicW.value='"&filenameStr&"'</script>"     
     response.write "<script>window.opener.document."&fileuseform&".rePicH.value='"&filenameStr&"'</script>"          
     response.write "<script>window.opener.document."&fileuseform&".SubmitPIC.disabled='true';'</script>"
     response.write "<script>window.close();</script>"     
    else
     response.write "<script>window.opener.document."&fileuseform&".showImg.src='"&filenameStr&"'</script>"
     response.write "<script>window.opener.document."&fileuseform&".rePic.value='"&filename&"'</script>"
     response.write "<script>window.opener.document."&fileuseform&".rePicW.value='"&getW&"'</script>"     
     response.write "<script>window.opener.document."&fileuseform&".rePicH.value='"&getH&"'</script>"          
     response.write "<script>window.opener.document."&fileuseform&".SubmitPIC.disabled='true';'</script>"     
     response.write "<script>window.close();</script>"
    end if
         iCount=iCount+1
     end if
  set file=nothing
 end if
next
set upload=nothing '刪除此對像

Else
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=big5">
<title>圖片上傳系統</title>
<style type="text/css">
<!--
form {
 margin: 0px;
}
.formword {
 font-family: "Georgia", "Times New Roman", "Times", "serif";
 font-size: 8pt;
}
-->
</style>
<style type="text/css">
<!--
.box {
 border: 1px dotted #333333;
}
-->
</style>
</head>
<body bgcolor="#EEEEEE" text="#333333" leftmargin="2" topmargin="2" marginwidth="2" marginheight="2">
<script language="JavaScript" type="text/JavaScript">
var windowW = 400;
var windowH = 180;
windowX = Math.ceil( (window.screen.width  - windowW) / 2 );
windowY = Math.ceil( (window.screen.height - windowH) / 2 );
window.resizeTo( Math.ceil( windowW ) , Math.ceil( windowH ) );
window.moveTo( Math.ceil( windowX ) , Math.ceil( windowY ) );
</script>
<form ACTION="fupload.asp?upload=true" METHOD="POST" name="form1" enctype="multipart/form-data">
  <table width="100%" height="100%" border="0" cellpadding="4" cellspacing="0">
    <tr>
      <td height="20"><table width="100%" border="0" cellpadding="4" cellspacing="0" bgcolor="#999999">
          <tr valign="baseline" class="formword">
            <td width="40" align="right"><font color="#FFFFFF">注意：</font></td>
            <td><font color="#FFFFFF"> 請選取圖片上傳，允許類型為GIF、JPG、JPEG、PNG
              <%if Request.QueryString("imgS") <>"" then%>
              ，檔案大小不可超過 <%= Request.QueryString("ImgS") %> KB
              <%end if%>
              。</font></td>
          </tr>
        </table></td>
    </tr>
    <tr>
      <td height="20" align="center"><table border="0" cellpadding="4" cellspacing="0">
          <tr>
            <td><input name="upfile" type="file" class="formword" id="upfile" size="40"></td>
          </tr>
        </table>
        <input name="Submit" type="submit" class="formword" value="開始上傳">
        <input name="close" type="button" class="formword" onClick="window.close();" value="關閉視窗">
        <input name="useForm" type="hidden" id="useForm" value="<%=Request.QueryString("useForm")%>">
        <input name="upUrl" type="hidden" id="upUrl" value="<%=Request.QueryString("upUrl")%>">
        <input name="prevImg" type="hidden" id="prevImg" value="<%=Request.QueryString("prevImg")%>">
        <input name="reItem" type="hidden" id="reItem" value="<%=Request.QueryString("reItem")%>">
        <input name="imgS" type="hidden" id="imgS" value="<%if Request.QueryString("imgS") <>"" then Response.Write(Request.QueryString("ImgS")) Else Response.Write("0") %>">
        <input name="reW" type="hidden" id="reW" value="<%if Request.QueryString("imgW") <>"" then Response.Write(Request.QueryString("ImgW")) Else Response.Write("0") %>">
        <input name="reH" type="hidden" id="reH" value="<%if Request.QueryString("imgH") <>"" then Response.Write(Request.QueryString("ImgH")) Else Response.Write("0") %>"></td>
    </tr>
    <tr>
      <td height="20" align="center"><table width="100%" border="0" cellpadding="4" cellspacing="0" bgcolor="#FFFFFF" class="box">
          <tr valign="baseline" class="formword">
            <td align="center"> Copyright &copy; 2009 <a href="http://www.e-dreamer.idv.tw" target="_blank">eDreamer</a> Inc. All rights reserved.</td>
          </tr>
        </table></td>
    </tr>
  </table>
</form>
</body>
</html>
<%end if%>

2.這是縮圖時要使用檔案-應該要放在哪才能正確使用

<%
Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("imag/proo/"&upfilename)
L = 450
jpeg.PreserveAspectRatio = True

If jpeg.OriginalWidth > jpeg.OriginalHeight Then
   jpeg.Width = L
Else
   jpeg.Height = L
End If

 
Jpeg.Sharpen 1, 130
Jpeg.Save Server.MapPath("imag/proo/p1/"&upfilename)
Set Jpeg = Nothing
%>

哪有人像你這樣問問題的

就直接放放在平行的路徑下就好了壓@_@

你好

直接放放在平行的路徑下就好了壓---------不懂

抱歉就是部會才這樣直接發問的

謝

我不知道你這段縮圖語法是從哪裡COPY來的

所以能用與否都是一個問題

你要不要先PO一下文章的本來來源處

你好

之前就上傳版本-就是使用這語法

只是現在改新版本-不知道這語法要放在哪個位置

謝

你試試看將你的

<%
Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("imag/proo/"&upfilename)
L = 450
jpeg.PreserveAspectRatio = True

If jpeg.OriginalWidth > jpeg.OriginalHeight Then
   jpeg.Width = L
Else
   jpeg.Height = L
End If

 
Jpeg.Sharpen 1, 130
Jpeg.Save Server.MapPath("imag/proo/p1/"&upfilename)
Set Jpeg = Nothing
%>

擺在IMG的HTML標籤裡~因為你說你這是縮圖~所以自然是擺在IMG標籤的Value裡