ASDL#37188 Multifile upload eerst wat meer van VB-script naar Javascript halen

svn path=/Website/trunk/; revision=30461

APPL/Shared/UploadForm_save.asp

@@ -22,6 +22,7 @@ if (Server.ScriptTimeout < 600) Server.ScriptTimeout = 600; // 10 minuten moet e
 <!-- #include file="./flexfiles.inc" -->
 <!-- #include file="../Shared/upload.inc" -->
 <!-- #include file='../cad/cad_scan_dwf.inc' -->
+<!-- #include file="../Shared/json2.js" -->
 
 <%
 protectQS.verify(); // tamper check
@@ -57,7 +58,40 @@ function jslog(str) // VB Vindt de twee underscores niet leuk
 
   __Log("Opslaan onder: " + params.AttachPath);
 
-  var VB_result = VB_savefile(regFilter, params.AttachPath, (params.encrypt? 1 : 0));
+  var found_files = [];
+  function js_add_file(name, data, contenttype)
+  {
+    found_files.push({ name: name, data: data, contenttype: contenttype});
+  }
+
+  var VB_result = VB_getfiles();
+
+  // Obscuur: hier geen 'i' gebruiken omdat upload.inc/ getString die ook al gebruikt
+  //          Je krijgt daar dan 'Illegal Assignment', ik verzin het niet
+  for (var j = 0; j < found_files.length; j++)
+  {
+    var finfo = found_files[j];
+    var safefilename = safe.filename(finfo.name);
+    var BinaryStream = Server.CreateObject("ADODB.Stream");
+    BinaryStream.Type = 1; // adTypeBinary
+    BinaryStream.Open();
+    try
+    {
+      BinaryStream.Write(finfo.data);
+      // Save binary data To disk
+      __Log("Saving to: " + params.AttachPath + safefilename);
+      CreateFullPath(params.AttachPath);
+      BinaryStream.SaveToFile(params.AttachPath + safefilename, 2); // adSaveCreateOverWrite
+    }
+    catch(e)
+    {
+        HELP;
+    }
+
+
+  }
+__DoLog(found_files);
+Response.End;
   var result = { message: VB_result("message"),
                  safefilename: VB_result("safefilename")
                };
@@ -227,7 +261,9 @@ Public Function iso8601Date(dt)
     iso8601Date = s
 End Function
 
-Public Function VB_savefile(regFilter, fullpath, doEncrypt)
+' Vult via de (JavaScript) functie js_add_file de globale found_files
+' Verder doen we echt zo veel mogelijk in JavaScript
+Public Function VB_getfiles()
     Dim myErr
     Set result = Server.CreateObject("Scripting.Dictionary")
 
@@ -240,7 +276,7 @@ Public Function VB_savefile(regFilter, fullpath, doEncrypt)
     on error goto 0
     If myErr <> "" Then
         result.add "message", myErr
-        Set VB_savefile = result
+        Set VB_getfiles = result
         Exit Function
     End If
 
@@ -249,70 +285,9 @@ Public Function VB_savefile(regFilter, fullpath, doEncrypt)
 
     contentType = UploadRequest.Item("imgfile").Item("ContentType")
     filepathname = UploadRequest.Item("imgfile").Item("FileName")
+    value = MultiByteToBinary(UploadRequest.Item("imgfile").Item("Value"))
+    js_add_file filepathname, value, contentType
 
-    safefilename = safe.filename(Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))) '" //syntaxhighlight correctie
-
-    jslog "File: " & filepathname & " safe: " & safefilename
-
-    Set re = new regexp
-
-    re.Pattern = S("flexAllowedExt")
-    re.IgnoreCase = true
-    If Not re.test(safefilename) Then
-        result.add "message", L("lcl_shared_file_ext_not_allowed")
-        Set VB_savefile = result
-        Exit Function
-    End If
-
-    re.Pattern = regFilter
-    re.IgnoreCase = true
-    If Not re.test(safefilename) Then
-        result.add "message", L("lcl_shared_file_ext_invalid_start") & params.extFilter & L("lcl_shared_file_ext_invalid_end")
-        Set VB_savefile = result
-        Exit Function
-    End If
-
-    '' iPad/IPhone uploaden directe foto altijd als 'Image.jpg' wat erg lastig is
-    If LCase(safefilename) = "image.jpg" Or LCase(safefilename) = "image.jpeg" Then
-        safefilename = "Image " + iso8601Date(Now) + ".jpg"
-    End If
-
-    value = UploadRequest.Item("imgfile").Item("Value")
-
-    If value = "" Or filepathname = "" Then
-        result.add "message", "Empty file or name?"
-        Set VB_savefile = result
-        Exit Function
-    End If
-
-    on error resume next
-    CreateFullPath(fullpath)
-    myErr = Err.Description
-    on error goto 0
-    If myErr <> "" Then
-        result.add "message", myErr
-        Set VB_savefile = result
-        Exit Function
-    End If
-
-    If doEncrypt = "1" Then ''Encrypting
-        Set oZip = Server.CreateObject("SLNKDWF.Zip")
-        oZip.New(fullpath & safefilename & ".encrypted")
-        call oZip.EncryptFromString(safefilename, value)
-    Else
-      Set BinaryStream = Server.CreateObject("ADODB.Stream")
-      BinaryStream.Type = 1 '' adTypeBinary
-      BinaryStream.Open
-      on error resume next
-   	      BinaryStream.Write MultiByteToBinary(Value)
-          ''Save binary data To disk
-          jslog("Saving to: " & fullpath & safefilename)
-          BinaryStream.SaveToFile fullpath & safefilename, 2 '' adSaveCreateOverWrite
-          myErr = Err.Description
-      on error goto 0
-    End If
-    result.add "safefilename", safefilename
-    result.add "message", myErr
-    Set VB_savefile = result
+    Set VB_getfiles = result
 End Function
 </script>