porblemer med chrb

hvad bør funktionen returnerer?
Nu har jeg lige afprøvet den sådan her

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

response.write getString("vbgfd")

Det eneste jeg får retur er det første bogstav. Altså v
Jeg får ingen fejlmeddelelse

sorry tog en forkert metode, hr er den rigtige:
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

den giver mig ??d retur
ingen fejlmeddelelse

ok jeg får følgende:
Function or method call not implemented: 'ChrB'
ScriptLibrary/incPureUpload.asp, line 241


Browser Type:
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; (R1 1.5); .NET CLR 1.1.4322)

Page:
POST 1747 bytes to /member/register.asp

POST Data:

Request object error 'ASP 0207 : 80004005'

Cannot use Request.Form

/member/myprofile.asp, line 183

Cannot use Request.Form collection after calling BinaryRead.

ah, okay. Det er noget helt andet.
Du har noget upload på siden.
Istedet for request.form("hvadditfelthedder") skal du bruge upload.form("hvadditfelthedder")

har stirret mig blind måske du kan hjælpe

register.asp:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!--#include file="Connections/conn.asp" -->
<!--#include file="ScriptLibrary/incPureUpload.asp" -->
<%
Dim rsUser__MMColParam
rsUser__MMColParam = "1"
if (Session("MM_Username") <> "") then rsUser__MMColParam = Session("MM_Username")
%>
<%
set rsUser = Server.CreateObject("ADODB.Recordset")
rsUser.ActiveConnection = MM_Conn_STRING
rsUser.Source = "SELECT * FROM USERS WHERE U_ID = '" + Replace(rsUser__MMColParam, "'", "''") + "'"
rsUser.CursorType = 0
rsUser.CursorLocation = 2
rsUser.LockType = 3
rsUser.Open()
rsUser_numRows = 0
%>
<%
' *** Redirect if username exists
MM_flag="MM_insert"
If (CStr(Request(MM_flag)) <> "") Then
  MM_dupKeyRedirect="duplicatedId.asp"
  MM_rsKeyConnection=MM_Conn_STRING
  MM_dupKeyUsernameValue = CStr(Request.Form("U_ID"))
  MM_dupKeySQL="SELECT U_ID FROM USERS WHERE U_ID='" & MM_dupKeyUsernameValue & "'"
  MM_adodbRecordset="ADODB.Recordset"
  set MM_rsKey=Server.CreateObject(MM_adodbRecordset)
  MM_rsKey.ActiveConnection=MM_rsKeyConnection
  MM_rsKey.Source=MM_dupKeySQL
  MM_rsKey.CursorType=0
  MM_rsKey.CursorLocation=2
  MM_rsKey.LockType=3
  MM_rsKey.Open
  If Not MM_rsKey.EOF Or Not MM_rsKey.BOF Then
    ' the username was found - can not add the requested username
    MM_qsChar = "?"
    If (InStr(1,MM_dupKeyRedirect,"?") >= 1) Then MM_qsChar = "&"
    MM_dupKeyRedirect = MM_dupKeyRedirect & MM_qsChar & "requsername=" & MM_dupKeyUsernameValue
    Response.Redirect(MM_dupKeyRedirect)
  End If
  MM_rsKey.Close
End If
%>

<%
'*** Pure ASP File Upload -----------------------------------------------------
' Copyright (c) 2001-2002 George Petrov, www.UDzone.com
' Process the upload
' Version: 2.0.9
'------------------------------------------------------------------------------
'*** File Upload to: """images""", Extensions: "GIF,JPG,JPEG,BMP,PNG", Form: form2, Redirect: "", "file", "10", "over", "false", "", "" , "", "", "", "", "600", "showProgress.htm", "300", "100"

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 "<b>You don't have latest version of ScriptLibrary/incPureUpload.asp uploaded on the server.</b><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, """images""", "file", "10", "over"
 
  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
'------------------------------------------------------------------------------
%>
<%
' *** Edit Operations: (Modified for File Upload) declare variables

MM_editAction = CStr(Request.ServerVariables("URL")) 'MM_editAction = CStr(Request("URL"))
If (UploadQueryString <> "") Then
  MM_editAction = MM_editAction & "?" & UploadQueryString
End If

' boolean to abort record edit
MM_abortEdit = false

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

If (CStr(UploadFormRequest("MM_insert")) <> "") Then

  MM_editConnection = MM_Conn_STRING
  MM_editTable = "USERS"
  MM_editRedirectUrl = "login.asp"
  MM_fieldsStr  = "U_ID|value|U_PASSWORD|value|U_FIRST|value|U_LAST|value|U_ADDRESS|value|U_CITY|value|image|value|U_STATE|value|U_ZIP|value|U_EMAIL|value|U_PHONE|value|U_FAX|value|subscribe|value"
  MM_columnsStr = "U_ID|',none,''|U_PASSWORD|',none,''|U_FIRST|',none,''|U_LAST|',none,''|U_ADDRESS|',none,''|U_CITY|',none,''|IMAGE|',none,''|U_STATE|',none,''|U_ZIP|',none,''|U_EMAIL|',none,''|U_PHONE|',none,''|U_FAX|',none,''|email_subscribe|none,1,0"

  ' create the MM_fields and MM_columns arrays
  MM_fields = Split(MM_fieldsStr, "|")
  MM_columns = Split(MM_columnsStr, "|")
 
  ' set the form values
  For i = LBound(MM_fields) To UBound(MM_fields) Step 2
    MM_fields(i+1) = CStr(UploadFormRequest(MM_fields(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
%>

<%
' *** Insert Record: (Modified for File Upload) construct a sql insert statement and execute it

If (CStr(UploadFormRequest("MM_insert")) <> "") Then

  ' create the sql insert statement
  MM_tableValues = ""
  MM_dbValues = ""
  For i = LBound(MM_fields) To UBound(MM_fields) Step 2
    FormVal = MM_fields(i+1)
    MM_typeArray = Split(MM_columns(i+1),",")
    Delim = MM_typeArray(0)
    If (Delim = "none") Then Delim = ""
    AltVal = MM_typeArray(1)
    If (AltVal = "none") Then AltVal = ""
    EmptyVal = MM_typeArray(2)
    If (EmptyVal = "none") Then EmptyVal = ""
    If (FormVal = "") Then
      FormVal = EmptyVal
    Else
      If (AltVal <> "") Then
        FormVal = AltVal
      ElseIf (Delim = "'") Then  ' escape quotes
        FormVal = "'" & Replace(FormVal,"'","''") & "'"
      Else
        FormVal = Delim + FormVal + Delim
      End If
    End If
    If (i <> LBound(MM_fields)) Then
      MM_tableValues = MM_tableValues & ","
      MM_dbValues = MM_dbValues & ","
    End if
    MM_tableValues = MM_tableValues & MM_columns(i)
    MM_dbValues = MM_dbValues & FormVal
  Next
  MM_editQuery = "insert into " & MM_editTable & " (" & MM_tableValues & ") values (" & MM_dbValues & ")"

  If (Not MM_abortEdit) Then
    ' execute the insert
    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
%>
<html>
<head>
<title>www.bachnielsen.com</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<script language="JavaScript">
<!--

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);}
}

function showProgressWindow(progressFile,popWidth,popHeight) { //v2.09
  var showProgress = false, form, field;
  for (var f = 0; f<document.forms.length; f++) {
    form = document.forms[f];
    for (var i = 0; i<form.elements.length; i++) {
      field = form.elements[i];
      if (field.type.toUpperCase() != 'FILE') continue;
      if (field.value != '') {showProgress = true;break;}
  } }
  if (showProgress && document.MM_returnValue) {
    var w = 480, h = 340;
    if (document.all || document.layers || document.getElementById) {
      w = screen.availWidth; h = screen.availHeight;}
    var leftPos = (w-popWidth)/2, topPos = (h-popHeight)/2;
    document.progressWindow = window.open(progressFile,'ProgressWindow','toolbar=no,location=no,status=no,menubar=no,scrollbars=no,resizable=no,width=' + popWidth + ',height='+popHeight);
    document.progressWindow.moveTo(leftPos, topPos);document.progressWindow.focus();
        window.onunload = function () {document.progressWindow.close();};
} }

function MM_findObj(n, d) { //v4.01
  var p,i,x;  if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) {
    d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}
  if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n];
  for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document);
  if(!x && d.getElementById) x=d.getElementById(n); return x;
}

function MM_validateForm() { //v4.0
  var i,p,q,nm,test,num,min,max,errors='',args=MM_validateForm.arguments;
  for (i=0; i<(args.length-2); i+=3) { test=args[i+2]; val=MM_findObj(args[i]);
    if (val) { nm=val.name; if ((val=val.value)!="") {
      if (test.indexOf('isEmail')!=-1) { p=val.indexOf('@');
        if (p<1 || p==(val.length-1)) errors+='- '+nm+' must contain an e-mail address.\n';
      } else if (test!='R') { num = parseFloat(val);
        if (isNaN(val)) errors+='- '+nm+' must contain a number.\n';
        if (test.indexOf('inRange') != -1) { p=test.indexOf(':');
          min=test.substring(8,p); max=test.substring(p+1);
          if (num<min || max<num) errors+='- '+nm+' must contain a number between '+min+' and '+max+'.\n';
    } } } else if (test.charAt(0) == 'R') errors += '- '+nm+' is required.\n'; }
  } if (errors) alert('The following error(s) occurred:\n'+errors);
  document.MM_returnValue = (errors == '');
}
//-->
</script>
<link href="../myStyle.css" rel="stylesheet" type="text/css">
</head>
<body>
<table width="100%" border="1"><!--DWLayoutTable-->
  <tr>
    <td colspan="3" align="center">www.bachnielsen.com</td>
  </tr>
  <tr>
    <td width="210" valign="top"><!-- #include file="menu.asp" --></td>
    <td width="100%" class="scroll" valign="top">
        <div style="width: 100%; height: 100%; overflow : auto;"><br><br>
        <p>
        <!--#include file="inc_header.asp" -->

<table width="84%" border="0" cellpadding="1" cellspacing="1">
  <tr>
    <td height="179" valign="top" bgcolor="#FFFFFF"> <table width="100%" border="0" cellspacing="0" cellpadding="0">
        <tr align="center">
          <td width="99%" valign="top"></td>
        </tr>
        <tr align="center">
          <td valign="top" class="tdstd"><b>Complete form below<br></b></font></td>
        </tr>
        <tr align="center">
          <td valign="top"> <table width="100%" border="0" cellspacing="0" cellpadding="0">
              <tr>
                <td align="center" valign="middle">
                    <form action="<%=MM_editAction%>" method="post" enctype="multipart/form-data" name="form2" onSubmit="checkFileUpload(this,'GIF,JPG,JPEG,BMP,PNG',false,10,'','','','','','');showProgressWindow('showProgress.htm',300,100);return document.MM_returnValue">
                    <table align="center" cellpadding="3" cellspacing="2">
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Username:</b></td>
                        <td width="405"><input type="text" name="U_ID" value="" size="50" maxlength="10" class="boxText">
                          * </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Password:</b></td>
                        <td width="405"> <input type="password" name="U_PASSWORD" value="" size="50" maxlength="10" class="boxText">
                          * </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>First Name:</b></td>
                        <td width="405"> <input type="text" name="U_FIRST" value="" size="50" class="boxText">
                          * </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Last Name:</b></td>
                        <td width="405"> <input type="text" name="U_LAST" value="" size="50" class="boxText">
                          * </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Address:</b></td>
                        <td width="405"> <input type="text" name="U_ADDRESS" value="" size="50" class="boxText">
                        </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>City:</b></td>
                        <td width="405"> <input type="text" name="U_CITY" value="" size="50" class="boxText">
                        </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" class="tdstd"><b>Photo</b></td>
                        <td><input name="image" type="file" class="boxText" id="image" onChange="checkOneFileUpload(this,'GIF,JPG,JPEG,BMP,PNG',false,10,'','','','','','')" size="35"></td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>State:</b></td>
                        <td width="405"> <input type="text" name="U_STATE" value="" size="50" class="boxText">
                        </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Zip:</b></td>
                        <td width="405"> <input type="text" name="U_ZIP" value="" size="50" class="boxText">
                        </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Email:</b></td>
                        <td width="405"> <input type="text" name="U_EMAIL" value="" size="50" class="boxText">
                          * </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Phone:</b></td>
                        <td width="405"> <input type="text" name="U_PHONE" value="" size="50" maxlength="15" class="boxText">
                        </td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138" class="tdstd"><b>Fax:</b></td>
                        <td width="405" class="tdstd"><input type="text" name="U_FAX" value="" size="50" maxlength="15" class="boxText">
                          <i>(Optional)</i></td>
                      </tr>
                      <tr valign="baseline">
                        <td height="19" align="right" nowrap class="tdstd"><b>Newsletter:</b></td>
                        <td><input name="subscribe" type="checkbox" id="subscribe" value="checkbox" checked></td>
                      </tr>
                      <tr valign="baseline">
                        <td nowrap align="right" width="138"> <h3><font size="2"><b><font color="#333333"></font></b></font></h3></td>
                        <td width="405"> <input name="submit" type="submit" class="boxButton" onClick="MM_validateForm('U_ID','','R','U_FIRST','','R','U_LAST','','R','U_EMAIL','','RisEmail','U_PASSWORD','','R');return document.MM_returnValue" value="Register">
                        </td>
                      </tr>
                    </table>
                    <input type="hidden" name="MM_insert" value="form2">
                  </form>
                </td>
              </tr>
            </table></td>
        </tr>
      </table>
      </td>
  </tr>
</table>
        </p></div> <!-- end center -->
    </td>
    <td width="140">
        <table> <!-- right col table -->
            <tr>
                <td align="center">
                    Just testing
                    <hr size="1" width="100%" align="center" color="#000000">
                </td>
            </tr>
            <tr>
                <td>
                    <script language="javascript">
                    var uri = 'http://impdk.tradedoubler.com/imp/img/564971/959645?' + new String (Math.random()).substring (2, 11);
                    document.write('<a href="http://trac'+'ker.tradedoubler.com/click?p=16933&a=959645&g=564971" target="_blank"><img src="'+uri+'" border=0></a>');
                    </script>
                    <script language="javascript">
                    var uri = 'http://impdk.tradedoubler.com/imp/iframe/141502/959645?' + new String (Math.random()).substring (2, 11);
                    document.write('<iframe src="'+uri +'" width="140" height="350" frameborder="0" border="0" marginwidth="0" marginheight="0" scrolling="no"></iframe>');
                    </script>
                </td>
            </tr>
        </table> <!-- end right col table -->
    </td>
  </tr>
  <tr>
      <td height="5"><img src="images/spacer.gif" alt="" width="200" height="1"></td>
    <td><img src="images/spacer.gif" alt="" width="340" height="1"></td>
    <td><img src="images/spacer.gif" alt="" width="140" height="1"></td>
  </tr>
</table> <!-- end DWLayoutTable -->
</body>
</html>
<%
rsUser.Close()
%>

incPureUpload.asp:
<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">

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 "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br>"
    Response.Write "Please correct and <A HREF=""java script: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 < 1.0 then
    Response.Write "<b>You don't have ADO 2.5 installed on the server.</b><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=""java script: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=""java script: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=""java script: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=""java script: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=""java script: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=""java script: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>

kan du lige se koden igennem?

kan du lige se koden igennem?

kan du lige se koden igennem?

Find det sted hvor funktionen kaldes. Det må være den input parameter der sendes med til funktionen der er request.form istedet for upload.form

jeg leder og leder men er stirret helt blind på koden... kan ikke finde fejlen

svar oprettet nyt spm