📄 hx_system.asp
字号:
OutUserName=Outrs("WS_UserName") '用户名
OutName=Outrs("WS_Name") '姓名
OutPhone=Outrs("WS_Phone")'电话号码
OutAddress=Outrs("WS_Address")'住址
OutAppointmentID=Outrs("WS_Appointment")'职位
OutdepartmentID=Outrs("WS_department")'部门
if OutAppointmentID>0 then
OutAppointment=conn.execute("select * from HX_Appointment where WS_Aid="&OutAppointmentID)("WS_AppointmentName")
end if
if OutdepartmentID>0 then
Outdepartment=conn.execute("select * from HX_Department where WS_Did="&OutdepartmentID)("WS_DepartmentName")
end if
Call HX_RSClose(OutRs)
end if
end if
End Sub
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Sub HX_OutCustonInfo(Cid)
if WS_S.HX_IsNUM(Cid) then
set crs=WS_S.HX_SetRSD(ColumnName,"HX_CustomInfo"," where WS_CIID="&Cid)
if crs.recordcount>0 then
response.write crs("WS_CustomInfoName")
else
response.write "不属于客户"
end if
else
response.write "不属于客户"
end if
End Sub
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Sub HX_OutSaleShop(SSID)
if WS_S.HX_IsNUM(SSID) then
set crs=WS_S.HX_SetRSD(ColumnName,"HX_SaleShop"," where WS_SSID="&SSID)
if crs.recordcount>0 then
response.write crs("WS_SaleShopName")
else
response.write "内部产品"
end if
else
response.write "内部产品"
end if
End Sub
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Sub HX_OutProduct(PTID)
if WS_S.HX_IsNUM(PTID) then
set crs=WS_S.HX_SetRSD(ColumnName,"HX_Product"," where WS_PTID="&PTID)
if crs.recordcount>0 then
response.write crs("WS_ProductName")
else
response.write "产品空缺"
end if
else
response.write "产品空缺"
end if
End Sub
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Function OutSchEduleSort(SchEduleID)
if WS_S.HX_IsNum(SchEduleID) then
set OutRs=WS_S.HX_SetRSD(ColumnName,"HX_SchEduleSort"," where WS_SEID="&SchEduleID)
if OutRs.recordcount>0 then
OutSchEduleSort=OutRs("WS_SchEduleSortName")
end if
Call HX_RSClose(OutRs)
end if
End Function
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Public Sub SaveAdminLog(WS_UserName,WS_Appointment,RequestStr)
On Error Resume Next
Path_Info = Request.ServerVariables("PATH_INFO")
Tmpstr = Split(Path_Info,"/")
ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
Err=0
if RequestStr="" then
RequestStr=Left(request.form,200)
RequestStr=CheckStr(URLDecode(RequestStr))
end if
SQL="Insert Into HX_ManageLog (WS_UserName,WS_Appointment,WS_UserIP,WS_ScriptName,WS_LogContent,WS_LogTime) values ('"&WS_UserName&"',"&WS_Appointment&",'"&Request.ServerVariables("REMOTE_ADDR")&"','"&ScriptName&"','"&RequestStr&"','"&Now&"')"
conn.Execute(SQL)
If Err Then
Response.Write "添加管理事件记录失败!原因:" & Err.Description
Err.Clear
End If
HX_ClosDB()
End Sub
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址:http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意:免费版程序不得用于商业用途,否则后果自负!!!!
Public Function HX_RSClose(RecordSetStr)
if isobject(RecordSetStr) then
RecordSetStr.Close:Set RecordSetStr = Nothing
end if
End Function
'Server.URLEncode解码函数
Public Function URLDecode(enStr)
dim deStr, c, i, v
deStr=""
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c="%" then
v=eval("&h"+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if IsValidHex(mid(enstr,i,3)) then
if IsValidHex(mid(enstr,i+3,3)) then
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c="+" then
deStr=deStr&" "
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
End Function
'显示"上一页 下一页":链接地址,总数,页数,是否显示总数,是否用下拉列表跳转,单位
Public Function PageControl(iCount,pagecount,page,table_style,font_style,colspan)
'生成上一页下一页链接
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
if colspan=0 then
Response.Write("<table " & Table_style & ">" & vbCrLf )
end if
Response.Write("<TR><TD align=right bgcolor=ffffff colspan="&colspan&" height=25>" & vbCrLf )
Response.Write(font_style & vbCrLf )
if page<=1 then
Response.Write ("首页 " & vbCrLf)
Response.Write ("上页 " & vbCrLf)
else
Response.Write("<A HREF=" & action & "?" & temp & "Page=1>首页</A> " & vbCrLf)
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上页</A> " & vbCrLf)
end if
if page>=pagecount then
Response.Write ("下页 " & vbCrLf)
Response.Write ("尾页 " & vbCrLf)
else
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下页</A> " & vbCrLf)
Response.Write("<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">尾页</A> " & vbCrLf)
end if
Response.Write(" 页次:" & page & "/" & pageCount & "页" & vbCrLf)
Response.Write(" 共有" & iCount & "条" & vbCrLf)
Response.Write("</TD>" & vbCrLf )
Response.Write("</TR>" & vbCrLf )
if colspan=0 then
Response.Write("</table>" & vbCrLf )
end if
End Function
Public Function ChecKIPlock(ip)
num_ip=IpEncode(ip)
set rs=WS_S.HX_SetRSD("WS_LOID","HX_lockip"," where int(WS_Startip)<="&num_ip&" and int(WS_Endip)>=" & num_ip)
if rs.recordcount>0 then
Call WS_S.HX_RSClose(rs)
Call HX_GoBack("你所在网段已被封锁。可能该网段有人捣乱,请联系管理员!","")
end if
Call WS_S.HX_RSClose(rs)
end function
function IpDecode(byval uip)
if trim(uip)="" or not isnumeric(uip) then
IpDecode=0
else
uip=Cdbl(uip)
dim ary_ip(3)
ary_ip(0)=fix(uip/16777216)
ary_ip(1)=fix((uip-ary_ip(0)*16777216)/65536)
ary_ip(2)=fix((uip-fix(uip/65536)*65536)/256)
uip=uip-fix(uip/65536)*65536
ary_ip(3)=fix(uip-fix(uip/256)*256)
IpDecode=join(ary_ip,".")
end if
end function
function IpEncode(byval uip)
if isnull(uip) or uip="" then
IpEncode=0
else
dim ary_ip,n
ary_ip=split(trim(uip),".")
n=ubound(ary_ip)
if n=3 then
IpEncode=ary_ip(0)*256*256*256+ary_ip(1)*65536+ary_ip(2)*256+ary_ip(3)
else
IpEncode=0
end if
end if
end function
'取得带端口的URL
Public Function Get_ScriptNameUrl()
If request.servervariables("SERVER_PORT")="80" Then
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
Else
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
End If
End Function
' 转为根路径格式
Public Function RelativePath2RootPath(url)
Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPath = sTempUrl
Exit Function
End If
Dim sNowPath
sNowPath = Request.ServerVariables("SCRIPT_NAME")
sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
Loop
RelativePath2RootPath = sNowPath & "/" & sTempUrl
End Function
' 根路径转为带域名全路径格式
Public Function RootPath2DomainPath(url)
Dim sHost, sPort
sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
sPort = Request.ServerVariables("SERVER_PORT")
If sPort <> "80" Then sHost = sHost & ":" & sPort
RootPath2DomainPath = sHost & url
End Function
Public Function GetSize(size,unit)
if isEmpty(size) or Not Isnumeric(size) then Exit Function
size=CheckUnit(size,unit)
if size>1024 then
size=(size/1024)
getsize=formatnumber(size,2) & " MB"
else
if size>0 then
getsize=formatnumber(size,2) & " KB"
else
getsize="0.00 KB"
end if
Exit Function
end if
if size>1024 then
size=(size/1024)
getsize=formatnumber(size,2) & " GB"
end if
End Function
Public Function CheckUnit(size,unit)
Select Case Lcase(Unit)
Case "b"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -