%@ Language=VBScript %>
<%Session("dir") = ""%>
<%
dim Set_Info
Get_PJNO=request.QueryString("pjno")
if Get_PJNO = "" then
response.Write("pjno not found")
response.End()
end if
'' 枠の表示幅も取得可能 ※ ただし基本的には使用させない
Get_td_width=request.QueryString("width")
if Get_td_width = "" then
Get_td_width = "600" '' よって、一応、最大幅600pxとする
end if
StrInfo = ""
Set_Info = ""
''StrInfo = "test"
''response.Write("HTML:" & StrInfo & "
")
''response.End()
if left(Get_PJNO,3) = "pre" then
strSQL = "SELECT * FROM AB_EVENT_INFO_PRE WHERE PROJ_NO='" & right(Get_PJNO,6) & "'"
else
strSQL = "SELECT * FROM AB_EVENT_INFO WHERE PROJ_NO='" & Get_PJNO & "'"
end if
Set OraDatabase = OraSession.GetDatabaseFromPool(10)
Set OraDynaset = OraDatabase.CreateDynaset(strSQL,4)
If Not OraDynaset.EOF Then
StrInfo = OraDynaset.Fields("MAINTEXT").Value
else
response.Write("pjno no data")
response.End()
End If
''response.Write("HTML:" & StrInfo & "
")
''response.Write("HTML:" & TextCRLF_Conv(StrInfo) & "
")
Set_Info = TextCRLF_Conv(StrInfo)
''response.Write("HTML:" & Set_Info & "
")
''response.End()
''--- メインロジックここまで ----
function TextCRLF_Conv(pStrText)
dim getText
dim ii, RtnFlg
if len(pStrText) <= 0 then
TextCRLF_Conv = ""
exit function
end if
getText = ""
for ii=1 to len(pStrText)
''getText = getText & mid(pStrText,ii,1)
if mid(pStrText,ii,1) = vbcrlf or mid(pStrText,ii,1) = vbcr or mid(pStrText,ii,1) = vblf then
if RtnFlg = 1 then
RtnFlg=0
else
getText = getText & "
"
RtnFlg = 1
end if
else
getText = getText & mid(pStrText,ii,1)
RtnFlg=0
end if
next
TextCRLF_Conv = getText
end function
function TextCRLF_Byte_Conv(pStrText,pRtnPointByte)
''******* Function MyLenB(ByVal a) が必要!! *******
dim getText
dim ii
if len(pStrText) <= 0 then
TextCRLF_Byte_Conv = ""
exit function
end if
RtnCnt = 0
getText = ""
for ii=1 to len(pStrText)
''getText = getText & mid(pStrText,ii,1)
RtnCnt = RtnCnt + MyLenB(mid(pStrText,ii,1))
if mid(pStrText,ii,1) = vbcrlf or mid(pStrText,ii,1) = vbcr or mid(pStrText,ii,1) = vblf then
getText = getText & mid(pStrText,ii,1)
else
'' pRtnPintByte数に達したか、それより1つ多いバイト数に達したら改行コードを無理やり入れる
if RtnCnt >= pRtnPointByte and ii<>len(pStrText) then
getText = getText & vbcrlf
RtnCnt = 0
end if
end if
next
TextCRLF_Byte_Conv = getText
end function
Function MyLenB(ByVal a)
Dim c
c = 0
Dim i
For i = 0 To Len(a) - 1
Dim k
k = Mid(a, i + 1, 1)
If (Asc(k) And &HFF00) = 0 Then
c = c + 1
Else
c = c + 2
End If
Next
MyLenB = c
End Function
%>
<%=Set_Info %> |