自定義的日期函數包

DatePackage.asp(日期函數包)

<%
'日期函數包DataPackage
%>
<script language="javascript">
function IsDateString(Str)
<!--
{
// 校驗是否YYYY-MM-DD格式的日期型數據，返回值爲True成功，否則返回False
// 如果傳遞的是空字符串則返回False
// 定義分隔符
var sSplit="-"

var iYearPos=Str.indexOf(sSplit);
if (iYearPos==-1) return false;

var iMonthPos=Str.indexOf(sSplit,iYearPos+1);
if (iMonthPos==-1) return false;

// 分離出年份
sYear=Str.substr(0,iYearPos);
// 分離出月份
sMonth=Str.substr(iYearPos+1,iMonthPos-iYearPos-1);
//月份長度爲二
if (sMonth.length!=2) return false;
if (sMonth.substr(0,1)=="0") sMonth=sMonth.substr(1);
// 分離出日期
sDay=Str.substr(iMonthPos+1);
//日長度爲二
if (sDay.length!=2) return false;
if (sDay.substr(0,1)=="0") sDay=sDay.substr(1);

// 年份是否數字？
if (isNaN(sYear)) return false;
var iYear=parseInt(sYear);
// 年份是否整數？
if (sYear!=iYear) return false;
// 年份是否在1000-9999之間？
if (iYear<1000 || iYear>9999) return false;

// 月份是否數字？
if (isNaN(sMonth)) return false;
var iMonth=parseInt(sMonth);
// 月份是否整數？
if (sMonth!=iMonth) return false;
// 月份是否在1-12之間？
if (iMonth<1 || iMonth>12) return false;

// 日期是否數字？
if (isNaN(sDay)) return false;
var iDay=parseInt(sDay);
// 日期是否整數？
if (sDay!=iDay) return false;
// 日期是否在1-31之間？
if (iDay<1 || iDay>31) return false;

if (iDay<29) return true;

// 日期數據是否合法的？
switch (iMonth)
{
case 1:
if (iDay>31) return false;
break;
case 2:
if (IsLeapYear(iYear))
{
if (iDay>29) return false;
}
else
{
if (iDay>28) return false;
}
break;
case 3:
if (iDay>31) return false;
break;
case 4:
if (iDay>30) return false;
break;
case 5:
if (iDay>31) return false;
break;
case 6:
if (iDay>30) return false;
break;
case 7:
if (iDay>31) return false;
break;
case 8:
if (iDay>31) return false;
break;
case 9:
if (iDay>30) return false;
break;
case 10:
if (iDay>31) return false;
break;
case 11:
if (iDay>30) return false;
break;
case 12:
if (iDay>31) return false;
}

return true;

}

function IsLeapYear(Y)
{
// 年份是否爲閏年

if (Y % 4 !=0) return false;
if (Y % 400 == 0) return true;
if (Y % 100 == 0) return false;
}

-->
</script>

<%
'**********************
'目的：將日期轉換成標準日期字符串
'輸入：日期
'輸出：日期字符串，如：2002-12-22
'**********************
Function getdatestr(ddate)
dim strtmp
getdatestr = DatePart("yyyy",ddate)
strtmp = trim(DatePart("m",ddate))
if len(strtmp)=1 then strtmp="0" & strtmp
getdatestr = getdatestr & "-" & strtmp
strtmp = trim(DatePart("d",ddate))
if len(strtmp)=1 then strtmp="0" & strtmp
getdatestr = getdatestr & "-" & strtmp
End Function
'**********************

'**********************
'目的：將日期時間轉換成標準日期時間字符串
'輸入：日期時間
'輸出：日期時間字符串，如：2002-12-22
'**********************
Function gettimestr(ddate)
dim strtmp
gettimestr = DatePart("yyyy",ddate)
strtmp = trim(DatePart("m",ddate))
if len(strtmp)=1 then strtmp="0" & strtmp
gettimestr = gettimestr & "-" & strtmp
strtmp = trim(DatePart("d",ddate))
if len(strtmp)=1 then strtmp="0" & strtmp
gettimestr = gettimestr & "-" & strtmp
gettimestr = gettimestr & " " & trim(DatePart("h",ddate))
gettimestr = gettimestr & ":" & trim(DatePart("m",ddate))
End Function
'**********************

'**********************
'目的：計算一月的總天數
'輸入：年，月
'輸出：天數
'**********************
function getmonthdays(myyear,mymonth)
dim thismonthfirday,nextmonthfirday
'取得當前年月的1日日期
thismonthfirday=myyear & "-" & mymonth & "-1"
'取得下個月1日的日期
nextmonthfirday=dateadd("m",1,thismonthfirday)
'取得當前月的天數
getmonthdays=DateDiff("d",thismonthfirday,nextmonthfirday)
end function
'**********************

'**********************
'目的：返回格式化日期
'輸入：任何類型參數
'輸出：格式化後的日期
'**********************
Function FormatDateEx(D)

dim varTemp

if IsDate(D) then
varTemp="'" & D & "'"
else
varTemp="NULL"
end if

FormatDateEx=varTemp

End Function
'**********************

'DatePackage End
%>

DataBasePackage.asp（數據庫函數包）

<%
'數據庫操作函數包DatabasePackage

'conn.Open Driver & DBPath
'Set CreateExcelRecordset = Server.CreateObject("ADODB.Recordset")
'打開Sheet，參數二爲Connection對象,因爲Excel ODBC驅動程序無法直接用‘sheet名來打開sheet,所以請注意以下的select語句
'CreateExcelRecordset.Open "Select * From ["&sheet&”$]”, conn, 2, 2
'**********************
'目的：取得各種數據庫連接字符串
'輸入：數據庫服務器名、數據庫名、用戶ID、密碼
'輸出：數據庫連接字符串
'**********************
Function GetConnStr(pServer,pDb,pId,pPwd,pType)
Dim strConn
strConn = ""
if pType="SQLSERVER" then
strConn = "Driver={SQL Server};Server=" & pServer & ";Database=" & pDb
strConn = strConn & ";Uid=" & pId & ";Pwd=" & pPwd & ";"
end if

if pType="ACCESS" then
strConn = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & Server.MapPath(pDb)
strConn = strConn & ";password=" & pPwd
end if

if pType="EXCEL" then
strConn = "Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & Server.MapPath(pDb)
end if

GetConnStr = strConn

End Function
'**********************

'**********************
'目的：返回客戶名稱
'輸入：客戶ID
'輸出：客戶名稱
'**********************
Function GetCustomerName(ID)

dim cn
dim rs
dim strSQL

set cn=server.CreateObject("ADODB.Connection")
set rs=server.CreateObject("ADODB.RecordSet")

cn.Open Application("ConnStr")

strSQL="select UserName from P_User_Info where Id=" & ID
rs.Open strSQL,cn
if rs.EOF then
GetCustomerName=""
else
GetCustomerName=rs("UserName")
end if

rs.Close
cn.Close
set rs=nothing
set cn=nothing
End Function
'**********************

'**********************
'目的：判斷表中某字段值是否已經存在
'輸入：表名、字段名、關鍵字
'輸出：true or false
'**********************
Function IsExist(TableName,FieldName,FieldValue)

dim cn
dim rs
dim blnTemp
dim strconn

set cn = server.CreateObject("ADODB.Connection")
set rs = server.CreateObject("ADODB.Recordset")

strconn = GetConnStr(cnstDataSvr,cnstDataName,cnstUserId,cnstUserPwd,"SQLSERVER")
cn.open strconn
with rs
.open "select " & FieldName & " from " & TableName & " where " & FieldName & "='" & FieldValue & "'",cn
blnTemp = not .EOF
.close
end with
cn.close
set rs = nothing
set cn = nothing

IsExist = blnTemp

End Function
'**********************

'**********************
'目的：事務處理更新後臺數據
'輸入：SQL執行字符串和錯誤信息字符串
'輸出：true or false
'**********************
Function ExecuteUpdate(strSQL)
dim cn,strconn
ExecuteUpdate = false
set cn = server.CreateObject("ADODB.Connection")
strconn = GetConnStr(cnstDataSvr,cnstDataName,cnstUserId,cnstUserPwd,"SQLSERVER")
cn.open strconn
on error resume next
cn.begintrans
cn.Execute strSQL
if cn.errors.count>0 then
cn.rollbacktrans
else
cn.committrans
ExecuteUpdate = true
end if
cn.Close
set cn = nothing
End Function
'**********************

'**********************
'目的：取字段預定義值
'輸入：數據庫連接，字段中文名，字段中文值
'輸出：字符串
'ts_TypeColValue:字段預定義常數表
'**********************
Function getFieldValue(pConn,pTable,pField,pValue)
dim strSql,rstmp
set rstmp = server.createobject("adodb.recordset")

strSql = "select * from ts_TypeColValue where TableName=" & pTable
strSql = strSql & " and ColCnNm=" & pField & "and TypeColName=" & pValue
rstmp.open strSql,pConn,1,3
if rstmp.recordcount>0 then
getFieldValue = rstmp("TypeColVal")
else
getFieldValue = ""
end if
rstmp.close
set rstmp = nothing
End Function
'**********************

'DatabasePackage End
%>

AccessDbPackage.asp(ACCESS數據庫訪問函數包)

<%
'ACCESS數據庫操作函數包AccessDbPackage

'*************************
'ACCESS數據庫操作方法
'*************************
function CreateDBfile(DbVer,SaveFileName)
'建立數據庫文件
'If DbVer is 0 Then Create Access97 dbFile
'If DbVer is 1 Then Create Access2000 dbFile
On error resume Next
If DbExists(FileName) Then
%>
<script language="javascript">
window.alert("對不起，該數據庫已經存在!");
</script>
<%
CreateDBfile = False
Else
Dim Ca
Set Ca = Server.CreateObject("ADOX.Catalog")
If Err.number<>0 Then
%>
<script language="javascript">
window.alert("無法建立，請檢查錯誤信息
" & Err.number & "
" & Err.Description);
</script>
<%
Err.Clear
Exit function
End If
If DbVer=0 Then
call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & FileName)
Else
call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName)
End If
Set Ca = Nothing
CreateDBfile = True
End If
End function

function DbExists(dbPath)
'查找數據庫文件是否存在
On Error resume Next
Dim c
Set c = Server.CreateObject("ADODB.Connection")
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
If Err.number<>0 Then
Err.Clear
DbExists = false
else
DbExists = True
End If
set c = nothing
End function

'AccessDbPackage End
%>

aspextend.asp(HTML擴展函數)

<%
'ASP控件擴展函數包AspPackage

'**********************
'目的：判斷兩值相等，輸出"selected",用於標誌組合框項目被選中
'輸入：參數一、參數二
'輸出："selected"或""
'**********************
Function Selected(req,reqvalue)
if req=reqvalue then
selected=" selected"
else
selected=""
end if
End Function
'**********************

'**********************
'目的：判斷兩值相等，輸出"checked",用於標誌複選框被選中
'輸入：參數一、參數二
'輸出："checked"或""
'**********************
Function Checked(req,reqvalue)
if req=reqvalue then
checked=" checked"
else
checked=""
end if
End Function
'**********************

'*********************************
'符合條件背景置色(歷史數據，custid>=10000000)
'*********************************
Function SetBackColor(req,reqvalue,dfaultcolor,color)
If req>=reqvalue Then
SetBackColor=color
Else
SetBackColor=dfaultcolor
End if

End Function
'*********************************

'*********************************
'符合條件背景置色(區分打印非打印記錄)
'*********************************
Function SetPrintColor(req,reqvalue,dfaultcolor,color)
If req>=reqvalue Then
SetPrintColor=color
Else
SetPrintColor=dfaultcolor
End if

End Function
'*********************************
'AspPackage End
%>