ASP UTF-8 保存

  



  
<%
Response.ContentType = "text/xml"
Response.Charset= "utf-8"
Response.ExpiresAbsolute=#May 31,2000 23:59:59#

' キャラクタセット変換用
Set Stream = Server.CreateObject( "ADODB.Stream" )
Set CAPIUtil = Server.CreateObject( "CAPICOM.Utilities" )
Set MyData = Server.CreateObject("Scripting.Dictionary")

' **********************************************************
' UTF-8 入力文字列の変換
' **********************************************************
Function ConvertQueryString()

	Dim InData,nData,aData,I,strChar

	Stream.Open

	InData = Split( Request.QueryString, "&" )
	For nData = 0 to Ubound( InData )
		
		Stream.Position = 0
		Stream.SetEOS
		Stream.Charset = "utf-8"
		Stream.Type = 1 ' バイナリ

		aData = Split( InData(nData), "=" )
		strChar =""
		For I = 1 to Len( aData(1) )
			strChar = Mid( aData(1), I, 1 )
			if strChar = "%" then
				I = I + 1
				strChar = ChrB(CLng( "&H" & Mid( aData(1), I, 2 ) ))
				I = I + 1
			else
				strChar = ChrB(Asc(strChar))
			end if

			ByteArray = CAPIUtil.BinaryStringToByteArray( strChar )
			Stream.Write ByteArray

		Next

		Stream.Position = 0
		Stream.Type = 2 ' テキスト
		MyData( aData(0) ) = Stream.ReadText()

	Next

	Stream.Close 

End Function

Call ConvertQueryString()

Call DBConnectByEnv( Cn )

Query = "select * from T_学生マスタ_累積 where 入学年度 >= 2001"
if Request.QueryString("name") <> "" then
	Query = Query & " and 学生氏名 like '%" _
		& ConvCharset2( Request.QueryString("name") ) & "%'"
end if

strOrder = " order by コード"

Call DBGet( Cn, Rs, Query & strCond & strOrder, false )

' ************************************************
' 内部コードを UTF-8 へ変換
' ************************************************
function ConvCharset( strValue )

	Stream.Position = 0
	Stream.SetEOS
	Stream.Type = 2	' テキスト
	Stream.Charset = "utf-8"
	Stream.WriteText strValue
	Stream.Position = 0
	Stream.Type = 1 ' バイナリ
	Stream.Position = 3 ' BOM
	ConvCharset = Stream.Read()

end function

' ************************************************
' encodeURIComponent で encode された
' データ(UTF-8)を 内部コードへ変換 ( Ajax 用 )
' ************************************************
function ConvCharset2( strValue )

	Dim I,strWork,strValue1,strValue2,ByteArray,strRet

	Stream.Position = 0
	Stream.SetEOS
	Stream.Charset = "utf-8"
	Stream.Type = 1 ' バイナリ


	strRet = ""
	For I = 1 to Len( strValue )
		strWork = Hex(Asc(Mid( strValue, I, 1 )))
		if Len(strWork) > 2 then
			strValue1 = ChrB( CLng("&H" & Left( strWork, 2 ) ) )
			strValue2 = ChrB( CLng("&H" & Right( strWork, 2 ) ) )
			strRet = strRet & strValue1 & strValue2
		else
			strRet = strRet & ChrB( CLng("&H" & strWork ) )
		end if
	Next

	ByteArray = CAPIUtil.BinaryStringToByteArray( strRet )
	Stream.Write ByteArray
	Stream.Position = 0
	Stream.Type = 2
	ConvCharset2 = Stream.ReadText()

end function

%>
<!-- #include file = "../dbSS.inc" --><?xml version="1.0" encoding="UTF-8" ?> 
<gakusei>
	<query><% Response.BinaryWrite ConvCharset( Query )  %></query>
<%
	nCount = 0
	Do While not DBEof( Rs )

		Response.Write "<row>" & vbCrLf
		Response.Write "<id>" & Rs.Fields("コード").value & "</id>" & vbCrLf
		Response.Write "<name>"
		Response.BinaryWrite ConvCharset( Rs.Fields("学生氏名").value & "" )
		Response.Write "</name>" & vbCrLf
		Response.Write "<fname>"
		Response.BinaryWrite ConvCharset( Rs.Fields("フリガナ").value & "" )
		Response.Write "</fname>" & vbCrLf
		Response.Write "</row>" & vbCrLf

		nCount = nCount + 1
		if nCount >= 50 then
			Exit Do
		end if
		Rs.MoveNext
	Loop
%></gakusei><% Call DBClose( Cn ) : Call DBClose( Rs ) : Stream.Close %>
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ