admin_saveskycn.asp

来自「多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 289 行

<!--#include file="setup.asp" -->
<%
NC_Admin.AdminChk = "18"
NC_Admin.Check
Server.ScriptTimeOut = 99999
Dim id, softname, softdx, softlanguage, softjm, softlx, softhj, softdj, softsj
Dim softlxr, softkfs, softcs, softjj, downurl, softxg, topsoft, lxzz
Dim siters, softid, pubSoftID, rootid, sortid, StringArray, File_Ext, sFileName
Dim start, over, softcode, url, serverid
serverid = 1 '设置天空下载服务器分类ID

Set Siters = server.CreateObject ("adodb.recordset")
On Error Resume Next
id = request("id")
url = "http://www.skycn.net/soft/"&id&".html"
softcode = getHTTPPage(url)
If Err.Number = 0 Then
        '***软件名称
        start = InStr(softcode, "<font color='#004FC6' size='3'>") + 31
        over = InStr(softcode, "</font></b></td></tr>")
        softname = Mid(softcode, start, over - start)
        '***软件大小
        start = InStr(softcode, "软件大小：</b>") + 9
        over = InStr(softcode, "<br><b>软件语言")
        softdx = Mid(softcode, start, over - start)
        softdx = Replace(softdx, "KB", "")
        softdx = Replace(softdx, "&nbsp;", "")
        softdx = Replace(softdx, " ", "")
        '***软件语言
        start = InStr(softcode, "软件语言：</b>") + 9
        over = InStr(softcode, "<br><b>软件类别")
        softlanguage = Mid(softcode, start, over - start)
        softlanguage = Replace(softlanguage, "&nbsp;", "")
        '***软件类别
        start = InStr(softcode, "软件类别：</b>") + 9
        over = InStr(softcode, "<br><b>应用平台")
        softlx = Mid(softcode, start, over - start)
        softlx = Replace(softlx, "&nbsp;", "")
        softlx = Replace(softlx, " ", "")
        '***运行环境
        start = InStr(softcode, "应用平台：</b>") + 9
        over = InStr(softcode, "<br><b>界面预览")
        softhj = Mid(softcode, start, over - start)
        softhj = Replace(softhj, "&nbsp;", "")
        '***软件等级
        start = InStr(softcode, "推荐等级：</b>") + 9
        over = InStr(softcode, ".gif' width=60 height=10 border=0><br><br><b>联 系 人")
        softdj = Mid(softcode, start, over - start)
        softdj = Replace(softdj, "&nbsp;", "")
        softdj = Replace(softdj, "<img src='../images/star", "")
        '***程序主页
        start = InStr(softcode, "开 发 商：</b>") + 10
        over = InStr(softcode, "</A><br><br><b>软件介绍")
        softkfs = Mid(softcode, start, over - start)
        '***软件简介
        start = InStr(softcode, "<script language=javascript src=../js/text_ad4.js></script><br>") + 63
        over = InStr(softcode, "<script language=javascript src=../js/text_ad5.js></script>")
        softjj = Mid(softcode, start, over - start)

        '***联系作者
        start = InStr(softcode, "title='与他联系'>") + 13
        over = InStr(softcode, "</A></td><td width=285 align='center'>")
        lxzz = Mid(softcode, start, over - start)
        '=================读取下载地开始======================
        '***下载地址1
        start = InStr(softcode, "<table align=center border=0 width=540 borderColorDark=#ffffff borderColorLight=#ffffff cellPadding=0 cellSpacing=0>") + 116
        over = InStr(softcode, "'>河南南阳下载")
        downurl = Mid(softcode, start, over - start)
        StringArray = Split(downurl, "'>")
        File_Ext = Split(StringArray(0), "/")
        sFileName = File_Ext(UBound(File_Ext))

        '=================读取下载地结束======================

Else
        wscript.echo Err.Description
End If

Function getHTTPPage(url)
        On Error Resume Next
        Dim http
        Set http = Server.CreateObject("Microsoft.XMLHTTP")
        Http.Open "GET", url, false
        Http.send()
        If Http.readystate<>4 Then
                Exit Function
        End If
        getHTTPPage = bytes2BSTR(Http.responseBody)
        Set http = Nothing
        If Err.Number<>0 Then Err.Clear
End Function


Function bytes2BSTR(vIn)
        Dim strReturn
        Dim i1, ThisCharCode, NextCharCode
        strReturn = ""
        For i1 = 1 To LenB(vIn)
                ThisCharCode = AscB(MidB(vIn, i1, 1))
                If ThisCharCode < &H80 Then
                        strReturn = strReturn & Chr(ThisCharCode)
                Else
                        NextCharCode = AscB(MidB(vIn, i1 + 1, 1))
                        strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
                        i1 = i1 + 1
                End If
        Next
        bytes2BSTR = strReturn
End Function

Dim strSoftType, strSoftkfs, SiteName, strdownurl
SiteName = "下载地址"
strSoftType = Split(softlx, "/")
strSoftkfs = Split(softkfs, ">")
Call checksave()

%>
<BR><BR style="OVERFLOW: hidden; LINE-HEIGHT: 8px">
<TABLE width="98%" bgcolor="#CECECE" cellSpacing=1 cellPadding=3 align=center border=0>
 <TR>
    <TD width="20%" bgcolor="#F7F7F7" align=center>软件名称</TD>
    <TD width="80%" bgcolor="#FFFFFF"><%=softname%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>软件类别</TD>
    <TD bgcolor="#FFFFFF"><%=strSoftType(0)%>/<%=strSoftType(2)%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>运行环境</TD>
    <TD bgcolor="#FFFFFF"><%=softhj%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>程序主页</TD>
    <TD bgcolor="#FFFFFF"><%=strSoftkfs(1)%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>联系作者</TD>
    <TD bgcolor="#FFFFFF"><%=lxzz%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>软件语言</TD>
    <TD bgcolor="#FFFFFF"><%=softlanguage%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>授权方式</TD>
    <TD bgcolor="#FFFFFF"><%=left(strSoftType(1),2)%>软件</TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>软件大小</TD>
    <TD bgcolor="#FFFFFF"><%=softdx%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>软件等级</TD>
    <TD bgcolor="#FFFFFF"><%=softdj%>星</TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>软件简介</TD>
    <TD bgcolor="#FFFFFF"><%=softjj%></TD>
 </TR>
 <TR>
    <TD bgcolor="#F7F7F7" align=center>下载地址</TD>
    <TD bgcolor="#FFFFFF"><%=sFileName%></TD>
 </TR>
</TABLE><BR>
<%

Sub softsave()
        If founderr = False Then
                sql = "select * from NC_softinfo where (softid is null)"
                rs.Open sql, conn, 1, 3
                rs.addnew
                rs("softname") = softname
                rs("rootid") = rootid
                rs("sortid") = sortid
                rs("sortname") = strSoftType(2)
                rs("content") = softjj
                rs("Language") = softlanguage
                rs("SoftType") = strSoftType(0)
                rs("RunSystem") = softhj
                rs("impower") = Left(strSoftType(1), 2)&"软件"
                rs("SoftSize") = CLng(softdx)
                rs("Grades") = CInt(softdj)
                rs("Homepage") = strSoftkfs(1)
                rs("Contact") = lxzz
                rs("username") = Session(Newasp.CacheName & "AdminName")
                rs("isUpdate") = 1
                rs("isLock") = 0
                rs("Errcode") = 0
                rs("SoftTime") = Now()
                Rs("isTop") = 0
                Rs("DayHits") = 0
                Rs("WeekHits") = 0
                Rs("MonthHits") = 0
                Rs("Hits") = 0
                Rs("HitsTime") = Now()
                Rs("MoneyNum") = 0
                Rs("isMember") = 0
                rs.update
                'pubSoftID=rs("SoftID")
                rs.Close
                Rs.Open "select top 1 softid from NC_SoftInfo order by softid desc", Conn, 1, 1
                pubSoftID = Rs("softid")
                Rs.Close
                sql = "update NC_softSort set SoftNum=SoftNum+1,isUpdate=1 where sortid=" & sortid
                conn.Execute sql
                sql = "update NC_softSort set SoftNum=SoftNum+1,isUpdate=1 where sortid=" & rootid
                conn.Execute sql
                '//////添加下载连接地址//////
                sql = "select * from NC_softsite where (ID is null)"
                Siters.Open sql, conn, 1, 3
                Siters.addnew
                Siters("SiteName") = "下载地址1"
                Siters("DownSite") = sFileName
                Siters("sortid") = sortid
                Siters("SoftID") = pubSoftID
                Siters("serverid") = serverid
                Siters.update
                Siters.Close

                Set rs = Nothing
        End If
End Sub

Sub savemodify()
        If founderr = False Then
                sql = "select * from NC_softinfo where softid="&softid
                rs.Open sql, conn, 1, 3
                rs("softname") = softname
                rs("rootid") = rootid
                rs("sortid") = sortid
                rs("sortname") = strSoftType(2)
                rs("content") = softjj
                rs("Language") = softlanguage
                rs("SoftType") = strSoftType(0)
                rs("RunSystem") = softhj
                rs("impower") = Left(strSoftType(1), 3)&"软件"
                rs("SoftSize") = CLng(softdx)
                rs("Grades") = CInt(softdj)
                rs("Homepage") = strSoftkfs(1)
                rs("Contact") = lxzz
                rs("username") = Session(CacheName & "AdminName")
                rs("isUpdate") = 1
                rs("isLock") = 0
                rs("Errcode") = 0
                rs("softTime") = Now()
                rs.update
                pubSoftID = rs("SoftID")
                rs.Close
                sql = "update NC_softSort set isUpdate=1 where sortid=" & sortid
                conn.Execute sql
                sql = "update NC_softSort set isUpdate=1 where sortid=" & rootid
                conn.Execute sql

                sql = "select * from NC_softsite where SoftID="&pubSoftID
                Siters.Open sql, conn, 1, 3
                Siters("DownSite") = sFileName
                Siters("serverid") = serverid
                Siters.update
                Siters.Close
        End If
End Sub

Sub checksave()
        Dim rsc
        Set rsc = server.CreateObject ("adodb.recordset")
        sql = "select * from NC_softsort where depth=1 and sortname like '"&strSoftType(2)&"%'"
        rsc.Open sql, conn, 1, 1
        If rsc.EOF And rsc.bof Then
                response.Write "没有找到该分类"
                response.End
        Else
                sortid = rsc("sortid")
                rootid = rsc("rootid")
        End If
        rsc.Close
        rsc.Open "Select * from NC_softinfo where softname='"&softname&"'", conn, 1, 1
        If Not rsc.EOF Then
                softid = rsc("softid")
                Call savemodify()
                response.Write "更新软件 <font color=#FF5500>"&softname&"</font> 数据成功！"
        Else
                Call softsave()
                response.Write "添加软件 <font color=#FF5500>"&softname&"</font> 数据成功！"
        End If
        rsc.Close
        Set rsc = Nothing
End Sub
%>