Facilitor/APPL/Shared/upload.inc

<% /*
     $Revision$
     $Id$
*/ %>
<script language="javascript" runat="Server">
function AlterCharset(str)
{
    // Door de IIS rewriter is de filenaam in de url utf-8 encoded
    // Zet dat hier terug om naar Windows-1252
    var fileStream = new ActiveXObject("ADODB.Stream");
    fileStream.Open();
    fileStream.Type = 2; // adTypeText
    fileStream.Charset = 'Windows-1252';
    fileStream.WriteText(str);
    fileStream.Position = 0;
    fileStream.Charset = 'utf-8';
    str1 = fileStream.ReadText(1000);
    fileStream.Close();
    if (escape(str) != escape(str1))
    {
        __Log("Stap 1: ik moest de filenaam converteren van {0} naar {1}".format(escape(str), escape(str1)));
    }

    // 'BAD Dé Arbeidsmediators.txt' waarbij de é als een e met Combining Acute Accent is gevormd
    // leidt uiteindelijk tot problemen bij de aanroepen van slnkdwf.dll/crypto/hex_sha1
    // daarom de volgende conversie die er een 'normale' é van lijkt te maken
    var objStreamISO = new ActiveXObject( "ADODB.Stream" );
    objStreamISO.Type = 2; // adTypeText
    objStreamISO.Charset = "Windows-1252"
    objStreamISO.Open
    objStreamISO.WriteText(str1);
    objStreamISO.Position = 0;
    var str2 = objStreamISO.ReadText(1000);
    objStreamISO.Close();
    if (escape(str1) != escape(str2))
    {
        __Log("Stap 2: ik moest de filenaam converteren van {0} naar {1}".format(escape(str1), escape(str2)));
    }

    return str2;
}
</script>
<script language="VBScript" runat="Server">
Sub BuildUploadRequest(RequestBin)
    'Get the boundary
    PosBeg = 1
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
    boundaryPos = InstrB(1,RequestBin,boundary)
    img_nr = 1
    '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 = AlterCharset(getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)))
            'Add filename to dictionary object
            UploadControl.Add "FileName", FileName
            Name = Name & img_nr
            img_nr = img_nr + 1
            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
        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)
dim i
 For i = 1 to Len(StringStr)
    char = Mid(StringStr,i,1)
    getByteString = getByteString & chrB(AscB(char))
 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

Function MultiByteToBinary(MultiByte)
  '© 2000 Antonin Foller, http://www.motobit.com
  ' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
  ' Using recordset
  Dim RS, LMultiByte, Binary
  Const adLongVarBinary = 205
  Set RS = CreateObject("ADODB.Recordset")
  LMultiByte = LenB(MultiByte)
  If LMultiByte>0 Then
    RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
    RS.Open
    RS.AddNew
      RS("mBinary").AppendChunk MultiByte & ChrB(0)
    RS.Update
    Binary = RS("mBinary").GetChunk(LMultiByte)
  Else
    Binary = ""
  End If
  MultiByteToBinary = Binary
End Function

</script>