ASP Programming Example: Using text +asp to build press release System 2

〈%
Dim myfso,myread
Set Myfso=createobject ("Scripting.FileSystemObject")
Set Myread=myfso.opentextfile (Server.MapPath ("./new_list.asp"), 1,0)
If Myread.atendofstream Then
Response.Write "Not currently added news"
Response.End
Else
Dim Mytext,listarray
Mytext=myread.readall
Listarray=split (mytext, "|") ' ###### #把所有记录分割成一个数组a
Dim Recordcount,pagecount, PageSize, Pagenum
Recordcount=ubound (Listarray) ' ########### #记录条数
pagesize=2
Pagecount=recordcount/pagesize ' ###### #取得页面数
If InStr (1,pagecount, ".") =null or InStr (1,pagecount, ".") =0 Then
Pagenum=pagecount
Else
Pagenum=int (PageCount) +1
End If
Dim topage
Topage=cint (Request.QueryString ("ToPage")) ' ####### #取得要显示的页面
If Topage〈=0 Then
Topage=1
End If
If Topage〉pagenum Then
Topage=pagenum
End If
Dim i,j,n
B=listarray
For i=0 to Recordcount-1 ' ####### #把每一条记录组成一个数组
J=split (Listarray (i), ",")
If UBound (j) =6 Then
B (i) = "〈span style= ' COLOR: #ffbd00; Font-size:7px ' 〉〈li〉〈/span〉〈span style= ' font-size:10pt ' 〉〈a href= ' news_view.asp?id= ' & J (0) & ' target=blank〉 ' & J (1) & "(figure) 〈/a〉 click:" & J (4) & "Last release Time:" &j (5) & "〈/span〉"
Else
B (i) = "〈span style= ' COLOR: #ffbd00; Font-size:7px ' 〉〈li〉〈/span〉〈span style= ' font-size:10pt ' 〉〈a href= ' news_view.asp?id= ' & J (0) & ' target=blank〉 ' & J (1) & "〈/a〉 click:" & J (4) & "Last release Time:" &j (5) & "〈/span〉"
End If
Next
' ####### #把记录反排序存储在新的数组实现按时间反排序
Dim c (100)
N=0
For I=recordcount to 0 step-1
C (n) =b (i)
N=n+1
Next
Dim CurrentRecord
currentrecord=pagesize* (topage-1) +1 ' ######## #显示每一页
For K=1 to PageSize
If Len (c (currentrecord)) =0 Then
Exit For
End If
Response.Write C (CurrentRecord) & "〈br〉"
Currentrecord=currentrecord+1
Next
Response.Write "〈body bgcolor= #EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉"
For M=1 to Pagenum
Response.Write "〈span style=font-size:10pt〉〈a href=news_list.asp?topage=" &m& "" "&m&" 〈/a〉〈/span〉 "
Next
End If%>
News Delete
!--#include file= "news_session.asp"--〉
〈%
Dim id
Id=request.querystring ("id")
Dim Myfso
Set Myfso=createobject ("Scripting.FileSystemObject")
If Myfso. FileExists (Server.MapPath ("./news_content/" &id& ". txt")) Then
Myfso. DeleteFile (Server.MapPath ("./news_content/" &id& ". txt")) ' ############ #删除新闻内容
End If
Dim mytext2,myread2
Set Myread2=myfso.opentextfile (Server.MapPath ("./new_list.asp"), 1,0)
If Myread2.atendofstream Then
Response.Write "No news content"
Myread2.close
Response.End
End If
Mytext2=myread2.readall
Myread2.close
Dim listarray,i,h,count,sf,title
Listarray=split (mytext2, "|") ' ######## #读取记录并以 # split into Listarray arrays
Count=ubound (Listarray)
For i=0 to count ' ########## #根据ID找到该新闻实现删除功能
Sf=split (Listarray (i), ",")
If Right (SF (0), 7) =right (id,7) Then
Dim thisid
Thisid=i
' ###### #为6说明上传了图片, delete the news picture and the list record
If UBound (SF) =6 Then
Myfso.deletefile (server. MapPath ("./images/" &SF (6)))
End If
Exit For
End If
Next
Dim Mytext,mappath
Mappath=server.mappath ("./")
Set Mytext=myfso.createtextfile (mappath& "\new_list.asp", -1,0)
For i=0 to Thisid-1 ' ######### #把所有数据重新写入文件
Mytext.write Listarray (i) & "|"
Next
For I=thisid+1 to UBound (Listarray)
If I=ubound (Listarray) Then
Mytext.write Listarray (i)
Exit For
Else
Mytext.write Listarray (i) & "|"
End If
Next
Mytext.close
%〉
〈script language= "JavaScript"
Alert ("Delete succeeded");
Location.href = ("news_admin1.asp");
〈/script〉
---------------
News_view.asp
〈% response.expires=0
Dim myid,myfso,myread,mytext1
Myid=request.querystring ("id")
If Len (myID) =0 Then
Response.Write "No News"
Response.End
End If
Set Myfso=createobject ("Scripting.FileSystemObject")
Set Myread=myfso.opentextfile (Server.MapPath ("./news_content/" &myid& ". txt"), 1,0)
If Myread.atendofstream Then
Response.Write "No news content"
Response.End
Else
Mytext1=myread.readall ' ###### #打开对应的新闻内容文件, and read with variable storage
function Htmlencode2 (str) ' ########## #字符处理函数
Dim result
Dim l
L=len (str)
Result= ""
Dim i
For i = 1 to L
Select Case Mid (str,i,1)
Case Chr (34)
result=result+ "" ""
Case "&"
result=result+ "&"
Case Chr (13)
result=result+ "〈br〉"
Case ""
Result=result+ ""
Case Chr (9)
Result=result+ ""
Case Chr (32)
Result=result+ ""
If I+1〈=l and i-1〉0 then
If Mid (str,i+1,1) =CHR (+) or mid (str,i+1,1) =CHR (9) or mid (str,i-1,1) =CHR (+) or mid (str,i-1,1) =CHR (9) Then
Result=result+ ""
Else
Result=result+ ""
End If
Else
Result=result+ ""
End If
Case Else
Result=result+mid (str,i,1)
End Select
Next
Htmlencode2=result
End Function
Myread.close
End If
Dim mytext2,myread2
Set Myread2=myfso.opentextfile (Server.MapPath ("./new_list.asp"), 1,0)
If Myread2.atendofstream Then
Response.Write "No news content"
Response.End
Else
Mytext2=myread2.readall
Myread2.close
Dim listarray,i,h
Listarray=split (mytext2, "|") ' ######## #读取记录并以 # split into Listarray arrays
Dim count,sf,title,src
Count=ubound (Listarray)
For i=0 to count ' ########## #根据ID找到该新闻并把文章点击次数加1
Sf=split (Listarray (i), ",")
If Right (SF (0), 7) =right (myid,7) Then
TITLE=SF (1)
SRC=SF (3)
SF (4) =SF (4) +1
' ###### #为6说明上传了图片, stored as a new array
If UBound (SF) =6 Then
Listarray (i) =sf (0) & "," &SF (1) & "," &SF (2) & "," &SF (3) & "," &SF (4) & "," &SF (5) & "," &SF (6)
Dim mypic
MYPIC=SF (6)
Else
Listarray (i) =sf (0) & "," &SF (1) & "," &SF (2) & "," &SF (3) & "," &SF (4) & "," &SF (5)
End If
‘##################
Exit For
End If
Next
Dim K,mytext,mappath
Mappath=server.mappath ("./")
Set Mytext=myfso.createtextfile (mappath& "\new_list.asp", -1,0)
For i=0 to UBound (listarray) ' ######### #把所有数据重新写入文件
If I=ubound (Listarray) Then
Mytext.write Listarray (i)
Else
Mytext.write Listarray (i) & "|"
End If
Next
Response.Write "〈body bgcolor= #EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉"
Response.Write "〈div align=center style=font-size:13pt〉〈strong〉" &title& "〈/strong〉〈span〉〈/div〉〈br〉"
Response.Write "〈hr size=1〉"
If Len (mypic) 〈〉0 Then
Response.Write "〈center〉〈img src= './images/" &mypic& "' 〉〈/center〉"
End If
Response.Write "〈span style=font-size:10pt〉" &htmlencode2 (MYTEXT1) & "〈/span〉"
Response.Write "〈br〉〈div align=right style= ' font-size:9pt ' news Source: 〈font color=red〉" &src& "〈/font〉〈/div〉"
%〉
〈object id=closes type= "Application/x-oleobject" classid= "Clsid:adb880a6-d8ff-11cf-9377-00aa003b7a11"
〈param name= "Command" value= "Close"
〈/object〉
〈center〉〈input type= "button" value= "Close Window" onclick= "closes. Click (); 〉〈/center〉
〈% End if%〉
News changes
' ###### #news_update. asp
!--#include file= "news_session.asp"--〉
〈script Id=clienteventhandlersjs language=javascript〉
〈!--
function Client_onblur (ii) {
Server=eval ("Form1.server" +ii)
if (server.value== "") {
Client=eval ("Form1.client" +ii)
Clientvalue=client.value+ ""
Varlen=clientvalue.length
A=clientvalue.lastindexof (' \ \ ')
Clientvalue=clientvalue.substring (a+1)
alert (Clientvalue);
Server.value=clientvalue
}
}
function Form1_onsubmit () {
for (i=1;i〈1;i++) {
Client=eval ("Form1.client" +i)
Server=eval ("Form1.server" +i)
if (client.value!= "" && server.value== "") {alert ("The file name after uploading cannot be empty!") "); Server.focus (); return false}
}
}
--〉
〈/script〉
〈% Dim myID
Myid=request.querystring ("id")
If Len (myID) =0 Then
Response.Write "No News"
Response.End
End If
Dim myfso,myread,mytext,newscontent
' ###### #打开对应的新闻内容文件, and read with variable storage
Set Myfso=createobject ("Scripting.FileSystemObject")
If Myfso. FileExists (Server.MapPath ("./news_content/" &myid& ". txt")) Then
Set Myread=myfso.opentextfile (Server.MapPath ("./news_content/" &myid& ". txt"), 1,0)
Newscontent=myread.readall
Myread.close
Newscontent=replace (newscontent, "〈br〉", Chr (13))
Newscontent=replace (Newscontent, "", "")
Newscontent=replace (Newscontent, "", Chr (32))
Newscontent=replace (Newscontent, "'", Chr (34))
Else
Response.Write "The news has been deleted"
Response.End
End If
Dim mytext2,myread2 ' ###### #打开新闻列表文件
Set Myread2=myfso.opentextfile (Server.MapPath ("./new_list.asp"), 1,0)
If Myread2.atendofstream Then
Response.Write "No news content"
Response.End
End If
Mytext2=myread2.readall
Dim Listarray
Listarray=split (mytext2, "|") ' ######## #读取记录并以 # split into Listarray arrays
Dim count,sf,i,title,src
Count=ubound (Listarray)
For i=0 to count ' ########## #根据ID找到该新闻并用变量存储给新闻的标题
Sf=split (Listarray (i), ",")
If Right (SF (0), 7) =right (myid,7) Then
TITLE=SF (1)
SRC=SF (3)
Exit For
End If
Next
%〉
〈head〉
〈style〉
td {FONT-SIZE:9PT}
Input.buttonface {
Background-color: #0079F2; Border-bottom: #333333 1px outset; Border-left: #333333 1px outset; Border-right: #ffffff 1px outset; Border-top: #ffffff 1px inset; Color:black; Font-size:9pta {color: #000000; Text-decoration:none}
. text {font-size:11pt}
Input.buttonface2 {
Background-color: #EDF0F5; Color:black; Font-size:9pta {color: #000000; Text-decoration:none}
a:hover {color:white; text-decoration:underline overline; background: #007EBB}
. text {font-size:11pt}
〈/style〉
〈/head〉
〈body bgcolor= #EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉
〈form method= "POST" action= "news_updateing.asp" Name= "Form1" enctype= "Multipart/form-data" onsubmit= "return form1_ OnSubmit () "
〈div align= "left"
〈table border= "1" width= "752" height= "Up" cellspacing= "0" cellpadding= "0"
〈tr〉
〈TD colspan= "2" height= "" align= "center" width= "" "Style=" font-size:12pt "〉〈strong〉 news release system background Management--News modification 〈/STRONG〉〈/TD 〉
〈/tr〉
〈tr〉
〈TD width= "119" height= "style=" "font-size:9pt" news headlines 〈/td〉
〈TD width= "675" height= "12"
〈input type= "text" name= "Newtitle" size= "94" value= "〈%=title%〉" class= "Buttonface2"
〈/td〉
〈/tr〉
〈tr〉
〈TD width= "119" height= "213" style= "font-size:9pt"
New 〈br〉
Smell 〈br〉.
Inner 〈br〉
Capacity 〈/td〉
〈TD width= "675" height= "213"
〈textarea rows= "name=" newcontent "cols=" "style=" color: #000000; "Class=" ButtonFace "
〈input type= "Reset" value= "all Override" Name= "B2" style= "Font-size:10pt;color: #000000;" class= "ButtonFace"
〈input type= "button" value= "Account Modification" onclick= "location.href=" admin/news_chadmin.asp "" Name= "B2" style= "FONT-SIZE:10PT; Color: #000000; "class=" ButtonFace "
〈input type= "button" value= "News Add" onclick= "location.href= ' news_add.asp" "Name=" B2 "style=" font-size:10pt;color:# 000000; "class=" ButtonFace "〉〈/p〉
〈input type=hidden name= "myID" value= "〈%=myid%〉"
〈input type= "hidden" name= "Server1"
〈input type= "hidden" name= "mysession" value= "MySession"
〈/form〉
##########
News_updating.asp
!--#include file= "news_session.asp"--〉
!--#include file= "Upload.inc"--〉
〈%
' Fields ("xxx"). Name gets the names of xxx (form Object) in form
' Fields ("xxx"). FilePath If the file Object gets the full path
' Fields ("xxx"). filename If file Object gets the file name
' Fields ("xxx"). ContentType if it is a file Object that gets the type
' Fields ("xxx"). Length gets the data lengths of xxx (Form Object) in form
' Fields ("xxx"). Value gets the data content of xxx (form Object) in form
Dim Formdata,formsize,gnote,bnote,notes,binlen,binstr
Formsize=request.totalbytes
Formdata=request.binaryread (Formsize)
Set fields = Getupload (FormData)
' ########### #判断输入错误
Dim mytitle,content,src,id,mysession
Mysession=fields ("Newtitle"). Value
If Len (mysession) =0 Then
Response.Write "illegal landing or extra time, please re-login"
Response.End
End If
Mytitle=fields ("Newtitle"). Value
Mytitle=replace (MyTitle, "|", "|")
Mytitle=replace (MyTitle, "〈br〉", "" ")
Content=fields ("Newcontent"). Value
Src=fields ("Newssrc"). Value
Src=replace (src, "|", "|")
Src=replace (SRC, "〈br〉", "" ")
Id=trim (Right ("myID"). value,12))
If Len (mytitle) =0 Then
Response.Write "〈script〉"
Response.Write "Alert (' ERROR! News headlines cannot be empty! ');"
Response.Write "Location.href=history.go (-1);"
Response.Write "〈/script〉"
End If
If Len (content) =0 Then
Response.Write "〈script〉"
Response.Write "Alert (' ERROR! News content cannot be empty! ');"
Response.Write "Location.href=history.go (-1);"
Response.Write "〈/script〉"
End If
If Len (src) =0 Then
Response.Write "〈script〉"
Response.Write "Alert (' ERROR! News source cannot be empty! ');"
Response.Write "Location.href=history.go (-1);"
Response.Write "〈/script〉"
End If
' ########################################################################################### #图片更该功能的实现
Newfile= "Client1"
If fields (NewFile). filename〈〉 "Then
Set File_0=server.createobject ("Scripting.FileSystemObject")
Dim contextname
Contextname=right ("Client1"). filename,4)
Imageid=id&contextname
If contextname〈〉 ". gif" and contextname〈〉 ". jpg" Then ' ######## #判断上传文件格式
Response.Write "〈script〉"
Response.Write "Alert (' ERROR!) upload file format not only for jpg/gif picture Format! ');"
Response.Write "Location.href=history.go (-1);"
Response.Write "〈/script〉"
End If
File_name=server.mappath ("./images/" &imageid& "")
' #################################### #上海诚凯男子医院程序提醒: If the original picture file is the main name ID, delete the picture
If File_0.fileexists (server. MapPath ("./images/" &id& ". gif")) then
Set F3 = File_0.getfile (server. MapPath ("./images/" &id& ". gif"))
F3. Delete
End If
If File_0.fileexists (server. MapPath ("./images/" &id& ". jpg") Then
Set F3 = File_0.getfile (server. MapPath ("./images/" &id& ". jpg"))
F3. Delete
End If
' ####################################### #写入图片
Set Outstream=file_0.opentextfile (file_name,8,-1)
Binstr=fields ("Client1"). Value
Binlen=1
Varlen=lenb (BINSTR)
For I=1 to Varlen
Clow = MidB (binstr,i,1)
If AscB (Clow) = 255 Then
Outstream.write chr (255)
Binlen=binlen+1
if (I mod 2) =0 Then
Notes=gnote
Exit For
End If
ElseIf AscB (Clow) 〉128 Then
CLOW1=MIDB (binstr,i+1,1)
If AscB (clow1) 〈64 or AscB (clow1) =127 or AscB (clow1) = 255 Then
Binlen=binlen+1
' If (binlen mod 2) =0 Then
Binlen=binlen+1
Outstream.write Chr (AscW (ChrB (&clow))
' End If
Notes=bnote
Exit For
Else
Outstream.write Chr (AscW (Clow1&clow))
Binlen=binlen+2
I=i+1
if (I mod 2) =0 Then
Notes=gnote
Exit For
End If
End If
Else
Outstream.write chr (AscB (Clow))
Binlen=binlen+1
if (I mod 2) =0 Then
Notes=gnote
Exit For
End If
End If
Next
Outstream.close
Set Outstream=file_0.opentextfile (file_name,8,false,-1)
Outstream.write MidB (newfile). Value,binlen)
Outstream.close
If Notes=bnote then notes=notes& (binlen-1) & "bytes. "
End If
‘#######################################################################################################
Dim Myfso,mywrite ' ###### #修改新闻详细内容
Set Myfso=createobject ("Scripting.FileSystemObject")
If Myfso. FileExists (Server.MapPath ("./news_content/" &id& ". txt")) Then
Myfso. DeleteFile (Server.MapPath ("./news_content/" &id& ". txt"))
End If
Set Mywrite=myfso.createtextfile (Server.MapPath ("./news_content/" &id& ". txt"), -1,0)
Mywrite.write Content
Dim mytext2,myread2 ' ######## #修改新闻的标题来源
Set Myread2=myfso.opentextfile (Server.MapPath ("./new_list.asp"), 1,0)
Mytext2=myread2.readall
Dim listarray,i,h,count,sf
Listarray=split (mytext2, "|") ' ######## #读取记录并以 # split into Listarray arrays
Count=ubound (Listarray)
For i=0 to count ' ########## #根据ID找到该新闻记录
Sf=split (Listarray (i), ",")
If Right (SF (0), 7) =right (id,7) Then
SF (1) =mytitle
SF (3) =src
' ###### #为6说明上传了图片, storing new array implementations view record clicks plus 1
If UBound (SF) =6 Then
If fields (NewFile). filename〈〉 "Then
SF (6) =imageid
End If
Listarray (i) =sf (0) & "," &SF (1) & "," &SF (2) & "," &SF (3) & "," &SF (4) & "," &SF (5) & "," &SF (6)
Else
Listarray (i) =sf (0) & "," &SF (1) & "," &SF (2) & "," &SF (3) & "," &SF (4) & "," &SF (5)
End If
‘##################
Exit For
End If
Next
function Htmlencode2 (str) ' ############ #字符处理函数
Dim result
Dim l
L=len (str)
Result= ""
Dim i
For i = 1 to L
Select Case Mid (str,i,1)
Case Chr (34)
Result=result+ ""
Case "&"
result=result+ "&"
Case Chr (13)
result=result+ "〈br〉"
Case ""
Result=result+ ""
Case Chr (9)
Result=result+ ""
Case Chr (32)
If I+1〈=l and i-1〉0 then
If Mid (str,i+1,1) =CHR (+) or mid (str,i+1,1) =CHR (9) or mid (str,i-1,1) =CHR (+) or mid (str,i-1,1) =CHR (9) Then
Result=result+ ""
Else
Result=result+ ""
End If
Else
Result=result+ ""
End If
Case Else
Result=result+mid (str,i,1)
End Select
Next
Htmlencode2=result
End Function
‘##########################
Dim K,mytext,mappath
Mappath=server.mappath ("./")
Set Mytext=myfso.createtextfile (mappath& "\new_list.asp", -1,0)
For i=0 to UBound (listarray) ' ######### #把所有数据重新写入文件
If I=ubound (Listarray) Then
Mytext.write Htmlencode2 (Listarray (i))
Else
Mytext.write Htmlencode2 (Listarray (i) & "|")
End If
Next
%〉
〈script language= "JavaScript"
Alert ("Change succeeded");
window.location= ("news_admin1.asp");
〈/script〉

ASP Programming Example: Using text +asp to build press release System 2