Index: /lang/vbscript/VbsUpload/Upload.wsc
===================================================================
--- /lang/vbscript/VbsUpload/Upload.wsc (revision 34731)
+++ /lang/vbscript/VbsUpload/Upload.wsc (revision 34731)
@@ -0,0 +1,362 @@
+<?xml version="1.0" encoding="Shift_JIS" ?>
+<package>
+<comment>
+****************************************************
+* UpLoad Windows Script Component
+*     Created by �܂�‚�--------------------------------------------------
+* �g�p��  Set Upload = GetObject( "...\...\UpLoad.wsc" )
+*  Response.Write UpLoad("title").Data
+*  UpLoad("file1").SaveAs "test.dat"
+*  Response.Write UpLoad("file1").Size
+* ���� MOD-001 2002.04.02 H.Suzuki �t�@�C���T�C�Y�擾�v���p�e�B Size �lj�*  MOD-002 2002.04.11 H.Suzuki ADODB.Recordset �̃o�O�������b�N
+****************************************************
+</comment>
+<component id="UploadCollection">
+<?component error="true" debug="true"?>
+<registration
+	description="UpLoad Collection Object"
+	progid="UpLoad.Collection"
+	version="1.00"
+	classid="{4330A687-86A7-4F45-AC92-0B35FC000778}"
+>
+</registration>
+
+<public>
+	<comment>Properties</comment>
+		<property name="Count" get />
+		<property name="Items" get />
+
+	<comment>Collections</comment>
+		<comment>Default</comment>
+		<property name="Item" get dispid="0" />
+</public>
+
+<implements type="ASP" id="ASP1"/>
+
+<script language="VBScript">
+<![CDATA[
+
+Private aryItems
+
+Call Class_Initialize()
+
+'******************************************************
+'* Form Data Collection Object
+'******************************************************
+
+Function get_Count()
+	On Error Resume Next
+	get_Count = aryItems.Count
+End Function
+
+Function get_Item(Name)
+	On Error Resume Next
+	Set get_Item = Nothing
+	Select Case TypeName( Name )
+	Case "Long", "Integer"
+		Dim aryKeys
+		aryKeys = aryItems.Keys
+		Dim intIndex
+		intIndex = Name - 1
+		If intIndex >= UBound( aryKeys ) Then
+			Set get_Item = aryItems( aryKeys( Name ) )
+		Else
+			Set get_Item = aryItems( Name )
+		End If
+	Case Else
+		Set get_Item = aryItems( Name )
+	End Select
+End Function
+
+Function get_Items()
+	Set get_Items = aryItems
+End Function
+
+Private Sub AddItem(Name,File,Mime,Data)
+	Dim objItem
+
+	Set objItem = CreateComponent("UpLoadItem")
+	With objItem
+		.Name = Name
+		.File = File
+		.Mime = Mime
+		.Data = Data
+	End With
+
+	On Error Resume Next
+	If aryItems.Exists(Name) Then
+		Dim objExist
+		If TypeName(aryItems(Name)) = "Dictionary" Then
+			aryItems(Name).Add aryItems(Name).Count+1, objItem
+		Else
+			Set objExist = aryItems(Name)
+			Set aryItems(Name) = CreateObject("Scripting.Dictionary")
+			aryItems(Name).CompareMode = vbTextCompare
+			aryItems(Name).Add 0, objExist
+			aryItems(Name).Add 1, objItem
+		End If
+	Else
+		aryItems.Add Name, objItem
+	End If
+End Sub
+
+Private Sub Class_Initialize()
+	Dim aryBinary
+	Dim nCnt
+	Dim strContentType
+	Dim strAllData
+	Dim strSplData
+	Dim arySplData
+	Dim strEncType
+	Dim strSeparator1
+	Dim strSeparator2
+	Dim strName
+	Dim strFile
+	Dim strMime
+	Dim strData
+	Dim strType
+	Dim nAsc
+	Dim cNew
+	Dim nPos
+	Dim sPos
+
+	'On Error Resume Next
+	' �|�X�g���ǂ����̔���If LCase(Request.ServerVariables("request_method")) <> "post" Then
+		Exit Sub
+	End If
+	' �G���R�[�h�^�C�v�𒲂ׂ�strEncType = "multipart/form-data"
+	strContentType = Request.ServerVariables("http_content_type")
+	If LCase(Left(strContentType,Len(strEncType))) <> strEncType Then
+		Exit Sub
+	End If
+	' ���p�Z�p���[�^�������strSeparator1 = ChrB(AscB(vbCr)) & ChrB(AscB(vbLf)) & ChrB(AscB("-")) & ChrB(AscB("-"))
+	strSeparator2 = ChrB(AscB(vbCr)) & ChrB(AscB(vbLf)) & ChrB(AscB("-")) & ChrB(AscB("-"))
+	For sPos = InStr(strContentType,"boundary=")+9 To Len(strContentType)
+		strSeparator1 = strSeparator1 & ChrB(AscB(Mid(strContentType,sPos,1)))
+		strSeparator2 = strSeparator2 & ChrB(AscB(Mid(strContentType,sPos,1)))
+	Next
+	strSeparator1 = strSeparator1 & ChrB(AscB(vbCr)) & ChrB(AscB(vbLf))
+	strSeparator2 = strSeparator2 & ChrB(AscB("-")) & ChrB(AscB("-")) & ChrB(AscB(vbCr)) & ChrB(AscB(vbLf))
+
+	' �o�C�i���f�[�^���
+	aryBinary = Request.BinaryRead(Request.TotalBytes)
+
+	nPos = 1
+
+	Set aryItems = CreateObject("Scripting.Dictionary")
+	aryItems.RemoveAll
+	aryItems.CompareMode = vbTextCompare
+	Do
+		strType = ""
+		'On Error Resume Next
+		Do
+			' �R���e���c���
+			nAsc = AscB(MidB(aryBinary,nPos,1))
+			If (&h81 <= nAsc And nAsc <= &h9F) Or (&hE0 <= nAsc And nAsc <= &hEF) Then
+				strType = strType & Chr(nAsc*256+AscB(MidB(aryBinary,nPos+1,1)))
+				nPos = nPos + 1
+			Else
+				strType = strType & Chr(nAsc)
+			End If
+			If Right(strType,4) = vbCrLf & vbCrLf Then
+				Exit Do
+			End If
+			nPos = nPos + 1
+		Loop While nPos < UBound(aryBinary)
+		If nPos = UBound(aryBinary) Then
+			Exit Do
+		End If
+
+		' ���O�A�t�@�C�����A�� �������	strName = Mid(strType,InStr(LCase(strType),"name=")+5)
+		If Left(strName,1) = """" Then
+			strName = Mid(strName,2,InStr(LCase(Mid(strName,2)),"""")-1)
+		Else
+			strName = Left(strName,InStr(LCase(strName),vbCrLf)-1)
+		End If
+		strFile = Mid(strType,InStr(LCase(strType),"filename=")+9)
+		If Left(strFile,1) = """" Then
+			strFile = Mid(strFile,2,InStr(LCase(Mid(strFile,2)),"""")-1)
+		Else
+			strFile = Left(strFile,InStr(LCase(strFile),vbCrLf)-2)
+		End If
+		sPos = InStr(LCase(strType),"content-type:")
+		If sPos > 0 Then
+			strMime = Mid(strType,sPos+14)
+			If Left(strMime,1) = """" Then
+				strMime = Mid(strMime,2,InStr(LCase(Mid(strMime,2)),"""")-1)
+			Else
+				sPos = 1
+				Do Until InStr(" ;" & vbCrLf,Mid(strMime,sPos,1)) > 0
+					sPos = sPos + 1
+				Loop
+				strMime = Left(strMime,sPos)
+			End If
+		Else
+			strMime = ""
+		End If
+
+		' �f�[�^�������	strType = ""
+		sPos = InStrB( nPos, aryBinary, strSeparator1 )
+		If sPos > 0 Then
+			strData = MidB(aryBinary,nPos+1,sPos-nPos-1)
+			nPos = sPos + LenB(strSeparator1)
+		Else
+			sPos = InStrB( nPos, aryBinary, strSeparator2 )
+			If sPos > 0 Then
+				strData = MidB(aryBinary,nPos+1,sPos-nPos-1)
+				nPos = UBound(aryBinary)
+			Else
+				nPos = UBound(aryBinary)
+			End If
+		End If
+
+		'�f�[�^��[����	AddItem strName,strFile,strMime,strData
+		If Err.Number Then
+			Exit Do
+		End If
+	Loop While nPos < UBound(aryBinary)
+End Sub
+
+]]>
+</script>
+</component>
+
+<component id="UploadItem">
+<?component error="true" debug="true"?>
+
+<registration
+	description="UpLoad Item Object"
+	progid="UpLoad.UpLoadItem"
+	version="1.00"
+	classid="{B682C01D-B85C-42d3-B2EF-B1293A2D21DD}"
+>
+</registration>
+
+<public>
+	<comment>Properties</comment>
+		<property name="Item" get dispid="0" />
+		<property name="Name" get put />
+		<property name="File" get put />
+		<property name="Mime" get put />
+		<property name="Data" get put />
+		<property name="Size" get />
+	<comment>Methods</comment>
+		<method name="SaveAs">
+			<PARAMETER name="FileName"/>
+		</method>
+</public>
+
+<implements type="ASP" id="ASP2"/>
+
+<script language="VBScript">
+<![CDATA[
+
+Private m_strName
+Private m_strFile
+Private m_strMime
+Private m_binData
+
+'******************************************************
+'* Form Data Item Object
+'******************************************************
+Function get_Item(Name)
+	get_Item = Name
+End Function
+Function get_Name()
+	get_Name = m_strName
+End Function
+Function put_Name(NewName)
+	m_strName = NewName
+End Function
+Function get_File()
+	get_File = m_strFile
+End Function
+Function put_File(NewFile)
+	m_strFile = NewFile
+End Function
+Function get_Mime()
+	get_Mime = m_strMime
+End Function
+Function put_Mime(NewMime)
+	m_strMime = NewMime
+End Function
+Function get_Data()
+	If m_strMime = "" Then
+		Dim nCnt
+		Dim nLen
+		Dim nAsc
+		Dim nChr
+		nLen = LenB(m_binData)
+		For nCnt = 1 To nLen
+			nAsc = AscB(MidB(m_binData,nCnt,1))
+			If (&h81 <= nAsc And nAsc <= &h9F) Or (&hE0 <= nAsc And nAsc <= &hEF) Then
+				nChr = nAsc * 256 + AscB(MidB(m_binData,nCnt+1,1))
+				get_Data = get_Data & Chr(nChr)
+				nCnt = nCnt + 1
+			Else
+				get_Data = get_Data & Chr(AscB(MidB(m_binData,nCnt,1)))
+			End If
+		Next
+	Else
+		get_Data = m_binData
+	End If
+End Function
+Function put_Data(NewData)
+	m_binData = NewData
+End Function
+
+Function get_Size()
+	get_Size = LenB(m_binData)
+End Function
+
+Function SaveAs(FileName)
+	Const adLongVarBinary = 205
+	Const adTypeBinary = 1
+	Const adSaveCreateOverWrite = 2
+	Dim objStream
+	Dim objRecordset
+	Dim BinaryData
+
+	'On Error Resume Next
+	If LenB(m_binData) > 0 Then
+
+		' ADODB.Recordset �̃o�O�������b�N
+		m_binData = m_binData & ChrB(0)
+		' ADODB.Recordset �̃o�O�������b�N
+
+		Set objRecordset = CreateObject("ADODB.Recordset")
+		With objRecordset
+		.Fields.Append "UpLoadBinary", adLongVarBinary, LenB(m_binData)
+		.Open
+		.AddNew
+		End With
+		objRecordset("UpLoadBinary").AppendChunk m_binData
+		objRecordset.Update
+
+		Set objStream = CreateObject("ADODB.Stream")
+		objStream.Type = adTypeBinary
+		objStream.Open
+
+		' ADODB.Recordset �̃o�O�������b�N
+		' objStream.Write objRecordset.Fields("UpLoadBinary").Value
+		objStream.Write objRecordset.Fields("UpLoadBinary").GetChunk(LenB(m_binData)-1)
+		' ADODB.Recordset �̃o�O�������b�N
+
+		Err.Clear
+		objStream.SaveToFile FileName, adSaveCreateOverWrite
+		objStream.Close
+		Set objStream = Nothing
+
+		Set objRecordset = Nothing
+	Else
+		Exit Function
+	End If
+
+End Function
+
+]]>
+</script>
+</component>
+
+</package>
+