⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hx_system.asp

📁 一个比较完整的oa系统
💻 ASP
📖 第 1 页 / 共 4 页
字号:
		   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 + -