<!--#include file="../../tgzcm.Cache/tgzcm.Admin.asp" -->
<!--#include file="Cai_Fun_aspjpeg1.asp" -->
<!--#include file="Cai_Fun_aspjpeg.asp" -->
<%
'定义图片大小开始
Dim bigw,bigh,smallw,smallh
bigw=replace(left(tgzcmId(18),3),"*","")
bigh=replace(right(tgzcmId(18),3),"*","")
smallw=replace(left(tgzcmId(19),3),"*","")
smallh=replace(right(tgzcmId(19),3),"*","")
t_width=bigw'大图
t_height=bigh
tt_width=smallw'小图
tt_height=smallh
%>
<%
Function IsExists(filespec) 
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	If (fso.FileExists(server.MapPath(filespec))) Then
	IsExists = True
	Else
	IsExists = False
	End If
End Function

Function IsFolder(Folder)
	Set  objFSO  =  Server.CreateObject("Scripting.FileSystemObject")  
	If  objFSO.FolderExists(server.MapPath(Folder))  Then  
	IsFolder = True
	Else
	IsFolder = False
	End If
End Function

Function CreateFolder(fldr) 
	Dim fso, f
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.CreateFolder(Server.MapPath(fldr))
	CreateFolder = f.Path
	Set f=nothing
	Set fso=nothing
End Function

Function GetPicurl(picurl)
    Up_Dir=tgzcm_Up_Dir
	If IsFolder("../../Picfile/"&Up_Dir)=False Then'检测文件夹是否存在
	    CreateFolder "../../Picfile/"&Up_Dir
	End if
	re_data_picurl="../../Picfile/"&Up_Dir&"big"&GenerateRandomFileName(picurl)'新文件名与相对保存路径
	If SaveRemoteFile(picurl, re_data_picurl) = True Then
	    GetPicurl=replace(re_data_picurl,"../","")
	Else
	    GetPicurl="Images/Nopic.gif"
	End If
      '启用自动缩略图开始，调用aspjpg组件：QQ:248682396
      basepic=re_data_picurl
      sl_width=t_width
      sl_height=t_height
      if tgzcmId(20)=1 then
      Call makesl (basepic,newpic,sl_width,sl_height)
      End if
End Function

Function GetPicurll(picurl)
    Up_Dir=tgzcm_Up_Dir
	If IsFolder("../../Picfile/"&Up_Dir)=False Then'检测文件夹是否存在
	    CreateFolder "../Picfile/"&Up_Dir
	End if
	re_data_picurll="../../Picfile/"&Up_Dir&"small"&GenerateRandomFileName(picurl)'新文件名与相对保存路径
	If SaveRemoteFile(picurl, re_data_picurll) = True Then
	    GetPicurll=replace(re_data_picurll,"../","")
	Else
	    GetPicurll="Images/Nosmallpic.gif"
	End If	
	'Response.write re_data_picurll&"xx"
	basepicc=re_data_picurll
	sll_width=tt_width'小图参数
    sll_height=tt_height
    if tgzcmId(20)=1 then
	Call makesll (basepicc,newpicc,sll_width,sll_height)
    Else
    Response.Write "服务器不支持aspjpeg组件"
    End if	
End Function
'==================================================
'函数名：SaveRemoteFile
'作  用：保存远程的文件到本地
'参  数：LocalFileName ------ 本地文件名
'        RemoteFileUrl ------ 远程文件URL
'返回值：True ----- 保存成功
'        False ----- 保存失败
'==================================================
Function SaveRemoteFile(RemoteFileUrl, LocalFileName)
    On Error Resume Next
    Dim Ads, Retrieval, GetRemoteData
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open "Get", RemoteFileUrl, False, "", ""
        .Send
        GetRemoteData = .ResponseBody
    End With
    If Err.Number <> 0 Then
        Err.Clear
        Response.Write "<br>" & RemoteFileUrl & " Get Failed"
        SaveRemoteFile = False
        Exit Function
    End If
    Set Retrieval = Nothing
    Set Ads = Server.CreateObject("Adodb.Stream")
    With Ads
        .Type = 1
        .Open
        .Write GetRemoteData
        .SaveToFile Server.MapPath(LocalFileName), 2
        .Cancel
        .Close
    End With
    Set Ads = Nothing
    If Err.Number <> 0 Then
        Err.Clear
        Response.Write "<br>" & LocalFileName & " Save Failed"
        SaveRemoteFile = False
    Else
	    Response.Write"预览图片：<a href='" &LocalFileName& "' target='_blank'>" &LocalFileName& "</a> <font color=red>"&formatnumber(len(GetRemoteData)/1024*2,2)&"</font>Kb<br>"	
        SaveRemoteFile = True
    End If
End Function
%>