由于系统只能统一设置缩略图大小，不适合客户要求，无奈之下，自己动手修改了。想到也许还有些朋友需要，于是发布了出来，改得很勉强，不要见笑。

第一步：修改admin/KS.UpFileForm.asp

第八行

Dim KSCls,classid

第40行

ChannelID=KS.ChkClng(KS.G("ChannelID"))
     UpType=KS.G("UpType")
     classid=KS.G("classid")

140行

'上传文章缩略图
  Sub Article_UpPhoto()
  Dim Path, InstallDir, DateDir
   Path = KS.ReturnChannelUpFilesDir(ChannelID)
   DateDir = Year(Now()) & Right("0" & Month(Now()), 2) & "/"
   Path = Path & "/" & DateDir

  Response.Write "  <table width=""95%"" border=""0""  cellpadding=""0"" cellspacing=""0"">"
  Response.Write "    <form name=""UpFileForm"" method=""post"" enctype=""multipart/form-data"" action=""Include/UpFileSave.asp"">"
  Response.Write "      <tr>"
  Response.Write "        <td valign=""top"">"
  Response.Write "          <input type=""file"" accept=""html"" size=""40"" name=""File1"" class=""upfile"">"
  Response.Write "          <input type=""submit"" id=""BtnSubmit""  name=""Submit"" class=""button"" value=""开始上传"">"
  Response.Write "          <input name=""Path"" value=""" & Path & """ type=""hidden"" id=""Path"">"
  Response.Write "          <input name=""UpType"" value=""Pic"" type=""hidden"" id=""UpLoadFrom"">"
  
  Response.Write "          <input name=""BasicType"" value=""" & BasicType & """ type=""hidden"">"
  Response.Write "          <input name=""ChannelID"" value=""" & ChannelID & """ type=""hidden"">"
  Response.Write "          <input name=""classid"" value=""" & classid & """ type=""hidden"">"

第二步：修改admin/KS.Article.asp  1985行左右

If F_B_Arr(11)=1 Then
   If CBool(UpPowerFlag) = True Then
   .Write "              <tr  class='tdbg' style='height:25px'>"
   .Write "                <td height='25' class='clefttitle'><div align=right><strong>" & F_V_Arr(11) & ":</strong></div></td>"
   .Write "                <td height='25' align='left'><iframe id='UpPhotoFrame' name='UpPhotoFrame' src='KS.UpFileForm.asp?UPType=Pic&ChannelID=" & ChannelID &"&classid="&FolderID&"' frameborder=0 scrolling=no width='100%' height='100%'></iframe>"
   .Write "              </td>"
   .Write "              </tr>"
   End If
     End If

1713行左右

   +'<div align="right">请稍候，系统正在保存远程图片到本地</div></td>'
        +'   <td width="25%"><font id="ShowArticleArea">&nbsp;</font></td>'
        +' </tr>'
        +'</table>'
        +'</td>'
        +'</tr>'
        +'</table>'
        +'</div>'
   document.write (SaveBeyondInfo)

   </script>
   <script type="text/javascript">
       function changeAction(id)
        {  
       
          var xxx=document.getElementById("UpPhotoFrame")
          xxx.action="KS.UpFileForm.asp?UPType=Pic&ChannelID=<%=ChannelID%>&classid="+id
          }
        </script>

1851行左右

If KS.C("SuperTF")=1 Then
   If F_B_Arr(11)=1 Then
     If CBool(UpPowerFlag) = True Then
       .Write " <select size='1' name='tid' style=""width:150px"" onChange='changeAction(this.value)'>"
       else
        .Write " <select size='1' style=""width:150px"" name='tid'>"
       end if
      else
       .Write " <select size='1' style=""width:150px"" name='tid'>"
      end if
  ' .Write " <select size='1' name='tid' style=""width:150px"">"
   .Write Replace(KS.LoadSelectClass(ChannelID),"{ClassID=" & FolderID & "}","selected") & " </select>"
  Else
   If F_B_Arr(11)=1 Then
     If CBool(UpPowerFlag) = True Then
       .Write " <select size='1' name='tid' onChange='changeAction(this.value)'>"
       else
        .Write " <select size='1' name='tid'>"
       end if
      else
       .Write " <select size='1' name='tid'>"
      end if

  '.Write " <select size='1' name='tid'>"
   .Write Replace(KSCls.GetAdminClass(ChannelID),"{ClassID=" & FolderID & "}","selected") & " </select>"
  End IF

第三步 修改 Admin/Include/UpFileSave.asp

第7行

Dim KSCls,classid

第56行左右

ChannelID=KS.ChkClng(UpFileObj.Form("ChannelID"))
  UpType=UpFileObj.Form("UpType")
  classid=UpFileObj.Form("classid")

154行左右

ReturnValue = CheckUpFile(FilePath,MaxFileSize,AllowFileExtStr,AutoReName,classid)

313行左右

Function CheckUpFile(Path,FileSize,AllowExtStr,AutoReName,classid)

343行左右

if SameFileExistTF = True then
       SaveFile Path,FormName,AutoReName,classid
      else
       SaveFile Path,FormName,"",classid
      end if

374行左右

Function SaveFile(FilePath,FormNameItem,AutoNameType,classid)

408行左右

ThumbFileName=split(FileName,".")(0)&"_S."&FileExtName
    call T.CreateThumbs(FilePath & FileName,FilePath & ThumbFileName,classid)

第四步 修改 KS_Cls/KS.PublicCls.asp 1355行左右

 '**************************************************
 '函数名：ReturnChannelUppicSize
 '作  用：返回栏目的生成图片缩略图信息
 '参  数：ClassID--栏目ID
 '参  数：wtype--调用类型：1为取宽度，2为取高度,3为取黄金分割点值
 '**************************************************
 Public Function ReturnChannelUppicSize(ClassID,wtype)
    ClassID = trim(ClassID)
    Dim CRS:Set CRS=conn.execute("Select pic_width,pic_height,cutnum From KS_Class Where ID='" & ClassID&"'")
   If trim(ClassID) = "0" Or (CRS.EOF And CRS.BOF) Then
  ReturnChannelUppicSize = 0
   Else
    if wtype=1 then
      if CRS(0)<>"" then
       ReturnChannelUppicSize = CRS(0)
     else
       ReturnChannelUppicSize=0
     end if
    elseif wtype=2 then
      if CRS(1)<>"" then
       ReturnChannelUppicSize = CRS(1)
     else
       ReturnChannelUppicSize=0
     end if
    elseif wtype=3 then
      if CRS(2)<>"" then
       ReturnChannelUppicSize = FormatNumber(CRS(2),1,-1)
     else
       ReturnChannelUppicSize=0
     end if
    end if
   End If
 CRS.Close:Set CRS = Nothing
 End Function
 
 '**************************************************
 '函数名：ReturnChannelAllowUpFilesSize
 '作  用：返回频道的最大允许上传文件大小
 '参  数：ChannelID--频道ID
 '**************************************************

第五步 修改 KS_Cls/KS.Thumbs.asp  258 行

 '由原图片根据数据里保存的设置生成缩略图
  Function CreateThumbs(FileName, ThumbFileName,classid)
  dim pic_width,pic_height,cutnum
   CreateThumbs = False
   If KS.TbSetting(0) <> "0" And (Not IsNull(KS.TbSetting(0))) Then
    If KS.TbSetting(1) = "0" Then
     pic_width=cint(KS.ReturnChannelUppicSize(classid,1))
     pic_height=cint(KS.ReturnChannelUppicSize(classid,2))
     cutnum=KS.ReturnChannelUppicSize(classid,3)
     if (pic_width=0) then
      pic_width=KS.TbSetting(2)
     end if
     if  pic_height=0 then
      pic_height=KS.TbSetting(3)
     end if
     if  cutnum=0 then
      cutnum=0.3
     end if
     
     CreateThumbs = CreateThumb(FileName, CInt(pic_width), CInt(pic_height), 0, ThumbFileName,cutnum)
    Else
     CreateThumbs = CreateThumb(FileName, 0, 0, CSng(KS.TbSetting(4)), ThumbFileName,cutnum)
    End If
   End If
  End Function
  '由原图片生成指定宽度和高度的缩略图
  Function CreateThumb(FileName, Width, Height, Rate, ThumbFileName,cutnum)
      On Error Resume Next

下面引用 梦中女孩 写的 图片上传自动生成不变形缩略图黄金分割修改方法  http://bbs.kesion.com/dispbbs.asp?boardid=41&id=46826

142行左右

GetPostion CInt(MarkPosition), x, y, objImage.Width, objImage.Height, objImage.crop,objImage.TextWidth, objImage.TextHeight

344行左右

If Rate = 0 And (Width <> 0 Or Height <> 0) Then
      If Width < objImage.OriginalWidth And Height < objImage.OriginalHeight Then
      ' If Width = 0 And Height <> 0 Then
      '  objImage.Width = objImage.OriginalWidth / objImage.OriginalHeight * Height
      '  objImage.Height = Height
      ' ElseIf Width <> 0 And Height = 0 Then
      '  objImage.Width = Width
      '  objImage.Height = objImage.OriginalHeight / objImage.OriginalWidth * Width
      ' ElseIf Width <> 0 And Height <> 0 Then
      '  objImage.Width = Width
      '  objImage.Height = Height
     '修改开始 

      dim qjazhro_h,qjazhro_w,qjazhro_t,qjazhro_hj,qjazhro,mznvhai 
       qjazhro=round((Width/Height),3)
       mznvhai=round((objImage.OriginalWidth/objImage.OriginalHeight),3)
       If qjazhro<mznvhai Then
           objImage.Height = Height
        objImage.Width = round((objImage.OriginalWidth / objImage.OriginalHeight * Height),3)
        qjazhro_w=round(((objImage.Width-Width)/2),3)
        qjazhro_t=Width+qjazhro_w
        objImage.crop qjazhro_w,0,qjazhro_t,Height
       ElseIf qjazhro>mznvhai Then
        objImage.Width = Width
        objImage.Height = round((objImage.OriginalHeight / objImage.OriginalWidth * Width),3)
        qjazhro_h=objImage.Height-Height
        qjazhro_hj=qjazhro_h*cutnum  'cutnum为黄金分割点值
        qjazhro_t=Height+qjazhro_hj
        objImage.crop 0,qjazhro_hj,Width,qjazhro_t
       ElseIf qjazhro=mznvhai Then
        objImage.Width = Width
        objImage.Height = Height

 '修改结束

第六步：

 修改 ks_cls/KS.ClassCls.asp

第20行

Dim Folder,CurrPath,TemplateRS, TemplateSql, TypeList, NowDate, YearStr, MonthStr, DayStr,DefaultArrGroupID,ReadPoint,ChargeType,PitchTime,ReadTimes,AllowArrGroupID,pic_width,pic_height,cutnum

60行左右

pic_width        = Rse("pic_width")
      pic_height       = Rse("pic_height")

    if Rse("cutnum")<>"" then
      cutnum           = FormatNumber(Rse("cutnum"),1,-1)

   else

     cutnum=0.3

   end if
      ClassBasicInfoArr=Split(Rse("ClassBasicInfo"),"||||")
      ClassPic=ClassBasicInfoArr(0)

80行左右

Else
       TopTitle="创建新" & TempStr
    pic_width=250
    pic_height=210
    cutnum=0.3

303行左右

 .Write "          <tr class=""tdbg"" onMouseOver=""this.className='tdbgmouseover'"" onMouseOut=""this.className='tdbg'"">" & vbCrLf
     .Write "            <td height='30' align='right' width='200' class='clefttitle'><strong>"  &TempStr & "缩略图大小：</strong></td>" & vbCrLf
     .Write "            <td height='28'>&nbsp;"
     .Write "              宽度:<INPUT NAME='pic_width' TYPE='text' value='" & pic_width & "' id='pic_width' class='upfile' size=5>px"
     .Write "              高度:<INPUT NAME='pic_height' TYPE='text' value='" & pic_height & "' id='pic_height' class='upfile' size=5>px"
     .Write "              黄金分割点:<INPUT NAME='cutnum' TYPE='text' value='" & cutnum & "' id='cutnum' class='upfile' size=3>(0-1)"
     .Write "              </td>"
     .Write "          </tr>" & vbCrLf
     
     If FolderID="0" Then
     .Write "          <tr class=""tdbg"" onMouseOver=""this.className='tdbgmouseover'"" onMouseOut=""this.className='tdbg'"">" & vbCrLf

680行左右

'添加频道目录的保存过程
'参数:ChannelID--频道ID
Sub ChannelFolderAddSave(ChannelID,Go)
Dim ID, TJ, FolderName, Folder, ClassID, TS, FolderTemplateID, FolderFsoIndex,BackUrl,ButtonSymbol,pic_width,pic_height,cutnum
Dim TemplateID, FnameType, FsoType, FolderDomain, FolderOrder, CurrPath, TopFlag

720行左右

    pic_width =Request.Form("pic_width")
    pic_height=Request.Form("pic_height")
    cutnum =Request.Form("cutnum")
    CirSpecialShowTF=Request.Form("CirSpecialShowTF")
    SpecialTemplateID=Request.Form("SpecialTemplateID")

830行左右

    if pic_width<>"" then
      RST("pic_width") = pic_width

    end if

    if pic_height<>"" then
      RST("pic_height") = pic_height

    end if

   if  cutnum<>"" then
      RST("cutnum") = cutnum

   end if
      RST.Update
      RST.Close
                       
      If KS.C("SuperTF")<>1 Then
       dim rsp:set rsp=server.CreateObject("adodb.recordset")
       rsp.open "select powerlist from ks_admin where username='" & KS.R(KS.C("AdminName")) & "'",conn,1,3
       rsp(0)=rsp(0) &"," & ClassID
       rsp.update
       Session(KS.SiteSn&"PowerList")=rsp(0)
       rsp.close
       set rsp=nothing
      end if
      
      Response.Write ("<script>if (confirm('创建成功,继续创建吗?')) {location.href='KS.Class.asp?ChannelID=" & ChannelID &"&Action=" & Action &"&Go=" & Go & "&FolderID=" & ID & "';}else{location.href='" &BackUrl& "?ChannelID=" & ChannelID & "&ID=" & ID & "&Go=" & Go&"';parent.frames['BottomFrame'].location.href='KS.Split.asp?ChannelID=" & ChannelID &"&ButtonSymbol=" & ButtonSymbol & "&FolderID=" & Id & "&Go=" & Go & "';}</script>")
     Else
      RST.Open "select * from KS_Class Where ID='" &KS.G("FolderID") & "'", Conn, 1, 3
      RST("FolderName") = FolderName
      If ID <> "" Then  RST("SpecialTemplateID")=SpecialTemplateID Else  RST("SpecialTemplateID")="0"
      RST("FolderTemplateID") = FolderTemplateID
      RST("TopFlag") = TopFlag
      RST("FolderFsoIndex") = FolderFsoIndex
      RST("TemplateID") = TemplateID
      RST("FnameType") = FnameType
      RST("FsoType") = FsoType
      RST("FolderDomain") = FolderDomain
      RST("FolderOrder") = FolderOrder
      RST("ClassPurview")=ClassPurview
      RST("CommentTF")=CommentTF
      RST("CirSpecialShowTF")=CirSpecialShowTF
      RST("DefaultArrGroupID")=GroupID
      RST("AllowArrGroupID")=AllowArrGroupID
      RST("DefaultReadPoint")=ReadPoint
      RST("DefaultChargeType")=ChargeType
      RST("DefaultPitchTime")=PitchTime
      RST("DefaultReadTimes")=ReadTimes
      RST("ClassBasicInfo")=ClassPic & "||||" & ClassDescript & "||||" & MetaKeyWord   &"||||" & MetaDescript& "||||" & AdPa
      RST("ClassDefineContent")=ClassDefineContent
      if pic_width<>"" then
      RST("pic_width") = pic_width

      RST.Update

最后，打开数据库，在ks_clas中添加三个字段 pic_width 数字 长整型  pic_height 数字 长整型  cutnum 数字 单精度

大功告成。

事实证明，很有用！

5.03有用吗？