<%
'--------------------------事务结束处理---------------------begin
Function rsRollbackTrans(rsErrors)
'sql="Insert into OA_OperationRecord (OperationID,OperationAction,OperationRecord,OperationIP) values ('"&session("adminID")&"','"&admin_save&"','"&OperationRecord&"','"&Request.ServerVariables("REMOTE_ADDR")&"')"
'objConn.Execute sql
if rsErrors=0 then
objConn.CommitTrans
else
objConn.RollbackTrans
%>
<%
Response.End
end if
End Function
'--------------------------事务结束处理---------------------end
'--------------------------生成唯一ID---------------------begin
'生成时间ID
Function DTimeID()
Ye=Year(date())
Mo=Month(date())
Da=Day(date())
Ho=Hour(time())
Mi=Minute(time())
Se=Second(time())
if len(Mo)=1 then Mo="0" & Mo
if len(Da)=1 then Da="0" & Da
if len(Ho)=1 then Ho="0" & Ho
if len(Mi)=1 then Mi="0" & Mi
if len(Se)=1 then Se="0" & Se
DTimeID = Mo&Da&Ho&Mi&Se
End Function
'生成日期ID
Function DDateID()
Ye=Year(date())
Mo=Month(date())
Da=Day(date())
Ho=Hour(time())
Mi=Minute(time())
Se=Second(time())
if len(Mo)=1 then Mo="0" & Mo
if len(Da)=1 then Da="0" & Da
if len(Ho)=1 then Ho="0" & Ho
if len(Mi)=1 then Mi="0" & Mi
if len(Se)=1 then Se="0" & Se
DDateID = Ye&Mo&Da
End Function
'创建随机ID过程
function getID()
dim numbers
dim letters
dim i
dim ID
Randomize
numbers = "0123456789"
letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
for i = 1 to 10
if i mod 2 <> 0 then
ID = ID & mid(letters, Int((26 * Rnd) + 1),1)
else
ID = ID & mid(numbers, Int((10 * Rnd) + 1),1)
end if
next
getID = ID
end function
'创建随机ID过程2
Function randKey(obj)
Dim char_array(80)
Dim temp
For i = 0 To 9
char_array(i) = Cstr(i)
Next
For i = 10 To 35
char_array(i) = Chr(i + 55)
Next
For i = 36 To 61
char_array(i) = Chr(i + 61)
Next
Randomize
For i = 1 To obj
'rnd函数返回的随机数在0~1之间，可等于0，但不等于1
'公式：int((上限-下限+1)*Rnd+下限)可取得从下限到上限之间的数，可等于下限但不可等于上限
temp = temp&char_array(int(62 - 0 + 1)*Rnd + 0)
Next
randKey = temp
End Function
'创建唯一ID过程,调用DTimeID()、getID()
Function CreateMyID()
dim MyID
MyID=DTimeID()&"-"&getID()
CreateMyID = MyID
End Function
'response.write CreateMyID()
'--------------------------生成唯一ID---------------------end
'日期格式整理
Function DateFormat(DateA)
If DateA<>"" Then
DateA=Month(DateA)&"/"&day(DateA)&" "&Right("0"&hour(DateA),2)&":"&Right("0"&Minute(DateA),2)
End If
DateFormat=DateA
End Function
Function NewMRPOrderID(OrderType)
NewMRPOrderID="MRP-"&OrderType&"-"&DDateID()&"-"&randKey(4)
End Function
'-------------------------供应商状态--------------------begin
Function Supplier_A(execLevel)
select case execLevel
case -1
Supplier_A="等待审核"
case 0
Supplier_A="正常"
end select
End Function
'-------------------------供应商状态--------------------end
'-------------------------采购入库/出库单状态--------------------begin
Function PurchaseOrderState_A(OrderState,OrdType)
If OrdType="10" Then
OrdTypeName="入库"
Else
OrdTypeName="出库"
End If
If OrderState=0 Then
PurchaseOrderState_A = "未审核"
ElseIf OrderState=1 Then
PurchaseOrderState_A = "已审核,等待"&OrdTypeName
ElseIf OrderState=2 Then
PurchaseOrderState_A = "部分"&OrdTypeName
ElseIf OrderState=3 Then
PurchaseOrderState_A = "已"&OrdTypeName
ElseIf OrderState=4 Then
PurchaseOrderState_A = "取消"
End If
End Function
'-------------------------采购入库/出库单状态--------------------end
'-------------------------销售出库/入库单状态--------------------begin
Function TradeOrderState_A(OrderState,OrdType)
If OrdType="11" Then
OrdTypeName="出库"
Else
OrdTypeName="入库"
End If
If OrderState=0 Then
TradeOrderState_A = "未审核"
ElseIf OrderState=1 Then
TradeOrderState_A = "已审核,等待"&OrdTypeName
ElseIf OrderState=2 Then
TradeOrderState_A = "部分"&OrdTypeName
ElseIf OrderState=3 Then
TradeOrderState_A = "已"&OrdTypeName
ElseIf OrderState=4 Then
TradeOrderState_A = "取消"
End If
End Function
'-------------------------采购入库/出库单状态--------------------end
'--------------------------字符转换---------------------begin
Function DealInput1(exp1)
dim exp2
exp2=Replace(exp1,chr(13),"")
exp2=Replace(exp2,chr(10),"")
DealInput1=trim(exp2)
End Function
'--------------------------字符转换---------------------end
'--------------------------字符转换2---------------------begin
Function DealInput2(exp1)
dim exp2
exp2=Replace(exp1,chr(13),"
")
exp2=Replace(exp2,chr(10),"")
DealInput2=trim(exp2)
End Function
'--------------------------字符转换2---------------------end
'是否判断
Function is_B(isInt)
select case isInt
case 0
is_B="否"
case 1
is_B="是"
end select
End Function
'--------------------------企业用户查找---------------------begin
Function UnitUser(UnitID,DataID)
if UnitID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select UnitID,UnitName,UnitShort,APPID from IntroducerUnitData where UnitID="&UnitID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
ADMINUnitID = adminrs("UnitID")
ADMINUnitName = adminrs("UnitName")
ADMINUnitShort = adminrs("UnitShort")
ADMINAPPID = adminrs("APPID")
adminrs.close()
else
DataID="UnitID"
End If
select case DataID
case "UnitID"
UnitUser = ADMINUnitID
case "UnitName"
UnitUser = ADMINUnitName
case "UnitShort"
UnitUser = ADMINUnitShort
case "UnitAPPID"
UnitUser = ADMINAPPID
end Select
End If
End Function
'--------------------------企业用户查找---------------------end
'--------------------------企业用户查找---------------------begin
Function UnitIntroducer(ServiceOrdIntroducer,DataID)
if ServiceOrdIntroducer<>"" Then
If IsNumeric(ServiceOrdIntroducer) Then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select IntroducerID,IntroducerName,IntroducerUnitID from IntroducerData where IntroducerID="&ServiceOrdIntroducer
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
IntroducerID = adminrs("IntroducerID")
IntroducerName = adminrs("IntroducerName")
IntroducerUnitID = adminrs("IntroducerUnitID")
Else
DataID="TXT"
End If
adminrs.close()
Else
DataID="TXT"
End If
else
DataID="TXT"
End If
select case DataID
case "TXT"
UnitIntroducer = ServiceOrdIntroducer
case "UnitName"
UnitIntroducer = IntroducerName
case "UnitID"
UnitIntroducer = IntroducerUnitID
end Select
End Function
'--------------------------企业用户查找---------------------end
'--------------------------用户查找---------------------begin
Function OAUser(adminID,DataID)
if adminID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select OA_User_ID,OA_User,OA_Name,OA_weixinAvatar,OA_mobile,OA_DepartmentID from OA_User where OA_User_ID="&adminID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
ADMINuserID = adminrs("OA_User_ID")
ADMINuser = adminrs("OA_User")
ADMINName = adminrs("OA_Name")
ADMINMobile = adminrs("OA_mobile")
ADMINAvatar = adminrs("OA_weixinAvatar")
ADMINDepartmentID = adminrs("OA_DepartmentID")
If ADMINAvatar="" Then ADMINAvatar="/resources/images/icon_avatar_default.png"
else
DataID="adminID"
end if
adminrs.close()
select case DataID
case "userID"
OAUser = ADMINuserID
case "UserName"
OAUser = ADMINName
case "UserPhone"
OAUser = ADMINMobile
case "adminID"
OAUser = adminID
case "Avatar"
OAUser = ADMINAvatar
case "DepartmentID"
OAUser = ADMINDepartmentID
end select
end if
End Function
'--------------------------用户查找---------------------end
'--------------------------部门查找---------------------begin
Function OADepartment(OA_DepartmentID,DataID)
if OA_DepartmentID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select id,vID,vtext,vType,vOrder from dictionary where vtitle='OA_Department' and vID="&OA_DepartmentID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
Did = adminrs("id")
DepartmentID = adminrs("vID")
DepartmentName = adminrs("vtext")
DepartmentParentid = adminrs("vType")
DepartmentOrder = adminrs("vOrder")
end if
adminrs.close()
select case DataID
case "Did"
OADepartment = Did
case "DepartmentID"
OADepartment = DepartmentID
case "DepartmentName"
OADepartment = DepartmentName
Case Else
OADepartment = OA_DepartmentID
end select
end if
End Function
'--------------------------部门查找---------------------end
'--------------------------职能查找---------------------begin
Function OACompetency(OA_Competency,DataID)
if OA_Competency<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select id,vID,vtext,vType,vOrder from dictionary where vtitle='OA_Competency' and vID="&OA_Competency
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
Cid = adminrs("id")
CompetencyID = adminrs("vID")
CompetencyName = adminrs("vtext")
CompetencyOrder = adminrs("vOrder")
end if
adminrs.close()
select case DataID
case "Cid"
OACompetency = Cid
case "CompetencyID"
OACompetency = CompetencyID
case "CompetencyName"
OACompetency = CompetencyName
Case Else
OACompetency = OA_Competency
end select
end if
End Function
'--------------------------职能查找---------------------end
'--------------------------车辆资料查询---------------------begin
Function CarDataA(CarID,CarLicense,DataID)
Set CarDataRS = Server.CreateObject("ADODB.Recordset")
If CarID<>"" then
CarDataA=CarID
sql="select * from CarData where CarID="&CarID
ElseIf CarLicense<>"" Then
CarDataA=CarLicense
sql="select * from CarData where CarLicense='"&CarLicense&"'"
End if
CarDataRS.open sql,objConn,1,1
if not CarDataRS.Eof then
CarDataAID = CarDataRS("CarID")
CarDataALicense = CarDataRS("CarLicense")
CarDataAAVIN = CarDataRS("CarVIN")
CarDataAModels = CarDataRS("CarModels")
CarDataAGPS_IMEI= CarDataRS("GPS_IMEI")
end if
CarDataRS.close()
select case DataID
case "CarID"
CarDataA = CarDataAID
case "CarLicense"
CarDataA = CarDataALicense
case "CarVIN"
CarDataA = CarDataAAVIN
case "CarModels"
CarDataA = CarDataAModels
case "CarIMEI"
CarDataA = CarDataAGPS_IMEI
end select
End Function
'--------------------------车辆资料查询---------------------end
'--------------------------医院资料查询---------------------begin
Function HospA(HospID,DataID)
if HospID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select id,vID,vtext,vType,vOrder from dictionary where vtitle='HospName' and vID="&HospID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
Hid = adminrs("id")
HospID = adminrs("vID")
HospName = adminrs("vtext")
HosOrder = adminrs("vOrder")
end if
adminrs.close()
select case DataID
case "HospName"
HospA = HospName
Case Else
HospA = HospName
end select
end if
End Function
'--------------------------医院资料查询---------------------end
'--------------------------审核状态---------------------begin
Function AP_Check_A(AP_Check)
select case AP_Check
case "1"
AP_Check_A="审核"
case "2"
AP_Check_A="审核"
case "0"
AP_Check_A="未审核"
case "-1"
AP_Check_A="作废"
case "4"
AP_Check_A="不通过"
end select
End Function
'--------------------------审核状态---------------------end
'--------------------------语言类型---------------------begin
Function AdminLanguage_A(AdminLanguage)
select case AdminLanguage
case "zh-CN"
AdminLanguage_A=Ch("简体中文")
case "En"
AdminLanguage_A=Ch("英文")
end select
End Function
'--------------------------语言类型---------------------end
'--------------------------是否有效---------------------begin
Function Is_A(IsInt)
select case IsInt
case 0
Is_A=Ch("有效")
case 1
Is_A=Ch("无效")
end select
End Function
'--------------------------语言类型---------------------end
'--------------------------服务单据状态---------------------begin
Function ServiceOrdStateA(ServiceOrdState)
Set ServiceOrdStateRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='ServiceOrderState' and vID="&ServiceOrdState
ServiceOrdStateRS.open sql,objConn,1,1
if not ServiceOrdStateRS.Eof then
ServiceOrdStateA = ServiceOrdStateRS(0)
else
ServiceOrdStateA = "问题订单"
end if
ServiceOrdStateRS.close()
End Function
'--------------------------服务单据状态---------------------end
'--------------------------服务单据状态(配色版)---------------------begin
Function ServiceOrdStateB(ServiceOrdState)
Set ServiceOrdStateRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='ServiceOrderState' and vID="&ServiceOrdState
ServiceOrdStateRS.open sql,objConn,1,1
if not ServiceOrdStateRS.Eof then
If ServiceOrdStateRS(0)="咨询单" Then
ServiceOrdStateB = ""&ServiceOrdStateRS(0)&""
ElseIf ServiceOrdStateRS(0)="取消单" Then
ServiceOrdStateB = ""&ServiceOrdStateRS(0)&""
ElseIf ServiceOrdStateRS(0)="未调度" Then
ServiceOrdStateB = ""&ServiceOrdStateRS(0)&""
Else
ServiceOrdStateB = ServiceOrdStateRS(0)
End If
else
ServiceOrdStateB = "问题订单"
end if
ServiceOrdStateRS.close()
End Function
'--------------------------服务单据状态(配色版)---------------------end
'--------------------------调度单据状态---------------------begin
Function DispatchOrdStateA(DispatchOrdState)
Set DispatchOrdStateRS = Server.CreateObject("ADODB.Recordset")
DispatchOrdState1=DispatchOrdState
If InStr(DispatchOrdState1,"_")>0 Then DispatchOrdState1=Left(DispatchOrdState1,InStr(DispatchOrdState1,"_")-1)
sql="select vtext from dictionary where vtitle='DispatchOrdState' and vID="&DispatchOrdState1
DispatchOrdStateRS.open sql,objConn,1,1
if not DispatchOrdStateRS.Eof then
DispatchOrdStateA = DispatchOrdStateRS(0)
else
DispatchOrdStateA = "问题订单"
end if
DispatchOrdStateRS.close()
End Function
'--------------------------调度单据状态---------------------end
'--------------------------调度单据状态(配色版)---------------------begin
Function DispatchOrdStateC(DispatchOrdState)
Set DispatchOrdStateRS = Server.CreateObject("ADODB.Recordset")
DispatchOrdState1=DispatchOrdState
If InStr(DispatchOrdState1,"_")>0 Then DispatchOrdState1=Left(DispatchOrdState1,InStr(DispatchOrdState1,"_")-1)
sql="select vtext from dictionary where vtitle='DispatchOrdState' and vID="&DispatchOrdState1
DispatchOrdStateRS.open sql,objConn,1,1
if not DispatchOrdStateRS.Eof then
If DispatchOrdState="4" Or DispatchOrdState="5" Or DispatchOrdState="6" Or DispatchOrdState="7" Then
DispatchOrdStateC = ""&DispatchOrdStateRS(0)&""
'ElseIf DispatchOrdState="4" Then
' DispatchOrdStateC = ""&DispatchOrdStateRS(0)&""
'ElseIf DispatchOrdState="4" Then
' DispatchOrdStateC = ""&DispatchOrdStateRS(0)&""
Else
DispatchOrdStateC = DispatchOrdStateRS(0)
End If
else
DispatchOrdStateC = "问题订单"
end if
DispatchOrdStateRS.close()
End Function
'--------------------------调度单据状态(配色版)---------------------end
'--------------------------调度单取消详情---------------------begin
Function CancelReasonB(DispatchOrdCancelReason,DispatchOrdCancelReasonTXT)
If DispatchOrdCancelReason<>"" then
Set DispatchOrdStateRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='CancelReason' and vID="&DispatchOrdCancelReason
DispatchOrdStateRS.open sql,objConn,1,1
if not DispatchOrdStateRS.Eof then
CancelReasonB = DispatchOrdStateRS(0)
else
CancelReasonB = "其它取消"
end If
If DispatchOrdCancelReasonTXT<>"" Then CancelReasonB=CancelReasonB&"("&DispatchOrdCancelReasonTXT&")"
DispatchOrdStateRS.close()
End If
End Function
'--------------------------调度单取消详情---------------------end
'--------------------------调度单据列表---------------------begin
Function DispatchOrdStateB(DispatchOrdState)
if DispatchOrdState="1" Or DispatchOrdState="2" then
DispatchOrdStateB = "未确认列表"
ElseIf DispatchOrdState="3" Then
DispatchOrdStateB = "未出车列表"
ElseIf DispatchOrdState="4" Or DispatchOrdState="5" Or DispatchOrdState="6" Or DispatchOrdState="7" Then
DispatchOrdStateB = "执行中列表"
ElseIf DispatchOrdState="8" Then
DispatchOrdStateB = "已返回列表"
ElseIf DispatchOrdState="9" Then
DispatchOrdStateB = "跑空单列表"
ElseIf DispatchOrdState="10" Then
DispatchOrdStateB = "取消单据列表"
ElseIf DispatchOrdState="12" Or DispatchOrdState="100" Then
DispatchOrdStateB = "历史任务列表"
else
DispatchOrdStateB = "全部调度单"
end if
End Function
'--------------------------调度单据列表---------------------end
'--------------------------个人任务-调度单据状态---------------------begin
Function TaskStateA(TaskState)
If TaskState="2" then
TaskStateA = "新任务"
ElseIf TaskState="3" then
TaskStateA = "进行中"
ElseIf TaskState="8" then
TaskStateA = "已完成"
else
TaskStateA = "问题订单"
end if
End Function
'--------------------------个人任务-调度单据状态---------------------end
'--------------------------单据号码类型---------------------begin
Function OrderClassA(OrderClass)
Set OrderClassRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='OrderClass' and vOrder2='"&OrderClass&"'"
OrderClassRS.open sql,objConn,1,1
if not OrderClassRS.Eof then
OrderClassA = OrderClassRS(0)
else
OrderClassA = "单据类型错误"
end if
OrderClassRS.close()
End Function
'--------------------------单据号码类型---------------------end
'--------------------------服务单类型---------------------begin
Function ServiceOrdTypeA(ServiceOrdType)
Set OrderTypeRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='ServiceOrderType' and vID="&ServiceOrdType
OrderTypeRS.open sql,objConn,1,1
if not OrderTypeRS.Eof then
ServiceOrdTypeA = OrderTypeRS(0)
else
ServiceOrdTypeA = ""
end if
OrderTypeRS.close()
End Function
'--------------------------服务单类型---------------------end
'--------------------------取消类型---------------------begin
Function CancelReasonA(CancelReason)
Set OrderTypeRS = Server.CreateObject("ADODB.Recordset")
sql="select vtext from dictionary where vtitle='CancelReason' and vID="&CancelReason
OrderTypeRS.open sql,objConn,1,1
if not OrderTypeRS.Eof then
CancelReasonA = OrderTypeRS(0)
else
CancelReasonA = "其它"
end if
OrderTypeRS.close()
End Function
'--------------------------取消类型---------------------end
'--------------------------小数显示---------------------begin
Function FN(n)
if IsNumeric(n)=False then
FN=n
elseif InStr(n,".")<=0 then
FN=FormatNumber(n,0,-1,,0)
elseif len(Mid(n,InStr(n,".")))=2 then
FN=FormatNumber(n,1,-1,,0)
else
FN=FormatNumber(n,2,-1,,0)
end if
End Function
'--------------------------小数显示---------------------end
'======================去掉UBB代码(单图片)======================
Private Function ReUBBimg(ByVal inVal) '转换成UBB代码：inVal 为需要转换的字符串
'inVal = Server.HTMLEncode(inVal)
inVal = Replace(inVal," "," ")
inVal = Replace(inVal,vbCrlf,"")
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "\[IMG]http://(.[^\[]*)(\.gif|\.jpg|\.jpeg)\[\/IMG]"
inVal = regEx.Replace(inVal,",http://$1$2")
regEx.Pattern = "\[IMG](.[^\[]*)(\.gif|\.jpg|\.jpeg)\[\/IMG]"
inVal = regEx.Replace(inVal,",$1$2")
Set regEx = Nothing
ReUBBimg = inVal
End Function
'验证字段2
Function SafeRequestHtml(ParaName)
ParaValue=ParaName
if not isnull(ParaValue) then
ParaValue = replace(ParaName,"'","''")
'ParaValue = replace(ParaValue,"""",""")
'ParaValue = replace(ParaValue,"http://v.com.cn:8080","")
'ParaValue = replace(ParaValue,"http://www.v.com.cn:8080","")
end if
OperationRecord=OperationRecord&ParaValue
SafeRequestHtml=ParaValue
End function
'--------------------------提交记录Form---------------------begin
Function RequestForm(Origin)
ReDim arr(Request.form.Count,2)
Dim v '所有表单值
Dim t '所有表单数量
v=Request.form
t=Request.form.Count
For i=0 To t-1
arr(i,1)=Split(Split(v,"&")(i),"=")(0)
arr(i,2)=Split(Split(v,"&")(i),"=")(1)
Next
For i = 0 To t-1
If arr(i,1)="province" Then arr(i,1)="ServiceOrdTraProvince"
If arr(i,1)="city" Then arr(i,1)="ServiceOrdTraCity"
If oldv<>arr(i,1) then
oldv=arr(i,1)
Origin=Origin & "|" & arr(i,1) & "=" & URLDecode(arr(i,2))
Else
Origin=Origin & "," & URLDecode(arr(i,2))
End If
Next
End Function
'--------------------------提交记录Form---------------------end
'--------------------------提交记录QueryString---------------------begin
Function RequestQueryString()
ReDim arr(Request.QueryString.Count,2)
Dim v '所有表单值
Dim t '所有表单数量
v=Request.QueryString
t=Request.QueryString.Count
For i=0 To t-1
arr(i,1)=Split(Split(v,"&")(i),"=")(0)
arr(i,2)=Split(Split(v,"&")(i),"=")(1)
Next
oldv=""
For i = 0 To t-1
If arr(i,1)="province" Then arr(i,1)="ServiceOrdTraProvince"
If arr(i,1)="city" Then arr(i,1)="ServiceOrdTraCity"
If oldv<>arr(i,1) then
oldv=arr(i,1)
Origin=Origin & "|" & arr(i,1) & "=" & URLDecode(arr(i,2))
Else
Origin=Origin & "," & URLDecode(arr(i,2))
End If
Next
End Function
'--------------------------提交记录QueryString---------------------end
'--------------------------URL反编码函数---------------------begin
Function URLDecode(ByVal urlcode)'URL反编码函数
Dim start,final,length,char,i,butf8,pass
Dim leftstr,rightstr,finalstr
Dim b0,b1,bx,blength,position,u,utf8
On Error Resume Next
b0 = Array(192,224,240,248,252,254)
urlcode = Replace(urlcode,"+"," ")
pass = 0
utf8 = -1
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
If start = 0 or length < 3 Then URLDecode = urlcode : Exit Function
leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final
char = Mid(urlcode,i,1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1 : blength = -1 : b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
If b1 < 128 or b1 > 191 Then butf8 = 0 : Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx : u = 0 : blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
If bx < 128 or bx > 191 Then u = 0 : Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &h100 : u = 0
bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode,1) = "%" Then
u = b1 + Asc(Mid(urlcode,i + 3,1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode,i + 1,1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
Next
URLDecode = leftstr & finalstr & rightstr
End Function
Function URLDecode_Hex(ByVal h)
On Error Resume Next
h = "&h" & Trim(h) : URLDecode_Hex = -1
If Len(h) <> 4 Then Exit Function
If isNumeric(h) Then URLDecode_Hex = cInt(h)
End Function
'--------------------------URL反编码函数---------------------end
'--------------------------秒数转X小时X分X秒---------------------begin
function SplitTime(secondTime)
HourTime=int(secondTime/3600)
MinuteTime=int((secondTime mod 3600)/60)
SecondTime=(secondTime mod 3600) mod 60
if len(MinuteTime)<2 then MinuteTime="0" & MinuteTime end if
if len(SecondTime)<2 then SecondTime="0" & SecondTime end if
SplitTime=""
If HourTime>0 Then SplitTime=HourTime&"小时 "
If MinuteTime>0 Then SplitTime=SplitTime & MinuteTime&"分 "
If SecondTime>0 Then SplitTime=SplitTime & SecondTime&"秒"
end function
'--------------------------秒数转X小时X分X秒---------------------end
'--------------------------UNIX时间戳---------------------begin
'ToUnixTime(now(), +8)
Function ToUnixTime(strTime, intTimeZone)
If IsEmpty(strTime) or Not IsDate(strTime) Then strTime = Now
If IsEmpty(intTimeZone) or Not isNumeric(intTimeZone) Then intTimeZone = 0
ToUnixTime = DateAdd("h",-intTimeZone,strTime)
ToUnixTime = DateDiff("s","1970-1-1 0:0:0", ToUnixTime)
End Function
'--------------------------UNIX时间戳---------------------end
'--------------------------远程获取图片至本地---------------------begin
Function downFile(url,filePath,fileSuffix)
'远程获取文件
'------------------------------------------------------
set xmlhttp = server.CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "get",url,false
xmlhttp.send
html = xmlhttp.ResponseBody
'获取文件名
'-----------------------------------------------------
If fileSuffix<>"" Then
fileName = ToUnixTime(now(),+8)&randKey(4) &"."&fileSuffix
else
fileNameSplit = Split(url,"/")
fileName = fileNameSplit(Ubound(fileNameSplit))
End If
'开始保存文件到本地
'-----------------------------------------------------
Set saveFile = Server.CreateObject("Adodb.Stream")
saveFile.Type = 1
saveFile.Open
saveFile.Write html
saveFile.SaveToFile server.MapPath(filePath)&"\"&fileName, 2
downFile=filePath&fileName
End Function
'中文转拼音首字
Function Pinyin_A(Str)
Str=Replace(Str,"（","")
Str=Replace(Str,"）","")
Str=Replace(Str," ","")
Str=Replace(Str,"、","")
Pinyin_A=GetBody("https://sys.966120.com.cn/inc/GB2312.gds","zhoz_txt="&server.urlencode(Str))
Pinyin_A=Replace(Pinyin_A,"?","")
End Function
'Get方法
Function GetBody(appUrl,Origin)
Set https = Server.CreateObject("Msxml2.ServerXMLHTTP")
With https
.Open "GET", appUrl&"?"&Origin, False
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send ""
GetBody = .ResponseBody
End With
GetBody = BytesToBstr(GetBody,"utf-8")
Set https = Nothing
End Function
Function BytesToBstr(body,Cset) '飘易：转换GB2312
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'--------------------------分钟转小时---------------------end
function mtodhm(mnum)
dim m,h0,h,d
m=(mnum mod 60)
h=int(mnum/60)
mtodhm=h&"小时"&m&"分"
end Function
'--------------------------分钟转小时---------------------end
'--------------------------字符串签名---------------------begin
'待签名字符串
Function SignArgs(args1)
args1SP=SPLIT(args1,"&")
ReDim arr(UBOUND(args1SP)+1,2)
Dim v '所有表单值
Dim t '所有表单数量
v=args1
t=UBOUND(args1SP)+1
For i=0 To t-1
arr(i,1)=Split(Split(v,"&")(i),"=")(0)
arr(i,2)=Split(Split(v,"&")(i),"=")(1)
Next
For i = 0 To t-1
For j = i + 1 To t-1
If arr(i,1) > arr(j,1) Then
tmp1 = arr(i,1)
arr(i,1) = arr(j,1)
arr(j,1) = tmp1
tmp2 = arr(i,2)
arr(i,2) = arr(j,2)
arr(j,2) = tmp2
End If
Next
Next
For i = 0 To t-1
'response.write arr(i,1) & "=" & arr(i,2) & "
"
If arr(i,1)="Sign" Then
reserve=arr(i,2)
else
If arr(i,2)="timestamp" Then arr(i,2)=Date() &" "& Time()
sParaSort=sParaSort & arr(i,1) & arr(i,2)
sParaRunning=sParaRunning &"&"& arr(i,1) &"="& arr(i,2)
End if
Next
sign_type = "MD5"
input_charset="utf-8"
stringA=sParaSort&key
'response.write sParaSort & "
"
'SignArgs=stringA
SignArgs=Md5Sign(sParaSort,key,input_charset)
End Function
'--------------------------字符串签名---------------------end
'--------------------------获取客户端真实IP地址---------------------begin
Private Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),1,InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),1,InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
'--------------------------获取客户端真实IP地址---------------------end
'--------------------------名传无线-短信发送---------------------begin
Function Get_SMS(Send_Phone,Send_Text,Send_Remarks)
'账号：201453
'密码：b9d04e62652a47f317616e122e819918
'地址：yun.mchuan.com
url="http://112.74.139.4:8002/sms3_api/jsonapi/jsonrpc2.jsp" '//定义要获取源代码的网址，一般是通过变量传递过来
Origin="{"
Origin=Origin&"""id"": 1 ,"
Origin=Origin&"""method"":""send"","
Origin=Origin&"""params"":{"
Origin=Origin&"""userid"":""201453"","
Origin=Origin&"""password"":""b9d04e62652a47f317616e122e819918"","
Origin=Origin&"""submit"": [{"
Origin=Origin&"""content"":"""&Send_Text&""","
Origin=Origin&"""phone"":"""&Send_Phone&""""
Origin=Origin&"}]}}"
'Response.Write url&"?"&Origin&"
"
'Response.end
HTMLCODE= GetBody(url,Server.URLEncode(Origin))
%>
<%
str=HTMLCODE
str=right(str,len(str)-instr(str,"[")+1)
str=left(str,InstrRev(str,"]"))
set obj = getjson(str)
for i=0 to obj.length-1
phone = obj.get(i).phone
msgid = obj.get(i).msgid
return = obj.get(i).return
errMsg = obj.get(i).info
sql="Insert into Sms_Log (Log_Id,Send_Text,Send_Phone,Send_OA,Send_errMsg,Send_Remarks) values ('"&msgid&"','"&Send_Text&"','"&phone&"',"&session("adminID")&",'"&errMsg&"','"&Send_Remarks&"')"
'objConn.Execute sql
Next
End Function
'--------------------------名传无线-短信发送---------------------end
%>