asp
<%@ Language=VBScript %>
<% Response.Buffer=true %>
<!--#include file="../Util.asp" -->
<html>
<head>
<!--#include file="../../inc/Title.inc" -->
<!--#include file="../../inc/ShowVersion.inc" -->
<meta name="VI60_defaultClientScript" content="VBScript">
<meta content="Microsoft FrontPage 4.0" name="GENERATOR">
<link rel="STYLESHEET" type="text/css" href="../../Css/oth.css">
<script ID="clientEventHandlersVBS" LANGUAGE="vbscript">
<!--
dim sinsp
vComarray = TranComarray
Bchk=False
sub window_onload
toolbar "","div_btn","<%=Session("comarray")(5)%>" '將toolbar引用進來，並決定要enabled的button
document.all("btn_Exit").src="../../images/button/black/Exit.gif"
txtcustid.FOCUS
end sub
sub txtcustid_onkeyup
txtcustid.value =ucase(trim(txtcustid.value))
end sub
Sub btnExit_onclick
frmAdd.Find.value = sinsp
frmAdd.submit
End Sub
Sub btnSave_onclick
if len(trim(txtcustid.value))=0 then
MsgBox "客戶代碼欄位不能空白"
txtcustid.focus
exit sub
end if
if len(trim(txtcustname.value))=0 then
MsgBox "客戶名稱欄位不能空白"
txtcustname.focus
exit sub
end if
if isnumeric(left((txtcustid.value),1))=true then
MsgBox "客戶代碼輸入錯誤,請重新輸入!"
txtcustid.focus
exit sub
end if
if isnumeric(mid((txtcustid.value),2,4))><true then
MsgBox "客戶代碼輸入錯誤,請重新輸入!"
txtcustid.focus
exit sub
end if
chk_dupl
if Bchk then
scustid =Trim(txtcustid.VALUE)
scustname =Trim(txtcustname.VALUE)
scustnameb=Trim(txtcustnameb.VALUE)
saddress=Trim(txtaddress.VALUE)
scontact=Trim(txtcontact.VALUE)
sphone=Trim(txtphone.VALUE)
sfax=Trim(txtfax.VALUE)
semail=Trim(txtemail.VALUE)
'sauser=vComarray(0)
vfield = Array("custid","custname","custnameb","address","contact","phone","fax","email")
vvalue =Array(CSTR(scustid),Cstr(scustname),Cstr(scustnameb),Cstr(saddress),Cstr(scontact),Cstr(sphone),Cstr(sfax),Cstr(semail))
Set OBJ = ADS.CreateObject("FICRFQ1001.RFQ1001at","HTTP://<%=request.ServerVariables("server_name")%>")
Badd= OBJ.addmast(vComarray,vfield,vvalue)
If Badd <> 0 Then
MsgBox "資料新增成功"
txtcustid.VALUE=""
txtcustname.VALUE=""
txtcustnameb.value=""
txtaddress.value=""
txtcontact.value=""
txtphone.value=""
txtfax.value=""
txtemail.value=""
txtcustid.focus()
Else
msgBox "資料新增失敗"
txtcustid.VALUE=""
txtcustname.VALUE=""
txtcustnameb.value=""
txtaddress.value=""
txtcontact.value=""
txtphone.value=""
txtfax.value=""
txtemail.value=""
txtcustid.focus()
End If
END IF
End Sub
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub chk_dupl
spn = txtcustid.value
Set OBJ = ADS.CreateObject("FICRFQ1001.RFQ1001a","HTTP://<%=request.ServerVariables("server_name")%>")
Set adoRs = OBJ.getdet(vComarray,cstr(spn))
If adoRs.RecordCount > 0 Then
MsgBox trim(scustid) & "客戶代碼已存在"
txtcustid.value =""
txtcustname.value =""
txtcustnameb.value=""
txtaddress.value=""
txtcontact.value=""
txtphone.value=""
txtfax.value=""
txtemail.value=""
Bchk=false
Else
Bchk=true
End If
End Sub
-->
</script>
</head>
<body><!--#include file="../../inc/toolbar.inc" --><!--#include file="../../inc/Timer.inc" -->
<OBJECT id=ADS height=1 width=1 classid=clsid:BD96C556-65A3-11D0-983A-00C04FC29E36></OBJECT>
<form NAME="frmAdd" METHOD="post" ACTION="RFQ1001.asp">
<input TYPE="hidden" NAME="Query" VALUE="Y">
<input TYPE="hidden" NAME="Find">
</form>
<p align="center">
<table background="../../images/banner/banner.gif" border="0" cellPadding="0" cellSpacing="0" height="38" style="LEFT: 200px; POSITION: absolute; TOP: 55px" width="375">
<tr>
<td><p align="center"><b><font color="#000066" size="4">客戶基本資料新增</font></b></p></td>
</tr>
</table>
<div STYLE="LEFT: 30px; WIDTH: 700px; POSITION: absolute; TOP: 130px; TEXT-ALIGN: center" ALIGN="center">
<Center>
<table BORDER="2" bordercolordark="#168096" bordercolorlight="#168096" cellspacing="2" cellpadding="1" align=center>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">客戶代碼 <font color="red"><%="*"%></font></td>
<td><input id="txtcustid" name="txtcustid" maxlength="4" value=""
style="HEIGHT: 22px; WIDTH: 210px" > </td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">客戶名稱 <font color="red"><%="*"%></font> </td>
<td><input id="txtcustname" name="txtcustname" maxlength="100" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">客戶簡稱</td>
<td><input id="txtcustnameb" name="txtcustnameb" maxlength="20" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">客戶地址</td>
<td><input id="txtaddress" name="txtaddress" maxlength="100" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">聯系人</td>
<td><input id="txtcontact" name="txtcontact" maxlength="20" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">電話</td>
<td><input id="txtphone" name="txtphone" maxlength="18" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">傳真</td>
<td><input id="txtfax" name="txtfax" maxlength="18" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td align="center" style="HEIGHT: 22px; WIDTH: 80px">E_MAIL</td>
<td><input id="txtemail" name="txtemail" maxlength="80" value=""
style="HEIGHT: 22px; WIDTH: 210px"></td>
</tr>
<tr>
<td COLSPAN="2" ALIGN="middle">
<input TYPE="button" NAME="btnSave" VALUE="存檔">
<INPUT type=button value=離開 name=btnExit></td>
<tr><td colspan=2><%="(1)打"%><font color="red"><%="*"%> </font><%="欄位,為必填欄位不可空白"%>
<br><%="(2)客戶代碼:依編碼原則("%><b><%="業務處"%></b><%="+客戶)輸入,如:"%><b><%="A"%></b><%="001"%>
</tr>
</table>
</Center>
</div>
</body>
</html>
com
Option Explicit
Public sSql As String
Private oGetPath As Object
Private Function ObjectControl_Activate() As Boolean
''MTS 啟動物件
End Function
Private Function ObjectControl_CanBePooled() As Boolean
''MTS 可 Pooling 物件
ObjectControl_CanBePooled = True
End Function
Private Function ObjectControl_Deactivate() As Boolean
''MTS 結束物件
End Function
Public Function GetMast(aUser As Variant) As ADODB.Recordset
' On Error GoTo err_rtn
Dim adoRs As New ADODB.Recordset
Dim sTableName(0) As String, sFullName(0) As String, sDsn(0) As String
Set oGetPath = CreateObject("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
sSql = "select * from " & sFullName(0)
sSql = sSql + " order BY CUSTID"
With adoRs
.CursorLocation = adUseClientBatch
.CursorType = adOpenKeyset
.LockType = adLockBatchOptimistic
.Open sSql, sDsn(0)
End With
Set GetMast = adoRs
Set adoRs = Nothing
Exit Function
err_rtn:
Set GetMast = Nothing
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001.GetMast" & _
vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function GetDet(aUser As Variant, sWhere As String) As ADODB.Recordset
On Error GoTo err_rtn
Dim adoRs As New ADODB.Recordset
Dim sTableName(1) As String, sFullName(1) As String, sDsn(1) As String
Set oGetPath = CreateObject("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
sSql = "select * "
sSql = sSql + " FROM " + sFullName(0) + " C "
sSql = sSql + " where c.custid like '" & sWhere & "'"
With adoRs
.CursorLocation = adUseClientBatch
.CursorType = adOpenKeyset
.LockType = adLockBatchOptimistic
.Open sSql, sDsn(0)
End With
Set GetDet = adoRs
Set adoRs = Nothing
Exit Function
err_rtn:
Set GetDet = Nothing
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001.GetDet" & _
vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function GetPrt(aUser As Variant, spn As String, ePn As String) As ADODB.Recordset
'On Error GoTo err_rtn
Dim adoRs As New ADODB.Recordset
Dim sTableName(1) As String, sFullName(1) As String, sDsn(1) As String
Set oGetPath = CreateObject("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
sSql = "select C.CUSTID,C.CUSTNAME,C.CUSTNAMEB,C.ADDRESS,C.CONTACT,C.PHONE,C.FAX,C.EMAIL,C.ADATE,C.UDATE from " & sFullName(0) & " c"
sSql = sSql + " where c.CUSTID between '" & spn & "' and '" & ePn & "'"
sSql = sSql + " order by A.CUSTID"
With adoRs
.CursorLocation = adUseClientBatch
.CursorType = adOpenKeyset
.LockType = adLockBatchOptimistic
.Open sSql, sDsn(0)
End With
Set GetPrt = adoRs
Set adoRs = Nothing
Exit Function
err_rtn:
Set GetPrt = Nothing
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001.GetPrt" & _
vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
com2
Option Explicit
Private sSql As String, sUser As String, sWhere As String
Private oGetPath As Object
Private laffcnt As Long
Public Function UpdMast(aUser As Variant, sFieldName As Variant, vFieldValue As Variant, sWhere As String) As Long
Dim oContext As ObjectContext
Set oContext = GetObjectContext()
' On Error GoTo err_rtn
Dim adoCn As New ADODB.Connection
Dim sTableName(1) As String, sFullName(1) As String, sDsn(1) As String
Dim Vsfieldname(8) As Variant
Dim Vvfieldvalue(8) As Variant
Vsfieldname(0) = sFieldName(0)
Vsfieldname(1) = sFieldName(1)
Vsfieldname(2) = sFieldName(2)
Vsfieldname(3) = sFieldName(3)
Vsfieldname(4) = sFieldName(4)
Vsfieldname(5) = sFieldName(5)
Vsfieldname(6) = sFieldName(6)
Vsfieldname(7) = sFieldName(7)
Vsfieldname(8) = "UDATE"
Vvfieldvalue(0) = vFieldValue(0)
Vvfieldvalue(1) = vFieldValue(1)
Vvfieldvalue(2) = vFieldValue(2)
Vvfieldvalue(3) = vFieldValue(3)
Vvfieldvalue(4) = vFieldValue(4)
Vvfieldvalue(5) = vFieldValue(5)
Vvfieldvalue(6) = vFieldValue(6)
Vvfieldvalue(7) = vFieldValue(7)
Vvfieldvalue(8) = CDate(Now())
Set oGetPath = oContext.CreateInstance("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
sTableName(1) = "LRFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
sUser = aUser(0)
adoCn.CursorLocation = adUseClient
adoCn.Open sDsn(0)
laffcnt = Update(adoCn, sFullName(0), Vsfieldname, Vvfieldvalue, sWhere)
'寫入LRFQCUST
If laffcnt >= 1 Then
sSql = "insert into " & sFullName(1) _
& " select *,'U','" + Format(Now, "mm/dd/yyyy HH:mm:ss") + "','" & sUser & "'" _
& " from " & sFullName(0) & " where " & sWhere
adoCn.Execute sSql
End If
UpdMast = laffcnt: oContext.SetComplete: adoCn.Close: Set adoCn = Nothing
Exit Function
err_rtn:
UpdMast = 0
oContext.SetAbort
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.UpdMast" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function Update(adoCn As Connection, sTable As String, vFieldName As Variant, vFieldValue As Variant, sClause As String) As Long
''依 sClause 的條件以 array 的方式更新 sTable 的一筆或多筆資料
'-----------------------------------------------------------------------------------
''sTableName Table名,由GetPath抓全名
''sFieldsName() 欄位名稱的 array
''sFieldsValue() 欄位值的 array
''sClause 更新的條件
'------------------------------------------------------------------------------------
Dim oContext As ObjectContext
Set oContext = GetObjectContext()
' On Error GoTo err_rtn
Dim iCnt As Integer, laffcnt As Long
sSql = "UPDATE " & sTable & " SET "
For iCnt = LBound(vFieldName) To UBound(vFieldName)
sSql = sSql & vFieldName(iCnt) & "=" & TranType(vFieldValue(iCnt)) & ","
Next iCnt
sSql = Left(sSql, Len(sSql) - 1) & " Where " & sClause
adoCn.Execute sSql, laffcnt
Update = laffcnt: oContext.SetComplete
Exit Function
err_rtn:
Update = 0
oContext.SetAbort
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.Update" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Private Function TranType(ChkData As Variant) As String
''配合 SQL 語法, 將非數字資料前後加上單引號
'-----------------------------------------------------------------------------------
''ChkData 要檢查是否轉換的資料
'------------------------------------------------------------------------------------
' On Error GoTo err_rtn
If IsNull(ChkData) Then
TranType = "Null"
Else
If Trim(ChkData) = "getdate()" Then
TranType = CStr(ChkData) ' getdate()為函數
Else
Select Case VarType(ChkData)
Case vbInteger, vbLong, vbVDouble, vbDecimal, VbVarType.vbCurrency, vbVSingle
TranType = CStr(ChkData)
Case Else
If InStrRev(ChkData, "'") <> 0 Then ChkData = Replace(ChkData, "'", "`") ' 防止單引號
TranType = "'" & ChkData & "'"
If VarType(ChkData) = 7 Then
TranType = "'" + Format(ChkData, "mm/dd/yyyy HH:mm:ss") + "'"
End If
End Select
End If
End If
Exit Function
err_rtn:
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.TranType" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function AddMast(aUser As Variant, sFieldName As Variant, vFieldValue As Variant) As Long
Dim oContext As ObjectContext
Set oContext = GetObjectContext()
' On Error GoTo err_rtn
Dim adoCn As New ADODB.Connection, oGetPath As Object
Dim sTableName(1) As String, sFullName(1) As String, sDsn(1) As String
Dim laffcnt As Long
Dim Vsfieldname(9) As Variant
Dim Vvfieldvalue(9) As Variant
Vsfieldname(0) = sFieldName(0)
Vsfieldname(1) = sFieldName(1)
Vsfieldname(2) = sFieldName(2)
Vsfieldname(3) = sFieldName(3)
Vsfieldname(4) = sFieldName(4)
Vsfieldname(5) = sFieldName(5)
Vsfieldname(6) = sFieldName(6)
Vsfieldname(7) = sFieldName(7)
Vsfieldname(8) = "ADATE"
Vsfieldname(9) = "UDATE"
Vvfieldvalue(0) = vFieldValue(0)
Vvfieldvalue(1) = vFieldValue(1)
Vvfieldvalue(2) = vFieldValue(2)
Vvfieldvalue(3) = vFieldValue(3)
Vvfieldvalue(4) = vFieldValue(4)
Vvfieldvalue(5) = vFieldValue(5)
Vvfieldvalue(6) = vFieldValue(6)
Vvfieldvalue(7) = vFieldValue(7)
Vvfieldvalue(8) = CDate(Now())
Vvfieldvalue(9) = CDate(Now())
Set oGetPath = oContext.CreateInstance("M2000UTIL.GETPATH")
' Set oGetPath = CreateObject("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
sTableName(1) = "LRFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
adoCn.Open sDsn(0)
laffcnt = Insert(adoCn, sFullName(0), Vsfieldname, Vvfieldvalue)
If laffcnt >= 1 Then
sSql = "insert into " & sFullName(1) _
& " select *,'I','" + Format(Now, "mm/dd/yyyy HH:mm:ss") + "','" & aUser(0) & "'" _
& " from " & sFullName(0) & " where CUSTID= '" & Vvfieldvalue(0) & "' "
adoCn.Execute sSql
End If
AddMast = laffcnt: oContext.SetComplete: adoCn.Close: Set adoCn = Nothing
Exit Function
err_rtn:
AddMast = 0
oContext.SetAbort
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.AddMast" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function Insert(adoCn As Connection, sTable As String, sFieldName As Variant, vFieldValue As Variant) As Long
'依陣列串字串去Insert sTable
'-----------------------------------------------------------------------------------
''sTableName Table名,由GetPath抓全名
''sFieldsName() 欄位名稱的 array
''sFieldsValue() 欄位值的 array
'------------------------------------------------------------------------------------
Dim oContext As ObjectContext ' 前3行為有Transation統一寫法,請參照
Set oContext = GetObjectContext()
' On Error GoTo err_rtn
Dim iCnt As Integer, laffcnt As Long
sSql = "INSERT INTO " & sTable & " (" & sFieldName(0)
For iCnt = 1 To UBound(sFieldName)
sSql = sSql & "," & sFieldName(iCnt)
Next iCnt
sSql = sSql & ") Values (" & TranType(vFieldValue(0))
For iCnt = 1 To UBound(sFieldName)
sSql = sSql & "," & TranType(vFieldValue(iCnt))
Next iCnt
sSql = sSql & ")"
adoCn.Execute sSql, laffcnt
Insert = laffcnt: oContext.SetComplete
Exit Function
err_rtn:
Insert = 0
oContext.SetAbort
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.AddMast" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
Public Function DelMast(aUser As Variant, spn As String) As Long
Dim oContext As ObjectContext
Set oContext = GetObjectContext()
On Error GoTo err_rtn
Dim adoCn As New ADODB.Connection, oGetPath As Object
Dim sTableName(1) As String, sFullName(1) As String, sDsn(1) As String
Dim laffcnt As Long
sUser = aUser(0)
Set oGetPath = oContext.CreateInstance("M2000UTIL.GETPATH")
sTableName(0) = "RFQCUST"
sTableName(1) = "LRFQCUST"
oGetPath.getpath aUser, sTableName(), Null, sFullName(), sDsn()
adoCn.Open sDsn(0)
'寫入LOGBONDGOODS
sSql = "insert into " & sFullName(1) _
& " select *,'D','" + Format(Now, "mm/dd/yyyy HH:mm:ss") + "','" & sUser & "'" _
& " from " & sFullName(0) & " where CUSTID like'" & spn & "'"
adoCn.Execute sSql
' 刪除記錄
sSql = "delete " & sFullName(0) & " where CUSTID like'" & spn & "'"
adoCn.Execute sSql, laffcnt
DelMast = laffcnt: oContext.SetComplete: adoCn.Close: Set adoCn = Nothing
Exit Function
err_rtn: '
DelMast = 0
oContext.SetAbort
Err.Raise Err.Number, Err.Source, "Porgram: FICRFQ1001.RFQ1001aT.DelMast" & vbCrLf & "Source:" & Err.Source & vbCrLf & "Error:" & Err.Description
End Function
此内容由惯性聚合(RSS阅读器)自动聚合整理，仅供阅读参考。 原文来自 — 版权归原作者所有。