Solved

Can a form timeout - enctype error?

Posted on 2004-08-10
12
485 Views
Last Modified: 2008-02-01
I have a simple form that updates a record and uploads an image file.  My client (on a 30kbps dial-up connection) seems to get errors "Form was submitted with no ENCTYPE="multipart/form-data"" even though this is specified in the form itself.  This happens whether she tries to upload an image or not and intermittantly.

She is using IE6 and Windows XP, I cannot work out what would cause this - apart from the form data 'timing out'.
0
Comment
Question by:Orroland
  • 6
  • 6
12 Comments
 
LVL 46

Accepted Solution

by:
fritz_the_blank earned 500 total points
Comment Utility
The form has no timeout property, so that can't be it....

FtB
0
 
LVL 46

Expert Comment

by:fritz_the_blank
Comment Utility
I am not sure this is correct, but:

http://www.dmxzone.com/ShowDetail.asp?NewsId=477

FtB
0
 

Author Comment

by:Orroland
Comment Utility
any ideas...?
0
 
LVL 46

Expert Comment

by:fritz_the_blank
Comment Utility
Take a look at my second post to see if that makes any sense.

The only other thing that I can think of, and this is pure speculation, is that the data being sent from the client to the server is getting garbled and then it throws the error.

FtB
0
 

Author Comment

by:Orroland
Comment Utility
Thanks for the link - this is not the problem.

I suppose that I just have to go there and eliminate 'human error'!
0
 
LVL 46

Expert Comment

by:fritz_the_blank
Comment Utility
May I have the code for that please?

;->

If this is the only person having that problem, and this person is using a modem, there could be a number of factors such as a noisy line, and etc. Again, this is pure speculation.

FtB
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:Orroland
Comment Utility
Yes, they are using a modem.  Their connection is very poor - and the problem is intermittant.  The code for the upload page - the two include files in the next post:

<%@LANGUAGE="VBSCRIPT"%>
<!--#include file="../Connections/broomtacklebox.asp" -->
<!--#include file="../ScriptLibrary/incResizeAddOn.asp" -->
<!--#include file="../ScriptLibrary/incPureUpload.asp" -->
<%
'*** Pure ASP File Upload -----------------------------------------------------
' Copyright (c) 2001-2002 George Petrov, www.UDzone.com
' Process the upload
' Version: 2.0.9
'------------------------------------------------------------------------------
'*** File Upload to: """../uploads""", Extensions: "JPG,JPEG", Form: form1, Redirect: "", "file", "", "uniq", "false", "", "" , "", "", "", "", "600", "", "", ""

Dim GP_redirectPage, RequestBin, UploadQueryString, GP_uploadAction, UploadRequest
PureUploadSetup

If (CStr(Request.QueryString("GP_upload")) <> "") Then
  on error resume next
  Dim reqPureUploadVersion, foundPureUploadVersion
  reqPureUploadVersion = 2.09
  foundPureUploadVersion = getPureUploadVersion()
  if err or reqPureUploadVersion > foundPureUploadVersion then
    Response.Write "<strong>You don't have latest version of ScriptLibrary/incPureUpload.asp uploaded on the server.</strong><br>"
    Response.Write "This library is required for the current page. It is fully backwards compatible so old pages will work as well.<br>"
    Response.End    
  end if
  on error goto 0
  GP_redirectPage = ""
  Server.ScriptTimeout = 600
 
  RequestBin = Request.BinaryRead(Request.TotalBytes)
  Set UploadRequest = CreateObject("Scripting.Dictionary")  
  BuildUploadRequest RequestBin, """../uploads""", "file", "", "uniq"
 
  If (GP_redirectPage <> "" and not (CStr(UploadFormRequest("MM_insert")) <> "" or CStr(UploadFormRequest("MM_update")) <> "")) Then
    If (InStr(1, GP_redirectPage, "?", vbTextCompare) = 0 And UploadQueryString <> "") Then
      GP_redirectPage = GP_redirectPage & "?" & UploadQueryString
    End If
    Response.Redirect(GP_redirectPage)  
  end if  
else
  if UploadQueryString <> "" then
    UploadQueryString = UploadQueryString & "&GP_upload=true"
  else  
    UploadQueryString = "GP_upload=true"
  end if  
end if
' End Pure Upload
'------------------------------------------------------------------------------
%>
<%
' *** Smart Image Processor 1.0.7
If (CStr(Request.QueryString("GP_upload")) <> "") Then
  Dim RUF_Component, RUF_DotNetResize, RUF_path, RUF_ResizeImages, RUF_maxWidth, RUF_maxHeight, RUF_Quality, RUF_MakeThumb, RUF_Suffix, RUF_maxWidthThumb, RUF_maxHeightThumb, RUF_QualityThumb, RUF_RedirectURL
  RUF_Component = "AUTO"
  RUF_DotNetResize = "../ScriptLibrary/ResizeImage.aspx"
  RUF_path = "../uploads"
  RUF_ResizeImages = true
  RUF_maxWidth = "300"
  RUF_maxHeight = "300"  
  RUF_Quality = "80"
  RUF_MakeThumb = true
  RUF_Suffix = "_small"
  RUF_maxWidthThumb = "100"
  RUF_maxHeightThumb = "100"
  RUF_QualityThumb = "70"
  RUF_RedirectURL = ""
  if RUF_ResizeImages then
    ResizeUploadedFiles RUF_Component, RUF_DotNetResize, RUF_path, "", RUF_maxWidth, RUF_maxHeight, RUF_Quality, true
  end if
  if RUF_MakeThumb then
    ResizeUploadedFiles RUF_Component, RUF_DotNetResize, RUF_path, RUF_Suffix, RUF_maxWidthThumb, RUF_maxHeightThumb, RUF_QualityThumb, false
  end if
  if RUF_RedirectURL <> "" then
    Response.Redirect RUF_RedirectURL
  end if
end if
%>
<%
' *** Edit Operations: (Modified for File Upload) declare variables

Dim MM_editAction
Dim MM_abortEdit
Dim MM_editQuery
Dim MM_editCmd

Dim MM_editConnection
Dim MM_editTable
Dim MM_editRedirectUrl
Dim MM_editColumn
Dim MM_recordId

Dim MM_fieldsStr
Dim MM_columnsStr
Dim MM_fields
Dim MM_columns
Dim MM_typeArray
Dim MM_formVal
Dim MM_delim
Dim MM_altVal
Dim MM_emptyVal
Dim MM_i

MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME"))
If (UploadQueryString <> "") Then
  MM_editAction = MM_editAction & "?" & Server.HTMLEncode(UploadQueryString)
End If

' boolean to abort record edit
MM_abortEdit = false

' query string to execute
MM_editQuery = ""
%>
<%
' *** Update Record: (Modified for File Upload) set variables

If (CStr(UploadFormRequest("MM_update")) = "form1" And CStr(UploadFormRequest("MM_recordId")) <> "") Then

  MM_editConnection = MM_broomtacklebox_STRING
  MM_editTable = "manufacturers"
  MM_editColumn = "manufacturerID"
  MM_recordId = "" + UploadFormRequest("MM_recordId") + ""
  MM_editRedirectUrl = "manufacturers_edit_list.asp"
  MM_fieldsStr  = "manufacturername|value|manufacturerimage|value|manufacturerdescription|value|manufacturerhome|value"
  MM_columnsStr = "manufacturername|',none,''|manufacturerimage|',none,''|manufacturerdescription|',none,''|manufacturerhome|none,'1','0'"

  ' create the MM_fields and MM_columns arrays
  MM_columnsStr = FixColumnsForUpload(MM_fieldsStr,MM_columnsStr)
  MM_fieldsStr = FixFieldsForUpload(MM_fieldsStr,MM_columnsStr)
  MM_fields = Split(MM_fieldsStr, "|")
  MM_columns = Split(MM_columnsStr, "|")
 
  ' set the form values
  For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
    MM_fields(MM_i+1) = CStr(UploadFormRequest(MM_fields(MM_i)))
  Next

  ' append the query string to the redirect URL
  If (MM_editRedirectUrl <> "" And UploadQueryString <> "") Then
    If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0 And UploadQueryString <> "") Then
      MM_editRedirectUrl = MM_editRedirectUrl & "?" & UploadQueryString
    Else
      MM_editRedirectUrl = MM_editRedirectUrl & "&" & UploadQueryString
    End If
  End If

End If
%>
<%
' *** Update Record: (Modified for File Upload) construct a sql update statement and execute it

If (CStr(UploadFormRequest("MM_update")) <> "" And CStr(UploadFormRequest("MM_recordId")) <> "") Then

  ' create the sql update statement
  MM_editQuery = "update " & MM_editTable & " set "
  For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
    MM_formVal = MM_fields(MM_i+1)
    MM_typeArray = Split(MM_columns(MM_i+1),",")
    MM_delim = MM_typeArray(0)
    If (MM_delim = "none") Then MM_delim = ""
    MM_altVal = MM_typeArray(1)
    If (MM_altVal = "none") Then MM_altVal = ""
    MM_emptyVal = MM_typeArray(2)
    If (MM_emptyVal = "none") Then MM_emptyVal = ""
    If (MM_formVal = "") Then
      MM_formVal = MM_emptyVal
    Else
      If (MM_altVal <> "") Then
        MM_formVal = MM_altVal
      ElseIf (MM_delim = "'") Then  ' escape quotes
        MM_formVal = "'" & Replace(MM_formVal,"'","''") & "'"
      Else
        MM_formVal = MM_delim + MM_formVal + MM_delim
      End If
    End If
    If (MM_i <> LBound(MM_fields)) Then
      MM_editQuery = MM_editQuery & ","
    End If
    MM_editQuery = MM_editQuery & MM_columns(MM_i) & " = " & MM_formVal
  Next
  MM_editQuery = MM_editQuery & " where " & MM_editColumn & " = " & MM_recordId

  If (Not MM_abortEdit) Then
    ' execute the update
    Set MM_editCmd = Server.CreateObject("ADODB.Command")
    MM_editCmd.ActiveConnection = MM_editConnection
    MM_editCmd.CommandText = MM_editQuery
    MM_editCmd.Execute
    MM_editCmd.ActiveConnection.Close

    If (MM_editRedirectUrl <> "") Then
      Response.Redirect(MM_editRedirectUrl)
    End If
  End If

End If
%>
<%
Dim manufacturers__MMColParam
manufacturers__MMColParam = "1"
If (Request.QueryString("manufacturerID") <> "") Then
  manufacturers__MMColParam = Request.QueryString("manufacturerID")
End If
%>
<%
Dim manufacturers
Dim manufacturers_numRows

Set manufacturers = Server.CreateObject("ADODB.Recordset")
manufacturers.ActiveConnection = MM_broomtacklebox_STRING
manufacturers.Source = "SELECT * FROM manufacturers WHERE manufacturerID = " + Replace(manufacturers__MMColParam, "'", "''") + ""
manufacturers.CursorType = 0
manufacturers.CursorLocation = 2
manufacturers.LockType = 1
manufacturers.Open()

manufacturers_numRows = 0
%>
<%
' *** Restrict Access To Page: Grant or deny access to this page
MM_authorizedUsers="broomtackleboxadmin"
MM_authFailedURL="login_fail.asp"
MM_grantAccess=false
If Request.Cookies("MM_Username") <> "" Then
  If (false Or CStr(Request.Cookies("MM_UserAuthorization"))="") Or _
         (InStr(1,MM_authorizedUsers,Request.Cookies("MM_UserAuthorization"))>=1) Then
    MM_grantAccess = true
  End If
End If
If Not MM_grantAccess Then
  MM_qsChar = "?"
  If (InStr(1,MM_authFailedURL,"?") >= 1) Then MM_qsChar = "&"
  MM_referrer = Request.ServerVariables("URL")
  if (Len(Request.QueryString()) > 0) Then MM_referrer = MM_referrer & "?" & Request.QueryString()
  MM_authFailedURL = MM_authFailedURL & MM_qsChar & "accessdenied=" & Server.URLEncode(MM_referrer)
  Response.Redirect(MM_authFailedURL)
End If
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html><!-- InstanceBegin template="/Templates/admin.dwt.asp" codeOutsideHTMLIsLocked="false" -->
<head>
<!-- InstanceBeginEditable name="doctitle" -->
<title>Broom Tackle Box - web site admin centre</title>
<!-- InstanceEndEditable -->
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<!-- InstanceBeginEditable name="head" --><!-- InstanceEndEditable -->
<meta name="author" content="SuperWebs Ltd - www.superwebs.co.uk" />
<script type="text/javascript" language="javascript" src="../Templates/navigation_admin.js">
function checkFileUpload(form,extensions,requireUpload,sizeLimit,minWidth,minHeight,maxWidth,maxHeight,saveWidth,saveHeight) { //v2.09
  document.MM_returnValue = true;
  for (var i = 0; i<form.elements.length; i++) {
    field = form.elements[i];
    if (field.type.toUpperCase() != 'FILE') continue;
    checkOneFileUpload(field,extensions,requireUpload,sizeLimit,minWidth,minHeight,maxWidth,maxHeight,saveWidth,saveHeight);
} }

function checkOneFileUpload(field,extensions,requireUpload,sizeLimit,minWidth,minHeight,maxWidth,maxHeight,saveWidth,saveHeight) { //v2.09
  document.MM_returnValue = true;
  if (extensions != '') var re = new RegExp("\.(" + extensions.replace(/,/gi,"|").replace(/\s/gi,"") + ")$","i");
    if (field.value == '') {
      if (requireUpload) {alert('File is required!');document.MM_returnValue = false;field.focus();return;}
    } else {
      if(extensions != '' && !re.test(field.value)) {
        alert('This file type is not allowed for uploading.\nOnly the following file extensions are allowed: ' + extensions + '.\nPlease select another file and try again.');
        document.MM_returnValue = false;field.focus();return;
      }
    document.PU_uploadForm = field.form;
    re = new RegExp(".(gif|jpg|png|bmp|jpeg)$","i");
    if(re.test(field.value) && (sizeLimit != '' || minWidth != '' || minHeight != '' || maxWidth != '' || maxHeight != '' || saveWidth != '' || saveHeight != '')) {
      checkImageDimensions(field,sizeLimit,minWidth,minHeight,maxWidth,maxHeight,saveWidth,saveHeight);
    } }
}

function showImageDimensions(fieldImg) { //v2.09
  var isNS6 = (!document.all && document.getElementById ? true : false);
  var img = (fieldImg && !isNS6 ? fieldImg : this);
  if (img.width > 0 && img.height > 0) {
  if ((img.minWidth != '' && img.minWidth > img.width) || (img.minHeight != '' && img.minHeight > img.height)) {
    alert('Uploaded Image is too small!\nShould be at least ' + img.minWidth + ' x ' + img.minHeight); return;}
  if ((img.maxWidth != '' && img.width > img.maxWidth) || (img.maxHeight != '' && img.height > img.maxHeight)) {
    alert('Uploaded Image is too big!\nShould be max ' + img.maxWidth + ' x ' + img.maxHeight); return;}
  if (img.sizeLimit != '' && img.fileSize > img.sizeLimit) {
    alert('Uploaded Image File Size is too big!\nShould be max ' + (img.sizeLimit/1024) + ' KBytes'); return;}
  if (img.saveWidth != '') document.PU_uploadForm[img.saveWidth].value = img.width;
  if (img.saveHeight != '') document.PU_uploadForm[img.saveHeight].value = img.height;
  document.MM_returnValue = true;
} }

function checkImageDimensions(field,sizeL,minW,minH,maxW,maxH,saveW,saveH) { //v2.09
  if (!document.layers) {
    var isNS6 = (!document.all && document.getElementById ? true : false);
    document.MM_returnValue = false; var imgURL = 'file:///' + field.value.replace(/\\/gi,'/').replace(/:/gi,'|').replace(/"/gi,'').replace(/^\//,'');
    if (!field.gp_img || (field.gp_img && field.gp_img.src != imgURL) || isNS6) {field.gp_img = new Image();
               with (field) {gp_img.sizeLimit = sizeL*1024; gp_img.minWidth = minW; gp_img.minHeight = minH; gp_img.maxWidth = maxW; gp_img.maxHeight = maxH;
           gp_img.saveWidth = saveW; gp_img.saveHeight = saveH; gp_img.onload = showImageDimensions; gp_img.src = imgURL; }
       } else showImageDimensions(field.gp_img);}
}
</script>
<link href="../css/broomtacklebox.css" rel="stylesheet" type="text/css">
<meta name="robots" content="NOINDEX" />
</head>

<body onLoad="initSwipeMenu()" onUnload="macGo()">
<table width="100%" border="0" bgcolor="#FFFFFF" class="main_table">
  <tr>
    <td class="arial24">BROOM TACKLE BOX - WEB SITE ADMIN CENTRE</td>
  </tr>
  <tr>
    <td><img src="../images/dot-green.gif" width="100%" height="2"></td>
  </tr>
  <tr>
    <td class="arial24"><img src="../images/shim.gif" width="24" height="24">
        <div id="imageHolder" name="SMBxx" style="position:absolute; width:1px; z-index:0; visibility: hidden; left: 0px; top: 0px"> <img src="" width="1" height="1"> <img src="" width="1" height="1"> <img src="" width="1" height="1"> <img src="" width="1" height="1"> </div></td>
  </tr>
  <tr>
    <td valign="top"> <!-- #BeginEditable "main" -->
      <table width="100%" border="0">
        <tr>
          <td valign="top"><p class="arial14"><strong>&gt;&gt;<a href="admin_centre.asp">Admin centre</a> &gt;&gt;Edit  manufacturers</strong></p>
                  <form action="<%=MM_editAction%>" method="POST" enctype="multipart/form-data" name="form1">
            <table width="100%" align="center">
              <tr align="left" valign="baseline" class="arial12">
                <td colspan="2" nowrap>Manufacturer name:<br>
                  <input name="manufacturername" type="text" class="fullwidth" value="<%=(manufacturers.Fields.Item("manufacturername").Value)%>" size="32">                </td>
                </tr>
              <tr align="left" valign="baseline" class="arial12">
                <td width="5%" nowrap>Image:</td>
                <td width="95%">                  <input name="manufacturerimage" type="file" id="manufacturerimage" value="<%=(manufacturers.Fields.Item("manufacturerimage").Value)%>"></td>
              </tr>
              <tr align="left" valign="baseline" class="arial12">
                <td colspan="2" nowrap><input name="manufacturerhome" class="checkbox" type="checkbox" id="manufacturerhome" value="checkbox" <% If (manufacturers.Fields.Item("manufacturerhome").Value) =  true then Response.Write("checked=""checked""") : Response.Write("") %> >
                  <label for="manufacturerhome">Show on home page</label></td>
                </tr>
              <tr align="left" valign="baseline" class="arial12">
                <td colspan="2" nowrap>
                  <textarea name="manufacturerdescription" cols="32"><%=(manufacturers.Fields.Item("manufacturerdescription").Value)%></textarea>
                        <script language="JavaScript1.2" defer>
var config = new Object();
config.toolbar = [
//    ['fontname'],
//    ['fontsize'],
//    ['fontstyle'],
//    ['linebreak'],
    ['bold','italic','underline','separator'],
//  ['strikethrough','subscript','superscript','separator'],
    ['justifyleft','justifycenter','justifyright','separator'],
    ['OrderedList','UnOrderedList','Outdent','Indent','separator'],
    ['forecolor','backcolor','separator'],
    ['HorizontalRule','Createlink'],
//    ['about'],
];
config.width = "95%";
config.height = "100px";
config.bodyStyle = 'background-color: white; font-family: "Verdana"; font-size: 12px;';
editor_generate('manufacturerdescription',config);

</script>                  </td>
                </tr>
              <tr align="left" valign="baseline" class="arial12">
                <td colspan="2" nowrap>
                  <input type="submit" value="Save">
                          <input type="button" name="Button" value="Delete" onClick="go_URL('manufacturers_delete.asp?manufacturerID=<%= manufacturers.Fields.Item("manufacturerID").Value %>')">
                                          </td>
                </tr>
            </table>
           
            <input type="hidden" name="MM_update" value="form1">
            <input type="hidden" name="MM_recordId" value="<%= manufacturers.Fields.Item("manufacturerID").Value %>">
            </form>
          <p>&nbsp;</p></td>
        </tr>
      </table>
    <!-- #EndEditable --></td>
  </tr>
  <tr>
    <td height="2"><img src="../images/dot-green.gif" width="100%" height="2"></td>
  </tr>
  <tr>
    <td align="center" class="arial12">
      <p>&copy; Broom Tackle Box <%=year(date)%>. All Rights Reserved.</p>
    <p>Designed by <a href="http://www.superwebs.co.uk" target="_blank">SuperWebs</a></p></td>
  </tr>
</table>
</body>
<!-- InstanceEnd --></html>
<%
manufacturers.Close()
Set manufacturers = Nothing
%>
0
 

Author Comment

by:Orroland
Comment Utility
incPureUpload.asp:

<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">
'*** Pure ASP File Upload -----------------------------------------------------
' Copyright 2001-2002 (c) George Petrov, www.UDzone.com
'
' Script partially based on code from Philippe Collignon
'              (http://www.asptoday.com/articles/20000316.htm)
'
' New features added:
'  * Fast file save with ADO 2.5 stream object
'  * new file handling, wrapper functions, extra error checking
'  * UltraDev Server Behavior extension
'  * Progress bars, file limit checking, file type checking, file existence checking
'  * Support for UltraDev Insert/Update Server Behavior
'  * and much more ...
'
' Version: 2.0.9
'------------------------------------------------------------------------------
Function getPureUploadVersion()
  getPureUploadVersion = 2.09
End Function

Sub BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)

  Dim PosBeg, PosEnd, checkADOConn, AdoVersion, Length, boundary, boundaryPos, Pos
  Dim PosFile, Name, PosBound, FileName, ContentType, Value, ValueBeg, ValueEnd, ValueLen
 
  'Get the boundary
  PosBeg = 1
  PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
  if PosEnd = 0 then
    Response.Write "<strong>Form was submitted with no ENCTYPE=""multipart/form-data""</strong><br>"
    Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"    
    Response.End
  end if
  'Check ADO Version
      set checkADOConn = Server.CreateObject("ADODB.Connection")
  on error resume next
      adoVersion = CSng(checkADOConn.Version)
      if err then
            adoVersion = Replace(checkADOConn.Version,".",",")  
            adoVersion = CSng(adoVersion)
      end if      
        err.clear
  on error goto 0      
      set checkADOConn = Nothing
      if adoVersion < 2.5 then
    Response.Write "<strong>You don't have ADO 2.5 installed on the server.</strong><br>"
    Response.Write "The File Upload extension needs ADO 2.5 or greater to run properly.<br>"
    Response.Write "You can download the latest MDAC (ADO is included) from <a href=""www.microsoft.com/data"">www.microsoft.com/data</a><br>"
    Response.End
      end if            
  'Check content length if needed
      Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
      If "" & sizeLimit <> "" Then
    sizeLimit = CLng(sizeLimit) * 1024
    If Length > sizeLimit Then
      Request.BinaryRead (Length)
      Response.Write "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(sizeLimit, 0) & "B"
      Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"      
      Response.End
    End If
  End If
  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 = LCase(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))
      FileName = RemoveInvalidChars(Mid(FileName,InStrRev(FileName,"\")+1))
      '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 = FileName
      ValueBeg = PosBeg-1
      ValueLen = 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))
      ValueBeg = 0
      ValueEnd = 0
    End If
    'Add content to dictionary object
    UploadControl.Add "Value" , Value      
    UploadControl.Add "ValueBeg" , ValueBeg
    UploadControl.Add "ValueLen" , ValueLen      
    'Add dictionary object to main dictionary
    if UploadRequest.Exists(name) then
      UploadRequest(name).Item("Value") = UploadRequest(name).Item("Value") & "," & Value
    else
      UploadRequest.Add name, UploadControl
    end if    
    'Loop to next object
    BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
  Loop

  Dim GP_keys, GP_i, GP_curKey, GP_value, GP_valueBeg, GP_valueLen, GP_curPath, GP_FullPath
  Dim GP_CurFileName, GP_FullFileName, fso, GP_BegFolder, GP_RelFolder, GP_FileExist, Begin_Name_Num
  Dim orgUploadDirectory
   
  if InStr(UploadDirectory,"""") > 0 then
    on error resume next
    orgUploadDirectory = UploadDirectory
    UploadDirectory = eval(UploadDirectory)  
    if err then
      Response.Write "<B>Upload folder is invalid</B><br><br>"      
      Response.Write "Upload Folder: " & Trim(orgUploadDirectory) & "<br>"
      Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
              err.clear
           response.End
    end if    
    on error goto 0
  end if  
 
  GP_keys = UploadRequest.Keys
  for GP_i = 0 to UploadRequest.Count - 1
    GP_curKey = GP_keys(GP_i)
    'Save all uploaded files
    if UploadRequest.Item(GP_curKey).Item("FileName") <> "" then
      GP_value = UploadRequest.Item(GP_curKey).Item("Value")
      GP_valueBeg = UploadRequest.Item(GP_curKey).Item("ValueBeg")
      GP_valueLen = UploadRequest.Item(GP_curKey).Item("ValueLen")

      'Get the path
      if InStr(UploadDirectory,"\") > 0 then
        GP_curPath = UploadDirectory
        if Mid(GP_curPath,Len(GP_curPath),1)  <> "\" then
          GP_curPath = GP_curPath & "\"
        end if        
        GP_FullPath = GP_curPath
      else
        GP_curPath = Request.ServerVariables("PATH_INFO")
        GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & UploadDirectory)
        if Mid(GP_curPath,Len(GP_curPath),1)  <> "/" then
          GP_curPath = GP_curPath & "/"
        end if
        GP_FullPath = Trim(Server.mappath(GP_curPath))
      end if

     
      if GP_valueLen = 0 then
        Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
        Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"
        Response.Write "File does not exists or is empty.<br>"
        Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
                response.End
          end if
     
      'Create a Stream instance
      Dim GP_strm1, GP_strm2
      Set GP_strm1 = Server.CreateObject("ADODB.Stream")
      Set GP_strm2 = Server.CreateObject("ADODB.Stream")
     
      'Open the stream
      GP_strm1.Open
      GP_strm1.Type = 1 'Binary
      GP_strm2.Open
      GP_strm2.Type = 1 'Binary
       
      GP_strm1.Write RequestBin
      GP_strm1.Position = GP_ValueBeg
      GP_strm1.CopyTo GP_strm2,GP_ValueLen
   
      'Create and Write to a File
      GP_CurFileName = UploadRequest.Item(GP_curKey).Item("FileName")      
      GP_FullFileName = GP_FullPath & "\" & GP_CurFileName
      Set fso = CreateObject("Scripting.FileSystemObject")
      'Check if the folder exist
      If NOT fso.FolderExists(GP_FullPath) Then
        GP_BegFolder = InStr(GP_FullPath,"\")
        while GP_begFolder > 0
          GP_RelFolder = Mid(GP_FullPath,1,GP_BegFolder-1)
          If NOT fso.FolderExists(GP_RelFolder) Then  
            fso.CreateFolder(GP_RelFolder)
          end if          
          GP_BegFolder = InStr(GP_BegFolder+1,GP_FullPath,"\")          
        wend
        If NOT fso.FolderExists(GP_FullPath) Then        
          fso.CreateFolder(GP_FullPath)        
        end if  
      end if
      'Check if the file already exist
      GP_FileExist = false
      If fso.FileExists(GP_FullFileName) Then
        GP_FileExist = true
      End If      
      if nameConflict = "error" and GP_FileExist then
        Response.Write "<B>File already exists!</B><br><br>"
        Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
                        GP_strm1.Close
                        GP_strm2.Close
                response.End
      end if
      if ((nameConflict = "over" or nameConflict = "uniq") and GP_FileExist) or (NOT GP_FileExist) then
        if nameConflict = "uniq" and GP_FileExist then
          Begin_Name_Num = 0
          while GP_FileExist    
            Begin_Name_Num = Begin_Name_Num + 1
            GP_FullFileName = Trim(GP_FullPath)& "\" & fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
            GP_FileExist = fso.FileExists(GP_FullFileName)
          wend  
          UploadRequest.Item(GP_curKey).Item("FileName") = fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
                              UploadRequest.Item(GP_curKey).Item("Value") = UploadRequest.Item(GP_curKey).Item("FileName")
        end if
        on error resume next
        GP_strm2.SaveToFile GP_FullFileName,2
        if err then
          Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
          Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"
          Response.Write "Maybe the destination directory does not exist, or you don't have write permission.<br>"
          Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
                  err.clear
                          GP_strm1.Close
                          GP_strm2.Close
                  response.End
            end if
                    GP_strm1.Close
                    GP_strm2.Close
                    if storeType = "path" then
                          UploadRequest.Item(GP_curKey).Item("Value") = GP_curPath & UploadRequest.Item(GP_curKey).Item("Value")
                    end if
        on error goto 0
      end if
    end if
  next

End Sub

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

'Byte string to string conversion (with double-byte support now)
Function getString(StringBin)
  Dim intCount,get1Byte
  getString =""
  For intCount = 1 to LenB(StringBin)
    get1Byte = MidB(StringBin,intCount,1)
    getString = getString & chr(AscB(get1Byte))
  Next
End Function

Function UploadFormRequest(name)
  Dim keyName
  keyName = LCase(name)
  if IsObject(UploadRequest) then
    if UploadRequest.Exists(keyName) then
      if UploadRequest.Item(keyName).Exists("Value") then
        UploadFormRequest = UploadRequest.Item(keyName).Item("Value")
      end if  
    end if  
  end if  
End Function

Function RemoveInvalidChars(str)
  Dim newStr, ci, curChar
  for ci = 1 to Len(str)
    curChar = Asc(LCase(Mid(str,ci,1)))
    if curChar = 95 or curChar = 45 or curChar = 46 or (curChar >= 97 and curChar <= 122) or (curChar >= 48 and curChar <= 57) then
      newStr = newStr & Mid(str,ci,1)
    end if
  next
  RemoveInvalidChars = newStr
End Function

Sub PureUploadSetup()
  UploadQueryString = Replace(Request.QueryString,"GP_upload=true","")
  if mid(UploadQueryString,1,1) = "&" then
        UploadQueryString = Mid(UploadQueryString,2)
  end if
  GP_uploadAction = CStr(Request.ServerVariables("URL")) & "?GP_upload=true"
  If (Request.QueryString <> "") Then  
    if UploadQueryString <> "" then
          GP_uploadAction = GP_uploadAction & "&" & UploadQueryString
    end if
  End If
End Sub

Function FixFieldsForUpload(GP_fieldsStr, GP_columnsStr)
  Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_FieldValue, GP_CurFileName, GP_CurContentType

  GP_Fields = Split(GP_fieldsStr, "|")
  GP_Columns = Split(GP_columnsStr, "|")
  GP_fieldsStr = ""
  ' Get the form values
  For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
    GP_FieldName = LCase(GP_Fields(GP_counter))
    GP_FieldValue = GP_Fields(GP_counter+1)
        if UploadRequest.Exists(GP_FieldName) then
      GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
      GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")
        else  
          GP_CurFileName = ""
          GP_CurContentType = ""
        end if      
    if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
      GP_fieldsStr = GP_fieldsStr & GP_FieldName & "|" & GP_FieldValue & "|"
    end if
  Next
  if GP_fieldsStr <> "" then
    GP_fieldsStr = Mid(GP_fieldsStr,1,Len(GP_fieldsStr)-1)
  else  
    Response.Write "<B>An error has occured during record update!</B><br><br>"
    Response.Write "There are no fields to update ...<br>"
    Response.Write "If the file upload field is the only field on your form, you should make it required.<br>"
    Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
    Response.End
  end if
 
  FixFieldsForUpload = GP_fieldsStr    
End Function

Function FixColumnsForUpload(GP_fieldsStr, GP_columnsStr)
  Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_ColumnName, GP_ColumnValue,GP_CurFileName, GP_CurContentType

  GP_Fields = Split(GP_fieldsStr, "|")
  GP_Columns = Split(GP_columnsStr, "|")
  GP_columnsStr = ""
  ' Get the form values
  For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
    GP_FieldName = LCase(GP_Fields(GP_counter))  
    GP_ColumnName = GP_Columns(GP_counter)  
    GP_ColumnValue = GP_Columns(GP_counter+1)
        if UploadRequest.Exists(GP_FieldName) then
          GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
          GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")       
        else  
          GP_CurFileName = ""
          GP_CurContentType = ""
        end if  
    if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
      GP_columnsStr = GP_columnsStr & GP_ColumnName & "|" & GP_ColumnValue & "|"
    end if
  Next
  if GP_columnsStr <> "" then
    GP_columnsStr = Mid(GP_columnsStr,1,Len(GP_columnsStr)-1)    
  end if
  FixColumnsForUpload = GP_columnsStr
End Function

</SCRIPT>
0
 

Author Comment

by:Orroland
Comment Utility
incResizeAddOn.asp:

<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">
'*** Resize Files After Upload -----------------------------------------------
' Copyright 2001-2002 (c) George Petrov, www.DMXzone.com
'
' Version: 1.0.9
'------------------------------------------------------------------------------

sub FitImage_Comp(compType,DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality)
  select case compType
  case "AUTO"
    FitImage_Comp DetectImageComponent(DotNetResize),DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "PICPROC"
    FitImage_PicProc imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "ASPJPEG"
    FitImage_AspJpeg imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "ASPIMAGE"
    FitImage_AspImage imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "ASPSMART"
    FitImage_AspSmart imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "IMGWRITER"
    FitImage_ImgWriter imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "ASPTHUMB"
    FitImage_AspThumb imgFile,newImgFile,maxWidth,maxHeight,Quality
  case "ASP.NET"
    select case DetectDotNetComponent(DotNetResize)
    case "DOTNET1"
      FitImage_DotNet "Msxml2.ServerXMLHTTP.4.0",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality
    case "DOTNET2"
      FitImage_DotNet "Msxml2.ServerXMLHTTP",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality
    case "DOTNET3"
      FitImage_DotNet "Microsoft.XMLHTTP",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality
    end select
  end select
end sub

function DetectImageComponent(DotNetResize)
  Dim objPictureProcessor, objASPjpeg, AspImage, AspSmart, objImgWriter, objAspThumb, ImageComponent
  ImageComponent = ""
  if Application("ResizeAutoComponent") = "" then
    on error resume next
   'Check for our own Picture Processor
    err.clear
    Set objPictureProcessor = Server.CreateObject("COMobjects.NET.PictureProcessor")
    if err.number = 0 then
      Set objPictureProcessor = nothing
      ImageComponent = "PICPROC"
    else
     'Check for AspJpeg
      err.clear
      Set objASPjpeg = Server.CreateObject("Persits.Jpeg")
      'Response.Write err & " - " & err.number & ":" & err.description & "<br>"
      if err.number = 0 then
        Set objASPjpeg = nothing
        ImageComponent = "ASPJPEG"
      else
        'Check for AspImage
        err.clear
        Set AspImage = Server.CreateObject("AspImage.Image")
        if err.number = 0 then
          Set AspImage = nothing
          ImageComponent = "ASPIMAGE"
        else
          'Check for AspSmart
          err.clear
          Set AspSmart = Server.CreateObject("aspSmartImage.SmartImage")
          if err.number = 0 then
            Set AspSmartImage = nothing
            ImageComponent = "ASPSMART"
          else
            'Check for ImgWriter
            err.clear
            Set objImgWriter = Server.CreateObject("softartisans.ImageGen")
            if err.number = 0 then
              Set objImgWriter = nothing
              ImageComponent = "IMGWRITER"
            else
              'Check for AspThumb
              err.clear
              Set objAspThumb = Server.CreateObject("briz.AspThumb")
              if err.number = 0 then
                Set objAspThumb = nothing
                ImageComponent = "ASPTHUMB"
              else
                ImageComponent = DetectDotNetComponent(DotNetResize)
              end if
            end if
          end if
        end if
      end if
    end if
    on error goto 0
    Application("ResizeAutoComponent") = ImageComponent
  else 'use application var
    ImageComponent = Application("ResizeAutoComponent")
  end if
  if ImageComponent = "" then
        Response.Write "SMART IMAGE PROCESSOR ERROR: Can not detect any Resize Server Components!<br>Please install at least the supplied server component. Read the online docs for more info."
        Response.End
  end if
 
  DetectImageComponent = ImageComponent
end function

function DetectDotNetComponent(DotNetResize)
  Dim objHttp, DotNetImageComponent, ResizeComUrl, LastPath
  if Application("ResizeDotNetComponent") = "" then
    DotNetImageComponent = ""
    ResizeComUrl = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("PATH_INFO")
    LastPath = InStrRev(ResizeComUrl,"/")
    if LastPath > 0 then
      ResizeComUrl = left(ResizeComUrl,Lastpath)
    end if
    ResizeComUrl = ResizeComUrl & DotNetResize
    'Response.Write ResizeComUrl & "<br>"
   
    'Check for ASP.NET 1
    on error resume next
    err.clear
    Set DotNet = Server.CreateObject("Msxml2.ServerXMLHTTP.4.0")
    if err.number = 0 then
      objHttp.open "GET", ResizeComUrl, false
      objHttp.Send ""
      if trim(objHttp.responseText) <> "" and instr(objHttp.responseText,"@ Page Language=""C#""") = 0 then
        DotNetImageComponent = "DOTNET1"
      end if
      Set DotNet = nothing
    else
      'Check for ASP.NET 2
      err.clear
      Set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
      if err.number = 0 then
        on error goto 0
        objHttp.open "GET", ResizeComUrl, false
        objHttp.Send ""
        if trim(objHttp.responseText) <> "" and instr(objHttp.responseText,"@ Page Language=""C#""") = 0 then
          DotNetImageComponent = "DOTNET2"
        end if
        Set objHttp = nothing
      else
        'Check for ASP.NET 3
        err.clear
        Set objHttp = Server.CreateObject("Microsoft.XMLHTTP")
        if err.number = 0 then
          objHttp.open "GET", ResizeComUrl, false
          objHttp.Send ""
          if trim(objHttp.responseText) <> "" and instr(objHttp.responseText,"@ Page Language=""C#""") = 0 then
            DotNetImageComponent = "DOTNET3"
          end if
          Set objHttp = nothing
        end if
      end if
    end if
    on error goto 0
    Application("ResizeDotNetComponent") = DotNetImageComponent
  else 'use application var
    DotNetImageComponent = Application("ResizeDotNetComponent")
  end if
  DetectDotNetComponent = DotNetImageComponent
end function

sub FitImage_PicProc(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objPictureProcessor, intNewWidth, intNewHeight
  on error resume next
  Set objPictureProcessor = Server.CreateObject("COMobjects.NET.PictureProcessor")
  if err.number <> 0 then
    Response.Write "ERROR: Picture Processor Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objPictureProcessor.LoadFromFile imgFile
  objPictureProcessor.Quality = Quality
  calculateNewImageSize objPictureProcessor.Width, objPictureProcessor.Height, maxWidth, maxHeight, intNewWidth, intNewHeight
  objPictureProcessor.Resize intNewWidth, intNewHeight
  objPictureProcessor.SaveToFileAsJpeg newImgFile
  Set objPictureProcessor = nothing
end sub

sub FitImage_AspJpeg(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objAspJpeg, intNewWidth, intNewHeight
  on error resume next
  Set objAspJpeg = Server.CreateObject("Persits.Jpeg")
  if err.number <> 0 then
    Response.Write "ERROR: AspJpeg Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspJpeg.Open imgFile
  objAspJpeg.Quality = Quality
  calculateNewImageSize objAspJpeg.OriginalWidth, objAspJpeg.OriginalHeight, maxWidth, maxHeight, intNewWidth, intNewHeight
  objAspJpeg.Width = intNewWidth
  objAspJpeg.Height = intNewHeight
  objAspJpeg.Save newImgFile
  Set objAspJpeg = nothing
end sub

sub FitImage_AspImage(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objAspImage, intNewWidth, intNewHeight
  on error resume next
  Set objAspImage = Server.CreateObject("AspImage.Image")
  if err.number <> 0 then
    Response.Write "ERROR: AspImage Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspImage.LoadImage imgFile
  objAspImage.JPEGQuality = Quality
  calculateNewImageSize objAspImage.MaxX, objAspImage.MaxY, maxWidth, maxHeight, intNewWidth, intNewHeight
  objAspImage.Resize intNewWidth, intNewHeight
  objAspImage.FileName = newImgFile
  objAspImage.SaveImage
  Set objAspImage = nothing
end sub

sub FitImage_AspSmart(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objAspSmart, intNewWidth, intNewHeight
  on error resume next
  Set objAspSmart = Server.CreateObject("aspSmartImage.SmartImage")
  if err.number <> 0 then
    Response.Write "ERROR: AspSmart Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspSmart.OpenFile CStr(imgFile)
  objAspSmart.Quality = Quality
  calculateNewImageSize objAspSmart.OriginalWidth, objAspSmart.OriginalHeight, maxWidth, maxHeight, intNewWidth, intNewHeight
  objAspSmart.Resample CInt(intNewWidth), Cint(intNewHeight)
  objAspSmart.SaveFile newImgFile
  Set objAspSmart = nothing
end sub

sub FitImage_ImgWriter(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objImgWriter, intNewWidth, intNewHeight
  on error resume next
  Set objImgWriter = Server.CreateObject("softartisans.ImageGen")
  if err.number <> 0 then
    Response.Write "ERROR: ImgWriter Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objImgWriter.LoadImage imgFile
  objImgWriter.ImageQuality = Quality
  calculateNewImageSize objImgWriter.Width, objImgWriter.Height, maxWidth, maxHeight, intNewWidth, intNewHeight
  objImgWriter.ResizeImage intNewWidth, intNewHeight
  objImgWriter.SaveImage 0,3,newImgFile
  Set objImgWriter = nothing
end sub

sub FitImage_AspThumb(imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objAspThumb, intNewWidth, intNewHeight
  on error resume next
  Set objAspThumb = Server.CreateObject("briz.AspThumb")
  if err.number <> 0 then
    Response.Write "ERROR: ImgWriter Server Component is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspThumb.Load imgFile
  objAspThumb.EncodingQuality = Quality
  calculateNewImageSize objAspThumb.Width, objAspThumb.Height, maxWidth, maxHeight, intNewWidth, intNewHeight
  objAspThumb.Resize intNewWidth, intNewHeight
  objAspThumb.Save newImgFile
  Set objAspThumb = nothing
end sub


sub FitImage_DotNet(DotNetComp, DotNetResize, imgFile,newImgFile,maxWidth,maxHeight,Quality)
  Dim objHttp, ResizeComUrl, ResizeParams, LastPath
  ResizeParams = "?f=" & Server.UrlEncode(imgFile) & "&nf=" & Server.UrlEncode(newImgFile) & "&w=" & maxWidth & "&h=" & maxHeight & "&q=" & Quality
  ResizeComUrl = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("PATH_INFO")
  LastPath = InStrRev(ResizeComUrl,"/")
  if LastPath > 0 then
    ResizeComUrl = left(ResizeComUrl,Lastpath)
  end if
  ResizeComUrl = ResizeComUrl & DotNetResize & ResizeParams

  on error resume next
  set objHttp = Server.CreateObject(DotNetComp)
  if err.number <> 0 then
    Response.Write "ERROR: ASP.NET (" & DotNetComp & ") is not installed!<br>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
 
  objHttp.open "GET", ResizeComUrl, false
  objHttp.Send ""
 
  ' Check notification validation
  if (objHttp.status <> 200 ) then
    ' HTTP error handling
    Response.Write "HTTP ERROR: " & objHttp.status & "<br>"
    Response.Write "Returned:<br>" & objHttp.responseText
   
  elseif (objHttp.responseText = "DONE") then
  else
    if trim(objHttp.responseText) = "" or instr(objHttp.responseText,"@ Page Language=""C#""") > 0 then
      Response.Write "DOT NET Unsupported"
    end if
  end if
  Set objHttp = Nothing
end sub

sub calculateNewImageSize(curWidth, curHeight, maxWidth, maxHeight, newWidth, newHeight)
  if maxWidth < curWidth or maxHeight < curHeight then
    if maxWidth >= maxHeight then
      newWidth = CInt(maxHeight*(curWidth/curHeight))
      newHeight = maxHeight
    else
      newWidth = maxWidth
      newHeight = CInt(maxWidth*(curHeight/curWidth))
    end if
    if newWidth > maxWidth then
      newWidth = maxWidth
      newHeight = CInt(maxWidth*(curHeight/curWidth))
    end if
    if newHeight > maxHeight then
      newWidth = CInt(maxHeight*(curWidth/curHeight))
      newHeight = maxHeight
    end if
  else
    newWidth = curWidth
    newHeight = curHeight
  end if
end sub

Sub ResizeUploadedFiles(RUF_Component, RUF_DotNetResize, RUF_path, RUF_Suffix, RUF_maxWidth, RUF_maxHeight, RUF_Quality, RUF_RemoveOrig)
  Dim RUF_keys, RUF_i, RUF_curKey, RUF_fileName, RUF_fso, RUF_newFileName, RUF_curPath, RUF_curName, RUF_curExt, RUF_lastPos, RUF_orgCurPath
  if RUF_path <> "" and right(RUF_path,1) <> "/" then RUF_path = RUF_path & "/"
  Set RUF_fso = CreateObject("Scripting.FileSystemObject")  
  RUF_maxWidth = Cint(RUF_maxWidth)
  RUF_maxHeight  = Cint(RUF_maxHeight)  
  RUF_keys = UploadRequest.Keys
  for RUF_i = 0 to UploadRequest.Count - 1
    RUF_curKey = RUF_keys(RUF_i)
    if UploadRequest.Exists(RUF_curKey) then
      if UploadRequest.Item(RUF_curKey).Exists("FileName") then    
            if UploadRequest.Item(RUF_curKey).Item("FileName") <> "" then    
          RUF_fileName = UploadRequest.Item(RUF_curKey).Item("Value")
          if RUF_fileName <> "" then
            RUF_curPath = "" : RUF_curName = "" : RUF_curExt = ""
            RUF_lastPos = InStrRev(RUF_fileName,"/")
            if RUF_lastPos > 0 then
              RUF_curPath = mid(RUF_fileName,1,RUF_lastPos)      
              RUF_curName = mid(RUF_fileName,RUF_lastPos+1,Len(RUF_fileName)-RUF_lastPos)      
              RUF_fileName = UploadRequest.Item(RUF_curKey).Item("FileName")            
            else
              RUF_curName = RUF_fileName      
            end if
            RUF_lastPos = InStrRev(RUF_curName,".")
            if RUF_lastPos > 0 then
              RUF_curExt = mid(RUF_curName,RUF_lastPos+1,Len(RUF_curName)-RUF_lastPos)      
              RUF_curName = mid(RUF_curName,1,RUF_lastPos-1)
            end if
            RUF_curExt = LCase(RUF_curExt)
                        RUF_orgCurPath = RUF_curPath
            if RUF_curPath = "" then RUF_curPath = RUF_path
            if RUF_fso.FileExists(Server.MapPath(RUF_curPath & RUF_fileName)) then
              if RUF_curExt = "jpg" or RUF_curExt = "jpeg" or RUF_curExt = "gif" or RUF_curExt = "bmp" or RUF_curExt = "png" or RUF_curExt = "pgm" or RUF_curExt = "tga" or RUF_curExt = "tiff" or RUF_curExt = "jfif" then
                RUF_newFileName = RUF_curName & RUF_Suffix & ".jpg"
                FitImage_Comp RUF_Component, RUF_DotNetResize, Server.MapPath(RUF_CurPath & RUF_fileName), Server.MapPath(RUF_curPath & RUF_newFileName), RUF_maxWidth, RUF_maxHeight, RUF_Quality
                if RUF_RemoveOrig then
                  if LCase(RUF_fileName) <> LCase(RUF_newFileName) then
                    RUF_fso.DeleteFile Server.MapPath(RUF_curPath & RUF_fileName)
                  end if  
                  if RUF_orgCurPath <> "" then
                    UploadRequest.Item(RUF_curKey).Item("Value") = RUF_orgCurPath & RUF_newFileName            
                  else
                    UploadRequest.Item(RUF_curKey).Item("Value") = RUF_newFileName
                  end if
                  UploadRequest.Item(RUF_curKey).Item("FileName") = RUF_newFileName
                end if
              end if  
            end if
          end if
        end if
      end if
    end if
  next      
End Sub

</SCRIPT>
0
 
LVL 46

Expert Comment

by:fritz_the_blank
Comment Utility
Orroland--

I am so sorry! I was making a joke about requesting the code to eliminate human error!!!

If this code works well for all of your other users, I can only imagine that the issue is environmental.

FtB
0
 

Author Comment

by:Orroland
Comment Utility
Sorry - human error at my end!

Giving fritz the points because he did answer the question "forms don't timeout"
0
 
LVL 46

Expert Comment

by:fritz_the_blank
Comment Utility
Thank you and sorry that I couldn't be of more help.

FtB
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

I would like to start this tip/trick by saying Thank You, to all who said that this could not be done, as it forced me to make sure that it could be accomplished. :) To start, I want to make sure everyone understands the importance of utilizing p…
I was asked about the differences between classic ASP and ASP.NET, so let me put them down here, for reference: Let's make the introductions... Classic ASP was launched by Microsoft in 1998 and dynamically generate web pages upon user interact…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now