<% '--------------------------事务结束处理---------------------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="" STraPrePayment=0 STraPaidPrice=0 STraTxnPrice=0 If DispatchOrdID<>"0" 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,ServiceOrdType,ServiceOrdCoName,ServiceOrdCoPhone,OutHosp=(select HospName from HospData where HospID=ServiceOrdPtOutHospID),ServiceOrdTraTxnPrice,ServiceOrdTraPrePayment,ServiceOrdTraPaidPrice from ServiceOrder where ServiceOrdID="&ServiceOrdID PaidMoneyRS.open sql,objConn,1,1 If not PaidMoneyRS.Eof Then NC_OAID=PaidMoneyRS(0) STraTxnPrice=PaidMoneyRS("ServiceOrdTraTxnPrice") '成交价 STraPrePayment=PaidMoneyRS("ServiceOrdTraPrePayment") '定金 STraPaidPrice=PaidMoneyRS("ServiceOrdTraPaidPrice") '已支付金额 SOrdTyp=PaidMoneyRS("ServiceOrdType") '服务单类型 SCoName=PaidMoneyRS("ServiceOrdCoName") '联系人姓名 SOutHosp=PaidMoneyRS("OutHosp") '出发地 Send_Phone=PaidMoneyRS("ServiceOrdCoPhone") '联系人电话 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) '服务单单编号 OrdTime=PaidMoneyRS("ServiceOrd_CC_Time") 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 '发送客户定金短信 If CLng(STraPrePayment)=CLng(PaidMoney) And CLng(STraPaidPrice)<=0 And SOrdTyp="20" Then '阿里云短信下发接口 lateCode="SMS_463648792" name=SCoName m1=STraPrePayment m2=CLng(STraTxnPrice)-CLng(STraPrePayment) d1=SOutHosp appUrl="https://api.966120.com.cn/v1/SendSms.php?Phone="&Send_Phone&"&name="&name&"&m1="&m1&"&m2="&m2&"&d1="&d1&"&lateCode="&lateCode 'Response.Write appUrl 'Response.end HTMLCODE= PostBody(appUrl,args1) Send_Text=name&"您好!您已支付了定金"&m1&"元,我们的服务团队到达出发地"&d1&"后,收齐余下"&m2&"元后再出发。" Send_Remarks="ServiceOrdID:"&ServiceOrdID sql="Insert into Sms_Log (Log_Id,Send_Text,Send_Phone,Send_OA,Send_errMsg,Send_Remarks) values ('阿里云','"&Send_Text&"','"&Send_Phone&"',0,'"&errMsg&"','"&Send_Remarks&"')" objConn.Execute sql Elseif CLng(STraTxnPrice)=CLng(PaidMoney) And SOrdTyp="20" Then '发送客户尾款短信(未完成) End If 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 '--------------------------微信OA信息下发接口---------------------end '获取微信access_token Function GetAccess_token21() '接口信息 corpid="wx248505bfbab6d0c1" corpsecret="2MCilqWYC0FWjOQ894sbb-s7Lb5sVH4HHuJgOsd9l1k" access_tokenID=1 '对应数据库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 '--------------------------企业用户查找---------------------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/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-0008-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 UserSource = obj.UserSource RecommendUserID = obj.RecommendUserID End If End If End Function '--------------------------用户ID注册&查询---------------------end %>