%
'--------------------------事务结束处理---------------------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.Write rsErrors
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过程(纯数字)
function getIDnumbers(obj)
dim numbers
dim letters
dim i
dim ID
Randomize
numbers = "0123456789"
letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
for i = 1 to obj
ID = ID & mid(numbers, Int((10 * Rnd) + 1),1)
next
getIDnumbers = ID
end function
'创建唯一ID过程,调用DTimeID()、getID()
Function CreateMyID()
dim MyID
MyID=DTimeID()&"-"&getID()
CreateMyID = MyID
End Function
'response.write CreateMyID()
'--------------------------生成唯一ID---------------------end
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
If exp1<>"" Then
exp2=Replace(exp1,chr(13),"")
exp2=Replace(exp2,chr(10),"
")
End If
DealInput1=trim(exp2)
End Function
'--------------------------字符转换---------------------end
'--------------------------字符转换2---------------------begin
Function DealInput2(exp1)
dim exp2
If exp1<>"" Then
exp2=Replace(exp1,chr(13),"")
exp2=Replace(exp2,chr(10),"
")
End If
DealInput2=trim(exp2)
End Function
'--------------------------字符转换2---------------------end
'--------------------------字符转换3---------------------begin
Function DealInput3(exp1)
dim exp2
If exp1<>"" Then
exp2=Replace(exp1,chr(13),"")
exp2=Replace(exp2,chr(10),"\n")
End If
DealInput3=trim(exp2)
End Function
'--------------------------字符转换3---------------------end
'是否判断
Function is_B(isInt)
select case isInt
case 0
is_B="否"
case 1
is_B="是"
end select
End Function
'--------------------------仓库查找---------------------begin
Function Warehouse_A(WarehouseID,DataID)
if WarehouseID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select WarehouseID,WarehouseName from MRP_Warehouse where WarehouseID="&WarehouseID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
ADMINWarehouseID = adminrs("WarehouseID")
ADMINWarehouseName = adminrs("WarehouseName")
else
DataID="ID"
end if
adminrs.close()
select case DataID
case "ID"
Warehouse_A = WarehouseID
case "Name"
Warehouse_A = ADMINWarehouseName
end select
end if
End Function
'--------------------------仓库查找---------------------end
'--------------------------供应商查找---------------------begin
Function Supplier_A(SupplierID,DataID)
if SupplierID<>"" then
Set adminrs = Server.CreateObject("ADODB.Recordset")
sql="select SupplierID,SupplierName from MRP_Supplier where SupplierID="&SupplierID
adminrs.open sql,objConn,1,1
if not adminrs.Eof then
ADMINSupplierID = adminrs("SupplierID")
ADMINSupplierName = adminrs("SupplierName")
else
DataID="ID"
end if
adminrs.close()
select case DataID
case "ID"
Supplier_A = SupplierID
case "Name"
Supplier_A = ADMINSupplierName
end select
end if
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 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")
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
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 EntourageOANameA(EntourageID,DispatchOrdID,DataID)
if EntourageID<>"" And DispatchOrdID<>"" then
Set EntourageOArs = Server.CreateObject("ADODB.Recordset")
sql="select OA_User_ID,OA_User,OA_Name,OA_weixinAvatar,EntourageLead,EntourageState,EntourageDKP,EntourageDKPScale,EntourageOT_is,EntourageLong_is,EntourageBetimesHH,EntourageEnd_Time,EntourageState_Time,Stretcher_is,StretcherM=isnull((select b.StretcherMoney/COUNT(a.Stretcher_is) from DispatchOrd_Entourage as a,DispatchOrd as b where a.DispatchOrdIDDt=DispatchOrd_Entourage.DispatchOrdIDDt and b.DispatchOrdID=a.DispatchOrdIDDt and a.EntourageState<>4 and a.Stretcher_is=1 and b.StretcherMoney>0 GROUP BY b.StretcherMoney),0) from DispatchOrd_Entourage,OA_User where OA_User_ID=EntourageOAid and EntourageState<>4 and DispatchOrdIDDt="&DispatchOrdID&" and EntourageID="&EntourageID
EntourageOArs.open sql,objConn,1,1
if not EntourageOArs.Eof then
EntourageOAuserID = EntourageOArs("OA_User_ID")
EntourageOAuser = EntourageOArs("OA_User")
EntourageOAName = EntourageOArs("OA_Name")
EntourageOAAvatar = EntourageOArs("OA_weixinAvatar")
If EntourageOAAvatar="" Then EntourageOAAvatar="/resources/images/icon_avatar_default.png"
EntourageOALead = EntourageOArs("EntourageLead")
EntourageOAState= EntourageOArs("EntourageState")
EntourageOT_is = EntourageOArs("EntourageOT_is") '是否休息出车
EntourageLong_is= EntourageOArs("EntourageLong_is") '是否跟车
EntourageBetimesHH= EntourageOArs("EntourageBetimesHH")'提出出车N小时
EntourageDKP = EntourageOArs("EntourageDKP") '个人绩效
EntourageDKPScale = EntourageOArs("EntourageDKPScale")'分成比例
EntourageEnd_Time = EntourageOArs("EntourageEnd_Time")'报告提交时间
EntourageState_Time = EntourageOArs("EntourageState_Time")'调度时间
Stretcher_is = EntourageOArs("Stretcher_is")
StretcherM = Stretcher_is*EntourageOArs("StretcherM")
else
DataID="userID"
end if
EntourageOArs.close()
select case DataID
case "userID"
EntourageOANameA = EntourageOAuserID
case "UserName"
EntourageOANameA = EntourageOAName
If EntourageOAState="3" Then
EntourageOANameA = ""&EntourageOANameA&""
ElseIf EntourageOAState="2" Then
EntourageOANameA = ""&EntourageOANameA&""
End if
If EntourageOALead="1" Then EntourageOANameA = "
"&EntourageOANameA
case "UserNameList"
EntourageOANameA = EntourageOAName
If EntourageOT_is="1" Then
EntourageOT_is="/休"
Else
EntourageOT_is=""
End If
If EntourageLong_is="1" Then
EntourageLong_is="/跟"
Else
EntourageLong_is=""
End If
If EntourageBetimesHH>0 Then
EntourageBetimesHH="/提"&EntourageBetimesHH
Else
EntourageBetimesHH=""
End If
If EntourageOAState="3" Then
EntourageOANameA = ""&EntourageOANameA&EntourageOT_is&EntourageLong_is&EntourageBetimesHH&""
ElseIf EntourageOAState="2" Then
EntourageOANameA = ""&EntourageOANameA&EntourageOT_is&EntourageLong_is&EntourageBetimesHH&""
End if
If EntourageOALead="1" Then EntourageOANameA = EntourageOANameA&"
"
case "UserNameReport"
EntourageOANameA = EntourageOAName
If Len(EntourageOANameA)=2 Then EntourageOANameA=EntourageOANameA&" "
If EntourageOT_is="1" Then
EntourageOANameA = ""&EntourageOANameA&""
ElseIf EntourageBetimesHH>0 Then
EntourageOANameA = ""&EntourageOANameA&" 提前"&EntourageBetimesHH&"小时"
End If
If EntourageDKP>0 Then
If EntourageDKPScale=1 Then
EntourageOANameA = EntourageOANameA &" 驻点提成:"&EntourageDKP_Money_A(DispatchOrdPerfomance,EntourageOT_is,EntourageLong_is,EntourageBetimesHH,EntourageDKP,EntourageDKPScale,EntourageState_Time)&"元"
else
EntourageOANameA = EntourageOANameA &" 绩效:"&EntourageDKP&" 提成:"&EntourageDKP_Money_A(DispatchOrdPerfomance,EntourageOT_is,EntourageLong_is,EntourageBetimesHH,EntourageDKP,EntourageDKPScale,EntourageState_Time)+StretcherM&"元"
End if
Else
EntourageOANameA = EntourageOANameA &" 未填写完成报告单"
End If
case "Avatar"
EntourageOANameA = EntourageOAuser
end select
end if
End Function
'--------------------------调度单跟随人员---------------------end
'--------------------------调度单跟随人员权限---------------------begin
Function EntourageOAidA(DispatchOrdID)
EntourageOAidA=0
if DispatchOrdID<>"" then
Set EntourageOArs = Server.CreateObject("ADODB.Recordset")
sql="select EntourageLead,EntourageState from DispatchOrd_Entourage where EntourageState<>4 and DispatchOrdIDDt="&DispatchOrdID&" and EntourageOAid="&session("adminID")
EntourageOArs.open sql,objConn,1,1
if not EntourageOArs.Eof Then
EntourageOALead = EntourageOArs("EntourageLead")
EntourageOAState= EntourageOArs("EntourageState")
else
EntourageOALead="-1"
end if
EntourageOArs.close()
select case EntourageOALead
case "0" '参考者
EntourageOAidA = 1
case "1" '领队
EntourageOAidA = 2
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 AdminType_A(AdminType)
select case AdminType
case 1
AdminType_A=Ch("管理员")
case 2
AdminType_A=Ch("经销商")
case 3
AdminType_A=Ch("供应商")
end select
End Function
'--------------------------用户账号类型---------------------end
'--------------------------账号状态---------------------begin
Function AdminExecLevel_A(AdminExecLevel)
select case AdminExecLevel
case -1
AdminExecLevel_A="停用"
case 0
AdminExecLevel_A="只读"
case 1
AdminExecLevel_A="正常"
case 2
AdminExecLevel_A="管理员"
case 3
AdminExecLevel_A="系统"
end select
End Function
'--------------------------账号状态---------------------end
'--------------------------账号状态B---------------------begin
Function AdminExecLevel_B(AdminExecLevel,weixinStatus,Status)
select case AdminExecLevel
case -1
AdminExecLevel_B="停用"
case 0
AdminExecLevel_B="只读"
case 1
AdminExecLevel_B="正常"
case 2
AdminExecLevel_B="管理员"
case 3
AdminExecLevel_B="系统"
end Select
If Status="1" then
select case weixinStatus
case 1
AdminExecLevel_B=AdminExecLevel_B&"-已关注微信OA"
case 2
AdminExecLevel_B=AdminExecLevel_B&"-已禁用微信OA"
case 4
AdminExecLevel_B=AdminExecLevel_B&"-未关注微信OA"
end Select
ElseIf Status="2" Then
select case weixinStatus
case 1
AdminExecLevel_B="[已关注]"
case 2
AdminExecLevel_B="[已禁用]"
case 4
AdminExecLevel_B="[未关注]"
end Select
ElseIf weixinStatus=4 And (AdminExecLevel=1 Or AdminExecLevel=2) Then
AdminExecLevel_B="未关注"
End if
End Function
'--------------------------账号状态B---------------------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 Companies_B(B2bID,DataID)
Set Crs = Server.CreateObject("ADODB.Recordset")
if B2bID<=1999 then
CompaniesName_zh="管理员"
CompaniesName_en="ADMIN"
Companies_is=1
elseif B2bID<=2999 then
sql="select DealerID,DealerName_zh,DealerName_en,Dealer_is,Dealer_Language from B2B_Dealer where DealerID="&B2bID
Crs.open sql,objConn,1,1
if not Crs.eof then
CompaniesName_zh = Crs("DealerName_zh")
CompaniesName_en = Crs("DealerName_en")
Companies_Language = Crs("Dealer_Language")
Companies_is = Crs("Dealer_is")
end if
Crs.close()
elseif B2bID<=3999 then
sql="select SupplierID,SupplierName_zh,SupplierName_en,Supplier_is,Supplier_Language from B2B_Supplier where SupplierID="&B2bID
Crs.open sql,objConn,1,1
if not Crs.eof then
CompaniesName_zh = Crs("SupplierName_zh")
CompaniesName_en = Crs("SupplierName_en")
Companies_Language = Crs("Supplier_Language")
Companies_is = Crs("Supplier_is")
end if
Crs.close()
end if
select case DataID
case "CompaniesName"
if session("Admin_Language")="zh-CN"then
CompaniesName= CompaniesName_zh
elseif session("Admin_Language")="En"then
CompaniesName= CompaniesName_en
end if
Companies_B = CompaniesName
case "CompaniesNameAll"
if session("Admin_Language")="zh-CN"then
CompaniesName= CompaniesName_zh
if CompaniesName_en<>"" then CompaniesName = CompaniesName &" ("&CompaniesName_en&")"
elseif session("Admin_Language")="En"then
CompaniesName= CompaniesName_en
if CompaniesName_zh<>"" then CompaniesName = CompaniesName &" ("&CompaniesName_zh&")"
end if
Companies_B = CompaniesName
end select
if Companies_is=1 then Companies_B = Companies_B &" ["&Is_A(Companies_is)&"]"
End Function
'--------------------------公司名称---------------------end
'--------------------------公司服务类型---------------------begin
Function CompaniesType_A(ID,CompaniesType)
Set Crs = Server.CreateObject("ADODB.Recordset")
sql="select * from GBR.dbo.dictionary WHERE vtitle = '"&CompaniesType&"' and vID="&ID
Crs.open sql,objConn,1,1
if not Crs.eof then
vtext = Crs("vtext")
vtextEn= Crs("vtextEn")
end if
Crs.close()
if session("Admin_Language")="En" then
CompaniesType_A = vtextEn
else
CompaniesType_A = vtext
end if
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 DispatchOrdStateA(DispatchOrdState)
Set DispatchOrdStateRS = Server.CreateObject("ADODB.Recordset")
DispatchOrdState1=DispatchOrdState
If InStr(DispatchOrdState1,"_")>0 Then DispatchOrdState1=Left(DispatchOrdState1,InStr(DispatchOrdState1,"_")-1)
sql="select vtext,vOrder2 from dictionary where vtitle='DispatchOrdState' and vID="&DispatchOrdState1
DispatchOrdStateRS.open sql,objConn,1,1
if not DispatchOrdStateRS.Eof then
If DispatchOrdStateRS(1)<>"" Then
DispatchOrdStateA = DispatchOrdStateRS(1)
Else
DispatchOrdStateA = DispatchOrdStateRS(0)
End If
else
DispatchOrdStateA = "问题订单"
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
'缩略图生成
Function strPICTurn(PicID,strPIC,strPICs,scaleW,scaleH,S)
if Instr(strPICs,scaleW&"x"&scaleH)>=1 or Request.ServerVariables("SERVER_NAME")="192.168.0.250" then '已有合适图片
'if Instr(strPICs,scaleW&"x"&scaleH)=0 then '已有合适图片 or Request.ServerVariables("SERVER_NAME")="new.v.com.cn"
strPICTurn=replace(strPIC,".","_"&scaleW&"x"&scaleH&".")
else '产生缩略图
org_file = server.mappath(strPIC)
org_FileName = Right(org_file, Len(org_file)-InstrRev(org_file,"\")) '源文件名
org_FilePath = Left(org_file, InstrRev(org_file,"\")) '文件路径
new_FileName = replace(org_FileName,".","_"&scaleW&"x"&scaleH&".") '新文件名
new_file = org_FilePath & new_FileName '新文件路径+新文件名
org_webPath = replace(strPIC,org_fileName,"") '文件网页路径
CreatThumbPhoto org_FilePath,org_FileName,org_FilePath,new_FileName,scaleW,scaleH,S,PicID
objConn.Execute "update GBR.dbo.Picture set PicURLs='"&strPICs&","&scaleW&"x"&scaleH&"' where PicID="&PicID
strPICTurn = org_webPath & new_FileName
end if
End Function
sub CreatThumbPhoto(org_path,org_name,target_path,target_name,scaleW,scaleH,S,PicID)
set fso = Server.CreateObject("scripting.FileSystemObject")
if fso.FileExists(org_path&org_name) then
Response.Expires = 0
' create instance of AspJpeg
Set jpeg = Server.CreateObject("Persits.Jpeg")
' Open source file
jpeg.Open( org_path & org_name )
W = cint(scaleW)
H = cint(scaleH)
PicWidth=cint(jpeg.OriginalWidth)
PicHeight=cint(jpeg.OriginalHeight)
SaveWidth=0
SaveHeight=0
if cint(jpeg.OriginalWidth) > W or cint(jpeg.OriginalHeight) > H then
if S="W" then
SaveWidth=W
SaveHeight=jpeg.OriginalHeight * W / jpeg.OriginalWidth
elseif S="H" then
SaveWidth=H
SaveHeight=jpeg.OriginalWidth * H / jpeg.OriginalHeight
else
If jpeg.OriginalWidth > jpeg.OriginalHeight Then
SaveWidth=jpeg.OriginalWidth * W / jpeg.OriginalHeight
SaveHeight=W
Else
SaveWidth=H
SaveHeight=jpeg.OriginalHeight * H / jpeg.OriginalWidth
End If
end if
jpeg.Width = SaveWidth
jpeg.Height = SaveHeight
if SaveWidth<>W or SaveHeight<>H then
x = 0
y = 0
if SaveWidth>SaveHeight then
x = (SaveWidth-W)/2
else
y = (SaveHeight-H)/2
end if
jpeg.crop x,y,W+x,H+y '开始切割其实是把超过52象素的下部分去掉
end if
'jpeg.Sharpen 1, 130
'jpeg.Quality = 100 ' 默认值为80,最佳为100
jpeg.Sharpen 1, 101 ' 设定锐化效果第一个阐述为半径(1或2),第二个为数量(百分比,大于100)
'jpeg.Interpolation 2 ' 设定锐化效果 2最慢,默认值为1,最快为0
else
jpeg.Height = jpeg.OriginalHeight
jpeg.Width = jpeg.OriginalWidth
end if
objConn.Execute "update GBR.dbo.Picture set PicWidth="&PicWidth&",PicHeight="&PicHeight&" where PicID="&PicID
Jpeg.Save target_path & target_name
end if
end Sub
'--------------------------商品价格类型---------------------begin
Function Shop_StrItm_Money(TM_slevel)
Set StrItm_Moneyrs = Server.CreateObject("ADODB.Recordset")
sql="select vtext from TVDV.dbo.dictionary where vtitle='商品价格分类' and vID="&TM_slevel
StrItm_Moneyrs.open sql,objConn,1,1
if not StrItm_Moneyrs.Eof then
Shop_StrItm_Money = StrItm_Moneyrs(0)
else
Shop_StrItm_Money = "热卖价"
end if
StrItm_Moneyrs.close()
End Function
'--------------------------商品价格类型---------------------end
'--------------------------会员类型---------------------begin
Function Shop_user_slevel(TM_slevel,UserSlevel)
Set StrItm_slevelrs = Server.CreateObject("ADODB.Recordset")
if TM_slevel=0 then
sql="select vtext from TVDV.dbo.dictionary where vtitle='TV_UserSlevel' and vID="&UserSlevel
else
sql="select vtext from TVDV.dbo.dictionary where vtitle='商品价格分类' and vID="&TM_slevel
end if
StrItm_slevelrs.open sql,objConn,1,1
if not StrItm_slevelrs.Eof then
Shop_user_slevel = StrItm_slevelrs(0)
else
Shop_user_slevel = "问题会员"
end if
StrItm_slevelrs.close()
End Function
'--------------------------会员类型---------------------end
'--------------------------会员类型---------------------begin
Function CAction_A(CAction)
select case CAction
case 0
CAction_A="(去电)"
case 1
CAction_A="(来电)"
end select
End Function
'--------------------------会员类型---------------------end
'--------------------------提交记录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
'--------------------------支付记录(API专用)---------------------begin
Function PaidMoneyA(ServiceOrdID,DispatchOrdID,PaidMoney,PaidMoneyType,PaidMoneyTimestamp,PaidMoneyMono,PaidMoneyCheck)
If DispatchOrdID="" Then DispatchOrdID=0
If PaidMoneyCheck="" Then PaidMoneyCheck=0
If Len(ServiceOrdID)=12 And Not IsNumeric(Left(ServiceOrdID,2)) And IsNumeric(Right(ServiceOrdID,10)) Then ServiceOrdID=Right(ServiceOrdID,10)
If Len(DispatchOrdID)=12 And Not IsNumeric(Left(DispatchOrdID,2)) And IsNumeric(Right(DispatchOrdID,10)) Then DispatchOrdID=Right(DispatchOrdID,10)
Set PaidMoneyRS = Server.CreateObject("ADODB.Recordset")
NC_OAID=""
If DispatchOrdID<>"0" And 1=2 then
'调度员ID
sql="select DispatchOrd_NS_ID,DispatchOrdClass,DispatchOrd_NS_Time,DispatchOrdNo from DispatchOrd where DispatchOrdID="&DispatchOrdID
PaidMoneyRS.open sql,objConn,1,1
If not PaidMoneyRS.Eof Then
NC_OAID=PaidMoneyRS(0)
DispatchOrdNo=PaidMoneyRS("DispatchOrdClass")& year(PaidMoneyRS("DispatchOrd_NS_Time"))&Right("0"&month(PaidMoneyRS("DispatchOrd_NS_Time")),2)&Right("0"&day(PaidMoneyRS("DispatchOrd_NS_Time")),2) & "-"&Right("00"&PaidMoneyRS("DispatchOrdNo"),3) '调度单编号
end if
PaidMoneyRS.close()
'领队ID
sql="select EntourageOAid from DispatchOrd_Entourage where EntourageLead=1 and EntourageState=3 and DispatchOrdIDDt="&DispatchOrdID
PaidMoneyRS.open sql,objConn,1,1
If not PaidMoneyRS.Eof Then
If PaidMoneyRS(0)<>NC_OAID then NC_OAID=NC_OAID&","&PaidMoneyRS(0)
end if
PaidMoneyRS.close()
Else
'客服ID
sql="select ServiceOrd_CC_ID,ServiceOrdClass,ServiceOrd_CC_Time,ServiceOrdNo from ServiceOrder where ServiceOrdID="&ServiceOrdID
PaidMoneyRS.open sql,objConn,1,1
If not PaidMoneyRS.Eof Then
NC_OAID=PaidMoneyRS(0)
ServiceOrdNo=PaidMoneyRS("ServiceOrdClass")& year(PaidMoneyRS("ServiceOrd_CC_Time"))&Right("0"&month(PaidMoneyRS("ServiceOrd_CC_Time")),2)&Right("0"&day(PaidMoneyRS("ServiceOrd_CC_Time")),2) & "-"&Right("00"&PaidMoneyRS("ServiceOrdNo"),3) '服务单单编号
end if
PaidMoneyRS.close()
End If
If NC_OAID="" Or NC_OAID="0" Then NC_OAID="78"
sql="select id from PaidMoney where PaidMoneyOaID="&UnitID&" and PaidMoneyTimestamp='"&PaidMoneyTimestamp&"'"
PaidMoneyRS.open sql,objConn,1,1
if PaidMoneyRS.Eof then
If PaidMoneyCheck=1 Then
sql="insert into PaidMoney (PaidMoneyClass,ServiceOrdIDDt,DispatchOrdIDDt,PaidMoney,PaidMoneyType,PaidMoneyOaID,PaidMoneyTimestamp,PaidMoneyMono,PaidMoney_AP_Check,PaidMoney_AP_Time,PaidMoney_AP_ID) values ('FI',"&ServiceOrdID&","&DispatchOrdID&","&PaidMoney&","&PaidMoneyType&","&UnitID&",'"&PaidMoneyTimestamp&"','"&PaidMoneyMono&"',1,getdate(),"&UnitID&")"
else
sql="insert into PaidMoney (PaidMoneyClass,ServiceOrdIDDt,DispatchOrdIDDt,PaidMoney,PaidMoneyType,PaidMoneyOaID,PaidMoneyTimestamp,PaidMoneyMono) values ('FI',"&ServiceOrdID&","&DispatchOrdID&","&PaidMoney&","&PaidMoneyType&","&UnitID&",'"&PaidMoneyTimestamp&"','"&PaidMoneyMono&"')"
End if
objConn.Execute sql
If ServiceOrdID<>"" And InStr(PaidMoneyMono,"打赏")>0 Then
sql="update ServiceOrder set Guest_Reward=Guest_Reward+"&PaidMoney&" where ServiceOrdID="&ServiceOrdID
objConn.Execute sql
ElseIf ServiceOrdID<>"" Then
sql="update ServiceOrder set ServiceOrdTraPaidPrice=ServiceOrdTraPaidPrice+"&PaidMoney&" where ServiceOrdID="&ServiceOrdID
objConn.Execute sql
End If
'NC_OAID="78"
'If NC_OAID<>"" Then
' If DispatchOrdNo<>"" then
' NC_Name="【"&UnitUser(UnitID,"UnitName")&"成功支付】"
' NC_Content="调度单:"&DispatchOrdNo&"客户已通过["&PaidMoneyType&"]成功支付"&PaidMoney&"元 "&PaidMoneyMono
' NC_PageUrl="/DispatchOrder.gds?DispatchOrdID="&DispatchOrdID
' NC_PageUrlM="/m_DispatchOrder.gds?DispatchOrdID="&DispatchOrdID
' Else
' NC_Name="【"&UnitUser(UnitID,"UnitName")&"成功支付】"
' NC_Content="服务单:"&ServiceOrdNo&"客户已通过["&PaidMoneyType&"]成功支付"&PaidMoney&"元 "&PaidMoneyMono
' NC_PageUrl="/ServiceOrder.gds?ServiceOrdID="&ServiceOrdID
' NC_PageUrlM=""
' End If
' Call Notification_Add(NC_OAID,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM)
'End If
end if
PaidMoneyRS.close()
End Function
'--------------------------支付记录---------------------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 EntourageDKP_A(DispatchOrdID,DispatchOrdPerfomance)
Set EntourageDKPRS = Server.CreateObject("ADODB.Recordset")
EntourageDoctors=0 '医生人数
EntourageNurse=0 '护士人数
EntourageDriver=0 '司机人数
EntourageSum=0 '总随行人数
sql="select vtext,COUNT(EntourageID) from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" GROUP BY vtext"
EntourageDKPRS.open sql,objConn,1,1
do while not EntourageDKPRS.Eof
select case EntourageDKPRS("vtext")
case "医生"
EntourageDoctors=EntourageDKPRS(1)
case "护士"
EntourageNurse=EntourageDKPRS(1)
case "司机"
EntourageDriver=EntourageDKPRS(1)
end Select
EntourageSum=EntourageSum+EntourageDKPRS(1)
EntourageDKPRS.movenext
loop
EntourageDKPRS.close()
If EntourageSum>0 Then
'提成算法
DKPScale_Doctors=0.16+0.05 '医生正常绩效(16%)+超时补贴(5%)
DKPScale_Nurse=0.11+0.04 '护士正常绩效(16%)+超时补贴(5%)
DKPScale_Driver=0.09+0.03 '司机正常绩效(9%)+超时补贴(3%)
'跟车绩效算法
EntourageLongDKP_Doctors=DispatchOrdPerfomance*(1/EntourageSum) '跟车医生绩效比例
EntourageLongDKP_Nurse=DispatchOrdPerfomance*(1/EntourageSum) '跟车护士绩效比例
EntourageLongDKP_Driver=DispatchOrdPerfomance*(1/EntourageSum) '跟车司机绩效比例
If DispatchOrdPerfomance=50 Then '驻点绩效 不出车情况下,绩效为0,补贴50元
sql="update DispatchOrd_Entourage set EntourageDKP=50,EntourageDKPScale=1 from DispatchOrd_Entourage as b where EntourageState<>4 and DispatchOrdIDDt="&DispatchOrdID&" and EntourageOAid not in (select a.EntourageOAid from DispatchOrd_Entourage as a,DispatchOrd,ServiceOrder where a.DispatchOrdIDDt=DispatchOrdID and DispatchOrdID<>b.DispatchOrdIDDt and ServiceOrdID=ServiceOrdIDDt and a.EntourageState<>4 and (ServiceOrdApptDate between b.EntourageEnd_Time and dateadd(d,1,b.EntourageEnd_Time) or DispatchOrdTraSDTime between b.EntourageEnd_Time and dateadd(d,1,b.EntourageEnd_Time) or DispatchOrdActualDate between b.EntourageEnd_Time and dateadd(d,1,b.EntourageEnd_Time)))"
objConn.Execute sql
ElseIf EntourageDoctors=1 And EntourageNurse=0 And EntourageDriver=1 Then '特殊情况① 1个医生,1个司机(分摊收入占比60%:40%)
EntourageLongDKP_Doctors=DispatchOrdPerfomance*0.6
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.6&",EntourageDKPScale="&DKPScale_Doctors&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='医生'"
objConn.Execute sql
EntourageLongDKP_Driver=DispatchOrdPerfomance*0.4
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.4&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
ElseIf EntourageDoctors=0 And EntourageNurse=1 And EntourageDriver=1 Then '特殊情况② 1个护士,1个司机(分摊收入占比60%:40%)
DKPScale_Nurse=0.16+0.05
EntourageLongDKP_Nurse=DispatchOrdPerfomance*0.6
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.6&",EntourageDKPScale="&DKPScale_Nurse&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='护士'"
objConn.Execute sql
DKPScale_Driver=0.11+0.04
EntourageLongDKP_Driver=DispatchOrdPerfomance*0.4
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.4&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
ElseIf EntourageDoctors=1 And EntourageNurse=0 And EntourageDriver=2 Then '特殊情况③ 1个医生,2个司机(分摊收入占比40%:30%:30%)
EntourageLongDKP_Doctors=DispatchOrdPerfomance*0.4
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.4&",EntourageDKPScale="&DKPScale_Doctors&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='医生'"
objConn.Execute sql
EntourageLongDKP_Driver=DispatchOrdPerfomance*0.3
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.3&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
ElseIf EntourageDoctors=0 And EntourageNurse=1 And EntourageDriver=2 Then '特殊情况④ 1个护士,2个司机(分摊收入占比40%:30%:30%)
EntourageLongDKP_Nurse=DispatchOrdPerfomance*0.4
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.4&",EntourageDKPScale="&DKPScale_Nurse&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='护士'"
objConn.Execute sql
EntourageLongDKP_Driver=DispatchOrdPerfomance*0.3
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*0.3&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
ElseIf EntourageDoctors=0 And EntourageNurse=0 And (EntourageDriver=2 Or EntourageDriver=1) Then '特殊情况5 1或2个司机(分摊收入占比50%:50% 司机绩效15%)
DKPScale_Driver=0.11+0.04
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*(1/EntourageSum)&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
Else '一般情况
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*(1/EntourageSum)&",EntourageDKPScale="&DKPScale_Doctors&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='医生'"
objConn.Execute sql
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*(1/EntourageSum)&",EntourageDKPScale="&DKPScale_Nurse&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='护士'"
objConn.Execute sql
sql="update DispatchOrd_Entourage set EntourageDKP="&DispatchOrdPerfomance*(1/EntourageSum)&",EntourageDKPScale="&DKPScale_Driver&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=0 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
End If
'跟车
sql="update DispatchOrd_Entourage set EntourageDKP="&EntourageLongDKP_Doctors&",EntourageDKPScale="&DKPScale_Doctors/2&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=1 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='医生'"
objConn.Execute sql
sql="update DispatchOrd_Entourage set EntourageDKP="&EntourageLongDKP_Nurse&",EntourageDKPScale="&DKPScale_Nurse/2&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=1 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='护士'"
objConn.Execute sql
sql="update DispatchOrd_Entourage set EntourageDKP="&EntourageLongDKP_Driver&",EntourageDKPScale="&DKPScale_Driver/2&" from DispatchOrd_Entourage,dictionary where vtitle='DispatchOrdEntourage' and vID=EntourageID and EntourageState<>4 and EntourageLong_is=1 and DispatchOrdIDDt="&DispatchOrdID&" and (DKPEdit_Reason is null or DKPEdit_Reason='') and vtext='司机'"
objConn.Execute sql
End If
End Function
'--------------------------调度单绩效算法---------------------end
'--------------------------个人绩效提成算法---------------------begin
Function EntourageDKP_Money_A(DispatchOrdPerfomance,EntourageOT_is,EntourageLong_is,EntourageBetimesHH,EntourageDKP,EntourageDKPScale,EntourageState_Time)
EntourageDKP_Money=0
If EntourageOT_is=1 Then '加班绩效提成计算方式
If DispatchOrdPerfomance<=1000 Then
If EntourageName="医生" Then
EntourageDKP_Money=100
ElseIf EntourageName="护士" Then
EntourageDKP_Money=80
Else
EntourageDKP_Money=70
End If
ElseIf DispatchOrdPerfomance>1000 And DispatchOrdPerfomance<=2000 Then
If EntourageName="医生" Then
EntourageDKP_Money=200
ElseIf EntourageName="护士" Then
EntourageDKP_Money=160
Else
EntourageDKP_Money=140
End If
ElseIf DispatchOrdPerfomance>2000 And DispatchOrdPerfomance<=3000 then
If EntourageName="医生" Then
EntourageDKP_Money=300
ElseIf EntourageName="护士" Then
EntourageDKP_Money=240
Else
EntourageDKP_Money=210
End If
Else
If EntourageName="医生" Then
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.1,1)
ElseIf EntourageName="护士" Then
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.08,1)
Else
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.07,1)
End If
End If
If (EntourageDKP*EntourageDKPScale)>EntourageDKP_Money Then EntourageDKP_Money=FormatNumber(EntourageDKP*EntourageDKPScale,1)
Else '正常上班时间
If CInt(EntourageBetimesHH)>0 Then
If CInt(EntourageBetimesHH)>2 And DateDiff("d",EntourageState_Time,"2016-12-5")<=0 Then EntourageBetimesHH=2
EntourageDKP_Money=EntourageBetimesHH*30
End If
EntourageDKP_Money=EntourageDKP_Money+FormatNumber(EntourageDKP*EntourageDKPScale,1)
End If
EntourageDKP_Money_A=EntourageDKP_Money
End Function
'--------------------------个人绩效提成算法---------------------end
'--------------------------个人绩效提成算法2---------------------begin
Function EntourageDKP_Money_B(DispatchOrdPerfomance,EntourageOT_is,EntourageLong_is,EntourageBetimesHH,EntourageDKP,EntourageDKPScale,EntourageState_Time,StretcherM)
EntourageDKP_Money=0
If EntourageOT_is=1 Then '加班绩效提成计算方式
If DispatchOrdPerfomance<=1000 Then
If EntourageName="医生" Then
EntourageDKP_Money=100
ElseIf EntourageName="护士" Then
EntourageDKP_Money=80
Else
EntourageDKP_Money=70
End If
ElseIf DispatchOrdPerfomance>1000 And DispatchOrdPerfomance<=2000 Then
If EntourageName="医生" Then
EntourageDKP_Money=200
ElseIf EntourageName="护士" Then
EntourageDKP_Money=160
Else
EntourageDKP_Money=140
End If
ElseIf DispatchOrdPerfomance>2000 And DispatchOrdPerfomance<=3000 then
If EntourageName="医生" Then
EntourageDKP_Money=300
ElseIf EntourageName="护士" Then
EntourageDKP_Money=240
Else
EntourageDKP_Money=210
End If
Else
If EntourageName="医生" Then
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.1,1)
ElseIf EntourageName="护士" Then
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.08,1)
Else
EntourageDKP_Money=FormatNumber(DispatchOrdPerfomance*0.07,1)
End If
End If
Else '正常上班时间
If CInt(EntourageBetimesHH)>0 Then
If CInt(EntourageBetimesHH)>2 And DateDiff("d",EntourageState_Time,"2016-12-5")<=0 Then EntourageBetimesHH=2
EntourageDKP_Money=EntourageBetimesHH*30
End If
EntourageDKP_Money=EntourageDKP_Money+FormatNumber(EntourageDKP*EntourageDKPScale,1)
End If
EntourageDKP_Money_B=EntourageDKP_Money+StretcherM
End Function
'--------------------------个人绩效提成算法2---------------------end
'--------------------------条形报表日期算法---------------------begin
Function labelsArr_A(DateA,DateB)
labelsArr=""
DateC=DateA
DateDay = DateDiff("d",DateA,DateB)+1
'日
If DateDay=1 Then
labelsArr="'0时','','','','','','6','','','','','12','','','','','','18','','','','','','23'"
'周
ElseIf DateDay=7 Then
labelsArr="'"&Month(DateC)&"."&Day(DateC)&"'"
do while DateCMonth(DateC) Then
labelsArr=labelsArr&",'"&Month(DateD)&"."&Day(DateD)&"'"
Else
labelsArr=labelsArr&",'"&Day(DateD)&"'"
End If
DateC=DateD
Loop
labelsArr=labelsArr&",'"&Month(DateB)&"."&Day(DateB)&"'"
'月
ElseIf DateDay=30 Or DateDay=31 Or DateDay=28 Or DateDay=29 Then
labelsArr="'"&Month(DateC)&"."&Day(DateC)&"'"
do while DateCMonth(DateC) Then
labelsArr=labelsArr&",'"&Month(DateD)&"."&Day(DateD)&"'"
ElseIf Day(DateD)=5 Or Day(DateD)=10 Or Day(DateD)=15 Or Day(DateD)=20 Or Day(DateD)=25 then
labelsArr=labelsArr&",'"&Day(DateD)&"'"
Else
labelsArr=labelsArr&",''"
End If
DateC=DateD
Loop
labelsArr=labelsArr&",'"&Month(DateB)&"."&Day(DateB)&"'"
'年
ElseIf DateDay=366 Or DateDay=365 Then
labelsArr="'"&Month(DateC)&"月'"
i=1
do while DateCMonth(DateC) And (i=5 Or i=11) Then
labelsArr=labelsArr&",'"&Month(DateD)&"月'"
ElseIf Month(DateD)<>Month(DateC) Then
labelsArr=labelsArr&",'"&Month(DateD)&"'"
Else
labelsArr=labelsArr&",''"
End If
DateC=DateD
i=i+1
Loop
'labelsArr=labelsArr&",'"&Month(DateB)&"."&Day(DateB)&"'"
End If
labelsArr_A=labelsArr
End Function
'--------------------------条形报表日期算法---------------------end
'中文转拼音首字
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
'--------------------------名传无线-短信发送---------------------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&"',0,'"&errMsg&"','"&Send_Remarks&"')"
objConn.Execute sql
Next
End Function
'--------------------------名传无线-短信发送---------------------end
'--------------------------转运快线-订单状态发送---------------------begin
Function Get_TritonshAPI(UserUUID,orderStatus,ServiceOrdID,iuid,CoName,CoPhone,orderPrice,orderSource)
'url="https://api.966120.com.cn/v1/cuituAPI.php"
'Origin="OrdID="&ServiceOrdID&"&method="&method&"&iuid="&iuid&"&uuid="&uuid
'HTMLCODE= GetBody(url,Origin)
appUrl="https://market.tritonsh.com/order/orderDeal"
args1="{"
'args1=args1&"""id"": """&uuid&"""," '对方订单ID
args1=args1&"""userId"": """&iuid&"""," '对方用户ID(介绍人ID)
args1=args1&"""orderStatus"": """&orderStatus&"""," '订单状态 0:初始订单 , 1:最终订单状态
args1=args1&"""orderType"":0," '下单类型 0:本人下单,1:代人下单
If orderSource="1" Then
args1=args1&"""orderSource"":""代客下单"","
ElseIf orderSource="2" Then
args1=args1&"""orderSource"":""面对面二维码"","
ElseIf orderSource="3" Then
args1=args1&"""orderSource"":""推广海报"","
End If
args1=args1&"""orderUserPhone"": """&CoPhone&"""," '客户手机号
args1=args1&"""userName"": """&CoName&"""," '客户姓名
args1=args1&"""orderPrice"": """&orderPrice&"""," '订单金额
args1=args1&"""orderServiceNo"": """&ServiceOrdID&"""" '订单服务单号
args1=args1&"}"
'call PostBody(appUrl,args1)
'Response.Write args1&"
"
HTMLCODE= PostBody1(appUrl,args1)
sql="update ServiceOrder set ToUserUUID="&UserUUID&" where ServiceOrdID="&ServiceOrdID
objConn.Execute sql
sql="update UserUUID set ToServiceOrdID="&ServiceOrdID&",TritonshJson='"&HTMLCODE&"',TritonshTime=getdate() where id="&UserUUID
objConn.Execute sql
'Response.Write HTMLCODE&"
"
'Response.end
'HTMLCODE= GetBody(url,Origin)
End Function
'--------------------------转运快线-订单状态发送---------------------end
'Post2方法
Function PostBody1(appUrl,args1)
Set https = Server.CreateObject("Msxml2.ServerXMLHTTP")
'Set https = Server.CreateObject("MSXML2.XMLHTTP")
With https
.Open "Post", appUrl, False
.setRequestHeader "Content-Type","application/json"
.Send args1
PostBody1 = .ResponseBody
End With
PostBody1 = BytesToBstr(PostBody1,"utf-8")
Set https = Nothing
End Function
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
'--------------------------时间戳校验---------------------begin
Function MD5_UnixTime(UnixTime)
sysUnix=ToUnixTime(now(), +8)
If IsNumeric(UnixTime) Then
If sysUnix-UnixTime>600 Or sysUnix-UnixTime<-600 Then
errcode=40008
errmsg="invalid UnixTime"
End If
Else
errcode=40007
errmsg="empty UnixTime"
'errmsg=Request.TotalBytes
End If
If Left(errcode,1)="4" Then
If is_test="1" Then errmsg=errmsg&" SystemUnixTime:"&sysUnix
webJson="{""APPID"":"""&APPID&""",""method"":"""&method&""",""result"":2,""errcode"":"&errcode&",""errmsg"":"""&errmsg&"""}"
Call OA_Running(UnitID,webJson)
Response.Write webJson
Response.end
End If
End Function
'--------------------------时间戳校验---------------------end
'--------------------------微信OA信息下发接口---------------------begin
Function WeiXin_MessageSend(access_token,touser,agentid,articles)
appUrl="https://qyapi.weixin.qq.com/cgi-bin/message/send?access_token="&access_token
If touser<>"" Then
If Mid(touser,1,1)="|" Then touser=Mid(touser,2)
'agentid=21
args1="{"
args1=args1&"""touser"": """&touser&"""," '成员ID列表(消息接收者,多个接收者用‘|’分隔,最多支持1000个)。特殊情况:指定为@all,则向关注该企业应用的全部成员发送 |liaojunliang
args1=args1&"""msgtype"": ""textcard"","
args1=args1&"""agentid"": "&agentid&"," '企业应用的id,整型。可在应用的设置页面查看
args1=args1&"""textcard"":"&articles
args1=args1&"}"
'call PostBody(appUrl,args1)
'Response.Write args1&"
"
HTMLCODE= PostBody(appUrl,args1)
If Mid(HTMLCODE,12,1)<>"0" Then
Call OA_Running(0,"weixin_message_send|"&agentid&"|"&touser&"|"&HTMLCODE)
'Response.Write HTMLCODE
End If
'Response.Write HTMLCODE
'Response.end
End If
End Function
'--------------------------微信OA信息下发接口---------------------end
'--------------------------微信OA信息下发接口---------------------begin
Function WeiXin_MessageSend1(access_token,touser,agentid,articles)
appUrl="https://qyapi.weixin.qq.com/cgi-bin/message/send?access_token="&access_token
If touser<>"" Then
If Mid(touser,1,1)="|" Then touser=Mid(touser,2)
'agentid=21
args1="{"
args1=args1&"""touser"": """&touser&"""," '成员ID列表(消息接收者,多个接收者用‘|’分隔,最多支持1000个)。特殊情况:指定为@all,则向关注该企业应用的全部成员发送 |liaojunliang
args1=args1&"""msgtype"": ""textcard"","
args1=args1&"""agentid"": "&agentid&"," '企业应用的id,整型。可在应用的设置页面查看
args1=args1&"""textcard"":"&articles
args1=args1&"}"
'call PostBody(appUrl,args1)
Response.Write args1&"
"
HTMLCODE= PostBody(appUrl,args1)
Response.Write HTMLCODE
Response.end
End If
End Function
'--------------------------微信OA信息下发接口---------------------end
'--------------------------微信OA信息下发接口21---------------------begin
Function WeiXin_MessageSend21(access_token,touser,agentid,articles)
access_token=GetAccess_token21()
appUrl="https://qyapi.weixin.qq.com/cgi-bin/message/send?access_token="&access_token
If touser<>"" Then
If InStr(touser,"|")=1 Then touser=Mid(touser,2)
'agentid=21
args1="{"
args1=args1&"""touser"": """&touser&"""," '成员ID列表(消息接收者,多个接收者用‘|’分隔,最多支持1000个)。特殊情况:指定为@all,则向关注该企业应用的全部成员发送 |liaojunliang
args1=args1&"""toparty"": """&toparty&"""," '部门ID列表,多个接收者用‘|’分隔,最多支持100个。当touser为@all时忽略本参数
args1=args1&"""totag"": """&totag&"""," '标签ID列表,多个接收者用‘|’分隔。当touser为@all时忽略本参数
args1=args1&"""agentid"": "&agentid&"," '企业应用的id,整型。可在应用的设置页面查看
args1=args1&"""msgtype"": ""news"","
args1=args1&"""news"": {"
args1=args1&"""articles"":["&articles&"]"
args1=args1&"}"
args1=args1&"}"
call PostBody1(appUrl,args1)
'Response.Write args1&"
"
'HTMLCODE= PostBody1(appUrl,args1)
'Response.Write HTMLCODE
'Response.end
End If
End Function
Function WeiXin_MessageSend21_1(access_token,touser,touserPhone,agentid,articles)
access_token=GetAccess_token21()
appUrl="https://qyapi.weixin.qq.com/cgi-bin/message/send?access_token="&access_token
If touser<>"" Then
If InStr(touser,"|")=1 Then touser=Mid(touser,2)
'agentid=21
args1="{"
args1=args1&"""touser"": """&touser&"""," '成员ID列表(消息接收者,多个接收者用‘|’分隔,最多支持1000个)。特殊情况:指定为@all,则向关注该企业应用的全部成员发送 |liaojunliang
args1=args1&"""toparty"": """&toparty&"""," '部门ID列表,多个接收者用‘|’分隔,最多支持100个。当touser为@all时忽略本参数
args1=args1&"""totag"": """&totag&"""," '标签ID列表,多个接收者用‘|’分隔。当touser为@all时忽略本参数
args1=args1&"""agentid"": "&agentid&"," '企业应用的id,整型。可在应用的设置页面查看
args1=args1&"""msgtype"": ""news"","
args1=args1&"""news"": {"
args1=args1&"""articles"":["&articles&"]"
args1=args1&"}"
args1=args1&"}"
call PostBody1(appUrl,args1)
'Response.Write args1&"
"
'HTMLCODE= PostBody1(appUrl,args1)
'Response.Write HTMLCODE
'Response.end
End If
If touserPhone<>"" Then
If InStr(touserPhone,"|")>0 Then touserPhone=Replace(touserPhone,"|",""",""")
appUrl="https://qyapi.weixin.qq.com/cgi-bin/pstncc/call?access_token="&access_token
args1="{"
args1=args1&"""callee_userid"":["""&touserPhone&"""]"
args1=args1&"}"
call PostBody1(appUrl,args1)
End If
End Function
'获取微信access_token21
Function GetAccess_token21()
'接口信息
corpid="wx248505bfbab6d0c1"
corpsecret="zXfzkk8wBJIZjrxq7BwZ1ckG2505cpNuSlJH1m8i-6Y"
access_tokenID=45 '对应数据库ID
Set rs = Server.CreateObject("ADODB.Recordset")
sql="select vtext,vMono from dictionary where id="&access_tokenID
rs.open sql,objConn,1,1
access_token=rs("vtext")
access_token_time=cdate(rs("vMono"))
rs.close()
If DateDiff("s",access_token_time,now())>0 then
'获取新的access_token
url="https://qyapi.weixin.qq.com/cgi-bin/gettoken" '//定义要获取源代码的网址,一般是通过变量传递过来
Origin="corpid="&corpid&"&corpsecret="&corpsecret
HTMLCODE= GetBody(url,Origin)
str="["&HTMLCODE&"]"
set obj = getjson(str)
access_token = obj.get(0).access_token
expires_in = obj.get(0).expires_in
'access_token=replace(replace(HTMLCODE,"{""access_token"":""",""),""",""expires_in"":7200}","")
access_token_time=DateAdd("s",500,now())
'写入数据库
sql="update dictionary set vtext='"&access_token&"',vMono='"&access_token_time&"' where id="&access_tokenID
objConn.Execute sql
End if
GetAccess_token21 = access_token
End Function
'--------------------------微信OA信息下发接口---------------------end
'--------------------------企业用户查找---------------------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 Notification_Add_old(NC_OAID,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM)
If NC_Name="" Then NC_Name=now()
If NC_OAID<>"" Then
NC_OAIDSP=SPLIT(NC_OAID,",")
for n = 0 to UBOUND(NC_OAIDSP)
sql="insert into Notification (NC_OAID,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM) values ("&NC_OAIDSP(n)&",'"&NC_Name&"','"&NC_Content&"','"&NC_PageUrl&"','"&NC_PageUrlM&"')"
objConn.Execute sql
next
End If
End Function
'--------------------------写入通知中心_旧---------------------end
'--------------------------写入通知中心_2019.8.20---------------------begin
Function Notification_Add(NC_OAID,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM)
If NC_Name="" Then NC_Name=now()
NC_Content=Replace(NC_Content,"单号","单")
NC_Content=Replace(NC_Content,":",":")
If NC_OAID="78" Or NC_OAID="" Then NC_OAID="0"
If InStr(NC_Name,"派单时间提醒")>0 Then
NC_Time=NC_PageUrlM
NC_PageUrlM=""
Else
NC_Time=now()
End If
If NC_OAID<>"0" Then '点对点发送通知
NC_OAIDSP=SPLIT(NC_OAID,",")
for n = 0 to UBOUND(NC_OAIDSP)
sql="insert into Notification (NC_OAID,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM,NC_Time) values ("&NC_OAIDSP(n)&",'"&NC_Name&"','"&NC_Content&"','"&NC_PageUrl&"','"&NC_PageUrlM&"','"&NC_Time&"')"
objConn.Execute sql
next
Else
If InStr(NC_Content,":")>0 Then
NC_OAClass=Mid(NC_Content,InStr(NC_Content,":")+1,2)
sql="insert into Notification (NC_OAID,NC_OAClass,NC_Name,NC_Content,NC_PageUrl,NC_PageUrlM,NC_Time) values (0,'"&NC_OAClass&"','"&NC_Name&"','"&NC_Content&"','"&NC_PageUrl&"','"&NC_PageUrlM&"','"&NC_Time&"')"
objConn.Execute sql
End If
End If
End Function
'--------------------------写入通知中心_2019.8.20---------------------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 SignArgs(args1)
sParaSort=""
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 stringA & "
"
'SignArgs=stringA
SignArgs=Md5Sign(sParaSort,key,input_charset)
End Function
'--------------------------字符串签名---------------------end
'--------------------------用户ID注册&查询---------------------begin
Function User_Login(UserID,UserPhone,wxOriginalID,wxOpenid,wxUnionID,UserSource,UserName)
If key="" Then key="966120API"
url="https://api.966120.com.cn/v3/User/"
If UserID="" Then UserID=0
If UserPhone<>"" Then
LoginType=1
ElseIf wxOpenid<>"" Then
LoginType=3
ElseIf UserID<>"0" Then
LoginType=0
Else
LoginType=-1
End If
If UserName="先生" Or UserName="小姐" Or UserName="test" Or UserName="测试" Or UserName="无" Or UserName="AA" Or Len(UserName)=11 Then
UserName=""
End If
If LoginType>=0 Then
Origin="method=User_Login"
If APPID<>"" Then
Origin=Origin&"&APPID="&APPID
Else
Origin=Origin&"&APPID=GDS-0001-fDwr"
End If
Origin=Origin&"&LoginType="&LoginType
Origin=Origin&"&UserID="&UserID
Origin=Origin&"&UserPhone="&UserPhone
Origin=Origin&"&wxOpenid="&wxOpenid
Origin=Origin&"&wxOriginalID="&wxOriginalID
Origin=Origin&"&wxUnionID="&wxUnionID
Origin=Origin&"&UserName="&UserName
Origin=Origin&"&UserSource="&UserSource
Origin=Origin&"&UnixTime="&ToUnixTime(now(),+8)
sParaSort=SignArgs(Origin)
Origin=Origin&"&Sign="&sParaSort
'Response.Write url&"?"&Origin&"
"
'Response.end
HTMLCODE= GetBody(url,Origin)
'Response.Write HTMLCODE&"
"
'Response.end
%>
<%
str=HTMLCODE
'str=right(str,len(str)-instr(str,"[")+1)
'str=left(str,InstrRev(str,"]"))
set obj = getjson(str)
If obj.result=1 Then
UserID = obj.UserID
UserPhone = obj.UserPhone
UserSource = obj.UserSource
UserName = obj.UserName
RecommendUserID = obj.RecommendUserID
End If
End If
End Function
'--------------------------用户ID注册&查询---------------------end
'--------------------------第三方平台数据更新---------------------begin
Function Get_UnitOrd(ServiceOrdUnitID,ServiceOrdID,ServiceOrdState,DispatchOrdState)
If ServiceOrdID<>"" Then
sysUnix=ToUnixTime(now(),+8)
timestamp=Replace(now(),"/","-")
If ServiceOrdUnitID="10" Then '羊城通
appUrl="https://yangbot.gzyct.com:15002/yctcare_api/business/t_vehicle/notify" '//定义要获取源代码的网址,一般是通过变量传递过来
sql="select ServiceOrdTraTxnPrice,ServiceOrdUnitRemarks from ServiceOrder where ServiceOrdID="&ServiceOrdID
rs.open sql,objConn,1,1
If not rs.Eof Then
ServiceOrdTraTxnPrice=rs("ServiceOrdTraTxnPrice")
ServiceOrdUnitRemarks=rs("ServiceOrdUnitRemarks")
reqRandom=getIDnumbers(8)
pre_code=ServiceOrdUnitRemarks
If pre_code<>"" Then
'订单状态修改(1未处理,2已报价,3已调度,4已取消,5已完成)
n_type=""
If ServiceOrdTraTxnPrice>0 And (ServiceOrdState="1" Or ServiceOrdState="2") Then
n_type="review_pre_order"
n_result="success"
ElseIf ServiceOrdTraTxnPrice>0 And ServiceOrdState="3" Then
n_type="dispatch_complete"
n_result="success"
ElseIf ServiceOrdState="4" Then
n_type="review_pre_order"
n_result="fail"
ElseIf ServiceOrdState="5" Then
n_type="order_finish"
n_result="success"
End If
If n_type<>"" Then
Origin=""
Origin=Origin&"channel=YCT-20000005&"
If ServiceOrdTraTxnPrice>0 Then Origin=Origin&"n_info={""ord_price"":"&ServiceOrdTraTxnPrice&"}&"
Origin=Origin&"n_result="&n_result&"&"
Origin=Origin&"n_type="&n_type&"&"
Origin=Origin&"order_code="&ServiceOrdID&"&"
Origin=Origin&"pre_code="&pre_code&"&"
Origin=Origin&"reqRandom="&reqRandom&"&"
Origin=Origin&"timestamp="×tamp&"&"
Origin=Origin&"version=1.0.0"
Origin=Origin&"&key=MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA1Tn5PZv6V50Zq7/hlZ/sQqCrTsAmFlJFOj1iLWTR3rs7YbiDq2INpK85XEsN08Lu5GJqYpgbj42PEJQAYd546DH7oDMHmsW8dg/EaedUBoZOTABYr2IEc81Ayo48Y3P4TgKTUVAudlnBBPeXxbReRwrcJ6xNWnPB/nrxjldlsnce8aVdcZ/C/B82YDwmTJuXZyLxnRATej2+kAGky17NuGTfAzIoSVwENl0Je6wXO7L5+Iin2ZHS2/j1FdPDvvnljSiwdoBNCP866sdpoYe8Vct3l4st83PqV21NRTTd1GSly+9zf/pSNKz9jIDRYtvu7C96w6+bHiZFh/DxDU0gpwIDAQAB"
'Origin=Origin&"""sign"":"""&signA&""""
'Response.Write Origin&"
"
'Response.end
sign1=md5(Origin,"utf-8")
'agentid=21
args1="{"
args1=args1&"""version"":""1.0.0"","
args1=args1&"""reqRandom"":"""&reqRandom&""","
args1=args1&"""channel"":""YCT-20000005"","
args1=args1&"""timestamp"":"""×tamp&""","
args1=args1&"""sign"":"""&sign1&""","
args1=args1&"""pre_code"":"""&pre_code&""","
args1=args1&"""order_code"":"""&ServiceOrdID&""","
args1=args1&"""n_type"":"""&n_type&""","
args1=args1&"""n_result"":"""&n_result&""""
If ServiceOrdTraTxnPrice>0 Then args1=args1&",""n_info"":""{\""ord_price\"":"&ServiceOrdTraTxnPrice&"}"""
args1=args1&"}"
'call PostBody(appUrl,args1)
'Response.Write appUrl&"
"
'Response.Write args1&"
"
HTMLCODE= PostBody1(appUrl,args1)
'Response.Write HTMLCODE
'Response.end
End If
End If
End If
rs.close()
Else
End If
End If
End Function
'--------------------------第三方平台数据更新---------------------end
%>