jk_fso.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 129 行

<%
'****************************************************
' 玫瑰情缘 2006v3.0      power by www.meigui8.cn
' email: [e-mail]  , [e-mail]
' web: http://www.meigui8.cn
' copyright (c) 2006 meigui8.cn all rights reserved.
'****************************************************

dim fso_sys_var
fso_sys_var="script"&"ing.file"&"sys"&"tem"&"object"

sub test_js()
  dim file_name,temp1,fi
  file_name="style/data_forum.js"
  fi=1
  temp1=vbcrlf&"var forum_list_sorts=new array();"
  sql="select class_id,forum_id,forum_star,forum_name from bbs_forum where forum_hidden=0 order by class_id,forum_order"
  set rs=joekoe_cms.exec(sql,1)
  do while not rs.eof
    temp1=temp1&vbcrlf&"forum_list_sorts[0,"&fi&"]="&rs("forum_id")&";" & _
	  vbcrlf&"forum_list_sorts[1,"&fi&"]="&rs("class_id")&";" & _
	  vbcrlf&"forum_list_sorts[2,"&fi&"]="&rs("forum_star")&";" & _
	  vbcrlf&"forum_list_sorts[3,"&fi&"]="""&rs("forum_name")&""";"
    rs.movenext
    fi=fi+1
  loop
  rs.close
  call create_file(file_name,temp1)
  call admin_msg("成功更新了论坛分类js！","?",1)
end sub

function code_fso(strers,ft1,ft2)
  if var_null(strers)="" then
    code_fso=""
    exit function
  end if
  dim strer
  strer=trim(strers)
  strer=replace(strer,"""","\""")
  if ft2=1 then
    strer=replace(strer,":","")
    strer=replace(strer,"|","")
  end if
  select case ft1
  case 1
    strer=replace(strer,vbcrlf,"<br>")
  end select
  code_fso=strer
end function

function file_trim_vbcrlf(fvar)
  dim temp1,tmp,tmpvar
  temp1=fvar
  tmp=false
  do while not tmp
    tmpvar=left(temp1,1)
    if tmpvar=chr(10) or tmpvar=chr(13) then
      temp1=right(temp1,len(temp1)-1)
    else
      tmp=true
    end if
  loop
  tmp=false
  do while not tmp
    tmpvar=right(temp1,1)
    if tmpvar=chr(10) or tmpvar=chr(13) then
      temp1=left(temp1,len(temp1)-1)
    else
      tmp=true
    end if
  loop
  file_trim_vbcrlf=temp1
end function

sub del_file(fname,ftype)
  'on error resume next
  dim fobj,file_name,upload_path
  if len(fname)<3 then exit sub
  if int(instr(fname,"://"))>0 then exit sub
  upload_path=web_dim(13)
  if right(upload_path,1)<>"/" then upload_path=upload_path&"/"
  select case ftype
  case 0
    file_name="style/"&fname
  case 1
    upload_path=web_dim(13)
    if right(upload_path,1)<>"/" then upload_path=upload_path&"/"
    file_name=upload_path&fname
  case 5
    file_name=fname
  case else
    exit sub
  end select
  file_name=server.mappath(file_name)
  set fobj=createobject(fso_sys_var)
  if fobj.fileexists(file_name) then
    fobj.deletefile(file_name)
  end if
  set fobj=nothing
end sub

function get_file(file_name)
  dim filetemp,fileos,filepath
  set fileos=createobject(fso_sys_var)
  filepath=server.mappath(file_name)
  set filetemp=fileos.opentextfile(filepath,1,true)
  get_file=filetemp.readall
  filetemp.close
  set filetemp=nothing
  set fileos=nothing
end function

sub create_file(file_name,filetype)
  dim filetemp,fileos,filepath
  set fileos=createobject(fso_sys_var)
  filepath=server.mappath(file_name)
  set filetemp=fileos.createtextfile(filepath,true)
  filetemp.writeline( filetype )
  filetemp.close
  set filetemp=nothing
  set fileos=nothing
end sub
'****************************************************
' 玫瑰情缘 2006v3.0      power by www.meigui8.cn
' email: [e-mail]  , [e-mail]
' web: http://www.meigui8.cn
' copyright (c) 2006 meigui8.cn all rights reserved.
'****************************************************
%>