├── inc ├── module │ ├── default │ │ ├── view │ │ │ └── default │ │ │ │ ├── pic │ │ │ │ └── no │ │ │ │ ├── font │ │ │ │ └── no │ │ │ │ ├── image │ │ │ │ └── no │ │ │ │ ├── js │ │ │ │ └── hello.js │ │ │ │ ├── tpl │ │ │ │ ├── inc │ │ │ │ │ ├── footer.htm │ │ │ │ │ └── header.htm │ │ │ │ ├── tag │ │ │ │ │ └── hello.htm │ │ │ │ ├── hello_detail.htm │ │ │ │ ├── upload.htm │ │ │ │ ├── hello_form.htm │ │ │ │ ├── hello_list.htm │ │ │ │ └── index.htm │ │ │ │ └── css │ │ │ │ └── hello.css │ │ ├── language │ │ │ ├── cn │ │ │ │ └── hello.asp │ │ │ └── en │ │ │ │ └── hello.asp │ │ ├── control │ │ │ ├── clear.asp │ │ │ ├── tag │ │ │ │ └── hello.asp │ │ │ ├── error.asp │ │ │ ├── upload.asp │ │ │ ├── start │ │ │ │ ├── route │ │ │ │ │ ├── reg.asp │ │ │ │ │ ├── key.asp │ │ │ │ │ └── pic.asp │ │ │ │ └── site.asp │ │ │ ├── json.asp │ │ │ ├── pic.asp │ │ │ ├── crypt.asp │ │ │ └── hello.asp │ │ └── model │ │ │ └── hello.asp │ └── help │ │ ├── view │ │ ├── inc │ │ │ ├── footer.htm │ │ │ └── header.htm │ │ ├── image │ │ │ └── no.gif │ │ └── help.htm │ │ └── control │ │ ├── start │ │ └── site.asp │ │ ├── error.asp │ │ ├── index.asp │ │ └── install.asp ├── class │ ├── route │ │ ├── module.asp │ │ └── slash.asp │ ├── js.asp │ ├── crypt │ │ ├── hex.asp │ │ ├── base64.asp │ │ ├── md5.asp │ │ ├── escape.asp │ │ ├── a2u.asp │ │ ├── aes.asp │ │ ├── des.asp │ │ ├── sha.asp │ │ ├── num.asp │ │ └── rsa.asp │ ├── ext │ │ ├── jsont.asp │ │ ├── zip.asp │ │ ├── stringbuilder.asp │ │ ├── jmail.asp │ │ ├── mail.asp │ │ ├── verify.asp │ │ ├── date.asp │ │ ├── xml.asp │ │ ├── jpeg.asp │ │ ├── cart.asp │ │ ├── json.asp │ │ ├── pack.asp │ │ ├── wia.asp │ │ ├── tqqwry.asp │ │ └── http.asp │ ├── session.asp │ ├── log.asp │ ├── error.asp │ ├── cookie.asp │ ├── pagelist.asp │ ├── response.asp │ ├── request.asp │ ├── cache.asp │ ├── valid.asp │ └── route.asp ├── config.bak.asp └── wts.asp ├── .gitignore ├── favicon.ico ├── web.bak ├── index.asp ├── README.md └── LICENSE /inc/module/default/view/default/pic/no: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /inc/module/default/view/default/font/no: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /inc/module/default/view/default/image/no: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /data 2 | /inc/config.asp 3 | web.config -------------------------------------------------------------------------------- /inc/module/help/view/inc/footer.htm: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /inc/module/default/view/default/js/hello.js: -------------------------------------------------------------------------------- 1 | console.log("Hello js"); -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/inc/footer.htm: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/tag/hello.htm: -------------------------------------------------------------------------------- 1 | this is a Extension : {tag_para} -------------------------------------------------------------------------------- /favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ekede/WTS-Classic-ASP-MVC-Framework/HEAD/favicon.ico -------------------------------------------------------------------------------- /inc/module/default/view/default/css/hello.css: -------------------------------------------------------------------------------- 1 | body{ 2 | font-family: Helvetica 3 | } 4 | .hello{ 5 | font-size:12px; 6 | } -------------------------------------------------------------------------------- /inc/module/help/view/image/no.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ekede/WTS-Classic-ASP-MVC-Framework/HEAD/inc/module/help/view/image/no.gif -------------------------------------------------------------------------------- /inc/module/default/language/cn/hello.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: language_cn_hello 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 演示语言包 6 | 7 | wts.site.tempdata("Lan_Language")="中文" 8 | wts.site.tempdata("Lan_Hello")="你好WTS" 9 | %> -------------------------------------------------------------------------------- /inc/module/default/language/en/hello.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: language_en_hello 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 演示语言包 6 | 7 | wts.site.tempdata("Lan_Language")="English" 8 | wts.site.tempdata("Lan_Hello")="Hello WTS" 9 | %> -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/hello_detail.htm: -------------------------------------------------------------------------------- 1 | {include inc/header.htm} 2 | 3 |

id:{tag_id}

4 | 5 |

name:{tag_name}

6 | 7 |

language: {Lan_Language}

8 | 9 |

Template Extension: {ext Tag/Hello:Hello}

10 | 11 | {include inc/footer.htm} -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/upload.htm: -------------------------------------------------------------------------------- 1 |
2 | File :
3 |
4 |
5 |
6 | 7 |
-------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/hello_form.htm: -------------------------------------------------------------------------------- 1 | {include inc/header.htm} 2 | 3 |
4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 |
14 |
15 | 16 | {include inc/footer.htm} -------------------------------------------------------------------------------- /inc/module/default/control/clear.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Clear 3 | '@author: ekede.com 4 | '@date: 2018-02-01 5 | '@description: 清除缓存 6 | 7 | Class Control_Clear 8 | 9 | '@Index_Action(): 10 | 11 | Public Sub Index_Action() 12 | loader.ClearApp() 13 | wts.cache.ClearValue() 14 | wts.responses.SetOutput "clear application" 15 | End Sub 16 | 17 | '@View_Action(): 18 | 19 | Public Sub View_Action() 20 | wts.responses.SetOutput loader.ViewApp() 21 | End Sub 22 | 23 | End Class 24 | %> -------------------------------------------------------------------------------- /inc/class/route/module.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Route_Module 3 | '@author: ekede.com 4 | '@date: 2018-12-06 5 | '@description: 标准路由前特殊模块判断 6 | 7 | Class Class_Route_Module 8 | 9 | Private route_ 10 | 11 | '@route: route对象依赖 12 | 13 | Public Property Let route(Value) 14 | Set route_ = Value 15 | End Property 16 | 17 | '@GetModule(ByRef r): 根据Requests对象参数做特殊模块判断 18 | 19 | Public Function GetModule(ByRef r) 20 | GetModule = False 21 | 'route_.module = "default" 22 | End Function 23 | 24 | End Class 25 | %> -------------------------------------------------------------------------------- /inc/class/js.asp: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /inc/module/default/control/tag/hello.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Tag_Hello 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 模块制作演示 6 | 7 | Class Control_Tag_Hello 8 | ' 9 | Dim temp_data 10 | 11 | Private Sub Class_Initialize() 12 | Set temp_data = Server.CreateObject("Scripting.Dictionary") 13 | End Sub 14 | 15 | Private Sub Class_Terminate() 16 | Set temp_data = Nothing 17 | End Sub 18 | 19 | '@Hello(): 返回模块信息 20 | 21 | Function Hello() 22 | temp_data("tag_para") = "this is a para" 23 | hello = loader.loadView("tag/hello.htm", temp_data) 24 | End Function 25 | 26 | End Class 27 | %> -------------------------------------------------------------------------------- /web.bak: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /inc/module/help/view/inc/header.htm: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | {loop meta} 7 | {loop_body start} 8 | 9 | {loop_body end} 10 | {end loop} 11 | 12 | {title} 13 | 14 | {loop script} 15 | {loop_body start} 16 | 17 | {loop_body end} 18 | {end loop} 19 | 20 | {loop style} 21 | {loop_body start} 22 | 23 | {loop_body end} 24 | {end loop} 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/inc/header.htm: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | {loop meta} 7 | {loop_body start} 8 | 9 | {loop_body end} 10 | {end loop} 11 | 12 | {title} 13 | 14 | {loop script} 15 | {loop_body start} 16 | 17 | {loop_body end} 18 | {end loop} 19 | 20 | {loop style} 21 | {loop_body start} 22 | 23 | {loop_body end} 24 | {end loop} 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/hello_list.htm: -------------------------------------------------------------------------------- 1 | {include inc/header.htm} 2 | 3 | {loop news} 4 | 5 | {loop_body start} 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | {loop_body end} 14 |
{news/id}{news/name}{news/time}Edit | Del
15 | {end loop} 16 | 17 | {loop news_page} 18 |

Page : 19 | {loop_body start} 20 | {if loop news_page/selected=1} 21 | {news_page/num} 22 | {else loop} 23 | {news_page/num} 24 | {end loop if} 25 | {loop_body end} 26 |

27 | {end loop} 28 | 29 |

Add Name

30 | 31 | {include inc/footer.htm} -------------------------------------------------------------------------------- /inc/module/help/control/start/site.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Start_Site 3 | '@author: ekede.com 4 | '@date: 2018-02-01 5 | '@description: Start 6 | 7 | Class Control_Start_Site 8 | 9 | '@config: 配置数据存储,便于不同对象间交换数据 10 | 11 | Dim config 12 | 13 | Private Sub Class_Initialize() 14 | Set config = Server.CreateObject("Scripting.Dictionary") 15 | End Sub 16 | Private Sub Class_Terminate() 17 | Set config = Nothing 18 | End Sub 19 | 20 | '@Start(): 启动模块 21 | 22 | Public Function Start() 23 | '路由 24 | wts.route.routers = "" '必须 25 | 'wts.route.rewrite_on = True 26 | wts.route.DeWrite() 27 | '静态根路径 28 | config("base_url") = wts.route.baseAddr 29 | ' 30 | loader.LoadControlAction wts.route.control, wts.route.action, "" 31 | ' 32 | wts.responses.Outputs 33 | 34 | End Function 35 | 36 | End Class 37 | %> -------------------------------------------------------------------------------- /inc/module/default/control/error.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Error 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 错误提示页 6 | 7 | Class Control_Error 8 | 9 | Private Sub Class_Initialize() 10 | End Sub 11 | 12 | Private Sub Class_Terminate() 13 | wts.responses.outputs 14 | wts.responses.Die("") 15 | End Sub 16 | 17 | '@E404_Action(): 404错误 18 | 19 | Public Sub E404_Action() 20 | wts.responses.setStatus = wts.responses.getStatus(404) 21 | wts.responses.SetOutput "this is 404" 22 | End Sub 23 | 24 | '@E405_Action(): 405错误 25 | 26 | Public Sub E405_Action() 27 | wts.responses.SetOutput "this is 405" 28 | End Sub 29 | 30 | '@E500_Action(): 500错误 31 | 32 | Public Sub E500_Action() 33 | wts.responses.setStatus = wts.responses.getStatus(500) 34 | wts.responses.SetOutput "this is 500" 35 | End Sub 36 | 37 | End Class 38 | %> -------------------------------------------------------------------------------- /inc/module/help/control/error.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Error 3 | '@author: ekede.com 4 | '@date: 2018-02-01 5 | '@description: Error 6 | 7 | Class Control_Error 8 | 9 | Private Sub Class_Initialize() 10 | End Sub 11 | 12 | Private Sub Class_Terminate() 13 | wts.responses.outputs 14 | wts.responses.Die("") 15 | End Sub 16 | 17 | '@E404_Action(): 404错误 18 | 19 | Public Sub E404_Action() 20 | wts.responses.setStatus = wts.responses.getStatus(404) 21 | wts.responses.SetOutput "this is 404" 22 | End Sub 23 | 24 | '@E405_Action(): 405错误 25 | 26 | Public Sub E405_Action() 27 | wts.responses.SetOutput "this is 405" 28 | End Sub 29 | 30 | '@E500_Action(): 500错误 31 | 32 | Public Sub E500_Action() 33 | wts.responses.setStatus = wts.responses.getStatus(500) 34 | wts.responses.SetOutput "this is 500" 35 | End Sub 36 | 37 | End Class 38 | %> -------------------------------------------------------------------------------- /inc/module/default/view/default/tpl/index.htm: -------------------------------------------------------------------------------- 1 | {include inc/header.htm} 2 | 3 |

{Lan_Hello}

4 | 5 |
    6 |
  1. Helper: View
    2. 7 |
  2. GitHub: View
    3. 8 |
9 | 10 |
    11 |
  1. DB(CURD): View
    2. 12 |
  2. Json Object: View
    3. 13 |
  3. Upload: View
    4. 14 |
  4. Crypt/Decrypt: View
    5. 15 |
  5. Http: View
    6. 16 |
  6. Static: View
    7. 17 |
  7. Pack: View
    8. 18 |
  8. Verify:View
    9. 19 |
20 | 21 | {include inc/footer.htm} -------------------------------------------------------------------------------- /inc/class/crypt/hex.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Crypt/Hex 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: Hex 6 | 7 | Class Class_Crypt_Hex 8 | 9 | '@Hex2Bytes(ByRef Str): Hex2Bytes 10 | 11 | Function Hex2Bytes(ByRef Str) 12 | Set objXML = Server.CreateObject("Msxml2.DOMDocument") 13 | Set objXMLNode = objXML.createElement("a") 14 | objXMLNode.DataType = "bin.hex" 15 | objXMLNode.Text = Str 16 | Bytes = objXMLNode.NodeTypedValue 17 | Set objXML = Nothing 18 | Set objXMLNode = Nothing 19 | Hex2Bytes=Bytes 20 | End Function 21 | 22 | '@Bytes2Hex(ByRef Bytes): Bytes2Hex 23 | 24 | Function Bytes2Hex(ByRef Bytes) 25 | Set objXML = Server.CreateObject("Msxml2.DOMDocument") 26 | Set objXMLNode = objXML.createElement("a") 27 | objXMLNode.DataType = "bin.hex" 28 | objXMLNode.NodeTypedValue = Bytes 29 | Outstr = Replace(objXMLNode.Text,Chr(10),"") 30 | Set objXML = Nothing 31 | Set objXMLNode = Nothing 32 | Bytes2Hex = Outstr 33 | End Function 34 | 35 | End Class 36 | %> -------------------------------------------------------------------------------- /index.asp: -------------------------------------------------------------------------------- 1 | <%@language=vbscript codepage=65001 %> 2 | <% 3 | '@title: 单入口 4 | '@author: ekede.com 5 | '@date: 2018-10-16 6 | '@description: 将404,403解析到该入口 7 | 8 | '#系统包含: 9 | '全局唯一系统包含,避免使用系统包含,去偶合 10 | '第一次使用,需要将inc/下的config.bak.asp手动复制为config.asp并进行配置 11 | %> 12 | 13 | 14 | <% 15 | '## 16 | 17 | '#根目录常量: 18 | '入口文件相对网站根目录的位置,为空说明当前是根目录 19 | Const PATH_ROOT = "" 20 | '## 21 | 22 | '#启动框架: 23 | '仅有的全局根对象,其余全部为局部,后续包含均通过loader实现 24 | Dim loader 25 | Dim wts 26 | Set loader = New Class_Load 27 | loader.frameworkPath=PATH_INC 28 | Set wts = loader.LoadFramework("Wts") 29 | wts.Start() 30 | wts.Finish() 31 | Set wts = Nothing 32 | Set loader = Nothing 33 | '## 34 | 35 | '#调试程序: 36 | '输出变量,中断 37 | Public Sub Die(str) 38 | On Error Resume Next 39 | If typename(wts) = "Framework_Wts" Then 40 | Response.write wts.fun.Print(str) 41 | Else 42 | Response.write "Invalid Framework" 43 | End If 44 | If err Then Response.Write "No Start Framework" 45 | Response.End 46 | End Sub 47 | '## 48 | %> -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### WTS Classic ASP Framework with VBScript based on Object ### 2 | 3 | Code: UTF-8 with BOM 4 | 5 | Program: request => route => module/control/action (model,view,language) => response 6 | 7 | Start: inc/wts.start() => inc/module/---/control/start/site.start() => ... 8 | 9 | Struct: 10 | 11 | index.asp Single entry point, IIS404,405 point here 12 | 13 | inc/ Program Folder 14 | inc/config.asp Global configure File 15 | inc/wts.asp Core Framework 16 | inc/class/ Asp Libray 17 | inc/module/ MVCL Program 18 | 19 | data/ Data Folder 20 | data/cache/ Cache Folder 21 | data/db/ Database Folder 22 | data/log/ Log Folder 23 | data/pic/ IMAGE Folder 24 | data/static/ Static Folder: css,js,icon... 25 | 26 | app/ Rewrite "inc/" Folder 27 | 28 | Note: 29 | 30 | First Copy inc/config.bak.asp inc/config.asp 31 | Program and Data path can be configured by config.asp 32 | Class libraries and program files based on object, loading file by loader object 33 | -------------------------------------------------------------------------------- /inc/class/crypt/base64.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Base64 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: Base64 6 | 7 | Class Class_Crypt_Base64 8 | 9 | '@Base642Bytes(ByRef str): Base642Bytes 10 | 11 | Public Function Base642Bytes(ByRef str) 12 | Dim objXML, objXMLNode 13 | Set objXML = server.CreateObject("msxml2.domdocument") 14 | Set objXMLNode = objXML.createelement("b64") 15 | objXMLNode.datatype = "bin.base64" 16 | objXMLNode.text = str 17 | Base642Bytes = objXMLNode.nodetypedvalue 18 | Set objXMLNode = Nothing 19 | Set objXML = Nothing 20 | End Function 21 | 22 | '@Bytes2Base64(ByRef bytes): Bytes2Base64 23 | 24 | Public Function Bytes2Base64(ByRef bytes) 25 | Dim objXML, objXMLNode 26 | Set objXML = server.CreateObject("msxml2.domdocument") 27 | Set objXMLNode = objXML.createelement("b64") 28 | objXMLNode.datatype = "bin.base64" 29 | objXMLNode.nodetypedvalue = bytes 30 | Bytes2Base64 = objXMLNode.text 31 | Set objXMLNode = Nothing 32 | Set objXML = Nothing 33 | End Function 34 | 35 | End Class 36 | %> -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 todaygods 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /inc/class/ext/jsont.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_JsonT 3 | '@author: ekede.com 4 | '@date: 2017-11-29 5 | '@description: Str To Json Object 6 | 7 | Class Class_Ext_JsonT 8 | 9 | Dim sc4Json 10 | 11 | Private Sub Class_Initialize() 12 | Set sc4Json = Server.CreateObject("MSScriptControl.ScriptControl") 13 | sc4Json.Language = "JavaScript" 14 | sc4Json.AddCode "var itemTemp=null;" 15 | sc4Json.AddCode "function getJSArray(arr, index){itemTemp=arr[index];}" 16 | End Sub 17 | 18 | Private Sub Class_Terminate() 19 | Set sc4Json = nothing 20 | End Sub 21 | 22 | '@GetJSONObject(ByRef strJSON): Json字符串转对象 23 | 24 | Function GetJSONObject(ByRef strJSON) 25 | sc4Json.AddCode "var jsonObject = " & strJSON 26 | Set getJSONObject = sc4Json.CodeObject.jsonObject 27 | End Function 28 | 29 | '@GetJSArrayItem(ByRef objJSArray,ByRef indexs): 数组对象索引取值 30 | 31 | Function GetJSArrayItem(ByRef objJSArray,ByRef indexs) 32 | On Error Resume Next 33 | sc4Json.Run "getJSArray",objJSArray, indexs 34 | Set GetJSArrayItem = sc4Json.CodeObject.itemTemp 35 | If Err.number=0 Then Exit Function 36 | GetJSArrayItem = sc4Json.CodeObject.itemTemp 37 | End Function 38 | 39 | End Class 40 | %> -------------------------------------------------------------------------------- /inc/config.bak.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: config 3 | '@author: ekede.com 4 | '@date: 2018-06-17 5 | '@description: 基础,常量,配置 6 | 7 | '#配置文件: 8 | '@DEBUGS: 开启调试,会自动关闭loader文件缓存,关闭调试,可提升运行效率 9 | Const DEBUGS = TRUE 10 | 11 | '@PATH_INC: 核心程序文件路径,不建议修改 12 | Const PATH_INC = "inc/" 13 | PATH_CLASS = PATH_INC&"class/" 14 | PATH_MODULE = PATH_INC&"module/" 15 | Const PATH_MODEL = "model/" 16 | Const PATH_CONTROL = "control/" 17 | Const PATH_VIEW = "view/" 18 | Const PATH_LANGUAGE = "language/" 19 | 20 | '@PATH_APP: 定制程序文件路径,文件路径与PATH_INC对应覆盖 21 | 'Const PATH_APP = "app/" 22 | 23 | '@PATH_DATA: 数据文件路径 24 | Const PATH_DATA = "data/" 25 | PATH_LOG = PATH_DATA&"log/" 26 | PATH_PIC = PATH_DATA&"pic/" 27 | PATH_STATIC = PATH_DATA&"static/" 28 | Const PATH_PIC_THUMBS = "thumb/" 29 | Const PATH_PIC_IMAGES = "image/" 30 | 31 | '@DB_TYPE: 数据库配置 32 | Const DB_TYPE = 1 '1:access ; 2:Excel; 3:sqlserver ; 5:dsn 33 | Const DB_VERSION = 2 '1:DRIVER ; 2:OLEDB ; 3:ACE 34 | DB_USER = "sa" 'sqlserver 35 | DB_PASS = "111" 'sqlserver 36 | Const DB_NAME = "hello.mdb" 'access:caca.asp ; sqlserver:caca ; dsn:caca.dsn ; 37 | Const DB_PRE = "wts_" 38 | DB_PATH = PATH_DATA&"db/" 'access:data/ ; sqlserver:. ; dsn:"/_dsn" 39 | 40 | '@MODULES: 模块配置 默认为default 41 | Const MODULES = "help,default" 42 | 43 | '## 44 | %> -------------------------------------------------------------------------------- /inc/class/crypt/md5.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Md5 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: MD5加密支持中文 6 | 7 | Class Class_Crypt_Md5 8 | 9 | Private TAsc 10 | 11 | Private Sub Class_Initialize() 12 | Set TAsc = Server.CreateObject("System.Text.UTF8Encoding") 13 | End Sub 14 | 15 | Private Sub Class_Terminate() 16 | Set TAsc = Nothing 17 | End Sub 18 | 19 | '@MD5(ByVal Str): MD5 20 | 21 | Public Function MD5(ByRef Str) 22 | Dim Enc,Bytes,objXML,objXMLNode,Outstr 23 | 'Borrow some objects from .NET (supported from 1.1 onwards) 24 | Set Enc = Server.CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") 25 | 'Convert the string to a byte array and hash it 26 | Bytes = TAsc.GetBytes_4(Str) 27 | MD5 = Enc.ComputeHash_2((Bytes)) 28 | Set Enc = Nothing 29 | End Function 30 | 31 | '@HMACMD5(ByVal Str,ByVal Key): HMACMD5 32 | 33 | Public Function HMACMD5(ByRef Str,ByRef Key) 34 | Dim Enc,Bytes 35 | 'Borrow some objects from .NET (supported from 1.1 onwards) 36 | Set Enc = Server.CreateObject("System.Security.Cryptography.HMACMD5") 37 | 'Convert the string to a byte array and hash it 38 | Enc.Key = TAsc.GetBytes_4(Key) 39 | Bytes = TAsc.GetBytes_4(Str) 40 | HMACMD5 = Enc.ComputeHash_2((Bytes)) 41 | Set Enc = Nothing 42 | End Function 43 | 44 | End Class 45 | %> -------------------------------------------------------------------------------- /inc/class/session.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Session 3 | '@author: ekede.com 4 | '@date: 2017-12-28 5 | '@description: Session操作类 6 | 7 | Class Class_Session 8 | 9 | Private sid_ 10 | 11 | '@session_id: 取得Session id 12 | 13 | Public Property Get session_id 14 | session_id = sid_ 15 | End Property 16 | 17 | Private Sub Class_Initialize() 18 | sid_ = Session.SessionID 19 | Session.CodePage = 65001 20 | Session.Timeout = 30 21 | End Sub 22 | 23 | Private Sub Class_Terminate() 24 | End Sub 25 | 26 | '@SetS(ByRef k,ByRef v): 写 27 | 28 | Public Sub SetS(ByRef k,ByRef v) 29 | Session.Contents(k) = v 30 | End Sub 31 | 32 | '@GetS(ByRef k): 读 33 | 34 | Public Function GetS(ByRef k) 35 | GetS = Session(k) 36 | End Function 37 | 38 | '@GetAllS(ByRef k): 读集合 39 | 40 | Public Function GetAllS(ByRef k) 41 | GetS = Session.Contents 42 | End Function 43 | 44 | '@DelS(ByRef k): 删 45 | 46 | Public Sub DelS(ByRef k) 47 | Session.Contents.Remove(k) 48 | End Sub 49 | 50 | '@DelAllS(ByRef k): RemoveAll 51 | 52 | Public Sub DelAllS(ByRef k) 53 | Session.Contents.RemoveAll() 54 | End Sub 55 | 56 | '@CleanS(ByRef k): Abandon 57 | 58 | Public Sub CleanS(ByRef k) 59 | Session.Abandon() 60 | End Sub 61 | 62 | End Class 63 | %> -------------------------------------------------------------------------------- /inc/module/default/control/upload.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Upload 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 上传演示 6 | 7 | Class Control_Upload 8 | 9 | Private Sub Class_Initialize() 10 | End Sub 11 | 12 | Private Sub Class_Terminate() 13 | End Sub 14 | 15 | '@Index_Action(): 表单 16 | 17 | Sub Index_Action() 18 | 'url 19 | wts.template.SetVal "form_url", wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=upload/save") 20 | 'template 21 | moban = wts.template.Fetch("upload.htm") 22 | wts.responses.SetOutput moban 23 | End Sub 24 | 25 | '@Save_Action(): 保存 26 | 27 | Sub Save_Action() 28 | '#上传保存演示: 29 | Dim upfile,i:i=0 30 | 31 | Set upFile=loader.LoadClass("Ext/UpFile") 32 | 'upFile.IsDebug = True 33 | upFile.NoAllowExt="asp;exe;htm;html;aspx;cs;vb;js;" 34 | upFile.GetData(1024*200) 35 | If upFile.isErr=0 Then '如果出错 36 | for each formName in upFile.file '列出所有上传了的文件 37 | set oFile=upfile.file(formname) 38 | if oFile.fileName <> "" then 39 | upFile.SaveToFile formname,wts.fso.GetMapPath(PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES&oFile.fileName) 40 | i=i+1 41 | end if 42 | set oFile=nothing 43 | Next 44 | end if 45 | set upFile = nothing 46 | '## 47 | wts.responses.SetOutput "Save "&i&" Files " 48 | End Sub 49 | 50 | End Class 51 | %> -------------------------------------------------------------------------------- /inc/class/log.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Log 3 | '@author: ekede.com 4 | '@date: 2017-12-7 5 | '@description: 日志操作类 6 | 7 | Class Class_Log 8 | ' 9 | Private fso_ 10 | Private logPath_ 11 | 12 | '@fso: fso对象依赖 13 | 14 | Public Property Let fso(Values) 15 | Set fso_ = Values 16 | End Property 17 | 18 | '@logPath: 日志根路径 19 | 20 | Public Property Let logPath(Values) 21 | logPath_ = PATH_ROOT&Values 22 | End Property 23 | 24 | Private Sub Class_Initialize() 25 | End Sub 26 | 27 | Private Sub Class_Terminate() 28 | End Sub 29 | 30 | '@GetLog(ByRef names): 取日志 31 | 32 | Public Function GetLog(ByRef names) 33 | Dim paths, str 34 | paths = LogPath_&names 35 | str = fso_.ReadTxtFile(fso_.GetMapPath(paths)) 36 | If str = "" Then 37 | GetLog = -1 38 | Else 39 | GetLog = str 40 | End If 41 | End Function 42 | 43 | '@SetLog(ByRef names,ByRef content): 写日志 44 | 45 | Public Function SetLog(ByRef names,ByRef content) 46 | Dim paths 47 | paths = logPath_&names 48 | ' 49 | fso_.CreateFolders fso_.GetMapPath(LogPath_) 50 | SetLog = fso_.WriteTxtFile(fso_.GetMapPath(paths), content, 3) 51 | End Function 52 | 53 | '@DelLog(ByRef names): 删日志 54 | 55 | Public Function DelLog(ByRef names) 56 | delLog = fso_.DeleteAFile(fso_.GetMapPath(logPath_&names)) 57 | End Function 58 | 59 | End Class 60 | %> -------------------------------------------------------------------------------- /inc/class/crypt/escape.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Escape 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: Escape 6 | 7 | Class Class_Crypt_Escape 8 | 9 | '@Escape(ByRef Str): 编码 10 | 11 | Public Function Escape(ByRef Str) 12 | dim i,s,c,a 13 | s = "" 14 | For i = 1 To Len(Str) 15 | c = Mid(str,i,1) 16 | a = ASCW(c) 17 | If (a >= 48 And a <= 57) Or (a >= 65 And a <= 90) Or (a >= 97 And a <= 122) Then 18 | s = s & c 19 | ElseIf InStr("@*_+-./",c) > 0 Then 20 | s = s & c 21 | ElseIf a > 0 And a < 16 Then 22 | s = s & "%0" & Hex(a) 23 | ElseIf a >= 16 And a < 256 Then 24 | s = s & "%" & Hex(a) 25 | Else 26 | s = s & "%u" & Hex(a) 27 | End If 28 | Next 29 | Escape = s 30 | End Function 31 | 32 | '@UnEscape(ByRef Str): 解码 33 | 34 | Public Function UnEscape(ByRef Str) 35 | dim i,s,c 36 | s = "" 37 | For i = 1 To Len(Str) 38 | c = Mid(Str,i,1) 39 | If Mid(Str,i,2) = "%u" And i <= Len(Str) - 5 Then 40 | If IsNumeric("&H" & Mid(Str,i + 2,4)) Then 41 | s = s & CHRW(CInt("&H" & Mid(Str,i + 2,4))) 42 | i = i + 5 43 | Else 44 | s = s & c 45 | End If 46 | ElseIf c = "%" And i <= Len(Str) - 2 Then 47 | If IsNumeric("&H" & Mid(Str,i + 1,2)) Then 48 | s = s & CHRW(CInt("&H" & Mid(Str,i + 1,2))) 49 | i = i + 2 50 | Else 51 | s = s & c 52 | End If 53 | Else 54 | s = s & c 55 | End If 56 | Next 57 | UnEscape = s 58 | End Function 59 | 60 | End Class 61 | %> -------------------------------------------------------------------------------- /inc/class/error.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Error 3 | '@author: ekede.com 4 | '@date: 2018-06-18 5 | '@description: 错误信息类 6 | 7 | Class Class_Error 8 | 9 | '@foundErr: 是否有错误 10 | 11 | Dim foundErr 12 | Private errMsg_ 13 | Private loader_ 14 | 15 | '@loader: Loader对象依赖 16 | 17 | Public Property Let loader(Values) 18 | Set loader_ = Values 19 | End Property 20 | 21 | Private Sub Class_Initialize() 22 | foundErr = False 23 | End Sub 24 | 25 | Private Sub class_terminate() 26 | End Sub 27 | 28 | '@AddMsg(ByRef msg): 添加错误 29 | 30 | Public Sub AddMsg(ByRef msg) 31 | foundErr = True 32 | ' 33 | If errMsg_ = "" Then 34 | errMsg_ = msg 35 | Else 36 | errMsg_ = errMsg_ & "|-|"&msg 37 | End If 38 | End Sub 39 | 40 | '@OutMsg(): 查看错误 41 | 42 | Public Sub OutMsg() 43 | Response.charset = "utf-8" 44 | Response.Write errMsg_ 45 | Response.End 46 | End Sub 47 | 48 | '@GetMsg(): 返回错误 49 | 50 | Public Function GetMsg() 51 | Dim temp, aMsg, aNum, i 52 | aMsg = Split(errMsg_, "|-|") 53 | aNum = UBound(aMsg) 54 | For i = 0 To aNum 55 | If i > 0 Then Temp = Temp&"," 56 | temp = temp&""""&aMsg(i)&"""" 57 | Next 58 | ' 59 | GetMsg = temp 60 | End Function 61 | 62 | '@Out(e): 转向404页 63 | 64 | Public Sub Out(e) 65 | loader_.LoadControlAction "Error", "E404" 66 | End Sub 67 | 68 | End Class 69 | %> -------------------------------------------------------------------------------- /inc/class/ext/zip.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_zip 3 | '@author: ekede.com 4 | '@date: 2018-07-16 5 | '@description: dyy.zipsvr压缩,解压缩类 6 | 7 | Class Class_Ext_zip 8 | 9 | Private isDebug_ 10 | Dim fSvrZip 11 | 12 | '@isDebug: 是否设置为调试模式 13 | 14 | Public Property Let isDebug(Values) 15 | isDebug_ = Values 16 | End Property 17 | 18 | Private Sub Class_Initialize() 19 | If IsEmpty(DEBUGS) Then 20 | isDebug_ = False 21 | Else 22 | isDebug_ = DEBUGS 23 | End If 24 | ' 25 | On Error Resume Next 26 | Set fSvrZip=Server.Createobject("dyy.zipsvr") 27 | If Err.Number <> 0 Then OutErr("创建dyy.zipsvrg组件失败") 28 | End Sub 29 | 30 | Private Sub Class_Terminate() 31 | Set fSvrZip=nothing 32 | End Sub 33 | 34 | '@Zip(ByRef p,ByRef f): Place To File 35 | 36 | Public Function Zip(ByRef p,ByRef f) 37 | 38 | Set fzip=fSvrZip.ZipCom 39 | fzip.fileName = f 40 | fzip.AddFiles p&"\*.*" 41 | fzip.password = "" 42 | fzip.Process 43 | Set fzip=Nothing 44 | 45 | End Function 46 | 47 | '@UnZip(ByRef f,ByRef p): File To Place 48 | 49 | Public Function UnZip(ByRef f,ByRef p) 50 | 51 | Set funzip=fSvrZip.UnZipCom 52 | funzip.fileName = f 53 | funzip.objDir = p 54 | funzip.force2CreateObjDir = True 55 | funzip.Process 56 | Set funzip=Nothing 57 | 58 | End Function 59 | 60 | '错误提示 61 | 62 | Private Sub OutErr(ByRef str) 63 | Response.charSet = "utf-8" 64 | Response.Write str 65 | Response.End 66 | End Sub 67 | 68 | End Class 69 | %> -------------------------------------------------------------------------------- /inc/class/ext/stringbuilder.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_StringBuilder 3 | '@author: Steve McMahon 4 | '@date: 2009-05-12 5 | '@description: vbAccelerator 6 | 7 | 'vbAccelerator的Steve McMahon给我们提供了一个好用的cStringBuilder类，便于我们实现StringBuilder的功能， 8 | '据作者讲添加10,000次类似于”http://vbaccelerator.com/”这样字符串，标准VB方式需要34秒，而使用Steve McMahon的cStringBuilder类只需要0.35秒。效率和速度还是相当不错的。 9 | 10 | Class Class_Ext_StringBuilder 11 | 12 | 'the array of strings to concatenate 13 | Private arr 14 | 15 | '@growth: the rate at which the array grows 16 | Private growthRate 17 | 18 | Public Property Let growth(Value) 19 | growthRate = Value 20 | End Property 21 | 22 | 'the number of items in the array 23 | Private itemCount 24 | 25 | Private Sub Class_Initialize() 26 | growthRate = 10 27 | itemCount = 0 28 | ReDim arr(growthRate) 29 | End Sub 30 | 31 | '@Append(ByVal strValue): Append a new string to the end of the array. 32 | 'If the number of items in the array is larger than the actual capacity of the array, then "grow" the array by ReDimming it. 33 | 34 | Public Sub Append(ByVal strValue) 35 | strValue=strValue & "" 'code borrowed from FastString to prevent crash on NULL 36 | If itemCount > UBound(arr) Then 37 | ReDim Preserve arr(UBound(arr) + growthRate) 38 | End If 39 | arr(itemCount) = strValue 40 | itemCount = itemCount + 1 41 | End Sub 42 | 43 | '@ToString(): Concatenate the strings 44 | 'by simply joining your array of strings and adding no separator between elements. 45 | 46 | Public Function ToString() 47 | ToString = Join(arr, "") 48 | End Function 49 | 50 | End Class 51 | %> -------------------------------------------------------------------------------- /inc/module/default/model/hello.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Model_Hello 3 | '@author: ekede.com 4 | '@date: 2017-02-23 5 | '@description: 模型演示 6 | 7 | '#模型演示: 8 | Class Model_Hello 9 | 10 | private t_fields 11 | private t_join 12 | private t_where 13 | private t_order 14 | 15 | '@tfields: 主要字段 16 | 17 | Public Property Get tfields 18 | tfields=t_fields 19 | End Property 20 | 21 | '@tjoin: 表连接 22 | 23 | Public Property Get tjoin 24 | tjoin=t_join 25 | End Property 26 | 27 | '@twhere: 条件 28 | 29 | Public Property Get twhere 30 | twhere=t_where 31 | End Property 32 | 33 | '@torder: 排序 34 | 35 | Public Property Get torder 36 | torder=t_order 37 | End Property 38 | 39 | Private sub Class_Initialize 40 | t_fields= "" 41 | t_join= DB_PRE&"hello" 42 | t_where= "" 43 | t_order= "" 44 | End Sub 45 | Private Sub Class_Terminate() 46 | End Sub 47 | 48 | '@getHello(): 取所有 49 | 50 | Public Function GetAll() 51 | Set getAll=wts.db.Query(t_join,"","","","",1,1) 52 | End Function 53 | 54 | '@getNameById(id): 取单条 55 | 56 | Public Function GetNameById(id) 57 | Set getNameById=wts.db.Query(t_join,"","id="&id,"","",1,1) 58 | End Function 59 | 60 | '@Add(name): 添加 61 | 62 | Public Function Add(name) 63 | Add=wts.db.Add(t_join, "name", "'"&name&"'") 64 | End Function 65 | 66 | '@Edit(data): 修改 67 | 68 | Public Function Edit(data) 69 | Edit=wts.db.Edit(t_join, "name", "'"&data("name")&"'","id="&data("id")) 70 | End Function 71 | 72 | '@Del(id): 删除 73 | 74 | Public Function Del(id) 75 | Del=wts.db.Del(t_join,"id="&id) 76 | End Function 77 | 78 | End Class 79 | '## 80 | %> -------------------------------------------------------------------------------- /inc/module/default/control/start/route/reg.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Start_Route_Reg 3 | '@author: ekede.com 4 | '@date: 2018-08-12 5 | '@description: 正则路由 6 | 7 | Class Control_Start_Route_Reg 8 | 9 | Private route_ 10 | Private tempKeys_ 11 | Private regEx_ 12 | Private isRule 13 | private rPath 14 | private nPath 15 | 16 | '@route: route对象依赖 17 | 18 | Public Property Let route(Values) 19 | Set route_ = Values 20 | End Property 21 | 22 | Private Sub Class_Initialize() 23 | isRule = False 24 | Set regEx_ = New RegExp 25 | Set tempKeys_ = Server.CreateObject("Scripting.Dictionary") 26 | End Sub 27 | 28 | Private Sub Class_Terminate() 29 | Set tempKeys_ = Nothing 30 | Set regEx_ = Nothing 31 | End Sub 32 | 33 | '@DeWrite(ByVal r_path): 解码 34 | 35 | Public Sub DeWrite(ByVal r_path) 36 | rPath = r_path 37 | ' 38 | For Each k in tempKeys_ 39 | Rule k,tempKeys_(k) 40 | Next 41 | '正则解析成斜线路由处理 42 | If isRule Then 43 | If IsObject(route_("slash")) Then route_("slash").Dewrite npath 44 | End If 45 | End Sub 46 | 47 | '解串 48 | Private Sub rule(ByVal sPattern,ByVal sContent) 49 | If isRule Then exit sub 50 | regEx_.Pattern = sPattern ' 设置模式。 51 | If regEx_.Test(rPath) Then 52 | nPath = regEx_.Replace(rPath, sContent) 53 | isRule = True 54 | End If 55 | End Sub 56 | 57 | '@ReWrite(ByVal str): 编码 58 | 59 | Public Function ReWrite(ByVal str) 60 | End Function 61 | 62 | '@SetRegKey(Byref keys,Byref values): 设置正则 63 | 64 | Public Sub SetRegKey(Byref keys,Byref values) 65 | tempKeys_(keys) = values 66 | End Sub 67 | 68 | End Class 69 | %> -------------------------------------------------------------------------------- /inc/class/crypt/a2u.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_A2U 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: UNICODE字符串转换 6 | 7 | 'ANSI并不是某一种特定的字符编码，而是在不同的系统中，ANSI表示不同的编码。 8 | '微软用一个叫“Windows code pages”（在命令行下执行chcp命令可以查看当前code page的值）的值来判断系统默认编码 9 | '@CODEPAGE作用于所有静态的字符串, Response.CodePage,Session.CodePage作用于所有动态输出的字符串。 10 | 11 | 'SetLocale "zh-CN" 设定本地字符集 12 | '其实在 GBK 集中，“轻”字对印的编码是二个字节: C7 E1 即是二进制的：11000111 11100001因为首位是1, 被当成有符号数了 13 | '那怎么才能取得无符号数的值呢，加上65536便成。所以一般呢取得字符的本地编码值Asc("轻")+65536 14 | 15 | '我们使用char来定义字符，占用一个字节，最多只能表示128个字符，也就是ASCII码中的字符. char可以表示所有的英文字符，在以英语为母语的国家完全没有问题。 16 | '汉语、日语等有成千上万个字符，需要用多个字节来表示，称之为宽字符(Wide Character) 17 | 'Unicode 是宽字符编码的一种，已经被现代计算机指定为默认的编码方式 18 | 19 | 'Asc("轻") -14361 Asc 是按本地字符集取文字的编码数值 20 | 'AscB("轻") 123 作用于包含在字符串中的字节数据,返回第一个字节的字符代码，而非字符的字符代码 21 | 'AscW("轻") -28805 函数返回Unicode字符代码，若平台不支持Unicode，则与Asc函数功能相同 22 | 23 | 'Chr 返回与指定的 ANSI 字符代码相对应的字符。 24 | 'ChrB 不是返回一个或两个字节的字符，而总是返回单个字节的字符。chrB(ascB("轻")) 25 | 'ChrW 它的参数是一个Unicode(宽字符)的字符代码 26 | 27 | Class Class_Crypt_A2U 28 | 29 | '@Encode(ByRef str): 将字符串中字符转UNICODE字符代码 30 | 31 | Public Function Encode(ByRef str) 'AscW() 32 | Dim a,s 33 | For i = 1 To Len(str) 34 | a = AscW(Mid(str, i, 1)) 35 | If a<0 Then a = a + 65536 36 | s = s&"&#"&a&";" 37 | Next 38 | Encode = s 39 | End Function 40 | 41 | '@Decode(ByRef str): 将字符串中UNICODE字符代码转字符 42 | 43 | Public Function Decode(ByRef str) 'ChrW() 44 | If InStr(str, "&#")>0 Then 45 | Dim arr, s 46 | arr = Split(str, "&#") 47 | For i = 0 To UBound(arr) 48 | If arr(i)<>"" Then s = s&ChrW(Left(arr(i), Len(arr(i)) -1)) 49 | Next 50 | Decode = s 51 | Else 52 | Decode = str 53 | End If 54 | End Function 55 | 56 | End Class 57 | %> -------------------------------------------------------------------------------- /inc/class/crypt/aes.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Aes 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: Aes加密解密 6 | 7 | Class Class_Crypt_Aes 8 | 9 | Private TAsc 10 | 11 | Private Sub Class_Initialize() 12 | Set TAsc = Server.CreateObject("System.Text.UTF8Encoding") 13 | End Sub 14 | 15 | Private Sub Class_Terminate() 16 | Set TAsc = Nothing 17 | End Sub 18 | 19 | '@AESEncrypt(ByRef Str,ByRef Key): 加密 20 | 21 | 'Mode 1 : cbc , 2 : ecb , 4 : cfb 22 | 'Padding 2 : pkcs5 , 4 : ansix923 23 | Public Function AESEncrypt(ByRef Str,ByRef Key) 24 | Dim Enc,BytesText,Bytes,Outstr 25 | 'Borrow some objects from .NET (supported from 1.1 onwards) 26 | Set Enc = Server.CreateObject("System.Security.Cryptography.RijndaelManaged") 27 | 'Convert the string to a byte array and hash it 28 | Enc.Mode = 2 29 | Enc.Padding = 2 30 | Enc.IV = TAsc.GetBytes_4(Key) 31 | Enc.Key = TAsc.GetBytes_4(Key) 32 | BytesText = TAsc.GetBytes_4(Str) 33 | Bytes = Enc.CreateEncryptor().TransformFinalBlock((BytesText),0,Lenb(BytesText)) 34 | 'Convert the byte array to a hex or bsae64 string 35 | AESEncrypt = Bytes 36 | Set Enc = Nothing 37 | End Function 38 | 39 | '@AESDecrypt(ByRef Bytes,ByRef Key): 解密 40 | 41 | 'Mode 1 : cbc , 2 : ecb , 4 : cfb 42 | 'Padding 2 : pkcs5 , 4 : ansix923 43 | Public Function AESDecrypt(ByRef Bytes,ByRef Key) 44 | Dim Enc,BytesText,Outstr 45 | 'Borrow some objects from .NET (supported from 1.1 onwards) 46 | Set Enc = Server.CreateObject("System.Security.Cryptography.RijndaelManaged") 47 | 'Convert the string to a byte array and hash it 48 | Enc.Mode = 2 49 | Enc.Padding = 2 50 | Enc.IV = TAsc.GetBytes_4(Key) 51 | Enc.Key = TAsc.GetBytes_4(Key) 52 | 'Convert the byte array to a hex or bsae64 string 53 | Outstr = Enc.CreateDecryptor().TransformFinalBlock((Bytes),0,Lenb(Bytes)) 54 | AESDecrypt = TAsc.GetString((Outstr)) 55 | Set Enc = Nothing 56 | End Function 57 | 58 | End Class 59 | %> -------------------------------------------------------------------------------- /inc/class/crypt/des.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Des 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: Des加密解密 6 | 7 | Class Class_Crypt_Des 8 | 9 | Private TAsc 10 | 11 | Private Sub Class_Initialize() 12 | Set TAsc = Server.CreateObject("System.Text.UTF8Encoding") 13 | End Sub 14 | 15 | Private Sub Class_Terminate() 16 | Set TAsc = Nothing 17 | End Sub 18 | 19 | '@DESEncrypt(ByRef Str,ByRef Key): 加密 20 | 21 | 'Mode 1 : cbc , 2 : ecb , 4 : cfb 22 | 'Padding 2 : pkcs5 , 4 : ansix923 23 | Public Function DESEncrypt(ByRef Str,ByRef Key) 24 | Dim Enc,BytesText,Outstr 25 | 'Borrow some objects from .NET (supported from 1.1 onwards) 26 | Set Enc = Server.CreateObject("System.Security.Cryptography.DESCryptoServiceProvider") 27 | 'Convert the string to a byte array and hash it 28 | Enc.Mode = 2 29 | Enc.Padding = 2 30 | Enc.IV = TAsc.GetBytes_4(Key) 31 | Enc.Key = TAsc.GetBytes_4(Key) 32 | BytesText = TAsc.GetBytes_4(Str) 33 | Bytes = Enc.CreateEncryptor().TransformFinalBlock((BytesText),0,Lenb(BytesText)) 34 | 'Convert the byte array to a hex or bsae64 string 35 | DESEncrypt = Bytes 36 | Set Enc = Nothing 37 | End Function 38 | 39 | '@DESDecrypt(ByVal Bytes,ByVal Key): 解密 40 | 41 | 'Mode 1 : cbc , 2 : ecb , 4 : cfb 42 | 'Padding 2 : pkcs5 , 4 : ansix923 43 | Public Function DESDecrypt(ByRef Bytes,ByRef Key) 44 | Dim Enc,BytesText,Outstr 45 | 'Borrow some objects from .NET (supported from 1.1 onwards) 46 | Set Enc = Server.CreateObject("System.Security.Cryptography.DESCryptoServiceProvider") 47 | 'Convert the string to a byte array and hash it 48 | Enc.Mode = 2 49 | Enc.Padding = 2 50 | Enc.IV = TAsc.GetBytes_4(Key) 51 | Enc.Key = TAsc.GetBytes_4(Key) 52 | 'Convert the byte array to a hex or bsae64 string 53 | Outstr = Enc.CreateDecryptor().TransformFinalBlock((Bytes),0,Lenb(Bytes)) 54 | DESDecrypt = TAsc.GetString((Outstr)) 55 | Set Enc = Nothing 56 | End Function 57 | 58 | End Class 59 | %> -------------------------------------------------------------------------------- /inc/module/default/control/json.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Json 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: json演示 6 | 7 | Class Control_Json 8 | 9 | Private Sub Class_Initialize() 10 | loader.Include PATH_CLASS&"Ext/Json" 11 | End Sub 12 | 13 | Private Sub Class_Terminate() 14 | End Sub 15 | 16 | '@Index_Action(): 17 | 18 | Public Sub Index_Action() 19 | Call Test2() 20 | End Sub 21 | 22 | '转Json串 23 | 24 | Private Sub Test1() 25 | '#生成json串: 26 | Set jj = New Class_Ext_Json 27 | jj.setKind="object" 28 | jj(null)="a" 29 | jj(null)="b" 30 | jj(null)="c" 31 | jj(null)="d" 32 | jj("b")="g" 33 | Set jj("a")= New Class_Ext_Json 34 | jj("a").setKind="array" 35 | jj("a")(null)="e" 36 | jj("a")(null)="f" 37 | str=jj.ToString 38 | Set jj = nothing 39 | '## 40 | wts.responses.SetContentType="application/json" 41 | wts.responses.SetOutput str 42 | 43 | End Sub 44 | 45 | 'rs转json串 46 | 47 | Public Sub Test2() 48 | '#rs转json串: 49 | Set mHello = loader.LoadModel("Hello") 50 | Set rs = mHello.getAll 51 | Set jsa = New Class_Ext_Json 52 | jsa.setKind = "array" 53 | While Not (rs.EOF Or rs.BOF) 54 | Set jsa(Null) = New Class_Ext_Json 55 | jsa(Null).setKind = "object" 56 | For Each col In rs.Fields 57 | jsa(Null)(col.Name) = col.Value 58 | Next 59 | rs.MoveNext 60 | Wend 61 | str=jsa.ToString 62 | Set jsa=nothing 63 | rs.close 64 | set rs = nothing 65 | set mHello = nothing 66 | '## 67 | wts.responses.SetContentType="application/json" 68 | wts.responses.SetOutput str 69 | 70 | End Sub 71 | 72 | '可增强 73 | 74 | Private Sub Test4() 75 | '#json串解析: 76 | str="{""a"":""1"",""b"":""2"",""c"":""3"",d:[5,{a1:{a1:11,a2:22222,a3:33}},7,8,9],e:{f:10,g:11}}" 77 | ' 78 | Set jt = loader.LoadClass("Ext/JsonT") 79 | Set jo = jt.getJSONObject(str) 80 | wts.responses.SetOutput jt.getJSArrayItem(jo.d,1).a1.a2 81 | Set jo = Nothing 82 | Set jt = Nothing 83 | '## 84 | End Sub 85 | 86 | End Class 87 | %> -------------------------------------------------------------------------------- /inc/class/ext/jmail.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_JMail 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 邮件类 JMAIL.Message 6 | 7 | Class Class_Ext_JMail 8 | 9 | Private isDebug_ 10 | Private mailObject_ 11 | Private mailServer_ 12 | 13 | '@isDebug: 是否设置为调试模式 14 | 15 | Public Property Let isDebug(Value) 16 | isDebug_ = Value 17 | End Property 18 | 19 | Private Sub Class_Initialize 20 | On Error Resume Next 21 | If IsEmpty(DEBUGS) Then 22 | isDebug_ = False 23 | Else 24 | isDebug_ = DEBUGS 25 | End If 26 | ' 27 | Set mailObject_ = Server.CreateObject("JMAIL.Message") 28 | ' 29 | If Err Then OutErr("No JMAIL.Message:"&Err.Description) 30 | End Sub 31 | 32 | Private Sub Class_Terminate 33 | Set mailObject_ = Nothing 34 | End Sub 35 | 36 | '@Setting(ByRef mServer,ByRef mPort,ByRef mSSL,ByRef mUserName,ByRef mPassword): 配置服务器 37 | 38 | Public Function Setting(ByRef mServer,ByRef mPort,ByRef mSSL,ByRef mUserName,ByRef mPassword) 39 | mailObject_.Charset="utf-8" '邮件编码 40 | mailObject_.silent=true 41 | mailObject_.ContentType = "text/html" '邮件正文格式 42 | 43 | mailServer_ = mServer 44 | 'mailObject_.ServerAddress= mServer '用来发送邮件的SMTP服务器 45 | mailObject_.MailServerUserName = mUserName '登录用户名 46 | mailObject_.MailServerPassWord = mPassword '登录密码 47 | mailObject_.MailDomain = MailDomain '域名（如果用“name@domain.com”这样的用户名登录时，请指明domain.com 48 | End Function 49 | 50 | '@Send(ByRef toMail,ByRef toName,ByRef subject,ByRef body,ByRef fromName,ByRef fromMail,ByRef priority): 发送邮件 51 | 52 | Public Function Send(ByRef toMail,ByRef toName,ByRef subject,ByRef body,ByRef fromName,ByRef fromMail,ByRef priority) 53 | On Error Resume Next 54 | Dim er 55 | Send = True 56 | ' 57 | With mailObject_ 58 | .AddRecipient toMail,toName '收信人 59 | .Subject=subject '主题 60 | '.HMTLBody=body '邮件正文（HTML格式） 61 | .Body=body '邮件正文（纯文本格式） 62 | .FromName=fromName '发信人姓名 63 | .From = fromMail '发信人Email 64 | .Priority=priority '邮件等级，1为加急，3为普通，5为低级 65 | .Send(mailServer_) 66 | er =.ErrorMessage 67 | End With 68 | ' 69 | If er <> "" Then 70 | Send = False 71 | OutErr("Send Mail Fail:"&er) 72 | End If 73 | End Function 74 | 75 | 'Err 76 | 77 | Private Sub OutErr(ByRef str) 78 | Err.clear 79 | If IsDebug_ = true Then 80 | Response.charset = "utf-8" 81 | Response.Write str 82 | Response.End 83 | End If 84 | End Sub 85 | 86 | End Class 87 | %> -------------------------------------------------------------------------------- /inc/class/crypt/sha.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Sha 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: SHA,HMACSHA加密 6 | 7 | Class Class_Crypt_Sha 8 | 9 | Private TAsc 10 | 11 | Private Sub Class_Initialize() 12 | Set TAsc = Server.CreateObject("System.Text.UTF8Encoding") 13 | End Sub 14 | 15 | Private Sub Class_Terminate() 16 | Set TAsc = Nothing 17 | End Sub 18 | 19 | '@SHA1(ByRef Str): SHA1 20 | 21 | Function SHA1(ByRef Str) 22 | Dim Enc,Bytes,objXML,objXMLNode,Outstr 23 | 'Borrow some objects from .NET (supported from 1.1 onwards) 24 | Set Enc = Server.CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider") 25 | 'Convert the string to a byte array and hash it 26 | Bytes = TAsc.GetBytes_4(Str) 27 | SHA1 = Enc.ComputeHash_2((Bytes)) 28 | Set Enc = Nothing 29 | End Function 30 | 31 | '@SHA256(ByRef Str): SHA256 32 | 33 | Function SHA256(ByRef Str) 34 | Dim Enc,Bytes,objXML,objXMLNode,Outstr 35 | 'Borrow some objects from .NET (supported from 1.1 onwards) 36 | Set Enc = Server.CreateObject("System.Security.Cryptography.SHA256Managed") 37 | 'Convert the string to a byte array and hash it 38 | Bytes = TAsc.GetBytes_4(Str) 39 | SHA256 = Enc.ComputeHash_2((Bytes)) 40 | Set Enc = Nothing 41 | End Function 42 | 43 | '@SHA512(ByRef Str): SHA512 44 | 45 | Function SHA512(ByRef Str) 46 | Dim Enc,Bytes,objXML,objXMLNode,Outstr 47 | 'Borrow some objects from .NET (supported from 1.1 onwards) 48 | Set Enc = Server.CreateObject("System.Security.Cryptography.SHA512Managed") 49 | 'Convert the string to a byte array and hash it 50 | Bytes = TAsc.GetBytes_4(Str) 51 | SHA512 = Enc.ComputeHash_2((Bytes)) 52 | Set Enc = Nothing 53 | End Function 54 | 55 | '@HMACSHA1(ByRef Str,ByRef Key): HMACSHA1 56 | 57 | Function HMACSHA1(ByRef Str,ByRef Key) 58 | Dim Enc,Bytes 59 | 'Borrow some objects from .NET (supported from 1.1 onwards) 60 | Set Enc = Server.CreateObject("System.Security.Cryptography.HMACSHA1") 61 | 'Convert the string to a byte array and hash it 62 | Enc.Key = TAsc.GetBytes_4(Key) 63 | Bytes = TAsc.GetBytes_4(Str) 64 | HMACSHA1 = Enc.ComputeHash_2((Bytes)) 65 | Set Enc = Nothing 66 | End Function 67 | 68 | '@HMACSHA256(ByRef Str,ByRef Key): HMACSHA256 69 | 70 | Function HMACSHA256(ByRef Str,ByRef Key) 71 | Dim Enc,Bytes 72 | 'Borrow some objects from .NET (supported from 1.1 onwards) 73 | Set Enc = Server.CreateObject("System.Security.Cryptography.HMACSHA256") 74 | 'Convert the string to a byte array and hash it 75 | Enc.Key = TAsc.GetBytes_4(Key) 76 | Bytes = TAsc.GetBytes_4(Str) 77 | HMACSHA256 = Enc.ComputeHash_2((Bytes)) 78 | Set Enc = Nothing 79 | End Function 80 | 81 | '@HMACSHA512(ByRef Str,ByRef Key): HMACSHA512 82 | 83 | Function HMACSHA512(ByRef Str,ByRef Key) 84 | Dim Enc,Bytes 85 | 'Borrow some objects from .NET (supported from 1.1 onwards) 86 | Set Enc = Server.CreateObject("System.Security.Cryptography.HMACSHA512") 87 | 'Convert the string to a byte array and hash it 88 | Enc.Key = TAsc.GetBytes_4(Key) 89 | Bytes = TAsc.GetBytes_4(Str) 90 | HMACSHA512 = Enc.ComputeHash_2((Bytes)) 91 | Set Enc = Nothing 92 | End Function 93 | 94 | End Class 95 | %> -------------------------------------------------------------------------------- /inc/class/ext/mail.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Mail 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 邮件类 CDO.Message 6 | 7 | Class Class_Ext_Mail 8 | 9 | Private isDebug_ 10 | Private mailObject_ 11 | Private objConfig_ 12 | Private fields_ 13 | 14 | '@isDebug: 是否设置为调试模式 15 | 16 | Public Property Let isDebug(Values) 17 | isDebug_ = Values 18 | End Property 19 | 20 | Private Sub Class_Initialize 21 | On Error Resume Next 22 | If IsEmpty(DEBUGS) Then 23 | isDebug_ = False 24 | Else 25 | isDebug_ = DEBUGS 26 | End If 27 | ' 28 | Set mailObject_ = Server.CreateObject("CDO.Message") 29 | Set objConfig_ = Server.CreateObject ("CDO.Configuration") 30 | Set fields_ = objConfig_.fields 31 | ' 32 | If Err Then OutErr("No CDO.Message:"&Err.Description) 33 | End Sub 34 | 35 | Private Sub Class_Terminate 36 | Set fields_ = Nothing 37 | Set objConfig_ = Nothing 38 | Set mailObject_ = Nothing 39 | End Sub 40 | 41 | '@Setting(ByRef mServer,ByRef mPort,ByRef mSSL,ByRef mUserName,ByRef mPassword): 配置服务器 42 | 43 | Public Function Setting(ByRef mServer,ByRef mPort,ByRef mSSL,ByRef mUserName,ByRef mPassword) 44 | With fields_ 45 | .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 '使用网络服务器还是本地服务 46 | .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServer '服务器地址 47 | .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mPort '465谷歌端口,正常25器 48 | .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 '服务器认证方式 49 | .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL '是否使用SSL 1或true为启用 50 | .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mUserName '发件人邮箱 51 | .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mPassword '发人邮箱密码 52 | .Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = "UTF-8" 53 | .Update() 54 | End With 55 | Set mailObject_.Configuration = objConfig_ 56 | End Function 57 | 58 | '@Send(ByRef toMail,ByRef toName,ByRef subject,ByRef body,ByRef fromName,ByRef fromMail,ByRef priority): 发送邮件 59 | 60 | Public Function Send(ByRef toMail,ByRef toName,ByRef subject,ByRef body,ByRef fromName,ByRef fromMail,ByRef priority) 61 | On Error Resume Next 62 | Send = True 63 | If fromName <> "" Then 64 | fm = """" & fromName & """ <" & Trim(fromMail) & ">" 65 | Else 66 | fm = fromMail 67 | End If 68 | ' 69 | With mailObject_ 70 | .Subject = subject 71 | .From = fm 72 | .To = toMail 73 | .HTMLBody = body 'HTML 網頁格式信件 74 | '.CC = strYouEmail '副本 75 | '.BCC = strYouEmail '密件副本 76 | '.TextBody = "信件內容" '文字格式信件內容 77 | '.AddAttachment(http://xxxxxx/xxxx.xxx) '或者其他任何正确的url,包括http,ftp,file等等。 78 | .Send 79 | End With 80 | ' 81 | If Err Then 82 | Send = False 83 | OutErr("Send Mail Fail:"&Err.Description) 84 | End If 85 | End Function 86 | 87 | 'Err 88 | 89 | Private Sub OutErr(str) 90 | Err.clear 91 | If IsDebug_ = true Then 92 | Response.charset = "utf-8" 93 | Response.Write str 94 | Response.End 95 | End If 96 | End Sub 97 | 98 | End Class 99 | %> -------------------------------------------------------------------------------- /inc/module/default/control/start/route/key.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Start_Route_Key 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: Keyword路由 6 | 7 | Class Control_Start_Route_Key 8 | 9 | Private route_ 10 | Private tempKeys_ 11 | Private tempDKeys_ 12 | 13 | '@route: route对象依赖 14 | 15 | Public Property Let route(Value) 16 | Set route_ = Value 17 | End Property 18 | 19 | Public Property Let tempkeys(Value) 20 | Set tempkeys_ = Value 21 | End Property 22 | 23 | Private Sub Class_Initialize() 24 | Set tempKeys_ = Server.CreateObject("Scripting.Dictionary") 25 | Set tempDKeys_ = Server.CreateObject("Scripting.Dictionary") 26 | End Sub 27 | 28 | Private Sub Class_Terminate() 29 | Set tempDKeys_ = Nothing 30 | Set tempKeys_ = Nothing 31 | End Sub 32 | 33 | '@DeWrite(ByVal r_path): 解码 34 | 35 | Public Sub DeWrite(ByVal r_path) 36 | If tempkeys_.Exists(r_path) Then 37 | r_path = tempkeys_(r_path) 38 | '调用SLASH路由 39 | If IsObject(route_("slash")) Then route_("slash").Dewrite r_path 40 | End If 41 | End Sub 42 | 43 | '@ReWrite(ByVal str): 编码 keyword只编码module/id/1,其余部分仍然动态参数 44 | 45 | Public Function ReWrite(ByVal str) 46 | Dim i, arr, arr_j 47 | Dim str_route, str_id, str_para 48 | Dim r_path 49 | ' 50 | If tempkeys_.Count = 0 Then Exit Function 51 | '去index.asp 52 | If InStr(str, "?")>0 Then 53 | str = Right(str, Len(str) - InStr(str, "?")) 54 | End If 55 | '拆参数 56 | arr = Split(str, "&") 57 | For i = 0 To UBound(arr) 58 | If arr(i)<> "" Then 59 | arr_j = Split(arr(i), "=") 60 | If UBound(arr_j) = 1 Then 61 | If arr_j(0)<>"" And arr_j(1)<>"" Then 62 | If arr_j(0) = "route" Then 63 | str_route = arr_j(1) 64 | ElseIf arr_j(0) = "id" Then 65 | str_id = arr_j(1) 66 | Else 67 | If str_para = "" Then 68 | str_para = arr_j(0)&"="&arr_j(1) 69 | Else 70 | str_para = str_para&"&"&arr_j(0)&"="&arr_j(1) 71 | End If 72 | End If 73 | End If 74 | End If 75 | End If 76 | Next 77 | '路由名+id 78 | If str_route<>"" Then r_path = str_route 79 | If str_id<>"" Then r_path = r_path&"/id/"&str_id 80 | '重写+参数 81 | If tempDKeys_.Exists(r_path) Then 82 | r_path = tempDKeys_(r_path) 83 | If str_para<>"" Then r_path = r_path&"?"&str_para 84 | ReWrite = r_path 85 | End If 86 | End Function 87 | 88 | '@SetUrlKey(ByRef Keys,ByRef values): 设置编码键值 89 | 90 | Public Sub SetUrlKey(Byref keys,Byref values) 91 | tempKeys_(keys) = values 92 | End Sub 93 | 94 | '@SetDUrlKey(Byref Keys,Byref values): 设置解码键值 95 | 96 | Public Sub SetDUrlKey(Byref Keys,Byref values) 97 | tempDKeys_(keys) = values 98 | End Sub 99 | 100 | End Class 101 | %> -------------------------------------------------------------------------------- /inc/module/help/view/help.htm: -------------------------------------------------------------------------------- 1 | {include inc/header.htm} 2 | 6 | 7 | 116 |
8 | 9 | {if list} 10 | {loop list} 11 | 12 | {loop_body start} 13 | 14 | {loop_body end} 15 |
{list/name} {list/select}
16 | {end loop} 17 | {end if} 18 | 19 | 		20 | 21 | {if tag_frame} 22 | 23 |

WTS Framework

24 |

ASP基于对象的MVCL框架

25 |

编码: UTF-8带BOM

26 |

流程: request => route => module/control/action (model,view,language) => response

27 |

启动: inc/wts.start() => inc/module/---/control/start/site.start() => ...

28 |

架构:

29 |
    30 |
  1. index.asp 　单入口文件,IIS404,405指向这里
    2. 31 |
32 |
    33 |
  1. inc/ 存放程序信息
    2. 34 |
  2. inc/config.bak.asp 第一次使用需复制 inc/config.bak.asp 为 inc/config.asp
    3. 35 |
  3. inc/config.asp 全局配置文件,程序必须的路径及全局常量,变量
    4. 36 |
  4. inc/wts.asp　 框架核心类
    5. 37 |
  5. inc/class/　 类库文件
    6. 38 |
  6. inc/module/　 MVCL模块程序文件
    7. 39 |
40 |
    41 |
  1. data/ 存放数据信息
    2. 42 |
  2. data/cache/ 缓存文件
    3. 43 |
  3. data/db/ 数据库
    4. 44 |
  4. data/log/ 日志
    5. 45 |
  5. data/pic/ 图像多媒体
    6. 46 |
  6. data/static/ 网站静态css,js,icon...
    7. 47 |
48 |
    49 |
  1. app/ 对应inc/,书写新代码或重写系统核心代码
    2. 50 |
51 |
    52 |
  1. 程序及数据文件路径可以通过config配置进行更改
    2. 53 |
  2. 类库和程序文件, 基于对象封装, 加载包含执行通过loader对象实现, 简单去耦合
    3. 54 |
55 | 56 |

建议权限:

57 | 58 | 59 | 60 | 61 |
类型index.aspinc/data/data/db/
windows读读读写－
IIS读,运行无读无
62 | 63 | {end if} 64 | 65 | {if head} 66 |

类描述

67 | {loop head} 68 | 69 | {loop_body start} 70 | 71 | {loop_body end} 72 |
{head/name}{head/content}
73 | {end loop} 74 | {end if} 75 | 76 | {if proper} 77 |

类属性

78 | {loop proper} 79 | 80 | {loop_body start} 81 | 82 | {loop_body end} 83 |
{proper/name}{proper/content}
84 | {end loop} 85 | {end if} 86 | 87 | {if func} 88 |

类方法

89 | {loop func} 90 | 91 | {loop_body start} 92 | 93 | {loop_body end} 94 |
{func/name}{func/content}
95 | {end loop} 96 | {end if} 97 | 98 | {if tag_help} 99 |

返回

100 | {end if} 101 | 102 | {if example} 103 |

{loop example}

104 | {loop_body start} 105 |
106 | {example/name} 107 | 
108 |         {example/content}
109 |
110 |
111 | {loop_body end} 112 | {end loop} 113 | {end if} 114 | 115 |
117 | {include inc/footer.htm} -------------------------------------------------------------------------------- /inc/class/cookie.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Cookie 3 | '@author: ekede.com 4 | '@date: 2017-12-6 5 | '@description: Cookie对象 6 | 7 | Class Class_Cookie 8 | 9 | Private path_ 10 | Private domain_ 11 | Private expire_ 12 | Private encode_ 13 | 14 | '@path: cookie路径 15 | 16 | Public Property Get path 17 | Set path = path_ 18 | End Property 19 | 20 | '@domain: cookie域名 21 | 22 | Public Property Let domain(Values) 23 | Set domain_ = Values 24 | End Property 25 | 26 | '@expire: cookie过期时间 27 | 28 | Public Property Let expire(Values) 29 | Set expire_ = Values 30 | End Property 31 | 32 | '@encode: cookie加密 33 | 34 | Public Property Let encode(Values) 35 | encode_ = Values 36 | End Property 37 | 38 | Private Sub Class_Initialize() 39 | 'path_=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/")) 40 | 'expire_=Date+1 41 | encode_=False 42 | End Sub 43 | Private Sub class_terminate() 44 | End Sub 45 | 46 | '--------------------------------- Server cookie 47 | 48 | '@GetC(ByRef k1,ByRef k2): 读 49 | 50 | Public Function GetC(ByRef k1,ByRef k2) 51 | Dim v 52 | If k2 = "" Then 53 | v = Request.Cookies(k1) 54 | Else 55 | v = Request.Cookies(k1)(k2) 56 | End If 57 | If encode_ = True Then 58 | GetC = DecodeC(v) 59 | Else 60 | GetC = v 61 | End If 62 | End Function 63 | 64 | '@SetC(ByRef k1,ByRef k2,ByVal v,ByVal d,ByVal p,ByVal e): 写 -key1,key2,Value,Domain,Path,Expires 65 | 66 | Public Sub SetC(ByRef k1,ByRef k2,ByVal v,ByVal d,ByVal p,ByVal e) 67 | If encode_ = True Then v = EncodeC(v) 68 | ' 69 | If k2 = "" Then 70 | Response.Cookies(k1) = v 71 | Else 72 | Response.Cookies(k1)(k2) = v 73 | End If 74 | ' 75 | If d="" And domain_ <> "" Then d = domain_ 76 | If d<>"" Then Response.Cookies(k1).Domain= d 77 | ' 78 | If p="" And path_ <> "" Then p = path_ 79 | If p<>"" Then Response.Cookies(k1).Path= p 80 | ' 81 | If e="" And expire_ <> "" Then e = expire_ 82 | If e<>"" Then Response.Cookies(k1).Expires = e 83 | End Sub 84 | 85 | '@DelC(ByRef k1,ByRef k2,ByRef d,ByRef p): 删 86 | 87 | Public Sub DelC(ByRef k1,ByRef k2,ByRef d,ByRef p) 88 | If k2 <> "" Then 89 | SetC k1,k2,"",d,p,"" 90 | Else 91 | SetC k1,"","",d,p,(Now()-1) 92 | End If 93 | End Sub 94 | 95 | '@CleanC(ByRef d,ByRef p): 清 96 | 97 | Public Sub CleanC(ByRef d,ByRef p) 98 | For Each k In Request.Cookies 99 | DelC k,"",d,p 100 | Next 101 | End Sub 102 | 103 | '编码cookies, 编码处理后的信息，字符以"a"隔开 104 | 105 | Private Function EncodeC(ByRef contentStr) 106 | Dim i,returnStr 107 | For i = Len(contentStr) to 1 Step -1 108 | returnStr = returnStr & Ascw(Mid(contentStr,i,1)) 109 | If (i <> 1) Then returnStr = returnStr & "a" 110 | Next 111 | EncodeC = returnStr 112 | End Function 113 | 114 | '解码cookies ,解码处理后的信息 115 | 116 | Private Function DecodeC(ByRef contentStr) 117 | Dim i 118 | Dim StrArr,StrRtn 119 | StrArr = Split(contentStr,"a") 120 | For i = 0 to UBound(StrArr) 121 | If isNumeric(StrArr(i)) = True Then 122 | StrRtn = Chrw(StrArr(i)) & StrRtn 123 | Else 124 | StrRtn = contentStr 125 | Exit Function 126 | End If 127 | Next 128 | DecodeC = StrRtn 129 | End Function 130 | 131 | End Class 132 | %> -------------------------------------------------------------------------------- /inc/class/ext/verify.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Verify 3 | '@author: Gerrit van Kuipers 4 | '@date: 2017-12-7 5 | '@description: aspJSON Februari 2014 - Version 1.17 by 6 | 7 | Class Class_Ext_Verify 8 | 9 | Private sn_ 10 | 11 | '@sn: 设置验证码session名 12 | Public Property Let sn(Value) 13 | sn_= Value 14 | End Property 15 | 16 | '@output: 输出验证码图片 17 | Public Property Get output() 18 | If sn_ = "" Then sn_ = "verifycode" 19 | 'Response.buffer=true 20 | ' 禁止缓存 21 | Response.Expires = -9999 22 | Response.AddHeader "Pragma","no-cache" 23 | Response.AddHeader "cache-ctrol","no-cache" 24 | Response.ContentType = "Image/BMP" 25 | 26 | Randomize 27 | 28 | Dim i, ii, iii 29 | 30 | Const cOdds = 2 ' 杂点出现的机率 31 | Const cAmount = 10 ' 文字数量 32 | Const cCode = "0123456789" 33 | 34 | ' 颜色的数据(字符，背景) 35 | Dim vColorData(1) 36 | vColorData(0) = ChrB(0) & ChrB(0) & ChrB(211) ' 蓝0，绿0，红0（黑色） 37 | vColorData(1) = ChrB(255) & ChrB(255) & ChrB(255) ' 蓝250，绿236，红211（浅蓝色） 38 | 39 | ' 随机产生字符 40 | Dim vCode(4), vCodes 41 | For i = 0 To 3 42 | vCode(i) = Int(Rnd * cAmount) 43 | vCodes = vCodes & Mid(cCode, vCode(i) + 1, 1) 44 | Next 45 | Session(sn_) = vCodes '记录入Session 46 | ' 字符的数据 47 | Dim vNumberData(9) 48 | vNumberData(0) ="1110000111110111101111011110111101001011110100101111010010111101001011110111101111011110111110000111" 49 | vNumberData(1) ="1111011111110001111111110111111111011111111101111111110111111111011111111101111111110111111100000111" 50 | vNumberData(2) ="1110000111110111101111011110111111111011111111011111111011111111011111111011111111011110111100000011" 51 | vNumberData(3) ="1110000111110111101111011110111111110111111100111111111101111111111011110111101111011110111110000111" 52 | vNumberData(4) ="1111101111111110111111110011111110101111110110111111011011111100000011111110111111111011111111000011" 53 | vNumberData(5) ="1100000011110111111111011111111101000111110011101111111110111111111011110111101111011110111110000111" 54 | vNumberData(6) ="1111000111111011101111011111111101111111110100011111001110111101111011110111101111011110111110000111" 55 | vNumberData(7) ="1100000011110111011111011101111111101111111110111111110111111111011111111101111111110111111111011111" 56 | vNumberData(8) ="1110000111110111101111011110111101111011111000011111101101111101111011110111101111011110111110000111" 57 | vNumberData(9) ="1110001111110111011111011110111101111011110111001111100010111111111011111111101111011101111110001111" 58 | ' 输出图像文件头 59 | Response.BinaryWrite ChrB(66) & ChrB(77) & ChrB(230) & ChrB(4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_ 60 | ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) &_ 61 | ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(10) & ChrB(0) &_ 62 | ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0) 63 | 64 | ' 输出图像信息头 65 | Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(176) & ChrB(4) &_ 66 | ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) &_ 67 | ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_ 68 | ChrB(0) & ChrB(0) 69 | 70 | For i = 9 To 0 Step -1 ' 历经所有行 71 | For ii = 0 To 3 ' 历经所有字 72 | For iii = 1 To 10 ' 历经所有像素 73 | ' 逐行、逐字、逐像素地输出图像数据 74 | If Rnd * 99 + 1 < cOdds Then ' 随机生成杂点 75 | Response.BinaryWrite vColorData(0) 76 | Else 77 | Response.BinaryWrite vColorData(Mid(vNumberData(vCode(ii)), i * 10 + iii, 1)) 78 | End If 79 | Next 80 | Next 81 | Next 82 | Response.end 83 | End Property 84 | 85 | End Class 86 | %> -------------------------------------------------------------------------------- /inc/wts.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Framework_Wts 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: WTS框架 6 | 7 | Class Framework_Wts 8 | 9 | '@fun: 对象 10 | '@fso: 对象 11 | '@errs: 对象 12 | '@valid: 对象 13 | '@logs: 对象 14 | '@cache: 对象 15 | '@cookie: 对象 16 | '@sessions: 对象 17 | '@requests: 对象 18 | '@responses: 对象 19 | '@route: 对象 20 | '@db: 对象 21 | '@template: 对象 22 | '@site: 对象 23 | 24 | Dim fun 25 | Dim fso 26 | Dim errs 27 | Dim valid 28 | Dim logs 29 | Dim cache 30 | Dim cookie 31 | Dim sessions 32 | Dim requests 33 | Dim responses 34 | Dim route 35 | Dim db 36 | Dim template 37 | Dim site 38 | 39 | Private attr_ 40 | Private zone_ 41 | Private times_ 42 | 43 | '@version: 版本 44 | 45 | Public Property Get version 46 | Version = "1.0.0" 47 | End Property 48 | 49 | '@zone: 时区 50 | 51 | Public Property Get zone 52 | zone = zone_ 53 | End Property 54 | 55 | '@times: 时间 56 | 57 | Public Property Get times 58 | times = times_ 59 | End Property 60 | 61 | '@attr: 自定义属性 attr(k)=v 62 | 63 | Public Property Let attr(k, v) 64 | If IsObject(v) Then 65 | Set attr_(k) = v 66 | Else 67 | attr_(k) = v 68 | End If 69 | End Property 70 | 71 | Public Default Property Get attr(k) 72 | If IsObject(attr_(k)) Then 73 | Set attr = attr_(k) 74 | Else 75 | attr = attr_(k) 76 | End If 77 | End Property 78 | 79 | Private Sub Class_Initialize() 80 | zone_ = 8 81 | times_ = Now() 82 | Set attr_ = Server.CreateObject("Scripting.Dictionary") 83 | End Sub 84 | Private Sub Class_Terminate() 85 | Set attr_ = Nothing 86 | End Sub 87 | 88 | '@Start():启动框架 89 | 90 | Public Sub Start() 91 | 92 | 'loader 类库路径配置 93 | loader.classPath = PATH_CLASS 94 | 95 | '全局对象 96 | Set fun = loader.LoadClass("Function") 97 | Set fso = loader.LoadClass("Fso") 98 | 99 | Set logs = loader.LoadClass("Log") 100 | logs.fso = fso 101 | logs.LogPath = PATH_DATA&"logs/" 102 | 103 | Set errs = loader.LoadClass("Error") 104 | errs.loader = loader 105 | 106 | Set valid = loader.LoadClass("Valid") 107 | valid.errs = errs 108 | 109 | Set cookie = loader.LoadClass("Cookie") 110 | Set sessions = Loader.LoadClass("Session") 111 | Set requests = loader.LoadClass("Request") 112 | Set responses = loader.LoadClass("Response") 113 | 114 | Set route = loader.LoadClass("Route") 115 | route.fun = fun 116 | route.loader = loader 117 | route.requests = requests 118 | route.modules = MODULES 119 | route.start() 120 | route.GetModule() 121 | 122 | 'loader MVCL默认路径配置 123 | loader.controlPath = PATH_MODULE&route.module&"/"&PATH_CONTROL 124 | loader.modelPath = PATH_MODULE&route.module&"/"&PATH_MODEL 125 | loader.languagePath = PATH_MODULE&route.module&"/"&PATH_LANGUAGE '&language_path 126 | loader.templatePath = PATH_MODULE&route.module&"/"&PATH_VIEW '&view_path 127 | 128 | '交接start 129 | Set site = loader.loadControl("Start/Site") 130 | site.start() 131 | Set site = Nothing 132 | 133 | End Sub 134 | 135 | '@Finish():释放框架 136 | 137 | Public Sub Finish() 138 | '释放对象 139 | Set route = Nothing 140 | Set responses = Nothing 141 | Set requests = Nothing 142 | Set sessions = Nothing 143 | Set cookie = Nothing 144 | Set valid = Nothing 145 | Set errs = Nothing 146 | Set logs = Nothing 147 | Set fso = Nothing 148 | Set fun = Nothing 149 | End Sub 150 | 151 | End Class 152 | %> -------------------------------------------------------------------------------- /inc/class/route/slash.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Route_Slash 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 斜线路由 6 | 7 | Class Class_Route_Slash 8 | 9 | Private route_ 10 | 11 | '@route: route对象依赖 12 | 13 | Public Property Let route(Value) 14 | Set route_ = Value 15 | End Property 16 | 17 | '@DeWrite(ByVal r_path): 解码 18 | 19 | Public Sub DeWrite(ByVal r_path) 20 | Dim i, c, c_path, j, k 21 | Dim temp_array 22 | ' 23 | If r_path = "" Then 24 | 'route_.module = "default" '默认模块为当前模块 25 | c_path = PATH_MODULE&route_.module&"/"&PATH_CONTROL 26 | c = "index" 27 | If route_.loader.LoadFile(c_path&c&".asp")<> -1 Then route_.control = c '--loader 28 | route_.dewrite_on = true 29 | Exit Sub 30 | End If 31 | ' 32 | temp_array = Split(r_path, "/") 33 | For i = 0 To UBound(temp_array) 34 | If temp_array(i) = "" Then 35 | '空斜线跳过 36 | Else 37 | If i = 0 Then 38 | r_path = temp_array(0) 39 | If route_.fun.StrEqual(r_path, route_.modules,",") Then 40 | 'route_.module = temp_array(0) '即使有匹配模块也跳过 41 | c_path = PATH_MODULE&route_.module&"/"&PATH_CONTROL 42 | Else 43 | 'route_.module = "default" '默认模块为当前模块 44 | c_path = PATH_MODULE&route_.module&"/"&PATH_CONTROL 45 | c = temp_array(0) 46 | If route_.loader.LoadFile(c_path&c&".asp")<> -1 Then route_.control = c '--loader 47 | k = 1 48 | End If 49 | Else 50 | If route_.control = "" Then 51 | If c = "" Then 52 | c = temp_array(i) 53 | Else 54 | c = c&"/"&temp_array(i) 55 | End If 56 | If route_.loader.LoadFile(c_path&c&".asp")<> -1 Then route_.control = c '--loader 57 | k = 1 58 | Else 59 | If route_.action = "" Then 60 | route_.action = temp_array(i) 61 | j = 0 62 | Else 63 | j = j + 1 64 | If j = 2 Then 65 | route_.requests.querystr(temp_array(i -1)) = temp_array(i) '++query 66 | j = 0 67 | End If 68 | End If 69 | End If 70 | End If 71 | End If 72 | Next 73 | '未做控制器判断,查看默认控制器是否存在 74 | If route_.control="" And k <> 1 Then 75 | c = "index" 76 | If route_.loader.LoadFile(c_path&c&".asp")<> -1 Then route_.control = c '--loader 77 | End If 78 | ' 79 | If route_.control<>"" Then route_.dewrite_on = true 80 | End Sub 81 | 82 | '@ReWrite(ByRef str): 编码 83 | 84 | Public Function ReWrite(ByRef str) 85 | If InStr(str, "?")>0 Then 86 | ReWrite = Add_Slash(Right(str, Len(str) - InStr(str, "?"))) 87 | Else 88 | ReWrite = str 89 | End If 90 | End Function 91 | 92 | Private Function Add_Slash(ByRef Web_Query) 93 | Dim i, j, arr, arr_j, str, str_route 94 | arr = Split(Web_Query, "&") 95 | For i = 0 To UBound(arr) 96 | If arr(i)<> "" Then 97 | arr_j = Split(arr(i), "=") 98 | If UBound(arr_j) = 1 Then 99 | If arr_j(0)<>"" And arr_j(1)<>"" Then 100 | If arr_j(0) = "route" Then 101 | str_route = arr_j(1) 102 | ElseIf arr_j(0) = "urlkey" Then 103 | '排除 104 | Else 105 | If str = "" Then 106 | str = arr_j(0)&"/"&arr_j(1) 107 | Else 108 | str = str&"/"&arr_j(0)&"/"&arr_j(1) 109 | End If 110 | End If 111 | End If 112 | End If 113 | End If 114 | Next 115 | if str="" then 116 | Add_Slash = str_route 117 | else 118 | Add_Slash = str_route&"/"&str 119 | end if 120 | End Function 121 | 122 | End Class 123 | %> -------------------------------------------------------------------------------- /inc/class/crypt/num.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Num 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 进制转换 binary二进制,decimal十进制,octal八进制,hexadecimal十六 6 | 7 | Class Class_Crypt_Num 8 | 9 | '@CBit(num): 十进制转二进制 10 | 11 | Public Function CBit(num) 12 | cBitstr = "" 13 | If Len(num)>0 And IsNumeric(num) Then 14 | Do While Not num \ 2 < 1 15 | cBitstr = (num Mod 2) &cBitstr 16 | num = num \ 2 17 | Loop 18 | End If 19 | CBit = num&cBitstr 20 | End Function 21 | 22 | '@CDec(num): 二进制转十进制 23 | 24 | Public Function CDec(num) 25 | cDecstr = 0 26 | If Len(num)>0 And IsNumeric(num) Then 27 | For inum = 0 To Len(num) -1 28 | cDecstr = cDecstr + 2^inum * CInt(Mid(num, Len(num) - inum, 1)) 29 | Next 30 | End If 31 | CDec = cDecstr 32 | End Function 33 | 34 | '@BcH(num): 二进制转十六进制 35 | 36 | Public Function BcH(num) 37 | BcH = Hex(cDec(num)) 38 | End Function 39 | 40 | '@HcB(num): 十六进制转二进制 41 | 42 | Public Function HcB(num) '字符串 43 | If Len(num)>0 Then 44 | HcBstr = "" 45 | For i = 1 To Len(num) 46 | Select Case (Mid(num, i, 1)) 47 | Case "0" HcBstr = HcBstr&"0000" 48 | Case "1" HcBstr = HcBstr&"0001" 49 | Case "2" HcBstr = HcBstr&"0010" 50 | Case "3" HcBstr = HcBstr&"0011" 51 | Case "4" HcBstr = HcBstr&"0100" 52 | Case "5" HcBstr = HcBstr&"0101" 53 | Case "6" HcBstr = HcBstr&"0110" 54 | Case "7" HcBstr = HcBstr&"0111" 55 | Case "8" HcBstr = HcBstr&"1000" 56 | Case "9" HcBstr = HcBstr&"1001" 57 | Case "A" HcBstr = HcBstr&"1010" 58 | Case "B" HcBstr = HcBstr&"1011" 59 | Case "C" HcBstr = HcBstr&"1100" 60 | Case "D" HcBstr = HcBstr&"1101" 61 | Case "E" HcBstr = HcBstr&"1110" 62 | Case "F" HcBstr = HcBstr&"1111" 63 | End Select 64 | Next 65 | End If 66 | HcB = HcBstr 67 | End Function 68 | 69 | '@OcB(num): 八进制转二进制 70 | 71 | Public Function OcB(num) 72 | OcBstr = "" 73 | If Len(num)>0 And IsNumeric(num) Then 74 | For i = 1 To Len(num) 75 | Select Case (Mid(num, i, 1)) 76 | Case "0" OcBstr = OcBstr&"000" 77 | Case "1" OcBstr = OcBstr&"001" 78 | Case "2" OcBstr = OcBstr&"010" 79 | Case "3" OcBstr = OcBstr&"011" 80 | Case "4" OcBstr = OcBstr&"100" 81 | Case "5" OcBstr = OcBstr&"101" 82 | Case "6" OcBstr = OcBstr&"110" 83 | Case "7" OcBstr = OcBstr&"111" 84 | End Select 85 | Next 86 | End If 87 | OcB = OcBstr 88 | End Function 89 | 90 | '@BcO(num): 二进制转八进制 91 | 92 | Public Function BcO(num) 93 | BcO = Oct(cDec(num)) 94 | End Function 95 | 96 | '@DcH(num): 十进制转十六进制 97 | 98 | Public Function DcH(num) 99 | DcH = Hex(num) 'system 100 | End Function 101 | 102 | '@HcD(num): 十六进制转十进制 103 | 104 | Public Function HcD(num) '字符串或者数字 105 | HcD = cDec(HcB(num)) 106 | End Function 107 | 108 | '@DcO(num): 十进制转八进制 109 | 110 | Public Function DcO(num) 111 | DcO = Oct(num) 'system 112 | End Function 113 | 114 | '@OcD(num): 八进制转十进制 115 | 116 | Public Function OcD(num) 117 | OcD = cDec(OcB(num)) 118 | End Function 119 | 120 | '@HcO(num): 十六进制转八进制 121 | 122 | Public Function HcO(num) 123 | HcO = Oct(HcD(num)) 124 | End Function 125 | 126 | '@OcH(num): 八进制转十六进制 127 | 128 | Public Function OcH(num) 129 | OcH = Hex(OcD(num)) 130 | End Function 131 | 132 | End Class 133 | %> -------------------------------------------------------------------------------- /inc/class/ext/date.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Date 3 | '@author: ekede.com 4 | '@date: 2017-02-23 5 | '@description: 时间类 6 | 7 | Class Class_Ext_Date 8 | 9 | Private dateTime_ 10 | Private zone_ 11 | 12 | Private Sub Class_Initialize 13 | dateTime_ = Now() 14 | zone_ = 8 15 | End Sub 16 | 17 | '@zone: 时区 18 | 19 | Public Property Get zone() 20 | zone = zone_ 21 | End Property 22 | 23 | Public Property Let zone(Value) 24 | If IsNumeric(Value) Then zone = Value 25 | End Property 26 | 27 | '@times: 时间 28 | 29 | Public Property Get times() 30 | times = dateTime_ 31 | End Property 32 | 33 | Public Property Let times(Value) 34 | If IsDate(Value) Then dataTime_ = CDate(Value) 35 | End Property 36 | 37 | '@unixTimes: 时间戳 38 | 39 | Public Property Get unixTimes() 40 | unixTimes = ToUnixTime(LocalTime(zone_, 0, dateTime_)) '转换为0时区日期,日期转时间戳 41 | End Property 42 | 43 | Public Property Let unixTimes(Value) 44 | If IsNumeric(Value) Then dateTime_ = LocalTime(0,zone_,FromUnixTime(Value)) '时间戳转0时区日期，0时区日期转当前时区日期 45 | End Property 46 | 47 | '@ToUnixTime(t): 0时区日期t 转 时间戳 48 | 49 | Public Function ToUnixTime(ByRef t) 50 | ToUnixTime = DateDiff("s", "1970-1-1 0:0:0", t) 51 | End Function 52 | 53 | '@FromUnixTime(t, z): 时间戳t 转 0时区日期 54 | 55 | Public Function FromUnixTime(ByRef t) 56 | FromUnixTime = DateAdd("s", t, "1970-1-1 0:0:0") 57 | End Function 58 | 59 | '@LocalTime(fz, tz, t): 转换时区时间 fz->tz 60 | 61 | Public Function LocalTime(ByRef fz, ByRef tz, ByRef t) 62 | LocalTime = DateAdd("h", (tz - fz), t) '时区相减 63 | End Function 64 | 65 | '@Week(d): 星期 66 | 67 | Public Function Week(ByRef d) 68 | temp = "Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday" 69 | temp = Split(temp, ",") 70 | Week = temp(Weekday(d) -1) 71 | End Function 72 | 73 | '@Zodiac(d): 生肖 74 | 75 | Public Function Zodiac(ByRef d) 76 | If IsDate(d) Then 77 | birthyear = Year(d) 78 | ZodiacList = Array("猴", "鸡", "狗", "猪", "鼠", "牛", "虎", "兔", "龙", "蛇", "马", "羊") 79 | Zodiac = ZodiacList(birthyear Mod 12) 80 | End If 81 | End Function 82 | 83 | '@Constellation(d): 星座 84 | 85 | Public Function Constellation(ByRef d) 86 | If IsDate(d) Then 87 | ConstellationMon = Month(d) 88 | ConstellationDay = Day(d) 89 | If Len(ConstellationMon)<2 Then ConstellationMon = "0"&ConstellationMon 90 | If Len(ConstellationDay)<2 Then ConstellationDay = "0"&ConstellationDay 91 | MyConstellation = ConstellationMon&ConstellationDay 92 | If MyConstellation < 0120 Then 93 | constellation = "魔羯座 Capricorn" 94 | ElseIf MyConstellation < 0219 Then 95 | constellation = "水瓶座 Aquarius" 96 | ElseIf MyConstellation < 0321 Then 97 | constellation = "双鱼座 Pisces" 98 | ElseIf MyConstellation < 0420 Then 99 | constellation = "白羊座 Aries" 100 | ElseIf MyConstellation < 0521 Then 101 | constellation = "金牛座 Taurus" 102 | ElseIf MyConstellation < 0622 Then 103 | constellation = "双子座 Gemini" 104 | ElseIf MyConstellation < 0723 Then 105 | constellation = "巨蟹座 Cancer" 106 | ElseIf MyConstellation < 0823 Then 107 | constellation = "狮子座 Leo" 108 | ElseIf MyConstellation < 0923 Then 109 | constellation = "处女座 Virgo" 110 | ElseIf MyConstellation < 1024 Then 111 | constellation = "天秤座 Libra" 112 | ElseIf MyConstellation < 1122 Then 113 | constellation = "天蝎座 Scorpio" 114 | ElseIf MyConstellation < 1222 Then 115 | constellation = "射手座 Sagittarius" 116 | ElseIf MyConstellation > 1221 Then 117 | constellation = "魔羯座 Capricorn" 118 | End If 119 | End If 120 | End Function 121 | 122 | End Class 123 | %> -------------------------------------------------------------------------------- /inc/class/pagelist.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_PageList 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 分页,翻页 6 | 7 | Class Class_PageList 8 | 9 | Private pageNum_ 10 | Private pageKey_ 11 | Private tempdata_ 12 | 13 | '@currentPage: 当前页 14 | 15 | Dim currentPage 16 | 17 | '@maxPerPage: 每页显示数 18 | 19 | Dim maxPerPage 20 | 21 | '@tempdata: 内容存放容器 22 | 23 | Public Property Let tempdata(Values) 24 | If VarType(Values) = 9 Then Set tempdata_ = Values 25 | End Property 26 | 27 | Private Sub Class_Initialize 28 | currentPage = 1 29 | maxPerPage = 10 30 | pageNum_ = 1 31 | Set tempdata_ = Server.CreateObject("Scripting.Dictionary") 32 | End Sub 33 | 34 | Private Sub Class_Terminate() 35 | Set tempdata_ = Nothing 36 | End Sub 37 | 38 | '@List(ByRef keys,ByRef Rs): 计算分页,将rs二维表抽象为一维存入dictionary对象,返回当前页条数 39 | 40 | Public Function List(ByRef keys,ByRef Rs) 41 | Dim n 42 | ' 43 | If keys = "" Then Exit Function 44 | pageKey_ = keys 45 | ' 46 | If Rs.EOF And Rs.bof Then 47 | n = 0 48 | Else 49 | Rs.Pagesize = MaxperPage 50 | pageNum_ = Rs.PageCount 51 | If currentPage>pageNum_ Then 52 | currentPage = pageNum_ 53 | n = 0 54 | Else 55 | Rs.Move (currentPage -1) * MaxperPage 56 | n = 0 57 | Do While Not rs.EOF 58 | For Each field In rs.fields 59 | tempdata_(keys&"/"&field.Name&"/"&n) = field.Value 60 | Next 61 | n = n + 1 62 | If n>= MaxPerPage Then Exit Do 63 | rs.movenext 64 | Loop 65 | End If 66 | tempdata_(keys) = n 67 | End If 68 | ' 69 | list = n 70 | End Function 71 | 72 | '@Plist(ByRef route, ByRef base, ByRef url): 生成翻页链接,保存在dictionary对象中,供模板loop读取 73 | 74 | Public Function Plist(ByRef route, ByRef base, ByRef url) 75 | Dim i,n 76 | n = 0 77 | ' 78 | PageUrl route, base, url, currentPage, Currentpage&"/"&pageNum_, 0 ,n 79 | n = n + 1 80 | 81 | '计算当前开始结束页 82 | naviLength = 5 83 | startPage = (currentPage \ naviLength) * naviLength + 1 84 | If (currentPage Mod naviLength) = 0 Then startPage = startPage - naviLength 85 | endPage = startPage + naviLength - 1 86 | If endPage>pageNum_ Then endPage = pageNum_ 87 | 88 | '前移分页 89 | If startPage>1 Then 90 | i = currentPage - (currentPage Mod naviLength) - naviLength + 1 91 | PageUrl route, base, url, i, "<<", 0 ,n 92 | n = n + 1 93 | End If 94 | '前移一页 95 | If currentPage <> 1 Then 96 | i = currentPage -1 97 | PageUrl route, base, url, i, "<", 0 ,n 98 | n = n + 1 99 | End If 100 | '当前分页 101 | For i = startPage To endPage 102 | If Currentpage = i Then 103 | PageUrl route, base, url, i, i, 1 ,n 104 | Else 105 | PageUrl route, base, url, i, i, 0 ,n 106 | End If 107 | n = n + 1 108 | Next 109 | '后移一页 110 | If currentPage <> pageNum_ Then 111 | i = currentPage + 1 112 | PageUrl route, base, url, i, ">", 0 ,n 113 | n = n + 1 114 | End If 115 | '后移分页 116 | If endPage pageNum_ Then i = pageNum_ 119 | PageUrl route, base, url, i, ">>", 0 ,n 120 | n = n + 1 121 | End If 122 | ' 123 | tempdata_(pageKey_&"_page") = n 124 | End Function 125 | 126 | 'link 127 | 128 | Private Function PageUrl(ByRef route,ByRef base,ByRef url,ByRef i,ByRef navi,ByRef selected,ByRef n) 129 | link = route.ReWrite(base,url&"&page="&i) 130 | tempdata_(pageKey_&"_page/link/"&n)=link 131 | tempdata_(pageKey_&"_page/num/"&n)=navi 132 | tempdata_(pageKey_&"_page/selected/"&n)=selected 133 | End Function 134 | 135 | End Class 136 | %> -------------------------------------------------------------------------------- /inc/module/default/control/start/route/pic.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Start_Route_Pic 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 图片路由 6 | 7 | Class Control_Start_Route_Pic 8 | 9 | Private route_ 10 | Private regEx 11 | 12 | '@route: route对象依赖 13 | 14 | Public Property Let route(Values) 15 | Set route_ = Values 16 | End Property 17 | 18 | Private Sub Class_Initialize() 19 | Set regEx = New RegExp 20 | End Sub 21 | 22 | Private Sub Class_Terminate() 23 | Set regEx = Nothing 24 | End Sub 25 | 26 | '@DeWrite(ByVal r_path): 解码 27 | 28 | Public Sub DeWrite(ByVal r_path) 29 | '解图片 30 | DeWrite_Static r_path 31 | If route_.dewrite_on Then Exit Sub 32 | '解静态 33 | DeWrite_Pic r_path 34 | End Sub 35 | 36 | 'DeWrite_Pic 37 | 38 | Private Sub DeWrite_Pic(ByVal r_path) 39 | if r_path="" Then Exit Sub 40 | regEx.Pattern = "^"&Replace(PATH_PIC&PATH_PIC_THUMBS, "/", "\/")&"([^\s]+\/|)([^\/]+)\.([0-9]+)x([0-9]+)\.(jpg|png|gif|bmp)(\?.*|)$" ' 设置模式。 41 | Set matches = regEx.Execute(r_path) 42 | If matches.Count>0 Then 43 | route_.requests.querystr("p_path") = matches(0).SubMatches(0) 44 | route_.requests.querystr("p_name") = matches(0).SubMatches(1) 45 | route_.requests.querystr("p_width") = matches(0).SubMatches(2) 46 | route_.requests.querystr("p_height") = matches(0).SubMatches(3) 47 | route_.requests.querystr("p_ext") = matches(0).SubMatches(4) 48 | ' 49 | c = "pic" 50 | If route_.loader.LoadFile(PATH_MODULE&route_.module&"/"&PATH_CONTROL&c&".asp")<> -1 Then 51 | route_.control = c 52 | route_.action = "index" 53 | route_.dewrite_on = true 54 | End If 55 | Else 56 | pageext = route_.fun.GetExt(r_path) 57 | If pageext = ".gif" Or pageext = ".jpg" Or pageext = ".png" Or pageext = ".bmp" Then 58 | c = "pic" 59 | If route_.loader.LoadFile(PATH_MODULE&module&"/"&PATH_CONTROL&c&".asp")<> -1 Then 60 | route_.control = c 61 | route_.action = "index" 62 | route_.dewrite_on = true 63 | End If 64 | End If 65 | End If 66 | Set matches = nothing 67 | End Sub 68 | 69 | 'DeWrite_Static 70 | 71 | Private Sub DeWrite_Static(ByVal r_path) 72 | if r_path="" Then Exit Sub 73 | regEx.Pattern = "^"&PATH_STATIC&"([^\/]+)\/([^\/]+)\/([^\s]+\/|)([^\/]+)\.(css|js|jpg|gif|png|bmp|svg|ico|woff2|otf|ttf|eot)(\?.*|)$" ' 设置模式。 74 | Set matches = regEx.Execute(r_path) 75 | If matches.Count>0 Then 76 | route_.requests.querystr("p_module") = matches(0).SubMatches(0) 77 | route_.requests.querystr("p_view") = matches(0).SubMatches(1) 78 | route_.requests.querystr("p_path") = matches(0).SubMatches(2) 79 | route_.requests.querystr("p_name") = matches(0).SubMatches(3) 80 | route_.requests.querystr("p_ext") = matches(0).SubMatches(4) 81 | c = "pic" 82 | If route_.loader.LoadFile(PATH_MODULE&route_.module&"/"&PATH_CONTROL&c&".asp")<> -1 Then 83 | route_.control = c 84 | route_.action = "static" 85 | route_.dewrite_on = true 86 | End If 87 | End If 88 | Set matches = nothing 89 | End Sub 90 | 91 | '@ReWrite(ByVal str): 编码未使用 92 | 93 | Public Function ReWrite(ByVal str) 94 | End Function 95 | 96 | '@ReWritePic(Byref base,Byref pic_name,Byref pic_width,Byref pic_height,Byref picdefault): 编码图片 97 | 98 | Public Function ReWritePic(Byref base,Byref pic_name,Byref pic_width,Byref pic_height,Byref picdefault) 99 | Dim str, pic_ext 100 | If IsNull(pic_name) Then pic_name = "" 101 | If pic_name = "" Then 102 | If picdefault<>"" Then 103 | str = picdefault 104 | Else 105 | str = "images/no.gif" 106 | End If 107 | Else 108 | str = pic_name 109 | End If 110 | str = LCase(str) 111 | ReWritePic = base&PATH_PIC&ReWrite_P(str, pic_width, pic_height) 112 | End Function 113 | 114 | Private Function ReWrite_P(Byref pic_name,Byref pic_width,Byref pic_height) 115 | Dim str, pic_ext 116 | str = pic_name 117 | If IsNumeric(pic_width) And IsNumeric(pic_height) Then 118 | str = Replace(str, PATH_PIC_IMAGES, PATH_PIC_THUMBS) 119 | pic_ext = route_.fun.GetExt(str) 120 | str = Replace(str, pic_ext, "."&pic_width&"x"&pic_height&pic_ext) 121 | End If 122 | ReWrite_P = str 123 | End Function 124 | 125 | '@ReWriteStatic(Byref base,Byref names): 编码static文件 126 | 127 | Public Function ReWriteStatic(Byref base,Byref names) 128 | ReWriteStatic = base&names 129 | End Function 130 | 131 | End Class 132 | %> -------------------------------------------------------------------------------- /inc/class/crypt/rsa.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Crypt_Rsa 3 | '@author: ekede.com 4 | '@date: 2020-10-28 5 | '@description: RSA 公钥加密->私钥解密 , 私钥签名->公钥验签 6 | 7 | Class Class_Crypt_Rsa 8 | 9 | Private TAsc,objRsa 10 | Private PrivateKey_,PublicKey_ 11 | 12 | '@PrivateKey: Your personal private key. Keep this hidden. Need C# format. 13 | 14 | Public Property Get PrivateKey 15 | PrivateKey = PrivateKey_ 16 | End Property 17 | 18 | Public Property Let PrivateKey(Value) 19 | PrivateKey_ = Value 20 | objRsa.FromXmlString (PrivateKey_) 21 | PublicKey_ = objRsa.ToXmlString(False) 22 | End Property 23 | 24 | '@PublicKey: Key for others to encrypt data with. 25 | 26 | Public Property Get PublicKey 27 | PublicKey = PublicKey_ 28 | End Property 29 | 30 | Public Property Let PublicKey(Value) 31 | PublicKey_ = Value 32 | objRsa.FromXmlString (PublicKey_) 33 | End Property 34 | 35 | Private Sub Class_Initialize() 36 | Set TAsc = Server.CreateObject("System.Text.UTF8Encoding") 37 | Set objRsa = Server.CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") 38 | CreateKey() 39 | End Sub 40 | 41 | Private Sub Class_Terminate() 42 | Set objRsa = Nothing 43 | Set TAsc = Nothing 44 | End Sub 45 | 46 | Public Sub CreateKey() 47 | PrivateKey_ = objRsa.ToXmlString(True) 48 | PublicKey_ = objRsa.ToXmlString(False) 49 | End Sub 50 | 51 | '@Encrypt(ByRef Str): 公钥加密 52 | 53 | Public Function Encrypt(ByRef Str) 54 | Dim Bytes 55 | Bytes = TAsc.GetBytes_4(Str) 56 | Encrypt = Bytes2Base64(RsaEncrypt((Bytes))) 57 | End Function 58 | 59 | Private Function RsaEncrypt(ByRef Bytes) 60 | RsaEncrypt = objRsa.Encrypt((Bytes),False) 61 | End Function 62 | 63 | '@Decrypt(ByRef Bytes): 私钥解密 64 | 65 | Public Function Decrypt(ByRef Str) 66 | Dim Bytes 67 | Bytes=RsaDecrypt(Base642Bytes(Str)) 68 | Decrypt = TAsc.GetString((Bytes)) 69 | End Function 70 | 71 | Private Function RsaDecrypt(ByRef Bytes) 72 | RsaDecrypt = objRsa.Decrypt((Bytes), False) 73 | End Function 74 | 75 | '@SignData(ByRef Str,ByRef Hash): 私钥签名 MD5 SHA1 SHA256 76 | 77 | Public Function SignData(ByRef Str,ByRef Hash) 78 | Dim Bytes 79 | Bytes = TAsc.GetBytes_4(Str) 80 | SignData = Bytes2Base64(SignHash(Bytes, Hash)) 81 | End Function 82 | 83 | Private Function SignHash(ByRef Bytes,ByRef Hash) 84 | Dim MapNameToOID 85 | If Hash="MD5" Then 86 | MapNameToOID = "1.2.840.113549.2.5" 87 | Bytes = Md5(Bytes) 88 | SignHash = objRsa.SignHash((Bytes),MapNameToOID) 89 | End If 90 | If Hash="SHA1" Then 91 | MapNameToOID = "1.3.14.3.2.26" 92 | Bytes = SHA1(Bytes) 93 | SignHash = objRsa.SignHash((Bytes),MapNameToOID) 94 | End If 95 | If Hash="SHA256" Then 96 | MapNameToOID = "2.16.840.1.101.3.4.2.1" 97 | Bytes = SHA256(Bytes) 98 | SignHash = objRsa.SignHash((Bytes),MapNameToOID) 99 | End If 100 | End Function 101 | 102 | '@VerifyData(ByRef str,ByRef Hash,ByRef StrSign): 公钥验签 103 | 104 | Public Function VerifyData(ByRef str,ByRef Hash,ByRef StrSign) 105 | Dim Bytes,BytesSign 106 | Bytes = TAsc.GetBytes_4(Str) 107 | BytesSign = Base642Bytes(StrSign) 108 | VerifyData = objRsa.VerifyData((Bytes),Hash,(BytesSign)) 109 | End Function 110 | 111 | 'Hash 112 | 113 | Public Function Md5(ByRef Bytes) 114 | Dim En 115 | Set En = Server.CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") 116 | Md5 = En.ComputeHash_2((Bytes)) 117 | Set En = Nothing 118 | End Function 119 | 120 | Public Function SHA1(ByRef Bytes) 121 | Dim En 122 | Set En = Server.CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider") 123 | SHA1 = En.ComputeHash_2((Bytes)) 124 | Set En = Nothing 125 | End Function 126 | 127 | Public Function SHA256(ByRef Bytes) 128 | Dim En 129 | Set En = Server.CreateObject("System.Security.Cryptography.SHA256CryptoServiceProvider") 130 | SHA256 = En.ComputeHash_2((Bytes)) 131 | Set En = Nothing 132 | End Function 133 | 134 | 'Base64 135 | 136 | Public Function Base642Bytes(ByRef str) 137 | Dim objXML, objXMLNode 138 | Set objXML = Server.CreateObject("msxml2.domdocument") 139 | Set objXMLNode = objXML.createelement("b64") 140 | objXMLNode.datatype = "bin.base64" 141 | objXMLNode.text = str 142 | Base642Bytes = objXMLNode.nodetypedvalue 143 | Set objXMLNode = Nothing 144 | Set objXML = Nothing 145 | End Function 146 | 147 | Public Function Bytes2Base64(ByRef bytes) 148 | Dim objXML, objXMLNode 149 | Set objXML = Server.CreateObject("msxml2.domdocument") 150 | Set objXMLNode = objXML.createelement("b64") 151 | objXMLNode.datatype = "bin.base64" 152 | objXMLNode.nodetypedvalue = bytes 153 | Bytes2Base64 = objXMLNode.text 154 | Set objXMLNode = Nothing 155 | Set objXML = Nothing 156 | End Function 157 | 158 | End Class 159 | %> -------------------------------------------------------------------------------- /inc/class/ext/xml.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Xml 3 | '@author: 做回自己 4 | '@date: 2005-3-15 5 | '@description: XmlDom操作类 6 | 7 | Class Class_Ext_Xml 8 | 9 | Private objXml 10 | Private xmlDoc 11 | Private xmlPath 12 | 13 | Sub Class_initialize 14 | Set objXml = Server.CreateObject("MSXML2.DOMDocument") 15 | objXml.preserveWhiteSpace = true 16 | objXml.async = false 17 | End Sub 18 | 19 | Sub Class_Terminate 20 | Set objXml = Nothing 21 | End Sub 22 | 23 | '@CreateNew(ByRef sName): 建立一个新的XML文档 24 | 25 | Public Function CreateNew(ByRef sName) 26 | Set tmpNode = objXml.createElement(sName) 27 | objXml.appendChild(tmpNode) 28 | Set CreateNew = tmpNode 29 | End Function 30 | 31 | '@OpenXml(ByRef sPath): 从外部读入XML文档 32 | 33 | Public Function OpenXml(ByRef sPath) 34 | OpenXml=False 35 | sPath=Server.MapPath(sPath) 36 | 'Response.Write(sPath) 37 | xmlPath = sPath 38 | If objXml.load(sPath) Then 39 | Set xmlDoc = objXml.documentElement 40 | OpenXml=True 41 | End If 42 | End Function 43 | 44 | '@LoadXml(ByRef sStr): 从外部读入XML字符串 45 | 46 | Public Sub LoadXml(ByRef sStr) 47 | objXml.loadXML(sStr) 48 | Set xmlDoc = objXml.documentElement 49 | End Sub 50 | 51 | '@InceptXml(ByRef xObj): 从外部读入XML对象 52 | 53 | Public Sub InceptXml(ByRef xObj) 54 | Set objXml = xObj 55 | Set xmlDoc = xObj.documentElement 56 | End Sub 57 | 58 | '@AddNode(ByRef sNode,ByRef rNode): 新增一个节点, sNode STRING 节点名称, rNode OBJECT 增加节点的上级节点引用 59 | 60 | Public Function AddNode(ByRef sNode,ByRef rNode) 61 | Dim TmpNode 62 | Set TmpNode = objXml.createElement(sNode) 63 | rNode.appendChild TmpNode 64 | Set AddNode = TmpNode 65 | End Function 66 | 67 | '@AddAttribute(ByRef sName,ByRef sValue,ByRef oNode): sName STRING 属性名称, sValue STRING 属性值, oNode OBJECT 增加属性的对象 68 | 69 | Public Function AddAttribute(ByRef sName,ByRef sValue,ByRef oNode) 70 | oNode.setAttribute sName,sValue 71 | End Function 72 | 73 | '@AddText(ByRef FStr,ByRef cdBool,ByRef oNode): 新增节点内容 74 | 75 | Public Function AddText(ByRef FStr,ByRef cdBool,ByRef oNode) 76 | Dim tmpText 77 | If cdBool Then 78 | Set tmpText = objXml.createCDataSection(FStr) 79 | Else 80 | Set tmpText = objXml.createTextNode(FStr) 81 | End If 82 | oNode.appendChild tmpText 83 | End Function 84 | 85 | '@GetAtt(ByRef aName,ByRef oNode): 取得节点指定属性的值, aName STRING 属性名称, oNode OBJECT 节点引用 86 | 87 | Public Function GetAtt(ByRef aName,ByRef oNode) 88 | dim tmpValue 89 | tmpValue = oNode.getAttribute(aName) 90 | GetAtt = tmpValue 91 | End Function 92 | 93 | '@GetNodeName(ByRef oNode): 取得节点名称, oNode OBJECT 节点引用 94 | 95 | Public Function GetNodeName(ByRef oNode) 96 | GetNodeName = oNode.nodeName 97 | End Function 98 | 99 | '@Function GetNodeText(ByRef oNode): 取得节点内容, oNode OBJECT 节点引用 100 | 101 | Public Function GetNodeText(ByRef oNode) 102 | GetNodeText = oNode.childNodes(0).nodeValue 103 | End Function 104 | 105 | '@GetNodeType(ByRef oNode): 取得节点类型, oNode OBJECT 节点引用 106 | 107 | Public Function GetNodeType(ByRef oNode) 108 | GetNodeType = oNode.nodeType 109 | End Function 110 | 111 | '@FindNodes(ByRef sNode): 查找节点名相同的所有节点 112 | 113 | Public Function FindNodes(ByRef sNode) 114 | Dim tmpNodes 115 | Set tmpNodes = objXml.getElementsByTagName(sNode) 116 | Set FindNodes = tmpNodes 117 | End Function 118 | 119 | '@FindNode(ByRef sNode): 查找一个相同节点 120 | 121 | Public Function FindNode(ByRef sNode) 122 | Dim TmpNode 123 | Set TmpNode=objXml.selectSingleNode(sNode) 124 | Set FindNode = TmpNode 125 | End Function 126 | 127 | '@DelNode(ByRef sNode): 删除一个节点 128 | 129 | Public Function DelNode(ByRef sNode) 130 | Dim TmpNodes,Nodesss 131 | Set TmpNodes=objXml.selectSingleNode(sNode) 132 | Set Nodesss=TmpNodes.parentNode 133 | Nodesss.removeChild(TmpNodes) 134 | End Function 135 | 136 | '@ReplaceNode(ByRef sNode,ByRef sText,ByRef cdBool): 替换一个节点 137 | 138 | Public Function ReplaceNode(ByRef sNode,ByRef sText,ByRef cdBool) 139 | 'replaceChild 140 | Dim TmpNodes,tmpText 141 | Set TmpNodes=objXml.selectSingleNode(sNode) 142 | 'AddText sText,cdBool,TmpNodes 143 | If cdBool Then 144 | Set tmpText = objXml.createCDataSection(sText) 145 | Else 146 | Set tmpText = objXml.createTextNode(sText) 147 | End If 148 | TmpNodes.replaceChild tmpText,TmpNodes.firstChild 149 | End Function 150 | 151 | '创建XML声明 152 | 153 | Private Function ProcessingInstruction 154 | '//--创建XML声明 155 | Dim objPi 156 | Set objPi = objXML.createProcessingInstruction("xml", "version="&chr(34)&"1.0"&chr(34)&" encoding="&chr(34)&"ISO-8859-1"&chr(34)) 157 | '//--把xml生命追加到xml文档 158 | objXML.insertBefore objPi, objXML.childNodes(0) 159 | End Function 160 | 161 | '@SaveXML(): 保存XML文档 162 | 163 | Public Function SaveXML() 164 | 'ProcessingInstruction() 165 | objXml.save(xmlPath) 166 | End Function 167 | 168 | '@SaveAsXML(ByRef sPath): 另存XML文档 169 | 170 | Public Function SaveAsXML(ByRef sPath) 171 | ProcessingInstruction() 172 | objXml.save(sPath) 173 | End Function 174 | 175 | '相关统计 176 | 177 | '@Root: 取得根节点 178 | 179 | Property Get Root 180 | Set Root = xmlDoc 181 | End Property 182 | 183 | '@Length: 取得根节点下子节点数 184 | 185 | Property Get Length 186 | Length = xmlDoc.childNodes.length 187 | End Property 188 | 189 | '@TestNode: 相关测试 190 | 191 | Property Get TestNode 192 | TestNode = xmlDoc.childNodes(0).text 193 | End Property 194 | 195 | End Class 196 | %> -------------------------------------------------------------------------------- /inc/class/response.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Response 3 | '@author: ekede.com 4 | '@date: 2017-12-12 5 | '@description: Response对象 6 | 7 | Class Class_Response 8 | 9 | Private output_ 10 | Private headers_, buffer_, charset_, contentType_, status_ 11 | 12 | '@setBuffer: 缓存输出 13 | 14 | Public Property Let setBuffer(str) 15 | buffer_ = str 16 | End Property 17 | 18 | '@setCharset: 编码类型 19 | 20 | Public Property Let setCharset(str) 21 | charset_ = str 22 | End Property 23 | 24 | '@setContentType: 文档类型 25 | 26 | Public Property Let setContentType(str) 27 | ContentType_ = str 28 | End Property 29 | 30 | '@setStatus: http状态 31 | 32 | Public Property Let setStatus(str) 33 | status_ = str 34 | End Property 35 | 36 | Private Sub Class_Initialize() 37 | Set headers_ = Server.CreateObject("Scripting.Dictionary") 38 | ' 39 | buffer_ = true 40 | charset_ = "UTF-8" '列表 41 | contentType_ = "text/html" '列表 42 | status_ = "200 ok" '列表 43 | End Sub 44 | 45 | Private Sub Class_Terminate() 46 | Set headers_ = Nothing 47 | End Sub 48 | 49 | '@SetHeader(ByRef names,ByRef content): 设置header 50 | 51 | Public Function SetHeader(ByRef names,ByRef content) 52 | headers_(names) = content 53 | End Function 54 | 55 | '@SetOutput(ByRef outs): 设置内容 56 | 57 | Public Function SetOutput(ByRef outs) 58 | output_ = outs 59 | End Function 60 | 61 | '@GetOutput(): 查看内容 62 | 63 | Public Function GetOutput() 64 | GetOutput = output_ 65 | End Function 66 | 67 | '@OutPuts(): 浏览器输出 68 | 69 | Public Sub OutPuts() 70 | Response.Clear() 71 | Response.Buffer = buffer_ 72 | Response.ContentType = contentType_ 73 | Response.Status = status_ 74 | For Each keys in headers_ 75 | Response.AddHeader keys, headers_(keys) 76 | Next 77 | If TypeName(output_)="String" Then 78 | Response.CodePage = 65001 79 | Response.Charset = charset_ 80 | Response.Write output_ 81 | ElseIf TypeName(output_)="Byte()" Then 82 | Response.BinaryWrite output_ 83 | Response.Flush 84 | End If 85 | End Sub 86 | 87 | '@Transfer(ByRef path): 转向包含 88 | 89 | Public Sub Transfer(ByRef path) 90 | Response.ContentType = ContentType_ 91 | Response.Status = Status_ 92 | Server.transfer(path) 93 | End Sub 94 | 95 | '@Direct(ByRef Url): 跳转 96 | 97 | Public Sub Direct(ByRef Url) 98 | response.redirect(Replace(Url, "&", "&")) 99 | End Sub 100 | 101 | '@Direct301(ByRef Url): 301跳转 102 | 103 | Public Sub Direct301(ByRef Url) 104 | Response.Status = GetStatus(301) 105 | Response.AddHeader "Location", Url 106 | Response.End 107 | End Sub 108 | 109 | '@Die(ByRef str): 中断 110 | 111 | Public Sub Die(ByRef str) 112 | Response.Charset = charset_ 113 | Response.write str 114 | Response.End 115 | End Sub 116 | 117 | '@GetStatus(ByRef n): 根据状态码取http状态字符串 118 | 119 | Public Function GetStatus(ByRef n) 120 | Select Case n 121 | Case 301 122 | GetStatus = "301 Moved Permanently" 123 | Case 401 124 | GetStatus = "404 Unauthorized" 125 | Case 404 126 | GetStatus = "404 Not Found" 127 | Case 500 128 | GetStatus = "500 Internal Server Error" 129 | Case Else 130 | GetStatus = "200 ok" 131 | End Select 132 | End Function 133 | 134 | '@GetContentType(ByRef ext): 根据扩展名取Content-Type(Mime-Type)字符串 135 | 136 | Public Function GetContentType(ByRef ext) 137 | Dim e,s 138 | e=LCase(replace(ext,".","")) 139 | Select Case e 140 | Case "html" 141 | s="text/html" 142 | Case "xhtml" 143 | s="text/html" 144 | Case "xml" 145 | s="text/xml" 146 | Case "xsl" 147 | s="text/xml" 148 | Case "xslt" 149 | s="text/xml" 150 | Case "wml" 151 | s="text/vnd.wap.wml" 152 | Case "wsdl" 153 | s="text/xml" 154 | ' 155 | Case "css" 156 | s="text/css" 157 | Case "js" 158 | s="application/x-javascript" 159 | Case "json" 160 | s="application/json" 161 | ' 162 | Case "woff" 163 | s="application/x-font-woff" 164 | Case "woff2" 165 | s="application/x-font-woff2" 166 | Case "otf" 167 | s="application/x-font-opentype" 168 | Case "ttf" 169 | s="application/x-font-truetype" 170 | Case "eot" 171 | s="application/vnd.ms-fontobject" 172 | ' 173 | Case "png" 174 | s="image/png" 175 | Case "jpg" 176 | s="image/jpeg" 177 | Case "gif" 178 | s="image/gif" 179 | Case "bmp" 180 | s="application/x-bmp" 181 | Case "svg" 182 | s="image/svg+xml" 183 | Case "ico" 184 | s="application/x-ico" 185 | ' 186 | Case "pdf" 187 | s="application/pdf" 188 | Case "xls" 189 | s="application/x-xls" 190 | Case "doc" 191 | s="application/msword" 192 | Case "ppt" 193 | s="application/x-ppt" 194 | Case "zip" 195 | s="application/zip" 196 | Case "gzip" 197 | s="application/gzip" 198 | ' 199 | Case Else 200 | s="" 201 | End Select 202 | ' 203 | GetContentType = s 204 | End Function 205 | 206 | End Class 207 | %> -------------------------------------------------------------------------------- /inc/module/help/control/index.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Index 3 | '@author: ekede.com 4 | '@date: 2018-10-30 5 | '@description: 查看帮助文件 6 | 7 | Class Control_Index 8 | 9 | Private template_ 10 | 11 | Private Sub Class_Initialize() 12 | Set template_ = loader.LoadClass("Template") 13 | template_.loader = loader 14 | template_.path_tpl = PATH_MODULE&wts.route.module&"/"&PATH_VIEW 15 | End Sub 16 | 17 | Private Sub Class_Terminate() 18 | Set template_ = Nothing 19 | End Sub 20 | 21 | '@Index_Action(): 22 | 23 | Sub Index_Action() 24 | Call View_Action() 25 | End Sub 26 | 27 | '@View_Action(): 查看 28 | 29 | Public Sub View_Action() 30 | '加css,js 31 | Dim cdn 32 | cdn="https://cdnjs.cloudflare.com/ajax/libs/" 'https://cdn.bootcss.com/ 33 | template_.SetVal "script/src", cdn&"SyntaxHighlighter/3.0.83/scripts/shCore.js" 34 | template_.UpdVal "script" 35 | template_.SetVal "script/src", cdn&"SyntaxHighlighter/3.0.83/scripts/shBrushVb.js" 36 | template_.UpdVal "script" 37 | template_.SetVal "style/href", cdn&"SyntaxHighlighter/3.0.83/styles/shCoreMidnight.css" 38 | template_.UpdVal "style" 39 | 40 | '接收文件 41 | filename=wts.requests.querystr("f") 42 | 'c = wts.cache.GetCache(filename) 43 | c=-1 44 | If c <> -1 Then 45 | moban=c 46 | Else 47 | f=wts.fso.Reads(wts.fso.getMapPath("./")&"\"&replace(filename,"_","\")&".asp","UTF-8") 48 | If f = -1 Then 49 | tag_frame = "WTS ASP FRAME" 50 | template_.SetVal "title",tag_frame 51 | Else 52 | tag_help = wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=help") 53 | template_.SetVal "tag_help",tag_help 54 | GetREM(f) 55 | End IF 56 | GetList(filename) 57 | ' 58 | template_.SetVal "tag_frame",tag_frame 59 | moban = template_.Fetch("help.htm") 60 | 'wts.cache.SetCache filename, moban 61 | End If 62 | ' 63 | wts.responses.SetOutput moban 64 | End Sub 65 | 66 | '取列表 67 | 68 | Private Sub GetList(f) 69 | 70 | p_inc=wts.fso.getmappath("./")&"\" 71 | Set d = Server.CreateObject("Scripting.Dictionary") 72 | LoadData wts.fso.GetMapPath("./"),d 73 | For Each k in d 74 | t=d(k) 75 | t=replace(t,p_inc,"") 76 | t=replace(t,"\","_") 77 | t=replace(t,".asp","") 78 | d(k)=t 79 | Next 80 | ' 81 | For Each k in d 82 | link=wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=help/index/view&f="&d(k)) 83 | template_.SetVal "list/name", replace(d(k),"_","/") 84 | template_.SetVal "list/link", link 85 | If f=d(k) Then template_.SetVal "list/select", "<--" 86 | template_.UpdVal "list" 87 | Next 88 | Set d = Nothing 89 | ' 90 | End Sub 91 | 92 | '取详细内容 93 | 94 | Private Sub GetREM(str) 95 | 96 | If str="" Then Exit Sub 97 | '属性方法 98 | Set matches = wts.fun.MatchesExp(str,"'"&""&"@(.*):(.*)\n") '增加了个无用空格，避免被当作注释显示到前端 99 | For Each x in matches 100 | names = x.SubMatches(0) 101 | content = x.SubMatches(1) 102 | If names="title" or names= "author" or names = "date" or names="description" Then 103 | If names="title" Then template_.SetVal "title",wts.fun.TrimVBcrlf(content) 104 | If names="description" Then template_.SetVal "description",wts.fun.TrimVBcrlf(content) 105 | '手工单独添加行 106 | link = wts.route.ReWrite(wts.site.config("base_url"), "index.asp?route=detail/index") '无id命名 107 | template_.SetVal "head/name", names 108 | template_.SetVal "head/content", replace(content,";","
") 109 | template_.UpdVal "head" 110 | ElseIf instr(names,"(") Then 111 | template_.SetVal "func/name", names 112 | template_.SetVal "func/content", replace(content,";","
") 113 | template_.UpdVal "func" 114 | Else 115 | template_.SetVal "proper/name", names 116 | template_.SetVal "proper/content", replace(content,";","
") 117 | template_.UpdVal "proper" 118 | End If 119 | Next 120 | Set matches = nothing 121 | '例子 122 | Set matches = wts.fun.MatchesExp(str,"'"&"#(.*):([\s\S]*?)'##") '增加了个无用空格，避免被当作注释显示到前端 123 | For Each x in matches 124 | names = x.SubMatches(0) 125 | content = x.SubMatches(1) 126 | template_.SetVal "example/name", names 127 | template_.SetVal "example/content", content 128 | template_.UpdVal "example" 129 | Next 130 | Set matches = nothing 131 | 132 | End Sub 133 | 134 | '递归文件 135 | 136 | Private Sub LoadData(dirPath,data) 137 | '有些文件夹没权限会导致判断错误 138 | On Error Resume Next 139 | 140 | Dim fso 141 | Dim objFolder 142 | Dim objFiles,objSubFolders 143 | 144 | Set fso = server.CreateObject("scripting.filesystemobject") 145 | Set objFolder = fso.GetFolder(DirPath) 146 | IF Err Then Exit Sub 147 | 148 | '文件列表集合 149 | Set objFiles = objFolder.Files 150 | For Each objFile in objFiles 151 | fpathname = DirPath &"\"& objFile.Name 152 | If wts.fun.getext(fpathname) = ".asp" Then 153 | data(fpathname)=fpathname 154 | End If 155 | Next 156 | Set objFiles = nothing 157 | 158 | '子文件夹集合 159 | Set objSubFolders = objFolder.SubFolders 160 | For Each objSubFolder in objSubFolders 161 | pathname = DirPath &"\"& objSubFolder.Name 162 | Call LoadData(pathname,data) 163 | Next 164 | Set objSubFolders = Nothing 165 | 166 | Set objFolder = nothing 167 | Set fso = nothing 168 | 169 | End Sub 170 | 171 | End Class 172 | %> -------------------------------------------------------------------------------- /inc/class/request.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Request 3 | '@author: ekede.com 4 | '@date: 2017-12-6 5 | '@description: Request对象,服务器信息 6 | 7 | Class Class_Request 8 | 9 | '@bytes: byte二进制流 10 | '@querystr: Get集合 11 | '@forms: Form集合 12 | '@servers: Server集合 13 | '@status404: 404状态 14 | '@standardAddr: 标准网址 15 | '@realAddr: 真实网址 16 | 17 | Dim querystr, forms, servers 18 | 19 | Dim https, queryStrings 20 | 21 | Dim status404, standardAddr, realAddr 22 | 23 | '@baseAddr: script目录所在地址 24 | '@basePicAddr: 图片网站根目录 25 | 26 | Dim baseAddr,basePicAddr 27 | 28 | '二进制流 29 | Public Property Get bytes() 30 | bytes = Request.BinaryRead(Request.TotalBytes) 'multipart/form-data 31 | End Property 32 | ' 33 | Private Sub Class_Initialize() 34 | Set querystr = Server.CreateObject("Scripting.Dictionary") 35 | Set forms = Server.CreateObject("Scripting.Dictionary") 36 | Set servers = Server.CreateObject("Scripting.Dictionary") 37 | ' 38 | ColDic Request.ServerVariables, servers 39 | ColDic request.QueryString, querystr 40 | If instr(servers("HTTP_CONTENT_TYPE"),"application/x-www-form-urlencoded")>0 Then 41 | ColDic Request.Form, forms 42 | End If 43 | '协议 44 | If servers("Https") = "on" Then 45 | https = "https://" 46 | Else 'off 47 | https = "http://" 48 | End If 49 | '修正IIS5 加port 50 | queryStrings = servers("QUERY_STRING") '参数:a=1&b=2 51 | If (servers("SERVER_SOFTWARE") = "Microsoft-IIS/5.1" And InStr(QueryStrings, ";")>0) Then 52 | queryStrings = Replace(queryStrings, servers("SERVER_NAME"), servers("SERVER_NAME")&":"&servers("SERVER_PORT")) 53 | queryStrings = Replace(queryStrings, "http://", https) '验证 54 | End If 55 | ' 56 | Real_Addr() 'realAddr 57 | status_404() 'status404 58 | Standard_Addr() 'standardAddr 59 | Base_Addr() 'baseAddr 60 | Base_Pic_Addr() 'basePicAddr 61 | End Sub 62 | 63 | 64 | Private Sub class_terminate() 65 | Set querystr = Nothing 66 | Set forms = Nothing 67 | Set servers = Nothing 68 | End Sub 69 | 70 | '404状态 71 | 72 | Private Sub Status_404() 73 | If InStr(servers("QUERY_STRING"), ";")>0 Then 74 | status404 = True 75 | Else 76 | status404 = False 77 | End If 78 | End Sub 79 | 80 | 'realAddr : http://localhost/sys/404.asp?404;http://localhost:80/sys/en/ 81 | 82 | Private Sub Real_Addr() 83 | Dim Url 84 | Url = https&servers("HTTP_HOST")&servers("URL") 85 | If queryStrings <>"" Then Url = Url&"?"& queryStrings 86 | If servers("SERVER_PORT") = "80" Then Url = Replace(Url, ":80/", "/") '去80 87 | If servers("SERVER_PORT") = "443" Then Url = Replace(Url, ":443/", "/") '去443 88 | realAddr = Url 89 | End Sub 90 | 91 | 'standardAddr : http://localhost:80/sys/en/ 92 | 93 | Private Sub Standard_Addr() 94 | Dim Url 95 | If queryStrings = "" Then 96 | Url = https&servers("HTTP_HOST")&servers("URL") 97 | Else 98 | If InStr(queryStrings, ";")>0 Then 99 | Url = Right(queryStrings, Len(queryStrings) - InStr(queryStrings, ";")) 100 | Else 101 | Url = https&servers("HTTP_HOST")&servers("URL")&"?"& queryStrings 102 | End If 103 | End If 104 | If servers("SERVER_PORT") = "80" Then Url = Replace(Url, ":80/", "/") '去80 http 105 | If servers("SERVER_PORT") = "443" Then Url = Replace(Url, ":443/", "/") '去443 https 106 | standardAddr = Url 107 | End Sub 108 | 109 | 'baseAddr : http://localhost/sys/ 110 | 111 | Private Sub Base_Addr() 112 | Dim Url 113 | Url = Replace(https&servers("HTTP_HOST")&servers("URL"), "index.asp", "") 114 | If servers("SERVER_PORT") = "80" Then Url = Replace(Url, ":80/", "/") '去80 http 115 | If servers("SERVER_PORT") = "443" Then Url = Replace(Url, ":443/", "/") '去443 https 116 | baseAddr = Url 117 | End Sub 118 | 119 | Private Sub Base_Pic_Addr() '回根目录 120 | Dim counter,arr,str,i 121 | if PATH_ROOT <> "" then 122 | If Instr(PATH_ROOT,"../")>0 Then 123 | counter=ubound(Split(PATH_ROOT,"../")) 124 | arr=split(baseAddr,"/") 125 | for i = 0 to Ubound(arr)-(counter+1) 126 | str=str&arr(i)&"/" 127 | next 128 | Else 129 | str = baseAddr&PATH_ROOT 130 | End If 131 | Else 132 | str = baseAddr 133 | End If 134 | basePicAddr = str 135 | End Sub 136 | 137 | '调用 - collection转换dictionary 138 | 139 | Public Sub ColDic(ByRef col,ByRef dic) 140 | For Each Keys in col 141 | dic(Keys) = col(Keys) 142 | Next 143 | End Sub 144 | 145 | '服务器参数举例 146 | 'servers("SERVER_SOFTWARE") 'Microsoft-IIS/5.1 Microsoft-IIS/6.0 Microsoft-IIS/7.5 147 | 'servers("HTTP_HOST") 'localhost:8080 148 | 'servers("SERVER_NAME") 'localhost 149 | 'servers("SERVER_PORT") '端口:80,8080 150 | 'servers("SCRIPT_NAME") '网页:/test/xxx.asp 151 | 'servers("URL") '网页:/test/xxx.asp 152 | 'servers("QUERY_STRING") '参数:a=1&b=2 153 | 'servers("Remote_Addr") 'IP: 127.0.0.1 计算地区 154 | 'servers("HTTP_REFERER") '来访页: http://www.xxx.com/xxx.asp?id=xxx 完整地址 155 | 'servers("HTTP_USER_AGENT") '操作系统,浏览器,版本 156 | 'servers("HTTP_ACCEPT_LANGUAGE") '语言 157 | 'servers("HTTP_ACCEPT") '文档类型 158 | 159 | End Class 160 | %> -------------------------------------------------------------------------------- /inc/module/default/control/pic.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Pic 3 | '@author: ekede.com 4 | '@date: 2018-06-17 5 | '@description: 图片及静态文件操作 6 | 7 | Class Control_Pic 8 | 9 | '@Index_Action(): 生成并访问缩略图 10 | 11 | Public Function Index_Action() 12 | ' 13 | pic_path = wts.requests.querystr("p_path") 14 | pic_name = wts.requests.querystr("p_name") 15 | pic_width = wts.requests.querystr("p_width") 16 | pic_height = wts.requests.querystr("p_height") 17 | pic_ext = wts.requests.querystr("p_ext") 18 | ' 19 | If pic_name = "" Then Pic_404() 20 | ' 21 | pic_ori_name = PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES&pic_path&pic_name&"."&pic_ext 22 | pic_target_path = PATH_ROOT&PATH_PIC&PATH_PIC_THUMBS&pic_path 23 | ' 24 | If wts.fso.GetRealPath(pic_ori_name)<> -1 Then 25 | wts.fso.createFolders wts.fso.GetMapPath(pic_target_path) 26 | pic_url = BuildThumbPic(pic_ori_name, pic_target_path, CInt(pic_width), CInt(pic_height), "") 27 | Else 28 | pic_404() 29 | End If 30 | ' 31 | If Left(pic_url, 5) = "Error" Or pic_url = "" Then 32 | pic_404() 33 | Else 34 | pic_stream = wts.fso.Reads(wts.fso.GetMapPath(pic_url),"") '读二进制图片 35 | wts.responses.setContentType = wts.responses.GetContentType("gif") 36 | wts.responses.SetOutput pic_stream '输出二进制图片 37 | End If 38 | 39 | End Function 40 | 41 | '@Static_Action(): 拷贝并访问静态文件 42 | 43 | Public Function Static_Action() 44 | Dim APP_MODULE,isFind 45 | isFind=False 46 | ' 47 | pic_module = wts.requests.querystr("p_module") 48 | pic_view = wts.requests.querystr("p_view") 49 | pic_path = wts.requests.querystr("p_path") 50 | pic_name = wts.requests.querystr("p_name") 51 | pic_ext = wts.requests.querystr("p_ext") 52 | pic_name = pic_name&"."&pic_ext 53 | '取得APP_MODULE地址 54 | If PATH_APP <> "" Then 55 | If Left(PATH_MODULE,Len(PATH_INC))= PATH_INC Then 56 | APP_MODULE = PATH_APP&Right(PATH_MODULE,Len(PATH_MODULE)-Len(PATH_INC)) 57 | Else 58 | APP_MODULE = PATH_APP&PATH_MODULE 59 | End If 60 | End If 61 | '查看APP_MODULE静态文件是否存在 62 | If APP_MODULE <> "" Then 63 | pic_ori_name = PATH_ROOT&APP_MODULE&pic_module&"/"&PATH_VIEW&pic_view&"/"&pic_path&pic_name 64 | pic_target_path = PATH_ROOT&PATH_STATIC&pic_module&"/"&pic_view&"/"&pic_path 65 | ' 66 | If wts.fso.GetRealPath(pic_ori_name)<> -1 Then 67 | wts.fso.CreateFolders wts.fso.GetMapPath(pic_target_path) 68 | wts.fso.CopyAFile wts.fso.GetMapPath(pic_ori_name), wts.fso.GetMapPath(pic_target_path&pic_name) 69 | wts.responses.setContentType = wts.responses.GetContentType(pic_ext) 70 | wts.responses.SetOutput wts.fso.Reads(wts.fso.GetMapPath(pic_target_path&pic_name),"") 71 | isFind = true 72 | Else '当前模板不存在的情况下,查看默认模板是否存在 73 | pic_def_name = PATH_ROOT&APP_MODULE&pic_module&"/"&PATH_VIEW&wts.site.tplDefaultPath&"/"&pic_path&pic_name 74 | If wts.fso.GetRealPath(pic_def_name)<> -1 and pic_ori_name <> pic_def_name Then 75 | wts.fso.CreateFolders wts.fso.GetMapPath(pic_target_path) 76 | wts.fso.CopyAFile wts.fso.GetMapPath(pic_def_name), wts.fso.GetMapPath(pic_target_path&pic_name) 77 | wts.responses.setContentType = wts.responses.GetContentType(pic_ext) 78 | wts.responses.SetOutput wts.fso.Reads(wts.fso.GetMapPath(pic_target_path&pic_name),"") 79 | isFind = True 80 | End If 81 | End If 82 | End If 83 | '查看PATH_MODULE静态文件是否存在 84 | If isFind = False Then 85 | pic_ori_name = PATH_ROOT&PATH_MODULE&pic_module&"/"&PATH_VIEW&pic_view&"/"&pic_path&pic_name 86 | pic_target_path = PATH_ROOT&PATH_STATIC&pic_module&"/"&pic_view&"/"&pic_path 87 | ' 88 | If wts.fso.GetRealPath(pic_ori_name)<> -1 Then 89 | wts.fso.CreateFolders wts.fso.GetMapPath(pic_target_path) 90 | wts.fso.CopyAFile wts.fso.GetMapPath(pic_ori_name), wts.fso.GetMapPath(pic_target_path&pic_name) 91 | wts.responses.setContentType = wts.responses.GetContentType(pic_ext) 92 | wts.responses.SetOutput wts.fso.Reads(wts.fso.GetMapPath(pic_target_path&pic_name),"") 93 | Else '当前模板不存在的情况下,查看默认模板是否存在 94 | pic_def_name = PATH_ROOT&PATH_MODULE&pic_module&"/"&PATH_VIEW&wts.site.tplDefaultPath&"/"&pic_path&pic_name 95 | If wts.fso.GetRealPath(pic_def_name)<> -1 and pic_ori_name <> pic_def_name Then 96 | wts.fso.CreateFolders wts.fso.GetMapPath(pic_target_path) 97 | wts.fso.CopyAFile wts.fso.GetMapPath(pic_def_name), wts.fso.GetMapPath(pic_target_path&pic_name) 98 | wts.responses.setContentType = wts.responses.GetContentType(pic_ext) 99 | wts.responses.SetOutput wts.fso.Reads(wts.fso.GetMapPath(pic_target_path&pic_name),"") 100 | Else 101 | wts.errs.AddMsg "no static file" 102 | wts.errs.Out 404 103 | End If 104 | End If 105 | End If 106 | End Function 107 | 108 | '404 109 | 110 | Private Sub Pic_404() 111 | wts.Responses.setStatus = wts.responses.getStatus(404) 112 | wts.responses.setContentType = "image/gif" 113 | wts.responses.Transfer PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES&"no.gif" 114 | End Sub 115 | 116 | '缩图函数 117 | 118 | Private Function BuildThumbPic(originalPath, buildBasePath, maxWidth, maxHeight, Canvas) 119 | '#生成缩略图: 120 | Set jpeg = loader.LoadClass("Ext/jpeg") 121 | 'jpeg.version 122 | 'jpeg.csText="EKEDE" 123 | 'jpeg.csImg=PATH_PIC&PATH_PIC_IMAGES&"watermark.gif" 124 | BuildThumbPic = jpeg.BuildPic(originalPath, buildBasePath, maxWidth, maxHeight) 125 | Set jpeg = Nothing 126 | '## 127 | End Function 128 | 129 | End Class 130 | %> -------------------------------------------------------------------------------- /inc/class/ext/jpeg.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Jpeg 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 图片缩放类 6 | 7 | Class Class_Ext_Jpeg 8 | ' 9 | Private aspJpeg 10 | Private version_, expires_ 11 | Private isDebug_ 12 | Private buildWidth, buildHeight '目标尺寸 13 | Private csText_, csImg_ '水印 14 | 15 | '@Version: Persits.Jpeg版本 16 | 17 | Public Property Get Version 18 | version = version_ &" - "& expires_ 19 | End Property 20 | 21 | '@isDebug: 是否设置为调试模式 22 | 23 | Public Property Let isDebug(Value) 24 | isDebug_ = Value 25 | End Property 26 | 27 | '@csText: 水印文字 28 | 29 | Public Property Let csText(Value) 30 | csText_ = Value 31 | End Property 32 | 33 | '@csImg: 水印图片 34 | 35 | Public Property Let csImg(Value) 36 | csImg_ = Value 37 | End Property 38 | 39 | Private Sub Class_Initialize 40 | If IsEmpty(DEBUGS) Then 41 | isDebug_ = False 42 | Else 43 | isDebug_ = DEBUGS 44 | End If 45 | ' 46 | On Error Resume Next 47 | Set aspJpeg = Server.CreateObject("Persits.Jpeg") 48 | version_ = aspJpeg.Version 49 | expires_ = aspJpeg.expires 50 | ' 51 | If Err.Number <> 0 Then OutErr("AspJpeg组件创建失败") 52 | If expires_="9999-9-9" or expires_="9999/9/9" Then 53 | Else 54 | OutErr("AspJpeg组件没有注册") 55 | End If 56 | End Sub 57 | 58 | Private Sub Class_Terminate 59 | Set aspJpeg = Nothing 60 | End Sub 61 | 62 | '@BuildPic(ByRef originalPath, ByRef buildBasePath, ByRef maxWidth, ByRef maxHeight): 生成图片 63 | 64 | Public Function BuildPic(ByRef originalPath, ByRef buildBasePath, ByRef maxWidth, ByRef maxHeight) 65 | On Error Resume Next 66 | If originalPath = "" Then Exit Function 67 | 68 | aspJpeg.Open Server.MapPath(originalPath) 69 | If Err.Number <> 0 Then OutErr("原图不存在,OriginalPath") 70 | ' 71 | ReSize aspJpeg.Width, aspJpeg.Height, maxWidth, maxHeight 72 | aspJpeg.Width = buildWidth 73 | aspJpeg.Height = buildHeight 74 | ' 75 | CanvasText csText_ 76 | CanvasImage csImg_ 77 | ' 78 | buildFileName = MakeName(originalPath,maxWidth, maxHeight) 79 | aspJpeg.Quality = 100 80 | aspJpeg.Save Server.MapPath(buildBasePath)&"\"&buildFileName 81 | 82 | '文件名 83 | If Right(buildBasePath, 1) <> "/" Then buildBasePath = buildBasePath & "/" 84 | If Err.Number <> 0 then 85 | OutErr("缩略图存盘失败,BuildBasePath") 86 | BuildPic = originalPath 87 | else 88 | BuildPic = buildBasePath&buildFileName 89 | end if 90 | End Function 91 | 92 | '水印文字 93 | 94 | Private Sub CanvasText(ByRef text) 95 | If text = "" Then Exit Sub 96 | 97 | Dim x, y 98 | x = buildWidth -200 '水印横坐标 99 | y = buildHeight -50 '水印纵坐标 100 | aspJpeg.Canvas.Font.Size = 12 101 | aspJpeg.Canvas.Font.Color = &HFFFFFF '颜色 102 | aspJpeg.Canvas.Font.Bold = True '加粗 103 | aspJpeg.Canvas.Font.Family = "Aria" '字体 104 | 'aspJpeg.Canvas.Font.Quality = 100 '清晰度 105 | 'aspJpeg.Canvas.Font.ShadowXoffset = 2 '水印文字阴影向右偏移的像素值，输入负值则向左偏 106 | 'aspJpeg.Canvas.Font.ShadowYoffset = 2 '水印文字阴影向下偏移的像素值，输入负值则向右偏 107 | 'aspJpeg.Canvas.Font.ShadowColor = &h0FFFFF '阴影颜色 108 | aspJpeg.Canvas.Print x, y, text 109 | End Sub 110 | 111 | '水印图片 112 | 113 | Private Sub CanvasImage(ByRef pic) 114 | On Error Resume Next 115 | If pic = "" Then Exit Sub 116 | Dim x, y, jpeg2 117 | Set jpeg2 = server.CreateObject("persits.jpeg") 118 | jpeg2.Open server.mappath(pic) 119 | If Err.Number <> 0 Then OutErr("水印图不存在,csImg_") 120 | 121 | x = 1 122 | y = 1 123 | aspJpeg.canvas.drawimage x, y, jpeg2, 0.4, &HFFFFFF 'x,y,水印图,透明度,抽取颜色 124 | Set jpeg2 = Nothing 125 | End Sub 126 | 127 | '命名图片 128 | 129 | Private Function MakeName(ByRef originalPath, ByRef maxWidth, ByRef maxHeight) 130 | Dim pos, oName, oExt 131 | pos = InStrRev(originalPath, "/") + 1 132 | oName = Mid(originalPath, pos) 133 | pos = InStrRev(oName, ".") 134 | oExt = Mid(oName, pos) 135 | MakeName = Replace(oName, oExt, "."&maxWidth&"x"&maxHeight&oExt) 136 | End Function 137 | 138 | '尺寸计算 139 | 140 | Private Sub ReSize(ByRef originalWidth, ByRef originalHeight, ByRef maxWidth, ByRef maxHeight) 141 | Dim div1, div2 142 | Dim n1, n2 143 | div1 = originalWidth / originalHeight 144 | div2 = originalHeight / originalWidth 145 | n1 = 0 146 | n2 = 0 147 | If originalWidth > maxWidth Then 148 | n1 = originalWidth / maxWidth 149 | Else 150 | buildWidth = originalWidth 151 | End If 152 | If originalHeight > maxHeight Then 153 | n2 = originalHeight / maxHeight 154 | Else 155 | buildHeight = originalHeight 156 | End If 157 | If n1 <> 0 Or n2 <> 0 Then 158 | If n1 > n2 Then 159 | buildWidth = maxWidth 160 | buildHeight = maxWidth * div2 161 | Else 162 | buildWidth = maxHeight * div1 163 | buildHeight = maxHeight 164 | End If 165 | End If 166 | End Sub 167 | 168 | '错误提示 169 | 170 | Private Sub OutErr(ByRef str) 171 | If isDebug_ Then 172 | Response.charset = "utf-8" 173 | Response.Write str 174 | Response.End 175 | End If 176 | End Sub 177 | 178 | End Class 179 | %> -------------------------------------------------------------------------------- /inc/class/ext/cart.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Cart 3 | '@author: ekede.com 4 | '@date: 2018-02-11 5 | '@description: 购物车类 6 | 7 | Class Class_Ext_Cart 8 | 9 | Private cart, cartName 10 | 11 | Private Sub Class_Initialize 12 | End Sub 13 | 14 | Private Sub Class_Terminate() 15 | End Sub 16 | 17 | '@cartId: 设置购物车id，便于区别不同站点 18 | 19 | Public Property Let cartId(Value) 20 | If Value <> "" Then 21 | cartName = "cart."&Value 22 | Else 23 | cartName = "cart" 24 | End If 25 | ' 26 | If Not IsObject(Session(cartName)) Then 27 | Set Session(cartName) = Server.CreateObject("Scripting.Dictionary") 28 | End If 29 | Set cart = Session(cartName) 30 | End Property 31 | 32 | '@HasNum(): 购物车产品总数量 33 | 34 | Public Function HasNum() 35 | Dim n 36 | n=0 37 | For Each x in Cart 38 | n = n + Cart(x) 39 | Next 40 | HasNum = n 41 | end function 42 | 43 | '@Has(): 购物车产品数量 44 | 45 | Public Function Has() 46 | has = cart.Count 47 | End Function 48 | 49 | '@GetAll(): 打印购物车信息 50 | 51 | Public Function GetAll() 52 | Dim Keys, Items, I 53 | Keys = cart.Keys 54 | Items = cart.Items 55 | For I = 0 To cart.Count -1 56 | response.Write Keys(I)&":"&Items(I)&Chr(10) 57 | Next 58 | End Function 59 | 60 | '@GetIds(): 返回购物车ID 61 | 62 | Public Function GetIds() 63 | On Error Resume Next 64 | Dim Keys, I, str 65 | Keys = cart.Keys 66 | For I = 0 To cart.Count -1 67 | If I = 0 Then 68 | str = Keys(I) 69 | Else 70 | str = Str&","&Keys(I) 71 | End If 72 | Next 73 | GetIds = str 74 | End Function 75 | 76 | '@GetById(ByRef productId): 取产品数量 77 | 78 | Public Function GetById(ByRef productId) 79 | If cart.Exists(product_id) Then 80 | GetById = cart.Item(productId) 81 | Else 82 | GetById = 0 83 | End If 84 | End Function 85 | 86 | '@Add(ByRef productId,ByRef productNum): 添加购物车 87 | 88 | Public Function Add(ByRef productId,ByRef productNum) 89 | If Not cart.Exists(productId) Then 90 | cart.Add productId, CInt(productNum) 91 | Else 92 | edit productId, cart.Item(productId) + CInt(productNum) 93 | End If 94 | Set Session(cartName) = cart 95 | End Function 96 | 97 | '@Edit(ByRef productId, ByRef productNum): 修改购物车 98 | 99 | Public Function Edit(ByRef productId, ByRef productNum) 100 | If cart.Exists(productId) Then 101 | cart.Item(productId) = CInt(productNum) 102 | Else 103 | Add productId, productNum 104 | End If 105 | Set Session(cartName) = cart 106 | End Function 107 | 108 | '@Remove(ByRef productId): 移除购物车产品 109 | 110 | Public Function Remove(ByRef productId) 111 | cart.Remove(productId) 112 | Set Session(cartName) = cart 113 | End Function 114 | 115 | '@RemoveAll(): 清空购物车 116 | 117 | Public Function RemoveAll() 118 | cart.RemoveAll() 119 | Set Session(cartName) = cart 120 | End Function 121 | 122 | '@CurrencyPrice(ByRef prices, ByRef currencys, ByRef decimals): 公式 - 汇率计算 123 | 124 | Public Function CurrencyPrice(ByRef prices, ByRef currencys, ByRef decimals) 125 | If IsNull(prices) Then 126 | CurrencyPrice = 0 127 | Else 128 | CurrencyPrice = Round(prices * currencys, decimals) 129 | End If 130 | End Function 131 | 132 | '@BuyDiscount(discount, discounts, quatity): 公式 - 折扣表计算 133 | '10:9.5,20:9,30:8.5,40:8 134 | 135 | Public Function BuyDiscount(ByRef discount, ByRef discounts, ByRef quatity) 136 | Dim i, discount_array, unit_array 137 | BuyDiscount = 10 138 | If discount>0 And discount<10 Then 139 | BuyDiscount = discount 140 | ElseIf discounts&"" <> "" Then 141 | discount_array = Split(discounts, ",") 142 | For i = 0 To UBound(discount_array) 143 | unit_array = Split(discount_array(i), ":") 144 | If UBound(unit_array) = 1 Then 145 | If CDbl(quatity)>= CDbl(unit_array(0)) Then 146 | BuyDiscount = CDbl(unit_array(1)) 147 | End If 148 | End If 149 | Next 150 | End If 151 | End Function 152 | 153 | '@ShipWeight(ByRef country_code, ByRef sum_weight, ByRef table_fee): 公式 - 重量运费表计算 154 | 'us,gb,es|1:2,2:3,10:100 155 | 156 | Public Function ShipWeight(ByRef country_code, ByRef sum_weight, ByRef table_fee) 157 | Dim i, j, k 158 | Dim line_array, country_array, fee_array, unit_array 159 | ShipWeight = -1 160 | ' 161 | line_array = Split(table_fee, vbCrLf) 162 | For i = 0 To UBound(line_array) 163 | ' 164 | country_array = Split(line_array(i), "|") 165 | If UBound(country_array) = 1 Then 166 | If InStr(country_array(0), country_code)>0 Then 167 | ' 168 | fee_array = Split(country_array(1), ",") 169 | For k = 0 To UBound(fee_array) 170 | ' 171 | unit_array = Split(fee_array(k), ":") 172 | If UBound(unit_array) = 1 Then 173 | If CDbl(sum_weight)>= CDbl(unit_array(0)) Then 174 | ShipWeight = CDbl(unit_array(1)) 175 | End If 176 | End If 177 | Next 178 | End If 179 | End If 180 | Next 181 | End Function 182 | 183 | End Class 184 | %> -------------------------------------------------------------------------------- /inc/class/ext/json.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Json 3 | '@author: json.org 4 | '@date: 2009-05-12 5 | '@description: 系统JSON类文件 Version 2.0.2 6 | 7 | Class Class_Ext_Json 8 | 9 | Public collection 10 | 11 | Public count 12 | 13 | '@quotedVars: 是否为变量增加引号 14 | 15 | Public quotedVars 16 | 17 | Public kind '0 = object, 1 = array 18 | 19 | Private Sub Class_Initialize 20 | Set collection = Server.CreateObject("Scripting.Dictionary") 21 | quotedVars = True 22 | count = 0 23 | End Sub 24 | 25 | Private Sub Class_Terminate 26 | Set collection = Nothing 27 | End Sub 28 | 29 | 'counter 30 | 31 | Private Property Get counter 32 | counter = count 33 | count = count + 1 34 | End Property 35 | 36 | '@setKind: 设置对象类型 0 = object, 1 = array 37 | 38 | Public Property Let setKind(fpKind) 39 | Select Case LCase(fpKind) 40 | Case "object" 41 | kind = 0 42 | Case "array" 43 | kind = 1 44 | End Select 45 | End Property 46 | 47 | '@Pair: Pair(p)=v 48 | 49 | Public Property Let Pair(p, v) 50 | If IsNull(p) Then p = counter 51 | collection(p) = v 52 | End Property 53 | 54 | Public Property Set Pair(p, v) 55 | If IsNull(p) Then p = counter 56 | If TypeName(v) <> "Class_Ext_Json" Then 57 | Err.Raise &hD, "class: class", "class object: '" & TypeName(v) & "'" 58 | End If 59 | Set collection(p) = v 60 | End Property 61 | 62 | Public Default Property Get Pair(p) 63 | If IsNull(p) Then p = Count - 1 64 | If IsObject(collection(p)) Then 65 | Set Pair = collection(p) 66 | Else 67 | Pair = collection(p) 68 | End If 69 | End Property 70 | 71 | ' 72 | 73 | Public Sub Clean 74 | collection.RemoveAll 75 | End Sub 76 | 77 | Public Sub Remove(ByRef vProp) 78 | collection.Remove vProp 79 | End Sub 80 | 81 | ' data maluplation 82 | 83 | ' encoding 84 | 85 | Public Function JsEncode(ByRef Str) 86 | Dim i, j, aL1, aL2, c, p 87 | 88 | aL1 = Array(&h22, &h5C, &h2F, &h08, &h0C, &h0A, &h0D, &h09) 89 | aL2 = Array(&h22, &h5C, &h2F, &h62, &h66, &h6E, &h72, &h74) 90 | For i = 1 To Len(Str) 91 | p = True 92 | c = Mid(Str, i, 1) 93 | For j = 0 To 7 94 | If c = Chr(aL1(j)) Then 95 | JsEncode = JsEncode & "\" & Chr(aL2(j)) 96 | p = False 97 | Exit For 98 | End If 99 | Next 100 | 101 | If p Then 102 | Dim a 103 | a = AscW(c) 104 | If a > 31 And a < 127 Then 105 | JsEncode = JsEncode & c 106 | ElseIf a > -1 Or a < 65535 Then 107 | JsEncode = JsEncode & "\u" & String(4 - Len(Hex(a)), "0") & Hex(a) 108 | End If 109 | End If 110 | Next 111 | End Function 112 | 113 | ' converting 114 | 115 | Public Function ToJSON(ByRef vPair) 116 | Select Case VarType(vPair) 117 | Case 1 ' Null 118 | ToJSON = "null" 119 | Case 7 ' Date 120 | ' yaz saati problemi var 121 | ' jsValue = "new Date(" & Round((vVal - #01/01/1970 02:00#) * 86400000) & ")" 122 | ToJSON = """" & CStr(vPair) & """" 123 | Case 8 ' String 124 | ToJSON = """" & JsEncode(vPair) & """" 125 | Case 9 ' Object 126 | Dim bFI, i 127 | bFI = True 128 | If vPair.kind Then ToJSON = ToJSON & "[" Else ToJSON = ToJSON & "{" 129 | For Each i In vPair.collection 130 | If bFI Then bFI = False Else ToJSON = ToJSON & "," 131 | 132 | If vPair.kind Then 133 | ToJSON = ToJSON & ToJSON(vPair(i)) 134 | Else 135 | If quotedVars Then 136 | ToJSON = ToJSON & """" & i & """:" & ToJSON(vPair(i)) 137 | Else 138 | ToJSON = ToJSON & i & ":" & ToJSON(vPair(i)) 139 | End If 140 | End If 141 | Next 142 | If vPair.kind Then ToJSON = ToJSON & "]" Else ToJSON = ToJSON & "}" 143 | Case 11 144 | If vPair Then ToJSON = "true" Else ToJSON = "false" 145 | Case 12, 8192, 8204 146 | Dim sEB 147 | ToJSON = MultiArray(vPair, 1, "", sEB) 148 | Case Else 149 | ToJSON = Replace(vPair, ",", ".") 150 | End Select 151 | End Function 152 | 153 | Public Function MultiArray(ByRef aBD,ByRef iBC,ByRef sPS, ByRef sPT) ' Array BoDy, Integer BaseCount, String PoSition 154 | Dim iDU, iDL, i ' Integer DimensionUBound, Integer DimensionLBound 155 | On Error Resume Next 156 | iDL = LBound(aBD, iBC) 157 | iDU = UBound(aBD, iBC) 158 | 159 | Dim sPB1, sPB2 ' String PointBuffer1, String PointBuffer2 160 | If Err = 9 Then 161 | sPB1 = sPT & sPS 162 | For i = 1 To Len(sPB1) 163 | If i <> 1 Then sPB2 = sPB2 & "," 164 | sPB2 = sPB2 & Mid(sPB1, i, 1) 165 | Next 166 | MultiArray = MultiArray & ToJSON(Eval("aBD(" & sPB2 & ")")) 167 | Else 168 | sPT = sPT & sPS 169 | MultiArray = MultiArray & "[" 170 | For i = iDL To iDU 171 | MultiArray = MultiArray & MultiArray(aBD, iBC + 1, i, sPT) 172 | If i < iDU Then MultiArray = MultiArray & "," 173 | Next 174 | MultiArray = MultiArray & "]" 175 | sPT = Left(sPT, iBC - 2) 176 | End If 177 | End Function 178 | 179 | '@ToString: Json String 180 | 181 | Public Property Get ToString 182 | ToString = ToJSON(Me) 183 | End Property 184 | 185 | Public Sub Flush 186 | If TypeName(Response) <> "Empty" Then 187 | Response.Write(ToString) 188 | End If 189 | End Sub 190 | 191 | Public Function Clone 192 | Set Clone = ColClone(Me) 193 | End Function 194 | 195 | Private Function ColClone(ByRef core) 196 | Dim jsc, i 197 | Set jsc = New Class_Ext_Json 198 | jsc.kind = core.kind 199 | For Each i In core.collection 200 | If IsObject(core(i)) Then 201 | Set jsc(i) = ColClone(core(i)) 202 | Else 203 | jsc(i) = core(i) 204 | End If 205 | Next 206 | Set ColClone = jsc 207 | End Function 208 | 209 | End Class 210 | %> -------------------------------------------------------------------------------- /inc/class/ext/pack.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Pack 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 打包解包文件夹 6 | 7 | Class Class_Ext_Pack 8 | 9 | Private pathDir_ 10 | 11 | '@Pack(ByRef pathDir,ByRef pathFile): 将目录pathDir打包成pathFile 12 | 13 | Public Sub Pack(ByRef pathDir,ByRef pathFile) 14 | '创建一个空的XML文件，为写入文件作准备 15 | Dim XmlDoc, Root 16 | Set XmlDoc = Server.CreateObject("Microsoft.XMLDOM") 17 | XmlDoc.async = False 18 | Set Root = XmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'") 19 | XmlDoc.appendChild(Root) 20 | XmlDoc.appendChild(XmlDoc.CreateElement("root")) 21 | XmlDoc.Save(pathFile) 22 | Set Root = Nothing 23 | Set XmlDoc = Nothing 24 | '格式化路径 25 | If Right(pathDir,1)<>"\" Then pathDir = pathDir&"\" 26 | pathDir_ = pathDir 27 | '递归加载文件到xml 28 | LoadData pathDir, pathFile 29 | End Sub 30 | 31 | '遍历目录内的所有文件以及文件夹 32 | 33 | Private Sub LoadData(ByRef pathDir,ByRef pathFile) 34 | Dim XmlDoc 35 | Dim fso 'fso对象 36 | Dim objFolder '文件夹对象 37 | Dim objSubFolders '子文件夹集合 38 | Dim objSubFolder '子文件夹对象 39 | Dim objFiles '文件集合 40 | Dim objFile '文件对象 41 | Dim objStream 42 | Dim pathname, TextStream, pp, Xfolder, Xfpath, Xfile, Xpath, Xstream 43 | Dim PathNameStr 44 | ' 45 | Set fso = server.CreateObject("scripting.filesystemobject") 46 | Set objFolder = fso.GetFolder(pathDir)'创建文件夹对象 47 | ' 48 | Set XmlDoc = Server.CreateObject("Microsoft.XMLDOM") 49 | XmlDoc.load pathFile 50 | XmlDoc.async = False 51 | '写入每个文件夹路径 52 | Set Xfolder = XmlDoc.SelectSingleNode("//root").AppendChild(XmlDoc.CreateElement("folder")) 53 | Set Xfpath = Xfolder.AppendChild(XmlDoc.CreateElement("path")) 54 | Xfpath.text = Replace(pathDir, pathDir_, "") 55 | Set objFiles = objFolder.Files 56 | For Each objFile in objFiles 57 | If LCase(pathDir & objFile.Name)<> LCase(Request.ServerVariables("PATH_TRANSLATED"))Then 58 | PathNameStr = pathDir & objFile.Name 59 | '写入文件的路径及文件内容 60 | Set Xfile = XmlDoc.SelectSingleNode("//root").AppendChild(XmlDoc.CreateElement("file")) 61 | Set Xpath = Xfile.AppendChild(XmlDoc.CreateElement("path")) 62 | Xpath.text = Replace(PathNameStr, pathDir_, "") 63 | '读文件流 64 | Set objStream = Server.CreateObject("ADODB.Stream") 65 | objStream.Type = 1 66 | objStream.Open() 67 | objStream.LoadFromFile(PathNameStr) 68 | objStream.position = 0 69 | '流转base64 70 | Set Xstream = Xfile.AppendChild(XmlDoc.CreateElement("stream")) 71 | Xstream.SetAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes" 72 | Xstream.dataType = "bin.base64" 73 | Xstream.nodeTypedValue = objStream.Read() 74 | Set Xstream = Nothing 75 | Set objStream = Nothing 76 | Set Xpath = Nothing 77 | Set Xfile = Nothing 78 | End If 79 | Next 80 | XmlDoc.Save(pathFile) 81 | Set Xfpath = Nothing 82 | Set Xfolder = Nothing 83 | Set XmlDoc = Nothing 84 | 85 | '创建的子文件夹对象 调用递归遍历子文件夹 86 | Set objSubFolders = objFolder.SubFolders 87 | For Each objSubFolder in objSubFolders 88 | pathName = pathDir & objSubFolder.Name &"\" 89 | Call LoadData(pathName, pathFile) 90 | Next 91 | Set objSubFolders = Nothing 92 | ' 93 | Set objFolder = Nothing 94 | Set fso = Nothing 95 | End Sub 96 | 97 | '@UnPack(ByRef pathFile,ByRef pathDir): 将pathFile解包到pathDir 98 | 99 | Public Sub UnPack(ByRef pathFile,ByRef pathDir) 100 | On Error Resume Next 101 | Dim objXmlFile 102 | Dim objNodeList 103 | Dim objFSO 104 | Dim objStream 105 | Dim i, j 106 | If Right(pathDir,1)<>"\" Then pathDir = pathDir&"\" 107 | ' 108 | Set objXmlFile = Server.CreateObject("Microsoft.XMLDOM") 109 | objXmlFile.load(pathFile) 110 | 111 | If objXmlFile.readyState = 4 Then 112 | If objXmlFile.parseError.errorCode = 0Then 113 | '输出目录 114 | Set objNodeList = objXmlFile.documentElement.selectNodes("//folder/path") 115 | Set objFSO = CreateObject("Scripting.FileSystemObject") 116 | j = objNodeList.Length -1 117 | For i = 0 To j 118 | If objFSO.FolderExists(pathDir & objNodeList(i).text) = False Then 119 | objFSO.CreateFolder(pathDir & objNodeList(i).text) 120 | End If 121 | Next 122 | Set objFSO = Nothing 123 | Set objNodeList = Nothing 124 | '输出文件 125 | Set objNodeList = objXmlFile.documentElement.selectNodes("//file/path") 126 | j = objNodeList.Length -1 127 | For i = 0 To j 128 | Set objStream = CreateObject("ADODB.Stream") 129 | With objStream 130 | .Type = 1 131 | .Open 132 | .Write objNodeList(i).nextSibling.nodeTypedvalue 133 | .SaveToFile pathDir & objNodeList(i).text, 2 134 | .Close 135 | End With 136 | Set objStream = Nothing 137 | Next 138 | Set objNodeList = Nothing 139 | End If 140 | End If 141 | 142 | Set objXmlFile = Nothing 143 | End Sub 144 | 145 | End Class 146 | %> -------------------------------------------------------------------------------- /inc/class/ext/wia.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Wia 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 扫描仪实现图片缩放类 6 | 7 | Class Class_Ext_Wia 8 | ' 9 | Private v,thumb,img,ip 10 | Private isDebug_ 11 | Private buildWidth, buildHeight '目标尺寸 12 | Private csText_, csImg_ '水印 13 | 14 | '@Version: 版本 15 | 16 | Public Property Get Version 17 | version = "1.0" 18 | End Property 19 | 20 | '@isDebug: 是否设置为调试模式 21 | 22 | Public Property Let isDebug(Value) 23 | isDebug_ = Value 24 | End Property 25 | 26 | '@csText: 水印文字 27 | 28 | Public Property Let csText(Value) 29 | csText_ = Value 30 | End Property 31 | 32 | '@csImg: 水印图片 33 | 34 | Public Property Let csImg(Value) 35 | csImg_ = Value 36 | End Property 37 | 38 | Private Sub Class_Initialize 39 | If IsEmpty(DEBUGS) Then 40 | isDebug_ = False 41 | Else 42 | isDebug_ = DEBUGS 43 | End If 44 | ' 45 | On Error Resume Next 46 | Set v = CreateObject("WIA.Vector") 47 | Set thumb = CreateObject("WIA.ImageFile") 48 | Set Img = server.CreateObject("WIA.ImageFile") 49 | Set IP = server.CreateObject("WIA.ImageProcess") 50 | ' 51 | If Err.Number <> 0 Then OutErr("创建WIA失败") 52 | End Sub 53 | 54 | Private Sub Class_Terminate 55 | Set IP = Nothing 56 | Set Img = Nothing 57 | Set thumb = Nothing 58 | Set v = Nothing 59 | End Sub 60 | 61 | '@BuildPic(ByRef originalPath, ByRef buildBasePath, ByRef maxWidth, ByRef maxHeight): 生成图片 62 | 63 | Public Function BuildPic(ByRef originalPath, ByRef buildBasePath, ByRef maxWidth, ByRef maxHeight) 64 | On Error Resume Next 65 | Dim i:i=0 66 | If originalPath = "" Then Exit Function 67 | '加载图片 68 | Img.LoadFile Server.MapPath(originalPath) 69 | 'EXIF过滤器：写一个新的标题标签图像 70 | If csText_ <> "" Then 71 | i=i+1 72 | IP.Filters.Add IP.FilterInfos("Exif").FilterID 73 | IP.Filters(i).Properties("ID") = 40091 74 | IP.Filters(i).Properties("Type") = 1101 'VectorOfBytesImagePropertyType 75 | v.SetFromString csText_ 76 | IP.Filters(i).Properties("Value") = v 77 | End If 78 | 'ARGB过滤器：创建一个修改版本的图片 79 | If False Then 80 | i=i+1 81 | Set c = Img.ARGBData 82 | For j = 1 To c.Count Step 21 83 | c(j) = &HFFFF00FF 'opaque pink (A=255,R=255,G=0,B=255) 84 | Next 85 | IP.Filters.Add IP.FilterInfos("ARGB").FilterID 86 | Set IP.Filters(i).Properties("ARGBData") = c 87 | End If 88 | '邮票过滤器：加图片标题信息 89 | If csImg_<>"" Then 90 | i=i+1 91 | Thumb.LoadFile Server.MapPath(csImg_) 92 | IP.Filters.Add IP.FilterInfos("Stamp").FilterID 93 | Set IP.Filters(i).Properties("ImageFile") = Thumb 94 | IP.Filters(i).Properties("Left") = Img.Width - Thumb.Width 95 | IP.Filters(i).Properties("Top") = Img.Height - Thumb.Height 96 | End If 97 | '裁剪滤镜：裁剪图片 98 | If False Then 99 | i=i+1 100 | IP.Filters.Add IP.FilterInfos("Crop").FilterID 101 | IP.Filters(i).Properties("Left") = Img.Width \ 4 102 | IP.Filters(i).Properties("Top") = Img.Height \ 4 103 | IP.Filters(i).Properties("Right") = Img.Width \ 4 104 | IP.Filters(i).Properties("Bottom") = Img.Height \ 4 105 | End If 106 | '缩放滤镜：调整图像的大小 107 | If True Then 108 | i=i+1 109 | IP.Filters.Add IP.FilterInfos("Scale").FilterID 110 | IP.Filters(i).Properties("MaximumWidth") = maxWidth 111 | IP.Filters(i).Properties("MaximumHeight") = maxHeight 112 | End If 113 | '旋转过滤器：旋转图片 114 | If False Then 115 | i=i+1 116 | IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID 117 | IP.Filters(i).Properties("RotationAngle") = 90 118 | End If 119 | '图片格式转换：创建一个压缩的JPEG文件 120 | If False Then 121 | i=i+1 122 | 'wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}" 123 | 'wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" 124 | 'wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}" 125 | 'wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}" 126 | wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" 127 | IP.Filters.Add IP.FilterInfos("Convert").FilterID 128 | IP.Filters(i).Properties("FormatID").Value = wiaFormatJPEG 129 | IP.Filters(i).Properties("Quality").Value = 8 130 | End If 131 | '最终执行 132 | Set Img = IP.Apply(Img) 133 | '保存 134 | buildFileName = MakeName(originalPath,maxWidth, maxHeight) 135 | DeleteFile Server.MapPath(buildBasePath)&"\"&buildFileName 136 | Img.SaveFile Server.MapPath(buildBasePath)&"\"&buildFileName 137 | '文件名 138 | If Right(buildBasePath, 1) <> "/" Then buildBasePath = buildBasePath & "/" 139 | If Err.Number <> 0 then 140 | OutErr("缩略图存盘失败,BuildBasePath") 141 | BuildPic = originalPath 142 | else 143 | BuildPic = buildBasePath&buildFileName 144 | end if 145 | End Function 146 | 147 | '命名图片 148 | 149 | Private Function MakeName(ByRef originalPath, ByRef maxWidth, ByRef maxHeight) 150 | Dim pos, oName, oExt 151 | pos = InStrRev(originalPath, "/") + 1 152 | oName = Mid(originalPath, pos) 153 | pos = InStrRev(oName, ".") 154 | oExt = Mid(oName, pos) 155 | MakeName = Replace(oName, oExt, "."&maxWidth&"x"&maxHeight&oExt) 156 | End Function 157 | 158 | '删除已存在图片 159 | 160 | Private Function DeleteFile(ByRef path) 161 | Dim fso 162 | Set fso=Server.CreateObject("Scripting.FileSystemObject") 163 | If fso.FileExists(path) Then 164 | fso.DeleteFile(path) 165 | End If 166 | Set fso=Nothing 167 | End Function 168 | 169 | '错误提示 170 | 171 | Private Sub OutErr(str) 172 | If isDebug_ Then 173 | Response.charset = "utf-8" 174 | Response.Write str 175 | Response.End 176 | End If 177 | End Sub 178 | 179 | End Class 180 | %> -------------------------------------------------------------------------------- /inc/module/default/control/start/site.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Start_Site 3 | '@author: ekede.com 4 | '@date: 2018-02-01 5 | '@description: module启动入口 6 | 7 | Class Control_Start_Site 8 | 9 | '@config: 配置数据存储,便于不同对象间交换数据 10 | '@tempdata: 临时数据存储,便于不同对象间交换数据 11 | Dim config 12 | Dim tempdata 13 | '@langId: 站点语言id 14 | Dim langId 15 | '@langDefaultPath: 默认语言文件夹 16 | '@langPath: 当前语言文件夹 17 | Dim langDefaultPath,langPath 18 | '@tplDefaultPath: 默认模板文件夹 19 | '@tplPath: 当前模板文件夹 20 | Dim tplDefaultPath,tplPath 21 | 22 | Private Sub Class_Initialize() 23 | '判断数据安装,正式上线可删除 24 | If wts.fso.ReportFolderStatus(wts.fso.GetMapPath(PATH_ROOT&PATH_DATA)) = -1 Then 25 | wts.responses.Direct(wts.route.basePicAddr&"index.asp?route=help/install") 26 | End If 27 | 28 | '全局容器 29 | Set config = Server.CreateObject("Scripting.Dictionary") 30 | Set tempdata = Server.CreateObject("Scripting.Dictionary") 31 | ' 32 | Set wts.template = loader.LoadClass("Template") 33 | wts.template.loader = loader 34 | wts.template.tempdata = tempdata 35 | Set wts.cache = loader.LoadClass("Cache") 36 | wts.cache.fso = wts.fso 37 | Set wts.db = loader.LoadClass("DB") 38 | If DB_TYPE > 0 Then wts.db.OpenConn DB_TYPE, DB_VERSION, DB_PATH, DB_NAME, DB_USER, DB_PASS 39 | DB_USER = "" 40 | DB_PASS = "" 41 | ' 42 | langId = 0 43 | langDefaultPath = "en" 44 | langPath = langDefaultPath 45 | tplDefaultPath = "default" 46 | tplPath = tplDefaultPath 47 | End Sub 48 | 49 | Private Sub Class_Terminate() 50 | Set wts.db = Nothing 51 | Set wts.cache = Nothing 52 | Set wts.template = Nothing 53 | '释放容器 54 | Set tempdata = Nothing 55 | Set config = Nothing 56 | End Sub 57 | 58 | '@Start(): 启动模块配置 59 | 60 | Public Function Start() 61 | 62 | '路由配置 正则,图片,关键词 reg,pic,key 63 | wts.route.routers = "pic,key" 64 | 'wts.route.rewrite_on = True '开启地址重写 65 | 66 | '初始化站点langId 67 | 'SetBaseAddr() '自定义路由多网址功能 68 | ' 69 | loader.languageDefaultPath = PATH_MODULE&wts.route.module&"/"&PATH_LANGUAGE&langDefaultPath&"/" 70 | loader.languagePath = PATH_MODULE&wts.route.module&"/"&PATH_LANGUAGE&langPath&"/" 71 | ' 72 | templateDefaultPath = PATH_MODULE&wts.route.module&"/"&PATH_VIEW&tplDefaultPath&"/" 73 | loader.templateDefaultPath = templateDefaultPath&"tpl/" 74 | wts.template.pathD_tpl = templateDefaultPath&"tpl/" 75 | ' 76 | templatePath = PATH_MODULE&wts.route.module&"/"&PATH_VIEW&tplPath&"/" 77 | loader.templatePath = templatePath&"tpl/" 78 | wts.template.path_tpl = templatePath&"tpl/" 79 | ' 80 | wts.cache.datapath = PATH_DATA&"cache/"&langId&"/" 81 | 82 | '路由分析 83 | 'SetUrlkey() '自定义路由SEO Url功能 84 | wts.route.DeWrite() 85 | ' 86 | config("base_url") = wts.route.baseAddr 87 | config("base_pic_url") = wts.route.basePicAddr 88 | config("base_static_url") = wts.route.basePicAddr&PATH_STATIC&wts.route.module&"/"&tplPath&"/" 89 | ' 90 | loader.LoadControlAction wts.route.control, wts.route.action, "" 91 | ' 92 | wts.responses.outputs 93 | End Function 94 | 95 | '取得虚拟根目录及其参数 96 | 97 | Private Sub SetBaseAddr() 98 | ' 99 | If wts.route.rewrite_on = FALSE Then Exit Sub 100 | dim i,arr,bie_location,bie_base,BaseA 101 | ' 102 | siteKeys = wts.cache.GetValue("siteKeys") 103 | If IsArray(siteKeys)=False Then '读数据库-数组演示 104 | ReDim siteKeys(3) 105 | siteKeys(0) = Array(1,"http://localhost/en/","","en","default") 106 | siteKeys(1) = Array(2,"http://localhost/cn/","","en","default") 107 | siteKeys(2) = Array(3,"http://localhost/de/","","en","default") 108 | siteKeys(3) = Array(4,"http://localhost/","","cn","new") 109 | wts.cache.SetValue "siteKeys", siteKeys 110 | End If 111 | ' 112 | bie_location=wts.route.GetBieUrl(wts.requests.standardAddr) 113 | For i = 0 to Ubound(siteKeys) 114 | bie_base=wts.route.GetBieUrl(siteKeys(i)(1)) 115 | If Instr(bie_location,bie_base)>0 then 116 | baseA=siteKeys(i) 117 | Exit For 118 | End If 119 | Next 120 | ' 121 | If IsArray(baseA) Then 122 | langId=baseA(0) 123 | langPath = baseA(3) 124 | tplPath = baseA(4) 125 | wts.route.SetBaseAddr baseA(1) 126 | If baseA(2) <> "" Then wts.route.SetBasePicAddr baseA(2) 127 | Else 128 | wts.responses.Die("Invalid Site") 129 | End if 130 | End Sub 131 | 132 | '缓存urlKeys+id 133 | 134 | Private Sub SetUrlkey() 135 | 136 | '是否开启重写 137 | If wts.route.rewrite_on = False Then Exit Sub 138 | 139 | 'urlkey路由设置 140 | If IsObject(wts.route("key")) Then 141 | urlKeys = wts.cache.GetValue("urlKeys") 142 | urlDKeys = wts.cache.GetValue("urlDKeys") 143 | If IsArray(urlKeys) and IsArray(urlDKeys) Then '读取 144 | For i = 0 To UBound(urlKeys) 145 | wts.route("key").SetUrlKey urlKeys(i)(0), urlKeys(i)(1) 146 | wts.route("key").SetDUrlKey urlDKeys(i)(0), urlDKeys(i)(1) 147 | Next 148 | Else '读数据库-数组演示 149 | ReDim urlKeys(10),urlDKeys(10) 150 | For i = 0 To UBound(urlKeys) 151 | k = "hello"&i&".html" 152 | v = "hello/detail/id/"&i 153 | urlKeys(i) = Array(k, v) 154 | urlDKeys(i) = Array(v, k) 155 | ' 156 | wts.route("key").SetUrlKey k, v 157 | wts.route("key").SetDUrlKey v, k 158 | Next 159 | wts.cache.SetValue "urlKeys", urlKeys 160 | wts.cache.SetValue "urlDKeys", urlDKeys 161 | End If 162 | wts.route("key").SetUrlKey "index.html", "index/index" 163 | wts.route("key").SetDUrlKey "index/index", "index.html" 164 | End If 165 | 166 | '正则路由设置 167 | If IsObject(wts.route("reg")) Then 168 | wts.route("reg").SetRegKey "^test-([0-9]+)\.do$","hello/detail/id/$1" 169 | wts.route("reg").SetRegKey "^robots\.txt$","hello/index/page/2" 170 | End If 171 | 172 | End Sub 173 | 174 | End Class 175 | %> -------------------------------------------------------------------------------- /inc/class/cache.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Cache 3 | '@author: ekede.com 4 | '@date: 2017-12-7 5 | '@description: 缓存操作类 6 | 7 | Class Class_Cache 8 | ' 9 | Private fso_ 10 | Private cacheTime_ 11 | Private cacheDataPath_ 12 | Private cacheDict_ 13 | 14 | '@fso: fso对象依赖 15 | 16 | Public Property Let fso(Values) 17 | Set fso_ = Values 18 | End Property 19 | 20 | '@cacheTime: 缓存时间 21 | 22 | Public Property Let cacheTime(Values) 23 | cacheTime_ = Values 24 | End Property 25 | 26 | '@dataPath: 数据缓存路径, 根据需要叠加全局缓存因子 PATH_DATA/cache/default/site_id/language_id/currency_id/usergroup_id ... 27 | 28 | Public Property Let dataPath(Values) 29 | cacheDataPath_ = PATH_ROOT&Values 30 | set cacheDict_ = CreateDict("dict_"&cacheDataPath_) '创建容器 31 | End Property 32 | 33 | Private Sub Class_Initialize() 34 | cacheTime_ = 3600 35 | End Sub 36 | 37 | Private Sub Class_Terminate() 38 | End Sub 39 | 40 | '@GetCache(ByRef names): File 读 41 | 42 | Public Function GetCache(ByRef names) 43 | Dim paths, str 44 | paths = cacheDataPath_&names 45 | ' 46 | ExpireCache names 47 | Str = fso_.Reads(fso_.getmappath(paths),"UTF-8") 48 | If Str = "" Then 49 | GetCache = -1 50 | Else 51 | GetCache = str 52 | End If 53 | End Function 54 | 55 | '@SetCache(ByRef names,ByRef content): File 写 56 | 57 | Public Function SetCache(ByRef names,ByRef content) 58 | Dim paths 59 | Dim fpath, fname 60 | Dim i, arr 61 | paths = cacheDataPath_&names 62 | ' 63 | If InStr(paths, "/")>0 Then 64 | arr = Split(paths, "/") 65 | For i = 0 To UBound(arr) -1 66 | fpath = fpath&arr(i)&"/" 67 | Next 68 | End If 69 | fname = Replace(paths, fpath, "") 70 | ' 71 | fso_.createFolders fso_.getmappath(fpath) 72 | SetCache = fso_.Writes(fso_.getmappath(paths), content, "UTF-8") 73 | End Function 74 | 75 | '@DelCache(ByRef names): File 删 76 | 77 | Public Function DelCache(ByRef names) 78 | DelCache = fso_.DeleteAFile(fso_.GetMapPath(cacheDataPath_&names)) 79 | End Function 80 | 81 | '@ExpireCache(ByRef names): File 过期 82 | 83 | Public Function ExpireCache(ByRef names) 84 | Dim paths, transtime 85 | paths = cacheDataPath_&names 86 | Transtime = fso_.ShowFileAccessInfo(fso_.getmappath(paths), 3) 87 | If transtime<> -1 Then 88 | If cacheTime_ = 0 Then Exit Function 89 | If DateDiff("s", CDate(transtime), Now())>cacheTime_ Then delCache names 90 | End If 91 | End Function 92 | 93 | '@ClearCache(): File 清 94 | 95 | Public Function ClearCache() 96 | ClearCache = fso_.DeleteAFolder(fso_.GetMapPath(cacheDataPath_)) 97 | End Function 98 | 99 | '****** Value -> cache 100 | 101 | '@GetValue(ByRef names): APPLICATION 读 102 | 103 | Public Function GetValue(ByRef names) 104 | Dim str 105 | str = Application("cache_"&cacheDataPath_&names) 106 | If IsArray(str) Then 107 | ElseIf IsObject(str) Then 108 | ElseIf str = "" Then 109 | str = -1 110 | End If 111 | GetValue = str 112 | End Function 113 | 114 | '@SetValue(ByRef names,ByRef Content): APPLICATION 写 支持数组 115 | 116 | Public Function SetValue(ByRef names,ByRef Content) 117 | Application.Contents("cache_"&cacheDataPath_&names) = Content 118 | End Function 119 | 120 | '@DelValue(ByRef names): APPLICATION 删 121 | 122 | Public Function DelValue(ByRef names) 123 | Application.Contents.Remove("cache_"&cacheDataPath_&names) '释放容器 124 | End Function 125 | 126 | '@ExpireValue(ByRef names): APPLICATION 过期 127 | 128 | Public Function ExpireValue(ByRef names) 129 | DelValue(names) 130 | End Function 131 | 132 | '@ClearValue(): APPLICATION 清 133 | 134 | Public Function ClearValue() 135 | For Each objItem in Application.Contents 136 | If instr(objItem, "cache_"&cacheDataPath_)>0 Then application.Contents.Remove(objItem) 137 | Next 138 | End Function 139 | 140 | '****** Dictionary -> cache 141 | 142 | '@GetDict(ByRef names): Dictionary 读 143 | 144 | Public Function GetDict(ByRef names) 145 | Dim str 146 | str = cacheDict_.Item(names) 147 | If IsArray(str) Then 148 | ElseIf IsObject(str) Then 149 | ElseIf str = "" Then 150 | str = -1 151 | End If 152 | GetDict = str 153 | End Function 154 | 155 | '@SetDict(ByRef names,ByRef Content): Dictionary 写 156 | 157 | Public Function SetDict(ByRef names,ByRef Content) 158 | cacheDict_.Item(names) = Content 159 | End Function 160 | 161 | '@DelDict(ByRef names): Dictionary 删 162 | 163 | Public Function DelDict(ByRef names) 164 | If cacheDict_.Exists(names) Then cacheDict_.Remove(names) 165 | End Function 166 | 167 | '@ExpireDict(ByRef names): Dictionary 过期 168 | 169 | Public Function ExpireDict(ByRef names) 170 | DelDict(names) 171 | End Function 172 | 173 | '@ClearDict(): Dictionary 清 174 | 175 | Public Function ClearDict() 176 | cacheDict_.RemoveAll() 177 | End Function 178 | 179 | '@CleanDict(): Dictionary 释放容器 180 | 181 | Public Function CleanDict() 182 | Set cacheDict_ = Nothing 183 | CloseDict "dict_"&cacheDataPath_ 184 | End Function 185 | 186 | '****** 187 | 188 | '@CreateDict(ByRef kname): 创建字典容器方法 189 | 190 | Public Function CreateDict(ByRef kname) 191 | Dim isDic:isDic = True 192 | If IsArray(Application(kname)) Then 193 | If ubound(Application(kname))<>-1 Then 194 | If typename(Application(kname)(0))<>"Dictionary" Then isDic = False 195 | Else 196 | isDic = False 197 | End If 198 | Else 199 | isDic = False 200 | End If 201 | if Not isDic Then 202 | Application.Lock 203 | Application(kname) = Array(Server.CreateObject("Scripting.Dictionary")) 204 | Application.Unlock 205 | End If 206 | set CreateDict = Application(kname)(0) 207 | End function 208 | 209 | '@CloseDict(ByRef kname): 释放字典容器方法 210 | 211 | Public Function CloseDict(ByRef kname) 212 | Application.Lock 213 | Application.Contents.Remove(kname) 214 | Application.Unlock 215 | End Function 216 | 217 | End Class 218 | %> -------------------------------------------------------------------------------- /inc/class/valid.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Valid 3 | '@author: ekede.com 4 | '@date: 2017-11-29 5 | '@description: Valid类 6 | 7 | Class Class_Valid 8 | 9 | Private errs_ 10 | 11 | '@errs: 依赖errors对象 12 | 13 | Public Property Let errs(Values) 14 | Set errs_ = Values 15 | End Property 16 | 17 | Private Sub Class_Initialize() 18 | End Sub 19 | 20 | Private Sub Class_Terminate() 21 | End Sub 22 | 23 | 'SaveErr(ByRef message): 保存错误 24 | 25 | Private Sub SaveErr(ByRef message) 26 | errs_.AddMsg message 27 | End Sub 28 | 29 | '@Text(ByVal values, ByRef start, ByRef length, ByRef message): 验证字符串长度,并自动截取 30 | 31 | Public Function Text(ByVal values, ByRef start, ByRef length, ByRef message) 32 | If IsNull(values) Then values = "" 33 | If length<>0 And start<>0 Then '上限和下限 34 | If Len(values)>length Or Len(values)"" Then SaveErr message 36 | End If 37 | Text = Left(Trim(values), length) 38 | ElseIf length = 0 And start<>0 Then '下限和无上限 39 | If Len(values)"" Then SaveErr message 41 | End If 42 | Text = Trim(values) 43 | ElseIf length<>0 And start = 0 Then '上限和无下限 44 | If Len(values)>length Then 45 | If message<>"" Then SaveErr message 46 | End If 47 | Text = Left(Trim(values), length) 48 | End If 49 | End Function 50 | 51 | '@Num(ByVal values, ByRef start, ByRef length, ByRef message): 验证数字大小 52 | 53 | Public Function Num(ByVal values, ByRef start, ByRef length, ByRef message) 54 | If IsNumeric(values) = False Then 55 | Num = start 56 | If message<>"" Then SaveErr message 57 | Else 58 | Num = CDbl(values) 59 | If length<>0 And start<>0 Then '上限和下限 60 | If Num >length Or num"" Then SaveErr message 63 | End If 64 | ElseIf length = 0 And start<>0 Then '下限和无上限 65 | If Num"" Then SaveErr message 68 | End If 69 | ElseIf length<>0 And start = 0 Then '上限和无下限 70 | If Num>length Then 71 | Num = length 72 | If message<>"" Then SaveErr message 73 | End If 74 | End If 75 | End If 76 | End Function 77 | 78 | '@IntNum(ByRef values, ByRef start, ByRef length, ByRef message): 验证整形数字大小 79 | 80 | Public Function IntNum(ByRef values, ByRef start, ByRef length, ByRef message) 81 | IntNum = Fix(num(values, start, length, message)) 82 | End Function 83 | 84 | '@Bool(ByRef values, ByRef message): 验证布尔值 0,1 85 | 86 | Public Function Bool(ByRef values, ByRef message) 87 | If IsNumeric(values) = False Then 88 | Bool = 0 89 | If message<>"" Then SaveErr message 90 | ElseIf CInt(values) = 0 Then 91 | Bool = 0 92 | Else 93 | Bool = 1 94 | End If 95 | End Function 96 | 97 | '@Email(ByRef values,ByRef message): 验证邮箱 98 | 99 | Public Function Email(ByRef values,ByRef message) 100 | If IsValidEmail (values) = False Then 101 | Email = "" 102 | If message<>"" Then SaveErr message 103 | Else 104 | Email = values 105 | End If 106 | End Function 107 | 108 | '@VerifyCode(ByRef values, ByRef message): 验证码 109 | 110 | Public Function VerifyCode(ByVal values, ByVal message) 111 | Dim ver 112 | ver = Session("verifycode") '全局变量 113 | ' 114 | If Trim(values) <> CStr(ver) Then 115 | Session("verifycode") = "" 116 | If message<>"" Then SaveErr message 117 | Else 118 | VerifyCode = ver 119 | End If 120 | End Function 121 | 122 | '@Times(ByRef values, ByRef start, ByRef length, ByRef message): 验证时间 123 | 124 | Public Function Times(ByRef values,ByRef start, ByRef length, ByRef message) 125 | If values<>"" And IsDate(values) = true Then 126 | times = CDate(values) 127 | Else 128 | If message<>"" Then SaveErr message 129 | times = Now() 130 | End If 131 | End Function 132 | 133 | '@Safe(ByVal values): 验证单引号 134 | 135 | Public Function Safe(ByVal values) 136 | if isNull(values) or values="" Then exit function 137 | Safe = Replace(values, "'", "") 138 | End Function 139 | 140 | '@Safes(ByRef values): 验证sql注入 141 | 142 | Public Function Safes(ByRef values) 143 | dim inj_data,inj_arr,str,i 144 | str = lcase(values&"") 145 | inj_data = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare" 146 | inj_arr = split(inj_data,"|") 147 | For i=0 To Ubound(inj_arr) 148 | if instr(str,inj_arr(i)) > 0 Then exit function 149 | next 150 | Safes = lcase(values&"") 151 | End Function 152 | 153 | '验证邮箱 154 | 155 | Private Function IsValidEmail(ByRef email) 156 | Dim wname, Name, i, c 157 | IsValidEmail = true 158 | wname = Split(email, "@") 159 | If UBound(wname) <> 1 Then 160 | IsValidEmail = false 161 | Exit Function 162 | End If 163 | For Each Name in wname 164 | If Len(Name) <= 0 Then 165 | IsValidEmail = false 166 | Exit Function 167 | End If 168 | For i = 1 To Len(Name) 169 | c = LCase(Mid(Name, i, 1)) 170 | If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then 171 | IsValidEmail = false 172 | Exit Function 173 | End If 174 | Next 175 | If Left(Name, 1) = "." Or Right(Name, 1) = "." Then 176 | IsValidEmail = false 177 | Exit Function 178 | End If 179 | Next 180 | If InStr(wname(1), ".") <= 0 Then 181 | IsValidEmail = false 182 | Exit Function 183 | End If 184 | i = Len(wname(1)) - InStrRev(wname(1), ".") 185 | If i <> 2 And i <> 3 Then 186 | IsValidEmail = false 187 | Exit Function 188 | End If 189 | If InStr(email, "..") > 0 Then 190 | IsValidEmail = false 191 | End If 192 | End Function 193 | 194 | End Class 195 | %> -------------------------------------------------------------------------------- /inc/module/default/control/crypt.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Crypt 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 加密解密 6 | 7 | Class Control_Crypt 8 | 9 | Private Sub Class_Initialize() 10 | End Sub 11 | 12 | Private Sub Class_Terminate() 13 | End Sub 14 | 15 | '@Index_Action(): 16 | 17 | Sub Index_Action() 18 | Call Test5 19 | End Sub 20 | 21 | '散列,哈西 22 | 23 | Private Sub Test0() 24 | '#md5演示: 25 | Set c = loader.loadClass("Ext/Md5") 26 | wts.responses.SetOutput "md5(""你好"") : "& c.MD5("你好",32) '中文不一致的问题 27 | Set c = Nothing 28 | '## 29 | End Sub 30 | 31 | Private Sub Test1() 32 | '#HMACMD5演示: 33 | Set h = loader.loadClass("Crypt/Hex") 34 | Set c = loader.loadClass("Crypt/Md5") 35 | wts.responses.SetOutput h.Bytes2Hex(c.MD5("你好")) 36 | wts.responses.SetOutput h.Bytes2Hex(c.HMACMD5("你好","123")) 37 | Set c = Nothing 38 | Set h = Nothing 39 | '## 40 | End Sub 41 | 42 | Private Sub Test2() 43 | '#HMACSHA1演示: 44 | Set h = loader.loadClass("Crypt/Hex") 45 | Set c = loader.loadClass("Crypt/Sha") 46 | wts.responses.SetOutput h.Bytes2Hex(c.SHA1("你好")) 47 | wts.responses.SetOutput h.Bytes2Hex(c.HMACSHA1("你好","123")) 48 | Set c = Nothing 49 | Set h = Nothing 50 | '## 51 | End Sub 52 | 53 | 'Base64,转码 54 | 55 | Private Sub Test3() 56 | '#Base64演示: 57 | Set c = loader.loadClass("Crypt/Base64") 58 | x = c.Bytes2Base64(wts.fso.Str2Bytes("Str,二进制,Base64转换","utf-8")) 59 | wts.responses.SetOutput wts.fso.Bytes2Str(c.Base642Bytes(x),"utf-8") 60 | Set c = Nothing 61 | '## 62 | End Sub 63 | 64 | Private Sub Test4() 65 | Set c = loader.loadClass("Crypt/Escape") 66 | x = c.Escape("Escape,UnEscape函数") 67 | wts.responses.SetOutput c.UnEscape(x) 68 | Set c = Nothing 69 | End Sub 70 | 71 | Private Sub Test5() 72 | Set c = loader.loadClass("Crypt/A2U") 73 | x = c.Encode("ASCII,UNICODE转换") 74 | wts.responses.SetOutput c.Decode(x) 75 | Set c = Nothing 76 | End Sub 77 | 78 | Private Sub Test6() 79 | Set c = loader.loadClass("Crypt/Num") 80 | wts.responses.SetOutput c.DcH(30) 81 | Set c = Nothing 82 | End Sub 83 | 84 | Private Sub Test7() 85 | Set c = loader.loadClass("Crypt/UrlDecode") 86 | c.UrlDecode(server.URLEncode("url解码")) 87 | Set c = Nothing 88 | End Sub 89 | 90 | 91 | '加密/解密-对称 92 | 93 | Private Sub Test8() 94 | Set c = loader.loadClass("Crypt/Des") 95 | x = c.DESEncrypt("DES加密,解密","12345678") 96 | wts.responses.SetOutput c.DESDecrypt(x,"12345678") 97 | Set c = Nothing 98 | End Sub 99 | 100 | Private Sub Test9() 101 | Set c = loader.loadClass("Crypt/Aes") 102 | x = c.AESEncrypt("AES加密,解密","12345678ABCDEFGH") 103 | wts.responses.SetOutput c.AESDecrypt(x,"12345678ABCDEFGH") 104 | Set c = Nothing 105 | End Sub 106 | 107 | '加密/解密-非对称 108 | 109 | Private Sub Test10() 110 | 111 | 112 | privatekey_pem="MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQC7wJL6+hjchXCbZCMkWDi7JThNf8f9wK4b7xSAavSqy9fo5SfEq7xgbXyEoYH/vL+cHCVzSZgfw9KQOZPZIZHnQszPZ7+vvIGS9rOXKS6XTOpVPAkcA6u1cNUrxBkwf+8XNE9mu+vVJvAIw+snlkZG198+ZP/sxWTzJZCj1eUCrYAHPrZrHA7UULpNlzc+mYT7ymvXz4CfMRqLRMKOrc1oLbxBavcsYkM798a1P9tbPS4Gtg+EIDF5jJawOiSJfQ1TSLFQHY+6Uaq+zO2OvFlhA+xkgiBnWUzP/jeut8caSu2Y54JLbn5T9uXN9lJEXpYNUiFPAErVwVFvi1WB3XTvAgMBAAECggEBALEYV0tmxjaTo4DfNoqcsH5OAEqRohnHOjNdEvCCcl/8QJ8ML7PB7cDi5RXRpeaMqgvdPLH/E/+6XQ3vUXb4xD/n8XodOWDRJUNzcji9/pV2Vn6pT0peaAOP93L92Gi389TmYZLc5Pk8biNGcbP4ejdufcPDzucN1kfHAiSXqBkZ4G/Fp8ImaG9EY2KdZ65cDUHPbx786oI4U/UYcQ2BYd5tjH0A2WVXna1Ok6Qz51gS5h8pen2ga24FZn5IuGgm9ZXVRjJXH16bmLz9Bxj7qHVmkyAUUwNQelvGnmpF0JKfPvs5yhyavMPqEnAxwwv3pGkNYnYFbvX7z387mWy/9jECgYEA9C9bAbM87egP+dLaA8IQA2lJEBG6b5pJidw40lm0E2Ey1v2NMCEhd3stEUSrS0QfVN9S0N0aPZmsBNkbm7P7nSviq53n2Qo/mEP06dhx7+MI1nKlmTrgqH0HvCYK7+55vxojZsuvj9E9Q7tE5KXJsKZ8syLrWbLPvrPPF4TVwjcCgYEAxNY0H25RbMJGFUaZ/a4b6/yPXECdFX7LeFxFAiJ4ds+zavenRMacm4MNjY91m90t7p0UZYvytk39YeX2/J6x0C2U/gQE3VS5ER+NAOqrl9UgBxZeb0e5Cz3TcU4w/zT+sQedYqG4p/ldT4UnBKXleI/+l6H86Qnix1O9Xae25wkCgYB3jpgohPHYKj9oOmy0Wlgs02gKjiOScSCAd2r60yDwPC8ARLTUU+Rm89BlHBIikAAnNhD+YsNuVcd7uDFkUwNnOQ2KqY3THsl0bBGGTYu7wJWbKhcap1FILa+T16yTPVgu0UV0F1amO/SbLR3WNbZC38E+lGJXUM2WucMz6L4gkQKBgQCa4OzsWlJpYEfiz8W1LP09Z2GqNhEj67vP/dIyxsrAudcz8J/F5v0tBCZy35GrzZIpsaFt8XtN5PndwSPhTEEfS+5zHNhzCwn/pjK9qOjRtFnaGci+iNHaPZCVE/BLrvhEdXhqNlPkn7rDKkM0ThDMF4k86LHm7+dn7cUP3zp0eQKBgCj5Tcne23U8C93ifTM0mzlx3VEilL41lbS3pIiABiV+Cjk/e9YqYmEdkwwCk8g2mLmBYmzRCnCTCJbEOaLu4YPI2v1qbgo3WcTpodt2x7XskAPC8i4Kb7I9b1kMvFXQlxMlLGY4uz7JKSzp58ja5dFV2b4r1KlEd6x4ILF9OT4E" 113 | privatekey_csharp="u8CS+voY3IVwm2QjJFg4uyU4TX/H/cCuG+8UgGr0qsvX6OUnxKu8YG18hKGB/7y/nBwlc0mYH8PSkDmT2SGR50LMz2e/r7yBkvazlykul0zqVTwJHAOrtXDVK8QZMH/vFzRPZrvr1SbwCMPrJ5ZGRtffPmT/7MVk8yWQo9XlAq2ABz62axwO1FC6TZc3PpmE+8pr18+AnzEai0TCjq3NaC28QWr3LGJDO/fGtT/bWz0uBrYPhCAxeYyWsDokiX0NU0ixUB2PulGqvsztjrxZYQPsZIIgZ1lMz/43rrfHGkrtmOeCS25+U/blzfZSRF6WDVIhTwBK1cFRb4tVgd107w==AQAB

9C9bAbM87egP+dLaA8IQA2lJEBG6b5pJidw40lm0E2Ey1v2NMCEhd3stEUSrS0QfVN9S0N0aPZmsBNkbm7P7nSviq53n2Qo/mEP06dhx7+MI1nKlmTrgqH0HvCYK7+55vxojZsuvj9E9Q7tE5KXJsKZ8syLrWbLPvrPPF4TVwjc=

xNY0H25RbMJGFUaZ/a4b6/yPXECdFX7LeFxFAiJ4ds+zavenRMacm4MNjY91m90t7p0UZYvytk39YeX2/J6x0C2U/gQE3VS5ER+NAOqrl9UgBxZeb0e5Cz3TcU4w/zT+sQedYqG4p/ldT4UnBKXleI/+l6H86Qnix1O9Xae25wk=d46YKITx2Co/aDpstFpYLNNoCo4jknEggHdq+tMg8DwvAES01FPkZvPQZRwSIpAAJzYQ/mLDblXHe7gxZFMDZzkNiqmN0x7JdGwRhk2Lu8CVmyoXGqdRSC2vk9eskz1YLtFFdBdWpjv0my0d1jW2Qt/BPpRiV1DNlrnDM+i+IJE=muDs7FpSaWBH4s/FtSz9PWdhqjYRI+u7z/3SMsbKwLnXM/Cfxeb9LQQmct+Rq82SKbGhbfF7TeT53cEj4UxBH0vucxzYcwsJ/6Yyvajo0bRZ2hnIvojR2j2QlRPwS674RHV4ajZT5J+6wypDNE4QzBeJPOix5u/nZ+3FD986dHk=KPlNyd7bdTwL3eJ9MzSbOXHdUSKUvjWVtLekiIAGJX4KOT971ipiYR2TDAKTyDaYuYFibNEKcJMIlsQ5ou7hg8ja/WpuCjdZxOmh23bHteyQA8LyLgpvsj1vWQy8VdCXEyUsZji7PskpLOnnyNrl0VXZvivUqUR3rHggsX05PgQ=sRhXS2bGNpOjgN82ipywfk4ASpGiGcc6M10S8IJyX/xAnwwvs8HtwOLlFdGl5oyqC908sf8T/7pdDe9RdvjEP+fxeh05YNElQ3NyOL3+lXZWfqlPSl5oA4/3cv3YaLfz1OZhktzk+TxuI0Zxs/h6N259w8PO5w3WR8cCJJeoGRngb8WnwiZob0RjYp1nrlwNQc9vHvzqgjhT9RhxDYFh3m2MfQDZZVedrU6TpDPnWBLmHyl6faBrbgVmfki4aCb1ldVGMlcfXpuYvP0HGPuodWaTIBRTA1B6W8aeakXQkp8++znKHJq8w+oScDHDC/ekaQ1idgVu9fvPfzuZbL/2MQ==" 114 | 115 | '#RSA 演示: 116 | 'c# Rsa Key Format : PEM PKCS1 <-> PEM PKCS8 <-> C# xml key 117 | 'privatekey_csharp = "xxx" 118 | Set r1= loader.loadClass("Crypt/Rsa") 119 | r1.Privatekey=privatekey_csharp 120 | 'r1.Publickey=publickey_csharp 121 | a="Hello WTS" 122 | b=r1.Encrypt(a) 123 | c=r1.Decrypt(b) 124 | d=r1.SignData(a,"SHA1") 125 | e=r1.VerifyData(a,"SHA1",d) 126 | Set r1 = Nothing 127 | '## 128 | 129 | s="" 130 | s=s+"a = "+a+Chr(10)+Chr(10) 131 | s=s+"b = Encrypt(a) : "+Chr(10)+b+Chr(10)+Chr(10) 132 | s=s+"c = Decrypt(b) :"+Chr(10)+c+Chr(10)+Chr(10) 133 | s=s+"d = SignData(a,""SHA1"") :"+Chr(10)+d+Chr(10)+Chr(10) 134 | s=s+"d = VerifyData(a,""SHA1"",d) :"+CStr(e)+Chr(10)+Chr(10) 135 | wts.responses.SetOutput s 136 | 137 | End Sub 138 | 139 | End Class 140 | %> -------------------------------------------------------------------------------- /inc/module/default/control/hello.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Hello 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: Hello WTS 6 | 7 | Class Control_Hello 8 | 9 | Private Sub Class_Initialize() 10 | '加载语言包 11 | loader.LoadLanguage "hello" 12 | '加css,js 13 | wts.template.SetVal "script/src", wts.site.config("base_static_url")&"js/hello.js" 14 | wts.template.UpdVal "script" 15 | wts.template.SetVal "style/href", wts.site.config("base_static_url")&"css/hello.css" 16 | wts.template.UpdVal "style" 17 | End Sub 18 | 19 | Private Sub Class_Terminate() 20 | End Sub 21 | 22 | '@Index_Action(): 控制器内部转向 23 | 24 | Sub Index_Action() 25 | Call List_Action() 26 | End Sub 27 | 28 | '@List_Action(): 查 列表,翻页 29 | 30 | Sub List_Action() 31 | '#列表分页演示: 32 | '接收参数 33 | page = wts.valid.IntNum(wts.requests.querystr("page"), 1, 500, "") 34 | 35 | '调用模型 36 | Set mHello = loader.LoadModel("Hello") 37 | Set rs = mHello.GetAll() '获取数据集合 38 | Set oPage = loader.LoadClass("PageList") '调用分页对象 39 | oPage.tempdata = wts.site.tempdata '用全局临时数据存储器取代默认临时数据存储器 40 | oPage.CurrentPage = page '设置当前页 41 | oPage.MaxPerPage = 5 '设置每页显示条数 42 | n = oPage.List("news", rs) '将数据集合导入分页对象,并返回当前页集合条数 43 | If n = 0 Then 44 | wts.errs.AddMsg "no page" 45 | wts.errs.Out 404 46 | Else 47 | '遍历将链接等将后生成数据更新到分页集合中 48 | For i = 0 To n 49 | link_str = "index.asp?route=hello/detail&id="&wts.template.GetVali("news/id", i) 50 | wts.template.setVali "news/link", i, wts.route.ReWrite(wts.site.config("base_url"), link_str) 51 | ' 52 | link_str = "index.asp?route=hello/edit&id="&wts.template.GetVali("news/id", i) 53 | wts.template.setVali "news/link_edit", i, wts.route.ReWrite(wts.site.config("base_url"), link_str) 54 | ' 55 | link_str = "index.asp?route=hello/del&id="&wts.template.GetVali("news/id", i) 56 | wts.template.setVali "news/link_del", i, wts.route.ReWrite(wts.site.config("base_url"), link_str) 57 | ' 58 | link_img = wts.route("pic").ReWritePic(wts.site.config("base_pic_url"), "image/no.gif", 50, 50, "") 59 | wts.template.setVali "news/pic", i, link_img 60 | ' 61 | wts.template.setVali "news/time", i, wts.fun.FormatDate(wts.template.GetVali("news/times", i),1) 62 | Next 63 | '生成分页"news_page" 64 | oPage.Plist wts.route,wts.site.config("base_url"),"index.asp?route=hello/list" 65 | End If 66 | Set oPage = Nothing 67 | rs.Close 68 | Set rs = Nothing 69 | Set mHello = Nothing 70 | 71 | '添加链接 72 | wts.template.setVal "tag_addlink", wts.route.ReWrite(wts.site.config("base_url"), "index.asp?route=hello/add") 73 | 74 | '设置标题 75 | wts.template.SetVal "title","WTS列表,翻页演示" 76 | 77 | '渲染模板 78 | moban = wts.template.Fetch("hello_list.htm") 79 | 80 | '输出内容 81 | wts.responses.SetOutput moban 82 | '## 83 | End Sub 84 | 85 | '@Detail_Action(): 查 详情 86 | 87 | Sub Detail_Action() 88 | '#详情页演示: 89 | '接收参数 90 | id = wts.valid.IntNum(wts.requests.querystr("id"), 0, 0, "") 91 | wts.template.SetVal "tag_id", id 92 | 93 | '调用模型 94 | Set mHello = loader.LoadModel("hello") 95 | Set rs = mHello.GetNameById(id) 96 | If rs.recordcount>0 Then 97 | wts.template.SetVal "tag_name", rs("name") 98 | wts.template.SetVal "title",rs("name") 99 | 'meta 100 | wts.template.SetVal "meta/name","description" 101 | wts.template.SetVal "meta/content",rs("name") 102 | wts.template.UpdVal "meta" 103 | Else 104 | wts.template.SetVal "tag_name", "no name" 105 | End If 106 | rs.Close 107 | Set rs = Nothing 108 | Set mHello = Nothing 109 | 110 | '渲染模板 111 | moban = wts.template.Fetch("hello_detail.htm") 112 | 113 | '输出内容 114 | wts.responses.SetOutput moban 115 | '## 116 | End Sub 117 | 118 | '@Add_Action(): 增 表单 119 | 120 | Sub Add_Action() 121 | submit_url=wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=hello/addsave") 122 | wts.template.SetVal "submit_url",submit_url 123 | 124 | '渲染模板 125 | moban = wts.template.Fetch("hello_form.htm") 126 | 127 | '输出内容 128 | wts.responses.SetOutput moban 129 | End Sub 130 | 131 | '@AddSave_Action(): 增 保存 132 | 133 | Sub AddSave_Action() 134 | name = wts.valid.text(wts.requests.forms("name"), 1, 50, "") 135 | Set mHello = loader.LoadModel("Hello") 136 | id=mHello.Add(name) 137 | Set mHello = Nothing 138 | ' 139 | wts.responses.Direct wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=hello/edit&id="&id) 140 | End Sub 141 | 142 | '@Edit_Action(): 改 表单 143 | 144 | Sub Edit_Action() 145 | 'querystr 146 | id = wts.valid.IntNum(wts.requests.querystr("id"), 0, 0, "") 147 | wts.template.SetVal "tag_id", id 148 | 149 | '调用模型 150 | Set mHello = loader.LoadModel("hello") 151 | Set rs = mHello.GetNameById(id) 152 | If rs.recordcount>0 Then 153 | wts.template.SetVal "name",rs("name") 154 | wts.template.SetVal "id",rs("id") 155 | End If 156 | rs.Close 157 | Set rs = Nothing 158 | Set mHello = Nothing 159 | 160 | '提交链接 161 | submit_url=wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=hello/editsave") 162 | wts.template.SetVal "submit_url",submit_url 163 | 164 | '渲染模板 165 | moban = wts.template.Fetch("hello_form.htm") 166 | 167 | '输出内容 168 | wts.responses.SetOutput moban 169 | End Sub 170 | 171 | '@EditSave_Action(): 改 保存 172 | 173 | Sub EditSave_Action() 174 | '接收并验证数据 175 | name = wts.valid.text(wts.requests.forms("name"), 1, 50, "Invalid Name") 176 | id = wts.valid.intNum(wts.requests.forms("id"), 1, 0, "Invalid Id") 177 | If wts.errs.foundErr Then wts.errs.OutMsg 178 | '判断id是否存在 179 | Set data = Server.CreateObject("Scripting.Dictionary") 180 | Set mHello = loader.LoadModel("Hello") 181 | Set rs = mHello.GetNameById(id) 182 | If rs.recordcount>0 Then 183 | data("name")=name 184 | data("id")=id 185 | mHello.Edit data '添加数据 186 | Else 187 | wts.errs.AddMsg "Invalid id" 188 | wts.errs.OutMsg 189 | End If 190 | rs.Close 191 | Set rs = Nothing 192 | Set mHello = Nothing 193 | Set data = Nothing 194 | '跳转 195 | wts.responses.Direct wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=hello/list") 196 | End Sub 197 | 198 | '@Del_Action(): 删 199 | 200 | Sub Del_Action() 201 | '接收并验证数据 202 | id = wts.valid.intNum(wts.requests.querystr("id"), 1, 0, "Invalid Id") 203 | If wts.errs.foundErr Then wts.errs.OutMsg 204 | '删除 205 | Set mHello = loader.LoadModel("Hello") 206 | 'mHello.Del id 207 | Set mHello = Nothing 208 | '跳转 209 | wts.responses.Direct wts.route.ReWrite(wts.site.config("base_url"),"index.asp?route=hello/list") 210 | End Sub 211 | 212 | End Class 213 | %> -------------------------------------------------------------------------------- /inc/class/ext/tqqwry.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Tqqwry 3 | '@author: ekede.com 4 | '@date: 2017-02-13 5 | '@description: 纯真IP库查询 6 | 7 | Class Class_Ext_Tqqwry 8 | 9 | ' 变量声名 10 | Private QQWryFile 11 | Private Stream, EndIPOff 12 | Private StartIP, EndIP, CountryFlag 13 | Dim FirstStartIP, LastStartIP, RecordCount 14 | Dim Country, LocalStr, Buf, OffSet 15 | 16 | '@Country: 国家信息 17 | 18 | '@data: IP库文件物理路径 19 | 20 | Public Property Let data(str) 21 | QQWryFile = str 22 | End Property 23 | 24 | Private Sub Class_Initialize 25 | QQWryFile = server.MapPath(PATH_ROOT&"data/db/qqwry.dat") 'IP库路径, 物理路径 26 | ' 27 | Country = "" 28 | LocalStr = "" 29 | StartIP = 0 30 | EndIP = 0 31 | CountryFlag = 0 32 | FirstStartIP = 0 33 | LastStartIP = 0 34 | EndIPOff = 0 35 | End Sub 36 | 37 | Private Sub Class_Terminate 38 | Stream.Close 39 | Set Stream = Nothing 40 | End Sub 41 | 42 | ' IP地址转换成整数 ip 43 | 44 | Function IPToInt(ByRef IP) 45 | If InStr(IP, ":")>0 Then IP = "127.0.0.1" '当IP地址是::1这样的地址时返回本机地址 46 | Dim IPArray, i 47 | IPArray = Split(IP, ".", -1) 48 | For i = 0 To 3 49 | If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0 50 | If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i))) 51 | If CInt(IPArray(i)) > 255 Then IPArray(i) = 255 52 | Next 53 | IPToInt = (CInt(IPArray(0)) * 256 * 256 * 256) + (CInt(IPArray(1)) * 256 * 256) + (CInt(IPArray(2)) * 256) + CInt(IPArray(3)) 54 | End Function 55 | 56 | ' 整数逆转IP地址 57 | 58 | Function IntToIP(ByRef IntValue) 59 | p4 = IntValue - Fix(IntValue / 256) * 256 60 | IntValue = (IntValue - p4) / 256 61 | p3 = IntValue - Fix(IntValue / 256) * 256 62 | IntValue = (IntValue - p3) / 256 63 | p2 = IntValue - Fix(IntValue / 256) * 256 64 | IntValue = (IntValue - p2) / 256 65 | p1 = IntValue 66 | IntToIP = CStr(p1) & "." & CStr(p2) & "." & CStr(p3) & "." & CStr(p4) 67 | End Function 68 | 69 | ' 获取开始IP位置 70 | 71 | Private Function GetStartIP(ByRef RecNo) 72 | OffSet = FirstStartIP + RecNo * 7 73 | Stream.Position = OffSet 74 | Buf = Stream.Read(7) 75 | 76 | EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256) 77 | StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256) 78 | GetStartIP = StartIP 79 | End Function 80 | 81 | ' 获取结束IP位置 82 | 83 | Private Function GetEndIP() 84 | Stream.Position = EndIPOff 85 | Buf = Stream.Read(5) 86 | EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256) 87 | CountryFlag = AscB(MidB(Buf, 5, 1)) 88 | GetEndIP = EndIP 89 | End Function 90 | 91 | ' 获取地域信息，包含国家和和省市 92 | 93 | Private Sub GetCountry(ByRef IP) 94 | If (CountryFlag = 1 Or CountryFlag = 2) Then 95 | Country = GetFlagStr(EndIPOff + 4) 96 | If CountryFlag = 1 Then 97 | LocalStr = GetFlagStr(Stream.Position) 98 | ' 以下用来获取数据库版本信息 99 | If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then 100 | LocalStr = GetFlagStr(EndIPOff + 21) 101 | Country = GetFlagStr(EndIPOff + 12) 102 | End If 103 | Else 104 | LocalStr = GetFlagStr(EndIPOff + 8) 105 | End If 106 | Else 107 | Country = GetFlagStr(EndIPOff + 4) 108 | LocalStr = GetFlagStr(Stream.Position) 109 | End If 110 | ' 过滤数据库中的无用信息 111 | Country = Trim(Country) 112 | LocalStr = Trim(LocalStr) 113 | If InStr(Country, "CZ88.NET") Then Country = "本地/局域网" 114 | If InStr(LocalStr, "CZ88.NET") Then LocalStr = "本地/局域网" 115 | End Sub 116 | 117 | ' 获取IP地址标识符 118 | 119 | Private Function GetFlagStr(ByRef OffSet) 120 | Dim Flag 121 | Flag = 0 122 | Do While (True) 123 | Stream.Position = OffSet 124 | Flag = AscB(Stream.Read(1)) 125 | If(Flag = 1 Or Flag = 2 ) Then 126 | Buf = Stream.Read(3) 127 | If (Flag = 2 ) Then 128 | CountryFlag = 2 129 | EndIPOff = OffSet - 4 130 | End If 131 | OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) 132 | Else 133 | Exit Do 134 | End If 135 | Loop 136 | 137 | If (OffSet < 12 ) Then 138 | GetFlagStr = "" 139 | Else 140 | Stream.Position = OffSet 141 | GetFlagStr = GetStr() 142 | End If 143 | End Function 144 | 145 | ' 获取字串信息 (www.viming.com) 这里获取代码最关键了 utf-8 146 | 147 | Private Function GetStr() 148 | Dim c 149 | getstr = "" 150 | Dim objstream 151 | Set objstream = server.CreateObject("adodb.stream") 152 | objstream.Type = 1 153 | objstream.mode = 3 154 | objstream.Open 155 | c = stream.Read(1) 156 | Do While (ascb(c)<>0 And Not stream.eos) 157 | objstream.Write c 158 | c = stream.Read(1) 159 | Loop 160 | objstream.position = 0 161 | objstream.Type = 2 162 | objstream.charset = "gb2312" 163 | getstr = objstream.readtext 164 | objstream.Close 165 | Set objstream = Nothing 166 | End Function 167 | 168 | '@QQWry(DotIP): 核心函数，执行IP搜索 169 | 170 | Public Function QQWry(ByRef DotIP) 171 | On Error Resume Next 172 | 173 | Dim IP, nRet 174 | Dim RangB, RangE, RecNo 175 | 176 | IP = IPToInt (DotIP) 177 | 178 | Set Stream = CreateObject("ADodb.Stream") 179 | Stream.Mode = 3 180 | Stream.Type = 1 181 | Stream.Open 182 | Stream.LoadFromFile QQWryFile 183 | If Err.Number<>0 Then OutErr(err.description) 184 | Stream.Position = 0 185 | Buf = Stream.Read(8) 186 | FirstStartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256) 187 | LastStartIP = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256) + (AscB(MidB(Buf, 8, 1)) * 256 * 256 * 256) 188 | RecordCount = Int((LastStartIP - FirstStartIP) / 7) 189 | ' 在数据库中找不到任何IP地址 190 | If (RecordCount <= 1) Then 191 | Country = "未知" 192 | QQWry = 2 193 | Exit Function 194 | End If 195 | 196 | RangB = 0 197 | RangE = RecordCount 198 | 199 | Do While (RangB < (RangE - 1)) 200 | RecNo = Int((RangB + RangE) / 2) 201 | Call GetStartIP (RecNo) 202 | If (IP = StartIP) Then 203 | RangB = RecNo 204 | Exit Do 205 | End If 206 | If (IP > StartIP) Then 207 | RangB = RecNo 208 | Else 209 | RangE = RecNo 210 | End If 211 | Loop 212 | 213 | Call GetStartIP(RangB) 214 | Call GetEndIP() 215 | 216 | If (StartIP <= IP) And ( EndIP >= IP) Then 217 | ' 没有找到 218 | nRet = 0 219 | Else 220 | ' 正常 221 | nRet = 3 222 | End If 223 | Call GetCountry(IP) 224 | 225 | QQWry = nRet 226 | End Function 227 | 228 | '错误提示 229 | 230 | Public Sub OutErr(ErrMsg) 231 | Response.charset = "utf-8" 232 | Response.Write ErrMsg 233 | Response.End 234 | End Sub 235 | 236 | End Class 237 | %> -------------------------------------------------------------------------------- /inc/module/help/control/install.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Control_Install 3 | '@author: ekede.com 4 | '@date: 2018-02-01 5 | '@description: 安装目录数据 6 | 7 | Class Control_Install 8 | 9 | Private Sub Class_Initialize() 10 | End Sub 11 | 12 | Private Sub Class_Terminate() 13 | End Sub 14 | 15 | '@Index_Action(): 安装数据目录,数据库 16 | 17 | Public Sub Index_Action() 18 | 19 | '安装目录 20 | Install_Folder() 21 | 22 | '安装Hello数据库 23 | Install_Access() 24 | 25 | '输出 26 | wts.responses.SetOutput "Install OK" 27 | 28 | End Sub 29 | 30 | '安装目录 31 | 32 | Private Sub Install_Folder() 33 | 34 | '判断数据路径是否存在并创建 35 | wts.fso.CreateFolders wts.fso.GetMapPath(PATH_ROOT&PATH_DATA) 36 | 37 | '判断图片路径是否存在并创建 38 | wts.fso.CreateFolders wts.fso.GetMapPath(PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES) 39 | 40 | '判断默认图片是否存在并拷贝 41 | d_pic="no.gif" 42 | If wts.fso.GetRealPath(PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES&d_pic)= -1 Then 43 | If wts.fso.GetRealPath(PATH_MODULE&wts.route.module&"/"&PATH_VIEW&PATH_PIC_IMAGES&d_pic) <> -1 Then 44 | wts.fso.CopyAFile _ 45 | wts.fso.GetMapPath(PATH_MODULE&wts.route.module&"/"&PATH_VIEW&PATH_PIC_IMAGES&d_pic),_ 46 | wts.fso.GetMapPath(PATH_ROOT&PATH_PIC&PATH_PIC_IMAGES&d_pic) 47 | End If 48 | End If 49 | 50 | '判断APP路径是否存在并创建 51 | If PATH_APP <> "" Then wts.fso.CreateFolders wts.fso.GetMapPath(PATH_ROOT&PATH_APP) 52 | 53 | End Sub 54 | 55 | '安装数据库 56 | 57 | Private Sub Install_Access() 58 | 59 | '#安装压缩Access演示: 60 | 61 | d_name = DB_NAME 62 | c_name = "backup.mdb" 63 | 64 | '判断数据库是否存在 65 | If DB_TYPE<>1 or wts.fso.GetRealPath(PATH_ROOT&DB_PATH&d_name)<> -1 Then Exit Sub 66 | 67 | '判断数据库路径是否存在并创建 68 | wts.fso.CreateFolders wts.fso.GetMapPath(PATH_ROOT&DB_PATH) 69 | 70 | Set db = loader.loadClass("db") 71 | 72 | '创建数据库 73 | db.CreateAccess DB_PATH&d_name 74 | 75 | '连接数据库 76 | db.OpenConn 1,DB_VERSION, DB_PATH, d_name, "", "" 77 | 78 | '创建表Hello 79 | sql="create table wts_hello ( "&_ 80 | "id integer IDENTITY(1,1) primary key, "&_ 81 | "name varchar(50), "&_ 82 | "times date Default now() "&_ 83 | ")" 84 | db.SqlExecute(sql) 85 | 86 | '插入一条记录 87 | sql="insert into wts_hello (id,name) values (1,'example name')" 88 | db.SqlExecute(sql) 89 | 90 | '创建表mytable 91 | 'm_id 自动编号字段并制作主键 92 | 'm_class 文本型，长度50，非空，默认值：AAA 93 | 'm_int 数字，长整型，非空 94 | 'm_number 数字,小数，精度6，数值范围2 95 | 'm_money 0.00货币，必添字段（非空）,默认0 96 | 'm_memo text备注 97 | 'm_date 日期/时间，date()默认当前日期（年月日）, datetime数据类型则对应 now() 98 | sql="create table mytable ( "&_ 99 | "m_id integer IDENTITY(1,1) primary key, "&_ 100 | "m_class varchar(50) NOT NULL Default 'AAA', "&_ 101 | "m_int integer NOT NULL, "&_ 102 | "m_numeric NUMERIC(6,2), "&_ 103 | "m_money money NOT NULL Default 0.00, "&_ 104 | "m_memo text, "&_ 105 | "m_date date Default date(), "&_ 106 | "m_boolean bit Default yes, "&_ 107 | "m_blob OLEObject, "&_ 108 | "m_double double, "&_ 109 | "m_float real "&_ 110 | ")" 111 | 'db.SqlExecute(sql) 112 | 113 | '增加字段 114 | sql="alter table mytable add column address varchar(200)" 115 | 'db.SqlExecute(sql) 116 | 117 | '修改字段 118 | sql="alter table mytable Alter column address varchar(50)" 119 | 'db.SqlExecute(sql) 120 | 121 | '删除字段 122 | sql="alter table mytable drop address" 123 | 'db.SqlExecute(sql) 124 | 125 | '删除表 126 | sql="Drop table mytable" 127 | 'db.SqlExecute(sql) 128 | 129 | '关闭数据库连接 130 | db.CloseConn 131 | 132 | '压缩备份数据库 133 | db.CompactAccess DB_PATH&d_name,DB_PATH&c_name 134 | 135 | Set db = Nothing 136 | 137 | '## 138 | 139 | End Sub 140 | 141 | '@Space_Action(): 服务器组件 142 | 143 | Public Sub Space_Action() 144 | 145 | '#常用组件: 146 | Dim theInstalledObjects(30) 147 | '危险 148 | theInstalledObjects(0) = array("WScript.Shell","wshom.ocx","danger") 149 | theInstalledObjects(1) = array("WScript.Network","wshom.ocx","danger") 150 | theInstalledObjects(2) = array("Shell.Application","shell32.dll","danger") 151 | '内置 152 | theInstalledObjects(3) = array("MSWC.AdRotator","adrot.dll","") 153 | theInstalledObjects(4) = array("MSWC.BrowserType","Browsercap.dll","") 154 | theInstalledObjects(5) = array("MSWC.NextLink","mswc.dll","") 155 | theInstalledObjects(6) = array("MSWC.Tools","tools.dll","") 156 | theInstalledObjects(7) = array("MSWC.Status","status.dll","") 157 | theInstalledObjects(8) = array("MSWC.Counters","counters.dll","") 158 | theInstalledObjects(9) = array("MSWC.PermissionChecker","permchk.dll","") 159 | '必要 160 | theInstalledObjects(10) = array("ADOX.Catalog","msadox.dll","") 161 | theInstalledObjects(11)= array("JRO.JetEngine","msjro.dll","") 162 | theInstalledObjects(12)= array("ADODB.Connection","msado15.dll","") 163 | theInstalledObjects(13)= array("ADODB.Stream","scrrun.dll","") 164 | theInstalledObjects(14)= array("Scripting.FileSystemObject","scrrun.dll","") 165 | theInstalledObjects(15)= array("Scripting.Dictionary","scrrun.dll","") 166 | '邮件 167 | theInstalledObjects(16)= array("CDO.Message","cdosys.dll","") 168 | theInstalledObjects(17)= array("JMail.Message","jmail.dll","x86") 169 | '图片 170 | theInstalledObjects(18)= array("WIA.ImageFile","wiaaut.dll","") 171 | theInstalledObjects(19)= array("Persits.Jpeg"," aspjpeg.dll","x86") 172 | '压缩 173 | theInstalledObjects(20)= array("Dyy.Zipsvr","dyy.dll","x86") 174 | 'XML 175 | theInstalledObjects(21)= array("Microsoft.XMLDOM","msxml.dll","") 176 | theInstalledObjects(22)= array("MSXML2.DOMDocument","","") 177 | theInstalledObjects(23)= array("MSXML2.DOMDocument.3.0","msxml3.dll","") 178 | theInstalledObjects(24)= array("MSXML2.DOMDocument.4.0","","") 179 | theInstalledObjects(25)= array("MSXML2.DOMDocument.5.0","","") 180 | theInstalledObjects(26)= array("MSXML2.DOMDocument.6.0","msxml6.dll","") 181 | 'HTTP 182 | theInstalledObjects(27)= array("MSXML2.ServerXMLHTTP","msxml2.dll","") 183 | '引擎 184 | theInstalledObjects(28)= array("MSScriptControl.ScriptControl","","x86") 185 | '应用 186 | theInstalledObjects(29)= array("InternetExplorer.Application","","") 187 | theInstalledObjects(30)= array("Excel.Application","","") 188 | '## 189 | '生成表格 190 | str="" 191 | str=str&"" 192 | For i=0 to ubound(theInstalledObjects) 193 | If theInstalledObjects(i)(0)<>"" then 194 | str=str&"" 195 | str=str&"" 196 | version=IsObjInstalled(theInstalledObjects(i)(0)) 197 | If version = "" Then 198 | str=str&"" 199 | str=str&"" 200 | Else 201 | str=str&"" 202 | str=str&"" 203 | End If 204 | str=str&"" 205 | str=str&"" 206 | str=str&"" & vbCrLf 207 | End If 208 | Next 209 | str=str&"
组件名称支持版本DLL说明
"& theInstalledObjects(i)(0) & "×√"&version&"" & theInstalledObjects(i)(1) & ""& theInstalledObjects(i)(2) & "
" 210 | 211 | '输出内容 212 | wts.responses.SetOutput str 213 | 214 | End Sub 215 | 216 | Private Function IsObjInstalled(strClass) 217 | On Error Resume Next 218 | Dim xTestObj 219 | Set xTestObj = Server.CreateObject(strClass) 220 | If Err Then 221 | Err.Clear 222 | Else 223 | IsObjInstalled = xTestObj.Version 224 | If Err Then 225 | IsObjInstalled = "-" 226 | Err.Clear 227 | End If 228 | Set xTestObj = Nothing 229 | End If 230 | End Function 231 | 232 | End Class 233 | %> -------------------------------------------------------------------------------- /inc/class/ext/http.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Ext_Http 3 | '@author: ekede.com 4 | '@date: 2018-08-24 5 | '@description: 模拟Http请求 6 | 7 | Class Class_Ext_Http 8 | 9 | Private isDebug_ 10 | Private slResolveTimeout, slConnectTimeout, slSendTimeout, slReceiveTimeout 11 | Private http_ 12 | Private form_ 13 | Private header_ 14 | Private cookie_ 15 | ' 16 | Private cache_,fun_ 17 | 18 | '@rStatus: 请求状态 19 | '@rHeader: header信息 20 | '@rBody: 内容二进制 21 | '@rText: 内容文本 22 | Dim rStatus,rHeader,rBody,rText 23 | 24 | '@rCookie: cookie字符串 25 | 26 | Public Property Get rCookie() 27 | rCookie = GetCookie() 28 | End Property 29 | 30 | '@cookie_on: 是否开启cookie 31 | 32 | Dim cookie_on 33 | 34 | '@cache: cache对象依赖 35 | 36 | Public Property Let cache(Value) 37 | Set cache_ = Value 38 | End Property 39 | 40 | '@items: item直接赋值,字符串或字节数组都可以 41 | 42 | Public Property Let items(Value) 43 | form_ = Value 44 | End Property 45 | 46 | '@isDebug: 是否设置为调试模式 47 | 48 | Public Property Let isDebug(Value) 49 | isDebug_ = Value 50 | End Property 51 | 52 | 53 | Private Sub Class_Initialize() 54 | If IsEmpty(DEBUGS) Then 55 | isDebug_ = False 56 | Else 57 | isDebug_ = DEBUGS 58 | End If 59 | slResolveTimeout = 20000 '解析DNS名字的超时时间,20秒 60 | slConnectTimeout = 20000 '建立Winsock连接的超时时间,20秒 61 | slSendTimeout = 30000 '发送数据的超时时间,30秒 62 | slReceiveTimeout = 30000 '接收response的超时时间,30秒 63 | Set http_ = Server.CreateObject("MSXML2.ServerXMLHTTP") 64 | Set header_ = Server.CreateObject("Scripting.Dictionary") 65 | ' 66 | cookie_on = False 67 | Set cookie_ = Server.CreateObject("Scripting.Dictionary") 68 | End Sub 69 | 70 | Private Sub Class_Terminate 71 | Set cookie_ = Nothing 72 | ' 73 | Set header_ = Nothing 74 | Set http_ = Nothing 75 | End Sub 76 | 77 | '@Send(ByRef method,ByVal url): 发送请求 78 | 79 | Public Sub Send(ByRef method,ByVal url) 80 | On Error Resume Next 81 | Dim c,s 82 | 'Header Read 83 | If cookie_on Then c = GetC(url) 84 | ' 85 | http_.setTimeouts slResolveTimeout, slConnectTimeout, slSendTimeout, slReceiveTimeout 86 | 'GET 87 | If method = "GET" Then 88 | If form_ <> "" Then 89 | If Instr(url,"?")>0 Then 90 | url = url&"&"&form_ 91 | Else 92 | url = url&"?"&form_ 93 | End If 94 | End If 95 | http_.Open "GET", url, False 96 | ' 97 | If c <> "" Then http_.setRequestHeader "Cookie", c 98 | For Each k in header_ 99 | http_.setRequestHeader k, header_(k) 100 | Next 101 | ' 102 | http_.Send() 103 | If Err Then OutErr("Http Get Fail:"&Err.Number&":"&Err.Description) 104 | End If 105 | 'POST 106 | If method = "POST" Then 107 | http_.Open method, url, False 108 | http_.setRequestHeader "Content-Length", Len(form_) 109 | ' 110 | If c <> "" Then http_.setRequestHeader "Cookie", c 111 | For Each k in header_ 112 | http_.setRequestHeader k, header_(k) 113 | Next 114 | ' 115 | http_.Send(form_) 116 | If Err Then OutErr("Http POST Fail:"&Err.Number&":"&Err.Description) 117 | End If 118 | ' 119 | While http_.readyState <> 4 120 | http_.waitForResponse 1000 121 | Wend 122 | ' 123 | rStatus = http_.Status 124 | rHeader = http_.getAllResponseHeaders() 125 | rText = http_.ResponseText 126 | rBody = http_.ResponseBody 127 | 'Header Write 128 | If cookie_on Then SetC url,rHeader 129 | 130 | End Sub 131 | 132 | '@AddItem(ByRef Key, ByRef Value): 添加表单键值 133 | 134 | Public Sub AddItem(ByRef Key, ByRef Values) 135 | On Error Resume Next 136 | If form_ = "" Then 137 | form_ = Key + "=" + Server.URLEncode(Values) 138 | Else 139 | form_ = form_ + "&" + Key + "=" + Server.URLEncode(Values) 140 | End If 141 | End Sub 142 | 143 | '@SetHeader(ByRef key,ByRef Value): 设置头信息 144 | 145 | Public Sub SetHeader(ByRef key, ByRef Values) 146 | header_(key) = Values 147 | End Sub 148 | 149 | '读Cookie 150 | 151 | Private Function GetC(ByRef url) 152 | Dim c 153 | key = "cookie/"&GetDomainKey(url)&".txt" 154 | c = cache_.GetCache(key) 155 | If c = -1 Then 156 | GetC = "" 157 | CleanCookie() 158 | Else 159 | GetC = c 160 | CleanCookie() 161 | SetCookie(c) 162 | End If 163 | End Function 164 | 165 | '写Cookie 166 | 167 | Private Function SetC(ByRef url,ByRef str) 168 | SetC = HeadCookie(str) 169 | If SetC Then 170 | key = "cookie/"&GetDomainKey(url)&".txt" 171 | cache_.SetCache key,rCookie 172 | End If 173 | End Function 174 | 175 | '--------------------------------- Http Header Cookie 176 | 177 | '@GetCookie(): Cookie_对象 -> str标准字符串, 返回cookie字符串 178 | 179 | Private Function GetCookie() 180 | Dim str 181 | For Each x in cookie_ 182 | If str = "" Then 183 | str = x&"="&cookie_(x) 184 | Else 185 | str = str & "; " & x &"="&cookie_(x) 186 | End If 187 | Next 188 | GetCookie = str 189 | End Function 190 | 191 | '@SetCookie(ByRef str): str标准字符串 -> cookie_对象, 初始化cookie_ 192 | 193 | Private Sub SetCookie(ByRef str) 194 | arr = Split(str,"; ") 195 | For i = 0 To UBound(arr) 196 | k = Left(arr(i),InStr(arr(i),"=")-1) 197 | v = Mid(arr(i),InStr(arr(i),"=")+1,Len(arr(i))-InStr(arr(i),"=")) 198 | cookie_(k)=v 199 | Next 200 | End Sub 201 | 202 | '@CleanCookie(): 清空cookie_ 203 | 204 | Private Sub CleanCookie() 205 | cookie_.RemoveAll 206 | End Sub 207 | 208 | '@HeadCookie(ByRef str): Header字符串 => Cookie_对象, 更新cookie_ 209 | 210 | Private Function HeadCookie(ByRef str) 211 | Dim c,k,v,arr,arrr,i,s 212 | HeadCookie = False 213 | Set c = MatchesExp(str,"Set-Cookie: ([^=]+)=([^;]+|);") 214 | For Each x in c 215 | HeadCookie = True 216 | k = x.SubMatches(0) 217 | v = x.SubMatches(1) 218 | If v = "" Then 219 | If cookie_.Exists(k) Then cookie_.Remove(k) 220 | Else 221 | If InStr(v,"=")>0 Then 222 | s="" 223 | arr=Split(v,"&") 224 | For i = 0 To UBound(arr) 225 | arrr=Split(arr(i),"=") 226 | If UBound(arrr)=1 Then 227 | If arrr(1)<>"" Then 228 | If s = "" Then 229 | s = arrr(0) &"="&arrr(1) 230 | Else 231 | s = s & "&" &arrr(0) &"="&arrr(1) 232 | End If 233 | End If 234 | End If 235 | Next 236 | If s="" Then 237 | If cookie_.Exists(k) Then cookie_.Remove(k) 238 | Else 239 | cookie_(k)=s 240 | End If 241 | Else 242 | cookie_(k)=v 243 | End If 244 | End If 245 | Next 246 | Set c = Nothing 247 | End Function 248 | 249 | '查找字符串并返回集合 250 | 251 | Private Function MatchesExp(ByRef strng,ByRef patrn) 252 | Dim regEx 253 | Set regEx = New RegExp 254 | regEx.Pattern = patrn 255 | regEx.IgnoreCase = true 256 | regEx.Global = True 257 | Set MatchesExp = regEx.Execute(strng) 258 | set regEx=nothing 259 | End Function 260 | 261 | '取域名key,不准确凑合用 262 | 263 | Private Function GetDomainKey(ByRef url) 264 | Dim str, num 265 | str= Replace(url, "://", "") 266 | num = InStr(str, "/") 267 | If num > 0 Then 268 | GetDomainKey = Left(str, num -1) 269 | Else 270 | GetDomainKey = str 271 | End If 272 | End Function 273 | 274 | 'Err 275 | 276 | Private Sub OutErr(ByRef str) 277 | Err.clear 278 | If IsDebug_ = true Then 279 | Response.charset = "utf-8" 280 | Response.Write str 281 | Response.End 282 | End If 283 | End Sub 284 | 285 | End Class 286 | %> -------------------------------------------------------------------------------- /inc/class/route.asp: -------------------------------------------------------------------------------- 1 | <% 2 | '@title: Class_Route 3 | '@author: ekede.com 4 | '@date: 2018-06-09 5 | '@description: 网站路由,通过操作Request对象中的url，解析出模块,控制器,方法,参数 6 | 7 | Class Class_Route 8 | 9 | Private isDebug_ 10 | Private loader_ 11 | Private requests_ 12 | Private fun_ 13 | Private s_ 14 | 15 | 16 | '@loader: loader对象依赖 17 | 18 | Public Property Let loader(Values) 19 | Set loader_ = Values 20 | End Property 21 | 22 | Public Property Get loader 23 | Set loader = loader_ 24 | End Property 25 | 26 | '@fun: fun对象依赖 27 | 28 | Public Property Let fun(Values) 29 | Set fun_ = Values 30 | End Property 31 | 32 | Public Property Get fun 33 | Set fun = fun_ 34 | End Property 35 | 36 | '@requests: requests对象依赖 37 | 38 | Public Property Let requests(Values) 39 | Set requests_ = Values 40 | End Property 41 | 42 | Public Property Get requests 43 | Set requests = requests_ 44 | End Property 45 | 46 | '@routers: 路由集合 47 | 48 | Public Property Let routers(Values) 49 | Dim arr 50 | '其他路由 51 | arr=Split(cstr(Values),",") 52 | For i = 0 to UBOUND(arr) 53 | If arr(i)<>"" Then 54 | Set s_(arr(i)) = loader_.LoadControl("start/route/"&arr(i)) 55 | s_(arr(i)).route = Me 56 | End If 57 | If Err Then OutErr("路由加载错误:"&arr(i)&":"&Err.Description) 58 | Next 59 | '加载斜线路由 60 | Set s_("slash") = loader_.LoadClass("route/slash") 61 | s_("slash").route = Me 62 | If Err Then OutErr("路由加载错误:slash:"&Err.Description) 63 | End Property 64 | 65 | Public Property Get routers 66 | Dim r,s 67 | For Each r in s_ 68 | If s = "" Then 69 | s=r 70 | Else 71 | s=s&","&r 72 | End If 73 | Next 74 | routers = s 75 | End Property 76 | 77 | '@s: 单个路由,默认属性 78 | 79 | Public Default Property Get s(k) 80 | If s_.Exists(k) Then Set s = s_(k) 81 | End Property 82 | 83 | '@baseAddr: 默认根目录,script所在目录 84 | 85 | Dim baseAddr 86 | 87 | '@routeAddr: 路由地址 88 | 89 | Dim routeAddr 90 | 91 | '@basePicAddr: 图片根目录,网站根地址 92 | 93 | Dim basePicAddr 94 | 95 | '@routePicAddr: 图片路由地址 96 | 97 | Dim routePicAddr 98 | 99 | '@modules: 已开启模块 100 | 101 | Dim modules 102 | 103 | '@module: 当前模块 104 | 105 | Dim module 106 | 107 | '@control: 当前控制器 108 | 109 | Dim control 110 | 111 | '@action: 当前方法 112 | 113 | Dim action 114 | 115 | '@rewrite_on: 开启url重写 116 | 117 | Dim rewrite_on 118 | 119 | '@dewrite_on: url解码是否成功 120 | 121 | Dim dewrite_on 122 | 123 | Private Sub Class_Initialize() 124 | If IsEmpty(DEBUGS) Then 125 | isDebug_ = False 126 | Else 127 | isDebug_ = DEBUGS 128 | End If 129 | ' 130 | modules = "default" 131 | Set s_ = Server.CreateObject("Scripting.Dictionary") 132 | End Sub 133 | 134 | Private Sub Class_Terminate() 135 | For Each r in s_ 136 | Set s_(r) = Nothing 137 | Next 138 | Set s_ = Nothing 139 | End Sub 140 | 141 | '--------------------------------------0 初始化路由 142 | 143 | '@Start(): 路由启动,需要预先设置loader,request外部依赖属性 144 | 145 | Public Sub Start() 146 | On Error Resume Next 147 | Dim arr,i 148 | ' 149 | rewrite_on = false 150 | dewrite_on = false 151 | module = "default" 152 | ' 153 | SetBaseAddr requests_.baseAddr 154 | SetBasePicAddr requests_.basePicAddr 155 | End Sub 156 | 157 | '--------------------------------------1 首先获得模块信息然后Start对应模块 158 | 159 | '@GetModule(): 获取模块 160 | 161 | Public Sub GetModule() 162 | '特殊路由模块计算并跳出:例如按照域名或其他特定规则在此判断 163 | Dim sModule,sStatus 164 | Set sModule = loader_.LoadClass("route/module") 165 | sModule.route = Me 166 | sStatus = sModule.GetModule(requests_) 167 | Set sModule = Nothing 168 | 169 | '如果已经匹配到模块则跳出 170 | If sStatus Then Exit Sub 171 | 172 | '标准模块判断 173 | GetStandardModule() 174 | End Sub 175 | 176 | Private Sub GetStandardModule() 177 | Dim temp_path 178 | 179 | '获取标准路由路径 180 | If requests_.Status404 Then 181 | temp_path = RouteAddr 182 | Else 183 | temp_path = requests_.querystr("route") 184 | End If 185 | 186 | '标准路由模块计算 187 | If temp_path <> "" Then 188 | temp_array = Split(temp_path, "/") 189 | temp_path = temp_array(0) 190 | If fun_.StrEqual(temp_path,modules,",") Then module = temp_array(0) 191 | End If 192 | End Sub 193 | 194 | '--------------------------------------2 设置根目录,计算路由地址 195 | 196 | '@SetBaseAddr(ByRef str): 指定网页baseAddr,得到routeAddr路由 197 | 198 | Public Sub SetBaseAddr(ByRef str) 199 | baseAddr = str 200 | ' 201 | dim tmp_standardAddr,tmp_baseAddr 202 | tmp_standardAddr=GetBieUrl(requests_.standardAddr) 203 | tmp_baseAddr=GetBieUrl(str) 204 | If Instr(tmp_standardAddr,tmp_baseAddr)>0 Then 205 | routeAddr = Replace(tmp_standardAddr, tmp_baseAddr, "") 206 | Else 207 | routeAddr = "error/e404" 208 | End if 209 | End Sub 210 | 211 | '@SetBasePicAddr(ByRef str): 指定图片basePicAddr,得到routePicAddr路由 212 | 213 | Public Sub SetBasePicAddr(ByRef str) 214 | basePicAddr = str 215 | ' 216 | dim tmp_standardAddr,tmp_basePicAddr 217 | tmp_standardAddr=GetBieUrl(requests_.standardAddr) 218 | tmp_basePicAddr=GetBieUrl(str) 219 | If Instr(tmp_standardAddr,tmp_basePicAddr)>0 Then 220 | routePicAddr = Replace(tmp_standardAddr, tmp_basePicAddr, "") 221 | End if 222 | End Sub 223 | 224 | '-------------------------------------- 路由对象 225 | 226 | ' 路由对 1,2,3 227 | 228 | ' 路由对象0 229 | 230 | Private Sub DeWrite_Ask(ByRef r_path,ByRef p_path) 231 | If InStr(r_path, "?")>0 Then 232 | temp_array = Split(r_path, "?") 233 | r_path = temp_array(0) 234 | Add_Query temp_array(1) 235 | End If 236 | ' 237 | If InStr(p_path, "?")>0 Then 238 | temp_array = Split(p_path, "?") 239 | p_path = temp_array(0) 240 | Add_Query temp_array(1) 241 | End If 242 | End Sub 243 | 244 | Private Function Add_Query(ByRef Web_Query) 245 | Dim i, j, arr, arr_j 246 | arr = Split(Web_Query, "&") 247 | For i = 0 To UBound(arr) 248 | If arr(i)<> "" Then 249 | arr_j = Split(arr(i), "=") 250 | If UBound(arr_j) = 1 Then 251 | If arr_j(0)<>"" And arr_j(1)<>"" Then 252 | requests_.querystr(arr_j(0)) = fun_.urldecodes(arr_j(1)) '++query 253 | End If 254 | End If 255 | End If 256 | Next 257 | End Function 258 | 259 | ' 路由对象4 260 | 261 | Private Sub DeWrite_404() 262 | c_path = PATH_MODULE&module&"/"&PATH_CONTROL 263 | c = "error" 264 | If loader_.LoadFile(c_path&c&".asp")<> -1 Then 265 | control = c 266 | action = "e404" 267 | dewrite_on = true 268 | End If 269 | End Sub 270 | 271 | '-------------------------------------- 编码，解码 272 | 273 | '@ReWrite(ByRef base,ByRef r_path): 路由编码 274 | 275 | Public Function ReWrite(ByRef base,ByRef r_path) 276 | On Error Resume Next 277 | Dim str 278 | 279 | 'status 280 | If rewrite_on = false Then 281 | ReWrite = base&r_path 282 | Exit Function 283 | End If 284 | 285 | '遍历路由 286 | For Each r in s_ 287 | str = s_(r).ReWrite(r_path) 288 | If str <> "" Then 289 | ReWrite = base&str 290 | Exit Function 291 | End If 292 | If Err Then OutErr("路由编码错误:"&r&":"&r_path&Err.Description) 293 | Next 294 | 295 | 'default 296 | ReWrite = base&"#" 297 | 298 | End Function 299 | 300 | '@DeWrite(): 路由解码 301 | 302 | Public Sub DeWrite() 303 | On Error Resume Next 304 | 305 | If requests_.Status404 Then 306 | r_path = RouteAddr 307 | p_path = RoutePicAddr 308 | Else 309 | r_path = requests_.querystr("route") 310 | If s_.Exists("slash") Then s_("slash").DeWrite r_path 311 | If dewrite_on Then Exit Sub 312 | End If 313 | 314 | '? 315 | DeWrite_Ask r_path,p_path 316 | 317 | '遍历路由 318 | For Each r in s_ 319 | If r = "pic" Then 320 | s_(r).DeWrite p_path 321 | Else 322 | s_(r).DeWrite r_path 323 | End If 324 | If dewrite_on Then Exit Sub 325 | If Err Then OutErr("路由解码错误:"&r&Err.Description) 326 | Next 327 | 328 | '404 329 | DeWrite_404 330 | If dewrite_on Then Exit Sub 331 | 332 | 'no control 333 | OutErr("no control") 334 | End Sub 335 | 336 | '@GetBieUrl(ByRef url): 去https,http,端口，用于对比网址 337 | 338 | Public Function GetBieUrl(ByRef url) 339 | dim tmp 340 | tmp=split(url,"://") 341 | if instr(tmp(1),":")>0 then 342 | GetBieUrl=left(tmp(1),instr(tmp(1),":")-1) + right(tmp(1),len(tmp(1))-instr(tmp(1),"/")+1) 343 | else 344 | GetBieUrl=tmp(1) 345 | end if 346 | End Function 347 | 348 | '错误提示 349 | 350 | Public Sub OutErr(ByRef ErrMsg) 351 | Err.Clear 352 | If isDebug_ = true Then 353 | Response.charset = "utf-8" 354 | Response.Write ErrMsg 355 | Response.End 356 | End If 357 | End Sub 358 | 359 | End Class 360 | %> --------------------------------------------------------------------------------