web-dev-qa-db-ja.com

クラシックASPでのファイルのアップロード

私は常に次のスクリプトを使用してクラシックASPでファイルをアップロードしましたが、動作しなくなり、このエラーが発生しました

vbscriptランタイムエラー800a01a8
オブジェクトが必要です 'アイテム（...）'

私は少し調査しましたが、問題は関数BuildUploadRequestを含むファイルupload.aspにあると思いますが、本当に理由がわかりません

形

<form method="POST" action="landing-page.asp" ENCTYPE="multipart/form-data">
    <input type="file" name="file">
    <input type="hidden" name="key" value="0">
    <input type="submit" name="send" value="1">
</form>

フォームが表示されるページ

byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)

Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest(RequestBin)  '//function defined in upload.asp
if UploadRequest.Item("key").Item("Value")="0" then  '//this is the line giving the error
    '//code here...
end if

upload.asp

Sub BuildUploadRequest(RequestBin)
    PosBeg = 1  
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)    
    boundaryPos = InstrB(1,RequestBin,boundary)

    '//Get all data inside the boundaries
    Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
        '//Members variable of objects are put in a dictionary object
        Dim UploadControl
        Set UploadControl = CreateObject("Scripting.Dictionary")
        '//Get an object name
        Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
        Pos = InstrB(Pos,RequestBin,getByteString("name="))
        PosBeg = Pos+6
        PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
        Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
        PosBound = InstrB(PosEnd,RequestBin,boundary)
        '//Test if object is of file type
        If  PosFile<>0 AND (PosFile<PosBound) Then
            '//Get Filename, content-type and content of file
            PosBeg = PosFile + 10
            PosEnd =  InstrB(PosBeg,RequestBin,getByteString(chr(34)))
            FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            '//Add filename to dictionary object
            UploadControl.Add "FileName", FileName
            Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
            PosBeg = Pos+14
            PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
            '//Add content-type to dictionary object
            ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            UploadControl.Add "ContentType",ContentType
            '//Get content of object
            PosBeg = PosEnd+4
            PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
            Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
        Else
            '//Get content of object
            Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
            PosBeg = Pos+4
            PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
            Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        End If
        '//Add content to dictionary object
        UploadControl.Add "Value" , Value   
        '//Add dictionary object to main dictionary
        '//response.write name & "<br>"
        UploadRequest.Add name, UploadControl   
        '//Loop to next object
        BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop
End Sub

'//String to byte string conversion
Function getByteString(StringStr)
  For i = 1 to Len(StringStr)
    charx = Mid(StringStr,i,1)
    getByteString = getByteString & chrB(AscB(charx))
  Next
End Function

'//Byte string to string conversion
Function getString(StringBin)
 getString =""
 For intCount = 1 to LenB(StringBin)
    getString = getString & chr(AscB(MidB(StringBin,intCount,1))) 
 Next
End Function

このコードは常にすべてのプロジェクトで適切に機能してきましたが、今ではどこでも機能していません。別の関数を編集して使用することはできないので、なぜ機能しないのかを理解する必要があります

file-uploadvbscriptasp-classic
17
Mattia Nocerino

修正＃1-「IE310の累積的なセキュリティ更新プログラムKB3104002」をアンインストールします

修正＃2-すべてのバイト配列をバイト値の文字列にコピーしてそれに対して機能するか、または独自の反復を行うinstrbの代替を提供しますアレイ。

Function InstrBNew(startPos, inputArray, searchChar)

  if LenB(searchChar) = 1 Then
    Dim loc
    For loc = startPos to Lenb(inputArray)
      if MidB(inputArray, loc, 1) = searchChar then Exit For
    Next
    InstrBNew = loc
  Else
    InstrBNew = InstrB(startPos, inputArray, searchChar)
  End If
End Function

修正＃3-マイクロソフトは修正プログラムをリリースしました。これは2016年1月にすべての人に公開されます。ここで早く入手できます。 https://support.Microsoft.com/en-us/kb/3125446

問題は、vbScriptのInstrB関数が次の条件下で値1を返すようになっているようです。

  • バイト配列を検索するとき（Response.BinaryReadなど）。これは、ASPまたはVBScriptでは一般的ではありませんが、ファイルのアップロードは、そうした場合の1つです。
  • シングルバイトを検索しているとき

文字列を検索する場合、またはマルチバイトパターンを検索する場合、InstrBは正しく機能します。

PosEnd = InstrB(PosBeg, ByteArray, chrb(13))

壊れたシステムでは、位置1にバイト値13がない場合でも、この関数は常に1を返します。バイト配列を検索すると、どの値でも1を返します。古典的なASPファイルアップロードコンポーネントです。これが、このスレッドに全員が参加している理由です。デリミタを探してバイト配列を解析しているため、この状況に陥ります。

PosEnd = InstrB(PosBeg,ByteArray,getByteString("FormBoundary"))
PosEnd = InstrB(PosBeg,ByteArray,getByteString(vbCRLF))
PosEnd = InstrB(PosBeg,"Normal string", chrb(103)) ' Search for letter g in a string

これらの上記の行は、期待どおりに正常に機能します。マルチバイト検索と文字列に対する一致は期待どおりに機能します。

この問題は昨夜、複数のサーバーで同時に発生しました。 Windowsシステムのアップデートが昨夜も実行されているのを見ました。絞り込むと、MS15-124（IE11の累積的なセキュリティ更新プログラム）にvbscript.dllの更新プログラムが含まれていることがわかりました。このアップデートを削除すると、コードは正常に機能するようになります。

IEアップデートに含まれていたため、彼らの「IE Con​​nect」システムに問題を提出しましたが、それが正しい場所かどうかはわかりません。

テストケースを添付しました。壊れたシステムでは、「5、1、5」を返します。稼働中のシステムでは「5、5、5」を返します

修正を期待しています。この古いコードの一部は、アクセスできないシステムで実行されています。

' Test.vbs
Dim byteArray, byteArray2, byteArray3, bPosition
Dim responseText

' byte string
' "hello hello"
byteArray = chrb(104) & chrb(101) & chrb(108) & chrb(108) & chrb(111) & chrb(32) & chrb(104) & chrb(101) & chrb(108) & chrb(108) & chrb(111) & chrb(0)

' byte array - What Response.BinaryRead is
byteArray2 = TextToBytes(byteArray)

' Vartype: http://stackoverflow.com/questions/3281355/get-the-type-of-a-variable-in-vbscript
ResponseText = ResponseText + "blen: " & lenb(byteArray) & vbCRLF
ResponseText = ResponseText + "type: " & vartype(byteArray) & vbCRLF

ResponseText = ResponseText + "blen: " & lenb(byteArray2) & vbCRLF
ResponseText = ResponseText + "type: " & vartype(byteArray2) & vbCRLF

bPosition = instrb(1, byteArray, chrb(111))
ResponseText = ResponseText + "Position in string: " & bPosition & vbCRLF

bPosition = instrb(1, byteArray2, chrb(111))
ResponseText = ResponseText + "Position in byte array: " & bPosition & vbCRLF

bPosition = instrb(1, byteArray2, chrb(111) & chrb(32))
ResponseText = ResponseText + "Position in byte array: " & bPosition & vbCRLF

WScript.Echo ResponseText

' Converts a string (8) to a vbArray of bytes (8192 + 17)
' I'm not sure how else to create a vbArray of bytes. It does not seem to be a common data type in vbscript
Private Function TextToBytes(ByRef pbinBinaryData)
    Dim lobjRs
    Dim llngLength
    Dim lbinBuffer
    CONST adLongVarBinary = 205
    llngLength = LenB(pbinBinaryData)
    Set lobjRs = CreateObject("ADODB.Recordset")
    Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
    Call lobjRs.Open()
    Call lobjRs.AddNew()
    Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData)
    Call lobjRs.Update()
    lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
    Call lobjRs.Close()
    Set lobjRs = Nothing
    TextToBytes = lbinBuffer
End Function
21
Matt

クラシックASPでも同じ問題が発生しました。デバッガーで検証すべきではない（つまり、問題の文字が17の位置にある）と検証した場合でも、InStrBが突然1を返します。

InStrBの次の置換関数を作成しました（1文字を探すときにのみ使用）。私はくだらないVBSプログラマーなので、自由に片付けてください。しかし、それはうまくいくようです...

Private Function findCharInStrB(startPos, inputArray, searchChar)
  Dim loc
  For loc = startPos to Len(inputArray)
    if MidB(inputArray, loc, 1) = searchChar then Exit For
  Next
  findCharInStrB = loc
End Function
1
qeurylous2

マイクロソフトは、この問題を修正する修正プログラムをリリースしました。

https://support.Microsoft.com/en-us/kb/3125446

1
J Hansen

低担当者のため元のコメントに応答できませんが、通常のコントロールパネルの方法を使用して更新を削除できなかった場合（アンインストールのリストに表示されませんでした）は、ここにあります。 Powershellとコマンドラインでそれを行う方法：

「KB3104002 IE11の累積的なセキュリティ更新プログラム」をアンインストールするための一時的な回避策：

アップデートがインストールされているかどうかを確認するには、次の手順を実行します：

  1. Windowsキー（またはWindowsボタンを右クリックするなど）をタップし、「cmd」と入力してEnterキーを押します。
  2. 「powershell」と入力してEnterキーを押します。
  3. コマンド「get-hotfix -id KB3104002」を使用して、アップデートがインストールされているかどうかを確認します。この更新プログラムのインストール日が含まれている場合は、そのリストが返されます。

アップデートがインストールされている場合、続行します：

  1. まだPowerShellを使用している場合は、「exit」と入力して終了します。
  2. コマンド「wusa/uninstall/kb：3104002」を使用してパッチをアンインストールします
  3. リブート！

警告： KB3104002 は「重要なセキュリティ更新プログラム」としてリストされています Microsoftによると この更新を永久に無視することはお勧めしませんが、この更新の問題に対する一時的な解決策として原因、これは私がやることを選んだことです。マイクロソフトは、ASPコードがまだ使用されているために明らかに引き起こしている大虐殺に対処するこのアップデートのアップデートを発行する予定です。

0
user1969235

代わりにこのアップロードコード（ルイスモテンのクレジット）を試してください： http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8525&lngWId=4

最近、サイトを新しいバージョンのWindows Serverに移行するときに同じ問題に遭遇しました。代わりに、Lewis Motenのアップロードコードを使用して問題を修正しました。

リンクが切れた場合、コードは this answer にも投稿されます。

0
Keith