📄 default.asp

📁 进销存软件源代码
💻 ASP
字号:
<!-- #include virtual="/eB3KTransaction.asp" -->
<!-- #include virtual="/Server/ebo.asp" -->
<!-- #include virtual="/Server/cblib.asp" -->
<!-- #include file="../Common.asp" -->
<HTML>
<script src="/client/Request.js"></script>
<script src="/client/IClient.js"></script>
<BODY>
<%
sysdefinedGet = EBO_GETTOSERVER

const MAPTOPRODUCT=2

dim ioType
ioType=unescape(request.form("IOType"))

dim TotalCount, iCount, i
iCount = 0
TotalCount = 0

'eboReg
dim NowTime, BillMemo, debitAmount, creditAmount
NowTime = Now
BillMemo = ""
debitAmount = 0
creditAmount = 0

eboReg 1,"NowTime","BillDate","","cbLocalVariable"
eboReg 1,"BillMemo","BillMemo","","cbLocalVariable"
eboReg 1,"debitAmount","Amount","","cbLocalVariable"
eboReg 1,"AccountID","AccountID","","cbLocalVariable"
eboReg 1,"Owner","Owner","","cbLocalVariable"
eboReg 1,"NULL","NULL","","cbRSBalanceCheck"			'平衡检查

eboReg 2,"Detail_0_","BillListMemo","","cbRSListDirect"
eboReg 2,"Detail_1_","ProductID","","cbRSListSubjectCheck"
eboReg 2,"Detail_4_","Quantity","","cbRSListDirect"
eboReg 2,"Detail_5_","Currency3","","cbRSListCurrencyZero"	'当前币种借方
eboReg 2,"Detail_6_","Currency4","","cbRSListCurrencyZero"	'当前币种贷方
eboReg 2,"Detail_5_","Currency1","","cbRSListDebit"		'本币借方并计算汇率
eboReg 2,"Detail_6_","Currency2","","cbRSListCredit"	'本币贷方并计算汇率
eboReg 2,"Detail_10_","Int1","","cbRSListDirect"		'借贷方
eboReg 2,"Detail_7_","LinkID","","cbRSListIntNull"
eboReg 2,"Detail_8_","LinkType","","cbRSListIntNull"
eboReg 2,"Detail_9_","LinkSerial","","cbRSListIntNull"

function cbRSBalanceCheck(fun, eboitem, rs, rsList)
	if debitAmount<>creditAmount then Err.Raise 10000,"cbFunBalanceCheck","借贷方不平!"
end function

function cbRSListDebit(fun, eboitem, rs, rsList)
	dim CurrencyString
	cbRSListCurrencyZero fun, eboitem, rs, rsList
	debitAmount=debitAmount+rsList(eboitem.FieldName)
end function

function cbRSListCredit(fun, eboitem, rs, rsList)
	dim CurrencyString
	cbRSListCurrencyZero fun, eboitem, rs, rsList
	creditAmount=creditAmount+rsList(eboitem.FieldName)
end function

'*******************************************************
dim ID, Memo, Debit, Credit, Mark, LinkBillID, LinkSerial, Quantity
dim SubjectLen
dim SubjectID()		'科目ID
dim SubjectValueName()	'科目取值
dim SubjectTotal()	'科目合计
dim SubjectMemo()	'科目摘要
dim SubjectDetail()	'明细或汇总
dim SubjectMark()	'借贷方

function InitSubject(n)
	SubjectLen=n
	redim SubjectID(SubjectLen)
	redim SubjectValueName(SubjectLen)
	redim SubjectTotal(SubjectLen)
	redim SubjectMemo(SubjectLen)
	redim SubjectDetail(SubjectLen)
	redim SubjectMark(SubjectLen)
end function

eboReg 10,"Detail_0_","Memo","","cbLocalVariable"
eboReg 10,"Detail_1_","ID","","cbLocalVariable"
eboReg 10,"Detail_4_","Quantity","","cbLocalVariable"
eboReg 10,"Detail_5_","Debit","","cbLocalVariable"		'本币借方
eboReg 10,"Detail_6_","Credit","","cbLocalVariable"	'本币贷方
eboReg 10,"Detail_7_","LinkBillID","","cbLocalVariable"
eboReg 10,"Detail_8_","bdType","","cbLocalVariable"
eboReg 10,"Detail_9_","LinkSerial","","cbLocalVariable"
eboReg 10,"Detail_10_","Mark","","cbLocalVariable"		'借贷方

function GetFieldValue(n, rsBD)
	select case n
		case 0
			GetFieldValue=rsBD("TaxAmount")
		case 1
			GetFieldValue=rsBD("Amount")
		case 2
			GetFieldValue=rsBD("TaxAmount")-rsBD("Amount")
		case 3
			GetFieldValue=rsBD("Cost")
		case else
			GetFieldValue=rsBD("TaxAmount")
	end select
end function

function GetListFieldValue(n, rsBDList)
	select case n
		case 0
			GetListFieldValue=rsBDList("TaxAmount")
		case 1
			GetListFieldValue=rsBDList("Amount")
		case 2
			GetListFieldValue=rsBDList("TaxAmount")-rsBD("Amount")
		case 3
			GetListFieldValue=rsBDList("AuditCost")
		case else
			GetListFieldValue=rsBDList("TaxAmount")
	end select
end function

function MapToChild(ParentID, MapFunction, MapID)
	dim rsCheck
	dim szSQL, szSQLCount
	
	szSQLCount = "SELECT COUNT(*) AS rc FROM [biSubject] WHERE [InfoType]=10 AND ([AccountID]=(SELECT RootID FROM [biCorperation] WHERE AccountID="&AccountID&") OR AccountID="&AccountID&") AND ParentID=" & ParentID & " AND [int4]=" & MapFunction & " AND [bigint4]=" & MapID
	szSQL = "SELECT ID FROM [biSubject] WHERE [InfoType]=10 AND ([AccountID]=(SELECT RootID FROM [biCorperation] WHERE AccountID="&AccountID&") OR AccountID="&AccountID&") AND ParentID=" & ParentID & " AND [int4]=" & MapFunction & " AND [bigint4]=" & MapID
	rsCheck=Conn.Execute(szSQLCount)
	if rsCheck("rc")>0 then
		rsCheck=Conn.Execute(szSQL)
		MapToChild=rsCheck("ID")
	else
		err.raise 10000,"OutStock.Export", "科目映射失败，请查看创建映射！"
	end if
	set rsCheck=nothing
end function

'CallBack
function OutbdOpenTitle(bdType, bdTableName, rsBD)
	dim i
	if ioType<>CStrEx(rsBD("Int1")) then err.raise 10000,"OutStock.Export", "IO类型错误！！"
	if CStr(rsBD("AuditID"))="0" then err.raise 10000,"OutStock.Export", "单据未审核！！"
	if rsBD("Int2")=1 then err.raise 10000, "OutStock.Export","单据已转换！！"				
	for i=0 to SubjectLen-1
		if SubjectMark(i)=0 then
			Debit=GetFieldValue(SubjectValueName(i), rsBD)
			Credit=0
			SubjectTotal(i)=SubjectTotal(i)+Debit
		else
			Debit=0
			Credit=GetFieldValue(SubjectValueName(i), rsBD)
			SubjectTotal(i)=SubjectTotal(i)+Credit
		end if
		if SubjectDetail(i)<>0 And SubjectDetail(i)<>MAPTOPRODUCT then
			Memo=SubjectMemo(i)
			if SubjectDetail(i)<>-1 then
				ID=MapToChild(SubjectID(i),SubjectDetail(i),rsBD("Organization"))
			end if
			LinkBillID=rsBD("ID")
			LinkSerial=null
			Quantity=0
			Mark=SubjectMark(i)
			eboGet 10, nothing, nothing
			TotalCount=TotalCount+1
		end if
	next
end function

function OutbdOpenList(bdType, bdTableName, rsBD, rsBDList)
	for i=0 to SubjectLen-1
		if SubjectDetail(i)=MAPTOPRODUCT then
			if SubjectMark(i)=0 then
				Debit=GetListFieldValue(SubjectValueName(i), rsBDList)
				Credit=0
			else
				Debit=0
				Credit=GetListFieldValue(SubjectValueName(i), rsBDList)
			end if
			Memo=SubjectMemo(i)
			ID=MapToChild(SubjectID(i),SubjectDetail(i),rsBDList("ProductID"))
			Quantity=rsBDList("Quantity")
			LinkBillID=rsBD("ID")
			LinkSerial=rsBDList("Serial")
			Mark=SubjectMark(i)
			eboGet 10, nothing, nothing
			TotalCount=TotalCount+1
		end if
	next
	OutbdOpenList=0
end function
'*******************************************************
function CvtbdOpenTitle(bdType, bdTableName, rsBD)
	InitSubject rsBD("int2")
end function

function CvtbdOpenList(bdType, bdTableName, rsBD, rsBDList)
	SubjectID(iCvtCount)=rsBDList("ProductID")
	SubjectValueName(iCvtCount)=rsBDList("int3")
	SubjectTotal(iCvtCount)=0
	SubjectMemo(iCvtCount)=rsBDList("BillListMemo")
	SubjectDetail(iCvtCount)=rsBDList("int4")
	SubjectMark(iCvtCount)=rsBDList("int1")
	iCvtCount=iCvtCount+1
	CvtbdOpenList=0
end function
'*******************************************************
function bdOpenTitle(bdType, bdTableName, rsBD)
	if bdType=26 then
		bdOpenTitle=CvtbdOpenTitle(bdType, bdTableName, rsBD)
	else
		bdOpenTitle=OutbdOpenTitle(bdType, bdTableName, rsBD)
	end if
end function

function bdOpenList(bdType, bdTableName, rsBD, rsBDList)
	if bdType=26 then
		bdOpenList=CvtbdOpenList(bdType, bdTableName, rsBD, rsBDList)
	else
		bdOpenList=OutbdOpenList(bdType, bdTableName, rsBD, rsBDList)
	end if
end function
'*******************************************************
function bdSaveTitle(bdType, bdTableName, rsBD)
	eboSet 1, rsBD, nothing
end function

function bdSaveList(bdType, bdTableName, rsBD, rsBDList)
	if iCount < TotalCount then
		eboSet 2, rsBD, rsBDList
		iCount = iCount + 1
		bdSaveList = 0
	else
		bdSaveList = -1
	end if
end function
'End

dim iCvtCount
iCvtCount=0
dim TotalConvert, ConvertID
TotalConvert=CLng(unescape(request.form("cvt_rows")))

dim eBD, x, bdid, szTableName, rsCheck, szSQL
Set eBD = Server.CreateObject("eB3KCommon.BillDocument")
x=eBD.bdOpen(ioType, 26, me)
if CStr(x)="0" then err.raise 10000, "OutStock.Export",eBD.GetLastError()
x = eBD.bdGetDetailByType(Conn, CLng(bdType), rsCheck)
if CStr(x)="0" then err.raise 10000,"OutStock.Export", eBD.GetLastError()
szTableName=rsCheck("TableName")
Set rsCheck=nothing
IData2d 1,10
szSQL="UPDATE ["&szTableName&"] SET [int2]=1 WHERE BillType="&bdType&" AND [ID]="
for i=0 to TotalConvert-1
	ConvertID=unescape(request.form("cvt_0_"&i))
	x=eBD.bdOpen(ConvertID, Clng(bdType), me)
	if CStr(x)="0" then err.raise 10000,"OutStock.Export", eBD.GetLastError()
	Conn.Execute szSQL & SQLInputParam(ConvertID)
next
for i=0 to SubjectLen-1
	if SubjectDetail(i)=0 then
		if SubjectMark(i)=0 then
			Debit=SubjectTotal(i)
			Credit=0
		else
			Debit=0
			Credit=SubjectTotal(i)
		end if
		Memo=SubjectMemo(i)
		ID=SubjectID(i)
		LinkBillID=null
		LinkSerial=null
		Quantity=0
		Mark=SubjectMark(i)
		eboGet 10, nothing, nothing
		TotalCount=TotalCount+1
	end if
next

x = eBD.bdSave(0, 8, me)
if CStr(x)="0" then err.raise 10000,"OutStock.Export", eBD.GetLastError()

function bdAuditTitle(bdType, szTableName, rsBD)
    rsBD("Auditor") = Owner
	bdAuditTitle=0
end function

function bdAuditList(bdType, szTableName, rsBD, rsBDList)
	bdAuditList=-1
end function

x = eBD.bdAudit(x, 8, me)
if CStr(x)="0" then err.raise 10000,"OutStock.Export", eBD.GetLastError()
set eBD = Nothing
%>
</BODY>
<script>
var data=new Array('<%=x%>');
IClient('data',data);
IClient('end','');
</script>
</HTML>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -