• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    个人学习之作 hta 原创

    复制代码 代码如下:
    !--
    ***********************************************************************
    '*一直想做一个自己用来学习的东西,可是一直没有时间,本想用asp(用netbox)做的。,我一直
    '*想学习程序,vb但没有时间学习,现在想用c#做一个,但没有什么时间,偶尔去官方找vbscript发现
    '*这个不错的hta于是花了两三天的时间,做了一个这个,希望大家能喜欢。
    '*Author: dxy(reterry)
    '*version:1.0
    '*QQ: 461478385
    '*Email:douxy001@gmail.com
    ***********************************************************************
    //-->
    html>
    head>
    meta http-equiv="Content-Type" content="text/html; charset=gb2312">
    hta:application
         id="dxymdb"
      scroll="yes"
      singleinstance="yes"
    border="thin"
      windowstate="maximize"
    icon="dxy.ico"
    >
    title>我的第一个hta程序/title>
    style type="text/css">
    !--
    BODY
    {
      scrollbar-face-color : #D8DBDF;
      scrollbar-highlight-color : #FFFFFF;
      scrollbar-shadow-color : #C1C6CC;
      scrollbar-3dlight-color : #ABB1B3;
      scrollbar-arrow-color : #7F8996;
      scrollbar-track-color : #F8FAF9;
      scrollbar-darkshadow-color : #ABB1B3;
    }
    body,td,th {
     font-size: 10pt;
     color: #FFFFFF;
    }
    body {
     background-color: #3a6ead;
    }
    a {
     font-size: 9pt;
     color: #000000;
    }
    a:link {
     text-decoration: none;
     color: #FFFF33;
    }
    a:visited {
     text-decoration: none;
     color: #FFFF33;
    }
    a:hover {
     text-decoration: none;
     color: #FFffff;
    }
    a:active {
     text-decoration: none;
    }
    .style4 {font-weight: bold}
    .b {
     border-bottom-width: 1px;
     border-bottom-style: dashed;
     border-bottom-color: #BFDFFF;
    }
    .style9 {color: #ffff33}
    input {

    font-size:12px;
    }
    -->
    /style>
    /head>
    script language="vbscript">
    '加入智能显示信息条数
    strComputer = "."
        Set objWMIService = GetObject("Winmgmts:\\" strComputer "\root\cimv2")
        Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
        For Each objItem in colItems
            thewidth = objItem.ScreenWidth
            theheight = objItem.ScreenHeight
        Next
    '------------------智能结速-----
    const adUserClient=3
    sub window_onload()
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sql="select * from theclass order by id desc"
    rs.open sql,conn,1,1
    rs.movefirst
    strclasslist="select onclick=changeclass() name=theclassname>"
    strclasslist=strclasslist+"option value="chr(34)chr(34)">"
    do until rs.eof
    strclasslist=strclasslist"option value="chr(34)rs.fields.item("class_name")chr(34)">"rs.fields.item("class_name")"/option>"
    rs.movenext
    loop
    strclasslist=strclasslist"option value='其它'>其它/option>option value='全部'>全部/option>/select>"
    classlist.innerHTML=strclasslist
    end sub
    sub changeclass()
    theclass.value=theclassname.value
    if theclass.value="全部" then
    theclass.value=""
    end if
    end sub
    sub addclass()
    classname=inputbox("请输入你要添加的类别","添加类别")
    if classname="" then
    msgbox "添加的类别不能为空"
    exit sub
    else
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    //sqla="insert into class(class_name)values("classname")"
    rs.open "theclass",conn,3,3
    rs.addnew()
    rs("class_name")=classname
    rs.update
    rs.close
    conn.close
    msgbox classname"添加成功",0
    end if
    call window_onload
    end sub

    sub delclass()
    if confirm("你真的要删除吗?") then
    delclassname=theclassname.value
    if delclassname="" then
    msgbox "要删除的类别不能为空"
    exit sub
    else
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sqld="delete from theclass where class_name="chr(39)delclassnamechr(39)
    rs.open sqld,conn,3,3
    msgbox chr(34)delclassnamechr(34)"删除成功",0
    //rs.close
    //conn.close
    end if
    call window_onload
    end if
    end sub

    sub editclass()
    theeditclass=theclassname.value
    reditclass=inputbox("请输入你要更改后的类别名称","类别修改")
    if theeditclass="" or reditclass="" then
    exit sub
    else
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sqld="update theclass set class_name="chr(39)reditclasschr(39)" where class_name="chr(39)theeditclasschr(39)
    rs.open sqld,conn,3,3
    msgbox chr(34)theeditclass"-->"reditclasschr(34)"成功修改",0
    call window_onload
    rs.close
    conn.close
    end if
    end sub

    sub window_onUnload
    on error resume next
    rs.close
    conn.close
    end sub

    sub quitscript
    on error resume next
    rs.close
    conn.close
    self.close
    end sub

    sub unadd()
    theclass.value=""
    thetitle.value=""
    content.value=""
    theadd.style.display="none"
    end sub

    sub addnews()
    theadd.style.display="block"
    add.disabled=false
    theclass.value=theclassname.value
    getclass=theclass.value
    gettitle=thetitle.value
    getcontent=content.value
    getisgood=isgood.value
    if getisgood="" then
    getisgood=0
    else
    getidgood=1
    end if
    if getclass>"" and getclass>"全部" and gettitle>"" and getcontent>"" then
    //msgbox gettitlegetcontent
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    rs.open "list",conn,3,3
    rs.addnew()
    rs("title")=gettitle
    rs("class_name")=getclass
    rs("content")=getcontent
    rs("isgood")=getisgood
    rs.update
    msgbox "恭喜,数据添加成功"
    theclass.value=""
    thetitle.value=""
    content.value=""
    end if
    //rs.close
    //conn.close
    end sub

    sub searchits()
    thesearch=searchstr.value

    'if thesearch>"" then
    'theclassname.value=""
    'end if

    call changeit(1)
    end sub

    sub changeit(thenum)
    theclass.value=theclassname.value
    thename=theclassname.value
    thesearch=searchstr.value
    'if thename>"" then searchstr.value=""
    thelist.innerHTML=""
    thecounts.innerHTML=""
    if thename>"" or thesearch>"" then
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    if thesearch="" then
      if thename="全部" then
      sql="select id,class_name,title,enter_time from list order by id desc"
      else
      sql="select id,class_name,title,enter_time from list where class_name='"thename"' order by id desc"
      end if
    else
      if thename="" then
      sql="select distinct id,class_name,title,enter_time from list where (title like '%"thesearch"%' or content like '%"thesearch"%' or class_name like '%"thesearch"%')"
      else
    sql="select distinct id,class_name,title,enter_time from list where (title like '%"thesearch"%' or content like '%"thesearch"%' or class_name like '%"thesearch"%') and class_name='"thename"'"
      end if
    end if
    rs.open sql,conn,1,1
    page=trim(thenum)
    if page>"" then page=cint(page)
    pre=true
    last=true
    if not rs.eof then
    if theheight=600 then
    maxperpage=20
    elseif theheight>600 then
    maxperpage=28
    else
    maxperpage=20
    end if
    rs.pagesize=maxperpage
    thepages=rs.pagecount
    thecount=rs.recordcount
    if page="" and page1 then
    intpage=1
    pre=false
    else
       if page>thepages then
         intpage=thepages
      last=false
      else
        intpage=cint(page)
     end if
    end if
    themovenum=(intpage-1)*maxperpage
    thecounts.innerHTML="共有font color='#ffff33'>"thecount"/font>条信息[font color='#ffff33'>"maxperpage"/font>条/页 共font color='#ffff33'>"thepages"/font>页 当前第font color='#ffff33'>"page"/font>页]"
    rs.movefirst
    if (intpage-1)*maxperpagethecounts then
    dim bookmark
    bookmark=rs.bookmark
    rs.move themovenum
    end if
    strlist="table width='80%' align='center' cellpadding='0' cellspacing='1' border=0>"
    for i=1 to maxperpage
    if rs.eof then exit for
    strlist=strlist"tr>td height='20' class='b'>[font color=yellow>"rs("class_name")"/font>]nbsp;"rs("title")"nbsp;nbsp;font color='#f6f6f6'>"rs("enter_time")"/font>nbsp;nbsp;a href='#' onclick=openthecontent("rs("id")")>查看/a>nbsp;a href='#' onclick=editnews("rs("id")")>修改/a>nbsp;a href='#' onclick=delthecontent("rs("id")")>删除/a>/td>/td>"
    rs.movenext
    if rs.eof then exit for
    next
    strlist=strlist"/table>"
    thelist.innerHTML=strlist
    pagelist="第select name='cpage' onchange=changeit2()>"
    for j=1 to thepages
    if j=intpage then
    pagelist=pagelist"option value="j" selected>"j"/option>"
    else
    pagelist=pagelist"option value="j">"j"/option>"
    end if
    next
    pagelist=pagelist"/select>页"
    fenye.innerHTML=pagelist
    call changepage
    else
    thecounts.innerHTML="font color='#ffff33'>对不起没有您要的信息/font>"
    end if
    end if
    //rs.close
    //conn.close
    end sub

    sub changeit2()
    thenum=cpage.value
    call changeit(thenum)
    end sub
    sub openthecontent(id)
    theid=id
    if id>"" then
    id=cint(id)
    end if
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sql="select * from list where id="id""
    rs.open sql,conn,1,1
    if not rs.eof then
    theopencontent=rs("content")
    theopencontent=replace(theopencontent,"","lt;")
    theopencontent=replace(theopencontent,">","gt;")
    set diswindow=window.open("about:blank","diswindow")
    diswindow.document.body.style.fontSize="12px"
    diswindow.focus()
    diswindow.document.write("html>head>scr"+"ipt>function saveit(){strDesktop='C:\\Documents and Settings\\Administrator\\桌面';var code=event.srcElement.parentElement.children[0].value;var objfso=new ActiveXObject('Scripting.FileSystemObject');var strname=prompt('请输入文件名和路',strDesktop+'\\temp.vbs');if(strname!=''){var objfile=objfso.CreateTextFile(strname,2,true);objfile.Write(code);objfile.Close();}}function runit(){var code=event.srcElement.parentElement.children[0].value;var newwin=window.open('');newwin.opener=null;newwin.document.write(code);newwin.document.close();}/scr"+"ipt>meta http-equiv='Content-Type' content='text/html; charset=gb2312'>title>"+rs("title")+"/title>body style='margin:10px' bgcolor='#3a6ead'>table width='700' border='0' align='center' cellpadding='0' cellspacing='0'>tr>td>textarea rows='20' style='width:700; border:1px solid #808080; overflow:hidden;' onmouseover='this.style.posHeight=this.scrollHeight' onpropertychange='this.style.posHeight=this.scrollHeight' onload='this.style.posHeight=this.scrollHeight'>"+theopencontent+"/textarea>br>input type=button value='运行上面的代码[html]' onclick='runit()'> input type=button value='保存' onclick='saveit()'>/td>/tr>/table>/body>/html>")
    diswindow.focus()
    diswindow.document.close()
    end if
    end sub

    sub delthecontent(strid)
    if confirm("你真的要删除吗?") then
    id=strid
    if id>"" then
    id=cint(id)
    end if
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sql="delete from list where id="id""
    rs.open sql,conn,3,3
    msgbox "成功删除"
    else
    exit sub
    end if
    end sub

    sub changepage()
    cpage_l=cint(cpage.length)
    cpage_v=cint(cpage.value)
    cpage_value="a href='#' onclick='changeit(1)'>首页/a>nbsp;nbsp;"
    if cpage_v>1 then
    cpage_value=cpage_value"a href='#' onclick='changeit("cpage_v-1")'>上一页/a>nbsp;nbsp;"
    end if
    if cpage_vcpage_l and cpage_v>=1 then
    cpage_value=cpage_value"a href='#' onclick='changeit("cpage_v+1")'>下一页/a>nbsp;nbsp;"
    end if
    cpage_value=cpage_value"a href='#' onclick='changeit("cpage_l")'>尾页/a>nbsp;nbsp;"
    dispage.innerHTML=cpage_value
    end sub

    sub editnews(strid)
    theadd.style.display="block"
    id=strid
    if id>"" then
    id=cint(id)
    end if
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sql="select * from list where id="id""
    rs.open sql,conn,1,1
    if not rs.eof then
    titlee=rs("title")
    contente=rs("content")
    classname=rs("class_name")
    end if
    theclassname.value=classname
    thetitle.value=titlee
    content.value=contente
    theid1.value=id
    add.disabled=true
    end sub

    sub editsave()
    id=theid1.value
    edittitle=thetitle.value
    editcontent=content.value
    classname=theclass.value
    if id>"" then
    dim conn
    set conn=createobject("adodb.connection")
    conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"
    set rs=createobject("adodb.recordset")
    rs.cursorlocation=adUserClient
    sql="select id,class_name,title,content from list where id="id""
    rs.open sql,conn,3,3
    rs("class_name")=classname
    rs("title")=edittitle
    rs("content")=editcontent
    rs.update
    if err.number=0 then
    msgbox("数据修改成功")
    end if
    end if
    theid1.value=""
    thetitle.value=""
    content.value=""
    'theclassname.value=""
    theclass.value=""
    theadd.style.display="none"
    add.disabled=false
    call changeit2()
    end sub
    /script>
    body style="margin:0px; ">
    table width="98" height="10" border="0" align="center" cellpadding="0" cellspacing="0">
      tr>
        td>/td>
      /tr>
    /table>
    span name="theadd" id="theadd" style="display:none">
    table width="760" border="0" align="center" cellpadding="0" cellspacing="0" style="border:1px dotted #ffffff ">
      tr>
        td style="line-height:150%; ">类nbsp;nbsp;nbsp;nbsp;别:
          input name="theclass" type="text" id="theclass" style="border:1px solid #808080;" size="10" maxlength="50">     
          标题:
          input name="thetitle" type="text" id="thetitle" size="40" maxlength="200">     
          input type="button" name="add" value="添加" onClick="addnews">
          input type="button" name="edit" value="修改" onClick="editsave">
          input type="button" name="undo" value="取消" onClick="unadd">
          br>
          添加内容:
          span class="style4">
          textarea name="content" rows="15" style="border:1px solid #808080; width:760; work-break:break-all; " ondblclick="content.style.posHeight=content.scrollHeight">/textarea>
          /span>    br>
          是否推荐:input name="isgood" type="text" size="5">
       br> id值:   
        input name="theid1" type="text" size="5">/td>
      /tr>
    /table>
    /span>br>
    table width="760" height="47" border="0" align="center" cellpadding="0" cellspacing="0" style="border:1px dotted #ffffff;">
       tr>
        td height="23" align="center">div align="left">span class="style9">内容列表/span>nbsp;[
          input type="button" value="添加信息" onClick="addnews">
          ]nbsp;类别:span id="classlist">/span>
    input name="button" type="button" onClick="changeit(1)" value="载入">
    input type="button" onClick="addclass" value="添加"'>
          input type="button" onClick="delclass" value="删除"'>
          input type="button" onClick="editclass" value="编辑"'>
          input type="button" name="Submit" value="退出" onClick="quitscript"'>
            input name="searchstr" type="text" id="searchstr"' onfocus="searchstr.select()">
        input type="submit" name="Submit" value="搜"' onClick="searchits">
    /div>/td>
      /tr> 
      tr>
        td>hr align="center" width="80%" size="1" noshade style="border:1px solid #ffffff ">/td>
      /tr>
      tr>
        td align="center">span id="fenyetop">/span>/td>
      /tr>
      tr>
        td>span id="thelist">/span>/td>
      /tr>
      tr>
        td align="center">span id="thecounts">/span>nbsp;nbsp;span id="dispage">/span>span id="fenye">/span>/td>
      /tr>  
    /table>
    /body>
    /html>

    打包下载:jb51_hta(jb51.net).rar

    上一篇:运行程序的hta
    下一篇:NCC Tools(never code counter tools) V1.0.1发布代码-代码统计工具
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    个人学习之作 hta 原创 个人,学习,之作,hta,原创,