Solved

Can a form timeout - enctype error?

Posted on 2004-08-10
12
497 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
12 Comments
 
LVL 46

Accepted Solution

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

FtB
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 11764579
I am not sure this is correct, but:

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

FtB
0
 

Author Comment

by:Orroland
ID: 11764610
any ideas...?
0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 11764660
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
ID: 11764850
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
ID: 11764879
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
 

Author Comment

by:Orroland
ID: 11764908
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
ID: 11764916
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
ID: 11764920
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
ID: 11764978
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
ID: 11764995
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
ID: 11765020
Thank you and sorry that I couldn't be of more help.

FtB
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I recently decide that I needed a way to make my pages scream on the net.   While searching around how I can accomplish this I stumbled across a great article that stated "minimize the server requests." I got to thinking, hey, I use more than one…
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…

733 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