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

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    FSO的强大功能
    复制代码 代码如下:

    HTML> 
    HEAD> 
    TITLE>笨狼代码大管家/TITLE> 
    meta http-equiv="Content-Type" content="text/html; charset=gb2312">
    style> 
    body 

    font-size:12; 
    BACKGROUND: #DADADA; 
    margin-left:5; 

    .folder 

    font-size:18; 
    cursor:hand; 

    .folderIcon 

    color:navy; 
    font-family:wingdings; 
    font-size:18; 
    cursor:hand; 

    .file 

    color:navy; 
    font-size:18; 
    cursor:hand; 
    height:21; 

    .fileIcon 

    color:navy; 
    font-family:wingdings; 
    font-size:18; 
    cursor:hand; 
    height:21; 
    display:inline; 

    input 

    width:20; 
    overflow:visible; 
    border:1px solid lightblue; 
    background-color:#cccccc; 
    cursor:text; 

    button 

    border:1px solid gray; 
    width:60; 
    margin-left:2; 
    cursor:hand; 
    font-size:12; 
    filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#eaeaff', endColorStr='#618fff', gradientType='0'); 

    textarea 

    font-family:Verdana; 
    width:750; 
    height:630; 
    font-size:12px; 
    overflow:scroll; 

    #frmTree 

    WIDTH:200px; 
    height:630; 
    MARGIN: 0px; 
    PADDING: 0px; 
    overflow:scroll; 
    MARGIN-right:10; 

    #frmSeach 

    WIDTH:200px; 
    height:630; 
    MARGIN: 0px; 
    PADDING: 0px; 
    overflow:scroll; 
    MARGIN-right:10; 

    #hide_control 

    POSITION: absolute; 
    LEFT:213px; 
    TOP:10px; 
    WIDTH:10px; 
    height:630; 
    BACKGROUND: #DADADA; 
    padding-top:300; 
    cursor:e-resize; 
    border:1 solid gray; 

    #txtFrm 

    POSITION: absolute; 
    LEFT:230px; 
    TOP:10px; 
    WIDTH:100%; 
    MARGIN: 0px; 
    PADDING: 0px; 
    BACKGROUND: #DADADA; 

    #tab1 

    border:1 solid ; 
    cursor:hand; 

    #tab2 

    border:1 solid ; 
    cursor:hand; 
    BACKGROUND: gray; 

    #tab3 

    border:1 solid; 
    cursor:hand; 
    BACKGROUND: gray; 

    #tab4 

    border:1 solid ; 
    cursor:hand; 

    /style> 
    /HEAD> 
    BODY onselectstart="vbs:selectControl" onkeydown="vbs:shortCut"> 
    div id="frmTree" onclick="vbs:f_Click" onkeydown="vbs:deletFile" > 
    span id="tab1" >  目 录 /span> 
    span id="tab2" onclick="vbs:showMe frmSeach,frmTree">  搜 索 /span> 
    hr/> 
    div id="tree" style='margin-left:0;color:navy;font-size:12;cursor:hand;' >/div> 
    /div> 
    div id="frmSeach" onclick="vbs:f_Click" > 
    span id="tab3" onclick="vbs:showMe frmTree,frmSeach" >  目 录 /span> 
    span id="tab4">  搜 索 /span> 
    hr/> 
    div id="list" style='margin-left:0' onkeydown="deletFile"> 
    input id="searchKey" style="width:100"/> 
    button onclick="vbs:seachFile" id="searchButton">查找/button>br/> 
    div id="seachList" style='margin-left:0' >搜索结果/div> 
    /div> 
    /div> 
    input type="button" id="hide_control" onmousedown="vbs:beginDrag" onmouseup="vbs:upHandler" bgcolor="#eeeeee"/> 
    div valign="top" id="txtFrm"> 
    标题:input id="articleTitle" style="width:100" readonly/> 
    button id="browse" onclick="vbs:browseMe" >预览/button> 
    button id="saveButton" onclick="vbs:saveFile" >保存/button> 
    button id="browse" onclick="vbs:createFile" >新建/button> 
    button id="test" onclick="vbs:showHelp">说明/button> 
    行 span id="Ln">1/span> 
    textarea id="txt" onkeydown='vbs:TabTxt' onclick="vbs:showLn">/textarea> 
    /div> 

    SCRIPT LANGUAGE="vbscript"> 
    '************************** 
    '*****超级大笨狼*********** 
    '************************** 
    on error resume next 
    window.resizeTo window.screen.availWidth,window.screen.availHeight 
    window.moveTo 0,0 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    dim thisFileDir'定义本文件绝对路径 
    dim thisFileName'定义本文件名 
    dim thisFileFolder'定义本文件夹路径 

    thisFileDir = replace(window.location.href,"file:///","") 
    thisFileDir = unescape(replace(thisFileDir,"/","\")) 
    thisFileName = LastOne(thisFileDir,"\") 
    thisFileFolder=getFolderDir(thisFileDir) 
    tree.title = thisFileFolder 
    dim currentDir'当前路径 
    dim currentFile'当前文件 
    dim currentDiv'当前DIV对象 
    dim currentSpan'当前Span对象 
    dim delatX 
    dim dragAble:dragAble = false 

    currentDir = thisFileFolder 
    set currentDiv = tree 
    tree.innerText = getTxtName(thisFileName) 
    showMe frmTree,frmSeach 
    showFolder tree 
    sub showLn 
    Ln.innerText = cint((window.event.offsetY-2)/15)+1 
    end sub 
    sub shortCut 
    if window.event.keyCode=83 and window.event.ctrlKey then 
    if currentFile>"" then saveFile 
    window.event.cancelBubble = true 
    window.event.returnValue = false 
    end if 
    if window.event.keyCode=66 and window.event.ctrlKey then 
    browseMe 
    window.event.cancelBubble = true 
    window.event.returnValue = false 
    end if 
    if window.event.keyCode=78 and window.event.ctrlKey then 
    createFile 
    window.event.cancelBubble = true 
    window.event.returnValue = false 
    end if 
    end sub 
    sub browseMe 
    dim win 
    set win=window.open() 
    win.document.write txt.value 
    end sub 
    sub createFile 
    '点创建按钮,真的创建了. 
    if vartype(currentSpan)>0 then currentSpan.style.color = "navy" 
    if currentDir ="" then 
    '如果点到了文件 
    currentDir=getFolderDir(currentFile) 
    else 
    '点到了文件夹 
    dim n 
    set n=currentDiv.nextSibling 
    do 
    if vartype(n) =9 then exit do 
    if left(n.title,len(currentDir)) > currentDir then exit do 
    set currentDiv =n 
    set n=n.nextSibling 
    loop 
    end if 
    dim re,newFile,s,f 
    set re = new RegExp 
    re.Pattern = "[^\d]" 
    re.Global=true 
    newFile = currentDir  "新收藏"  re.Replace(mid(cstr(now()),3),"")  ".txt" 
    currentFile=newFile'新建文件是当前文件 
    '构造innerHTML 
    s = "div class='file' title='"  newFile 
    s = s  "' style='margin-left:" 
    if currentDiv.className = "file" then 
    s = s  currentDiv.style.marginLeft  ";' > " 
    else 
    s = s  px2Int(currentDiv.style.marginLeft) + 8  ";' > " 
    end if 
    s = s  "span class='fileIcon'>2"  "/span>" 
    s = s  "input value='" 
    s = s  getTxtName(lastOne(newFile,"\"))  "' title='"  getTxtName(lastOne(newFile,"\"))  "' onchange='vbs:reName me' />" 
    s = s  "/div>" 
    '插入innerHTML 
    currentDiv.insertAdjacentHTML "AfterEnd",s 
    articleTitle.value = getTxtName(lastOne(newFile,"\")) 
    txt.value = "" 
    currentDir = "" 
    set currentDiv = currentDiv.nextSibling 
    set currentSpan = currentDiv.getElementsByTagName("SPAN")(0) 
    currentSpan.style.color = "red" 
    '创建文件 
    set f=fso.CreateTextFile(newFile) 
    f.close 
    end sub 
    function getFolderDir(fullDir) 
    '输入得到全路径,得到文件夹路径 
    s=LastOne(fullDir,"\") 
    getFolderDir = left(fullDir,len(fullDir)-len(s)) 
    end function 
    sub saveFile 
    '保存对文件的修改 
    Dim st 
    Set st = fso.OpenTextFile(currentFile, 2, True) 
    st.Write txt.value 
    st.close 
    end sub 

    sub deletFile 
    '删除文件 
    dim n 
    if window.event.keyCode =46 and window.event.srcElement.tagName>"INPUT" then 
    if currentFile>"" then 
    if currentFile = thisFileDir then 
    alert "不允许删除本文件!" 
    exit sub 
    end if 
    if fso.FileExists(currentFile) then 
    fso.deletefile currentFile,true 
    currentDiv.parentElement.removeChild currentDiv 
    txt.value = "" 
    currentFile = "" 
    articleTitle.value = "" 
    end if 
    end if 
    if currentDir>"" then 
    if currentDir = thisFileFolder then 
    alert "不允许删除根目录!" 
    exit sub 
    end if 
    set n = currentDiv.nextSibling 
    if window.confirm( currentDir  vbcrlf  "这个文件夹有子文件,你要删除全部子文件吗?") then 
    do 
    if vartype(n) =9 then exit do 
    if px2Int(n.style.marginLeft) = px2Int(currentDiv.style.marginLeft) then exit do 
    n.parentElement.removeChild n 
    set n=currentDiv.nextSibling 
    loop 
    if fso.FolderExists(currentDir) then fso.DeleteFolder currentDir 
    currentDiv.parentElement.removeChild currentDiv 
    end if 
    end if 
    end if 
    end sub 
    sub showMe(obj1,obj2) 
    obj1.style.display="" 
    obj2.style.display="none" 
    end sub 
    sub beginDrag 
    '开始拖拽 
    delatX=window.event.clientX - px2Int(hide_control.currentStyle.left) 
    document.attachEvent "onmousemove",getRef("moveHandler") 
    dragAble = true 
    window.event.cancelBubble = true 
    end sub 
    sub moveHandler 
    '移动绑定事件 
    if not dragAble then exit sub 
    dim x 
    x = window.event.clientX - delatX 
    hide_control.style.left= x  "px" 
    frmTree.style.width = abs( x - 10)  "px" 
    frmSeach.style.width = abs( x - 10)  "px" 
    txtFrm.style.left=( x + 20)  "px" 
    window.event.cancelBubble=true 
    end sub 
    sub upHandler 
    '放开绑定事件 
    document.detachEvent "onmousemove",getRef("moveHandler") 
    dragAble = false 
    window.event.cancelBubble=true 
    end sub 
    function getTxtName(fullName) 
    '去掉文件名后缀 
    dim s:s=lastOne(fullName,".") 
    getTxtName = left(fullName ,len(fullName)-len(s)-1) 
    end function 

    sub reName(obj) 
    '改名 
    dim Arr,a 
    Arr=array("/","\",":","*","?",chr(34),"|","",">") 
    for each a in Arr 
    if instr(obj.value,a) >0 then 
    alert "命名不能含有/\:*?"  chr(34)  "|>其中的一个" 
    obj.focus 
    exit sub 
    end if 
    next 
    dim oldName,newName,oldPath,oldType 
    oldName = obj.parentElement.title 
    oldPath = getFolderDir(oldName) 
    oldType = lastOne(oldName,".") 
    newName = oldPath  obj.value  "."  oldType 
    Set f = fso.GetFile(oldName) 
    f.copy newName 
    f.delete True 
    obj.parentElement.title = newName 
    articleTitle.value = getTxtName(lastOne(newName,"\")) 
    end sub 
    Function LastOne(Str,splitStr) 
    '输入字符和分隔符,得到最后一部分 
    LastOne = right(Str,len(Str)-InStrRev(Str,splitStr)) 
    End Function 
    sub selectControl 
    '控制页面选择的状态 
    if window.event.srcElement.tagName>"INPUT" and window.event.srcElement.tagName>"TEXTAREA" then 
    document.selection.clear 
    end if 
    end sub 
    function isTXT(fileNameStr) 
    '判断是否是文本类型的文件 
    dim s,Arr,a,returnValue 
    returnValue = false 
    s=lcase(LastOne(fileNameStr,".")) 
    Arr=array("txt","htm","html","asp","csv","aspx","xml","js","vbs","ini","bat","css","htc","hta","xsl","xslt","sql") 
    for each a in Arr 
    if a=s then 
    returnValue =true 
    exit for 
    end if 
    next 
    isTXT = returnValue 
    end function 
    sub showFolder(obj) 
    dim folderspec :folderspec = obj.title 
    obj.setAttribute "parsed",true 
    if not fso.FolderExists(folderspec) then 
    alert folderspec  "该文件夹不存在,也许是被移动了,所以刷新一下本程序" 
    window.location.reload 
    exit sub 
    end if 
    dim f, f1, sf,sf1,i,s,fName 
    set f=fso.GetFolder(folderspec) 
    set sf=f.Subfolders 
    re = re  f.name  "\" 
    s="" 
    for each sf1 in sf 
    s = s  "div class='folder' title='"  sf1.path  "\' style='margin-left:"  cint(replace(obj.style.marginLeft,"px","")) + 8  ";'>" 
    s = s  "span class='folderIcon'>0"  "/span>input value='"  sf1.name  "' readonly style='cursor:hand;'/>/div>" 
    next 
    For Each f1 in f.Files 
    if isTXT(f1.name) then 
    s = s  "div class='file' title='"  f1.path 
    s = s  "' style='margin-left:" 
    s = s  px2Int(obj.style.marginLeft) + 8  ";' > " 
    s = s  "span class='fileIcon'>2"  "/span>" 
    s = s  "input value='" 
    fName = getTxtName(f1.name) 
    s = s  fName  "' title='"  fName  "' onchange='vbs:reName me' />" 
    s = s  "/div>" 
    end if 
    Next 
    obj.insertAdjacentHTML "AfterEnd",s 
    end sub 
    function px2Int(px) 
    px2Int = cint(replace(px,"px","")) 
    end function 
    sub f_Click() 
    dim obj,d,f,state 
    set obj = window.event.srcElement 
    if obj.id="searchKey" then exit sub 
    if obj.tagName>"SPAN" and obj.tagName>"INPUT" then exit sub 
    set currentDiv = obj.parentElement 
    set obj = currentDiv.getElementsByTagName("SPAN")(0) 
    window.event.cancelBubble = true 
    select case obj.className 
    case "folderIcon" 
    '点到了文件夹 
    if vartype(currentSpan)=8 then 
    currentSpan.style.color = "navy" 
    end if 
    set currentSpan = obj 
    state = abs(cint(obj.innerHTML) -1) 
    obj.innerHTML = state 
    obj.style.color="red" 
    set d = obj.parentElement 
    currentDir = d.title 
    currentFile = "" 
    if d.getAttribute("parsed")=true then 
    '合拢 
    fold d,state 
    else 
    '解析 
    showFolder d 
    end if 

    case "fileIcon" 
    '点到了文件,在textArea里面载入文本文件 
    if vartype(currentSpan)=8 then 
    currentSpan.style.color = "navy" 
    end if 
    set currentSpan = obj 
    obj.style.color="red" 
    readText obj.parentElement.title 
    currentDir = "" 
    currentFile = obj.parentElement.title 
    end select 
    end sub 
    sub fold(o,stateOpen) '合拢 
    dim n 
    set n=o.nextSibling 
    do 
    if vartype(n) =9 then exit do 
    if px2Int(n.style.marginLeft) = px2Int(o.style.marginLeft) then exit do 
    if stateOpen=1 then n.style.display="" else n.style.display="none" 
    set n=n.nextSibling 
    loop 
    end sub 

    sub readText(filePath) 
    Dim f,fName 
    if not fso.FileExists(filePath) then 
    alert filePath  vbcrlf  "该文件不存在,也许是被移动了,所以刷新一下本程序" 
    window.location.reload 
    exit sub 
    end if 
    'TXT已经加载的当前文件不再加载. 
    if filePath = currentFile then exit sub 
    txt.value = "" 
    Set f = fso.OpenTextFile(filePath, 1, true) 
    if not f.AtEndOfStream then 
    txt.value = f.readAll 
    else 
    txt.value = "" 
    end if 
    fName = lastOne(filePath,"\") 
    articleTitle.value = getTxtName(fName) 
    f.Close 
    Ln.innerText = 1 
    End sub 
    sub TabTxt() 
    '支持tab键的文本框 
    if window.event.keyCode=38 then 
    if cint(Ln.innerText) >1 then Ln.innerText = cint(Ln.innerText)-1 
    end if 
    if window.event.keyCode=40 then 
    Ln.innerText = cint(Ln.innerText)+1 
    end if 
    if window.event.keyCode> 9 then exit sub 
    dim sel,mytext 
    set sel = document.selection.createRange() 
    'txt.createTextRange 
    mytext = sel.text 
    if len(mytext)=0 then 
    sel.text =string(4," ") 
    window.event.cancelBubble = true 
    window.event.returnValue = false 
    exit sub 
    end if 
    dim t,Arr 
    t=0 
    Arr = split(mytext,vbcrlf) 
    if window.event.shiftKey then 
    '按sift 
    for i=0 to ubound(Arr) 
    if left(Arr(i),1)=vbtab then 
    Arr(i) = mid(Arr(i),2) 
    t= t + 1 
    else 
    for j=1 to 4 
    if left(Arr(i),1)=" " then 
    Arr(i) = mid(Arr(i),2) 
    t= t + 1 
    else 
    exit for 
    end if 
    next 
    end if 
    next 
    t= t 
    else 
    '不按sift 
    for i=0 to ubound(Arr) 
    Arr(i) = vbtab  Arr(i) 
    t= t +1 
    next 
    end if 
    mytext = join(Arr,vbcrlf) 
    sel.text = mytext 
    sel.collapse true 
    sel.moveEnd "character",0 
    sel.moveStart "character",(len(mytext) * -1) + t 
    sel.select() 
    window.event.cancelBubble = true 
    window.event.returnValue = false 
    end sub 
    '下面是关于搜索 
    dim seachResult'查找结果 
    dim num '结果数量 
    dim word'搜索关键字 
    tagStop = false 
    seachResult ="" 
    sub seachFile() 
    num =0 
    seachList.innerText = "搜索结果" 
    word = searchKey.value 
    seachResult ="" 
    if trim(word)="" then 
    alert "关键字为空!" 
    searchKey.focus 
    exit sub 
    else 
    dim l 
    for each l in list.getElementsByTagName("DIV") 
    if l.id>"seachList" then list.removeChild l 
    next 
    seachList.innerText = "搜索结果" 
    seachWord thisFileFolder 
    seachList.insertAdjacentHTML "AfterEnd",seachResult 
    seachList.innerText = "搜索结果:"  num  "个" 
    alert "搜索完毕!" 
    end if 
    end sub 
    sub seachWord(theFolder) 
    dim f,f1,st,re,fd,fd1 
    set f = fso.GetFolder(theFolder) 
    for each f1 in f.Files 
    if isTxt(f1.name) then 
    if instr(f1.name,word)>0 then 
    seachResult = seachResult  "div class='file' title='"  f1.path 
    seachResult = seachResult  "'>span class='fileIcon'>2"  "/span>" 
    seachResult = seachResult  "input value='" 
    fName = getTxtName(f1.name) 
    seachResult = seachResult  fName  "' title='"  fName  "'>" 
    seachResult = seachResult  "/div>" 
    num = num + 1 
    else 
    set st = f1.OpenAsTextStream 
    '逐行读 
    Do While st.AtEndOfStream > True 
    if instr(st.ReadLine,word)>0 then 
    num = num +1 
    seachResult = seachResult  "div class='file' title='"  f1.path 
    seachResult = seachResult  "'>span class='fileIcon'>2"  "/span>" 
    seachResult = seachResult  "input value='" 
    fName = getTxtName(f1.name) 
    seachResult = seachResult  fName  "' title='"  fName  "'>" 
    seachResult = seachResult  "/div>" 
    exit do 
    end if 
    Loop 
    st.Close 
    end if 
    end if 
    next 
    set fd = fso.GetFolder(theFolder) 
    for each fd1 in fd.SubFolders 
    seachWord fd1 
    next 
    end sub 

    sub showHelp 
    dim msg 
    msg = " 文本代码管理工具【IE5.5以上版本】"  vbcrlf 
    msg = msg  "------------------------------------------------"  vbcrlf 
    msg = msg  " 使用方法:放到文本类型的文件夹里面,双击运行。"  vbcrlf 
    msg = msg  "功能:"  vbcrlf 
    msg = msg  "1,快速浏览,预览CTRL+B,搜索文本类型的文件和代码;"  vbcrlf 
    msg = msg  "2,按DEL可以删除点中的文件和文件夹;"  vbcrlf 
    msg = msg  "3,可以修改文件名和文字内容,CTRL+S保存;"  vbcrlf 
    msg = msg  "4,可以创建文件CTRL+N并且编辑保存;"  vbcrlf 
    msg = msg  "5,文本编辑支持TAB和shift+TAB键;"  vbcrlf 
    msg = msg  vbcrlf 
    msg = msg  "作者:CSDN超级大笨狼[2005/1/18版本]"  vbcrlf 
    msg = msg  "欢迎传播使用,交流代码panyuguang962@sohu.com"  vbcrlf 
    msg = msg  "http://superdullwolf.cnzone.net/index.asp"  vbcrlf 
    alert msg 
    end sub 
    /SCRIPT> 
    /BODY> 
    /HTML> 
    上一篇:初学asp者必看
    下一篇:写入文本文件的过程函数(ASP)
  • 相关文章
  • 

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

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

    FSO的强大功能 FSO,的,强大,功能,FSO,的,