Microsoft VBScript runtime (0x800A01A8) Object required: ''

[interkrome]

Error Type:
Microsoft VBScript runtime (0x800A01A8)
Object required: ''
/hrdept/dl_add_url.asp, line 41

Code:

<%

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
curpagetype = "downloads"
uploadPg = true
sString = ""

CurPageInfoChk = "1"
function CurPageInfo ()
PageName = "New Download"
PageAction = "Submitted"
CurPageInfo = PageAction & PageName
end function

%><!-- #INCLUDE file="config.asp" -->
<!-- #INCLUDE file="includes/inc_clsUpload.asp" -->
<!-- #INCLUDE file="inc_functions.asp" -->
<!-- INCLUDE file="modules/downloads/dl_functions.asp" -->
<!-- INCLUDE file="modules/downloads/dl_custom.asp" -->
<!-- #INCLUDE file="inc_top.asp" -->
<!-- INCLUDE file="includes/inc_ADOVBS.asp" -->
<%


if trim(objUpload.Fields("cat").Value) = "" then --> ERROR
Response.Redirect("dl.asp")
else
cat = cLng(objUpload.Fields("cat").Value)


name = ChkString(objUpload.Fields("name").Value,"sqlstring")
URL = ChkString(objUpload.Fields("URL").Value,"url")
key = ChkString(objUpload.Fields("key").Value,"sqlstring")
size = ChkString(objUpload.Fields("size").Value,"sqlstring")
description = ChkString(objUpload.Fields("des").Value,"sqlstring")
email = ChkString(objUpload.Fields("mail").Value,"url")
license = ChkString(objUpload.Fields("license").Value,"sqlstring")
language = ChkString(objUpload.Fields("language").Value,"sqlstring")
platform = ChkString(objUpload.Fields("platform").Value,"sqlstring")
publisher = ChkString(objUpload.Fields("publisher").Value,"sqlstring")
publisherURL = ChkString(objUpload.Fields("publisherURL").Value,"url")
uploader = ChkString(objUpload.Fields("uploader").Value,"title")
today = strCurDateString
uLoad = filename

Set objUpload = Nothing

strSQL = "SELECT CAT_ID FROM DL_SUBCATEGORIES WHERE SUBCAT_ID = " & cat
dim rsCategories
set rsCategories = server.CreateObject("adodb.recordset")
rsCategories.Open strSQL, my_Conn
parent = rsCategories("CAT_ID")
rsCategories.Close
set rsCategories = nothing

strSQL = "select UP_ACTIVE, UP_ALLOWEDUSERS, UP_ALLOWEDEXT from " & strTablePrefix & "UPLOAD_CONFIG where UP_LOCATION = 'download'"
dim rsUload
set rsUload = server.CreateObject("adodb.recordset")
rsUload.Open strSQL, my_Conn
uActive = rsUload("UP_ACTIVE")
uAllowed = rsUload("UP_ALLOWEDUSERS")
extAllowed = rsUload("UP_ALLOWEDEXT")
rsUload.Close
set rsUload = nothing

if trim(uLoad) <> "" and FSOenabled = true and strAllowUploads = 1 and uActive = 1 and mLev >= uAllowed then
banner = remotePath & parent & "/" & cat & "/" & uLoad
url = banner
end if
if trim(uLoad) = "" then
sString = ""
end if

if len(trim(name)) = 0 then
sString = sString & "<li>Please enter Program Title.</li>"
end if

isOK = false
if len(trim(url)) <= 8 and trim(uLoad) = "" then
sString = sString & "<li>Please enter a Download URL.</li>"
elseif len(trim(url)) > 8 and trim(uLoad) = "" then
tmpExt = split(extAllowed,",")
for ex = 0 to ubound(tmpExt)
if right(url,3) = tmpExt(ex) then
isOK = true
end if
next
if not isOK then
sString = sString & "<li>Please enter a valid Download URL.</li>"
end if
else

strSql="Select URL from DL where URL like '%" & URL & "%'"
set RS = my_Conn.execute(strSql)

if not rs.eof then
sString = sString & "<li>This Download already exists in our database.</li>"
end if
RS.close
end if

if cat = "--Please select one--" then
sString = sString & "<li>Please select category that match your program.</li>"
end if

if len(trim(Description)) = 0 then
sString = sString & "<li>Please enter program description.</li>"
end if

if len(trim(Description)) => 255 then
sString = sString & "<li>" &len(trim(Description))&" characters. Your description is too long. 255 characters max</li>"
end if

if len(trim(Email)) = 0 then
sString = sString & "<li>You must give an email address.</li>"
else
if EmailField(Email) = 0 then
sString = sString & "<li>You Must enter a valid email address.</li>"
end if
end if


end if

if sString = "" then

sSql = "SELECT APP_ID FROM "& strTablePrefix & "APPS WHERE APP_iNAME = 'downloads'"
set rsA = my_Conn.execute(sSql)
if not rsA.eof then
intAppID = rsA("APP_ID")
else
intAppID = 0
end if
session.Contents("uploadType") = ""
strSql = "INSERT INTO DL"
strSql = strSql & "(NAME"
strSql = strSql & ", URL"
strSql = strSql & ", KEYWORD"
strSql = strSql & ", CATEGORY"
strSql = strSql & ", DESCRIPTION"
strSql = strSql & ", EMAIL"
strSql = strSql & ", POST_DATE"
strSql = strSql & ", PARENT_ID"
strSql = strSql & ", SHOW"
strSql = strSql & ", BADLINK"
strSql = strSql & ", FILESIZE "
strSql = strSql & ", LICENSE "
strSql = strSql & ", LANG "
strSql = strSql & ", PLATFORM "
strSql = strSql & ", PUBLISHER "
strSql = strSql & ", PUBLISHER_URL "
strSql = strSql & ", UPLOADER "
strSql = strSql & ") "
strSql = strSql & " VALUES ("
strSql = strSql & "'" & name & "'"
strSql = strSql & ", " & "'" & url & "'"
strSql = strSql & ", " & "'" & key & "'"
strSql = strSql & ", " & "'" & cat & "'"
strSql = strSql & ", " & "'" & description & "'"
strSql = strSql & ", " & "'" & email & "'"
strSql = strSql & ", " & "'" & today & "'"
strSql = strSql & ", " & "'" & parent & "'"
if mlev=4 then
strSql = strSql & ", " & "1"
else
strSql = strSql & ", " & "0"
end if
strSql = strSql & ", " & "0"
strSql = strSql & ", " & "'" & size & "'"
strSql = strSql & ", " & "'" & license & "'"
strSql = strSql & ", " & "'" & language & "'"
strSql = strSql & ", " & "'" & platform & "'"
strSql = strSql & ", " & "'" & publisher & "'"
strSql = strSql & ", " & "'" & publisherurl & "'"
strSql = strSql & ", " & "'" & uploader & "'"
strSql = strSql & ")"

executeThis(strSQL)

if trim(uLoad) <> "" and FSOenabled = true and strAllowUploads = 1 and uActive = 1 and mLev >= uAllowed then
on error resume next
set fso = Server.CreateObject("Scripting.FileSystemObject")
dirPath = server.MapPath(remotePath) & "\"
if fso.FolderExists(dirPath & parent) = false then
fso.CreateFolder(dirPath & parent)
end if
if fso.FolderExists(dirPath & parent & "\" & cat) = false then
fso.CreateFolder(dirPath & parent & "\" & cat)
end if
if fso.FileExists(dirPath & uLoad) = true then
fso.MoveFile dirPath & uLoad, dirPath & parent & "\" & cat & "\" & uLoad
end if
set fso = nothing
on error goto 0
end if

if mLev = 4 and intSubscriptions = 1 and strEmail = 1 then
'send subscriptions emails
eSubject = strSiteTitle & " - New Download"
eMsg = "A new download has been submitted at " & strSiteTitle & vbCrLf
eMsg = eMsg & "that you have a subscription for." & vbCrLf & vbCrLf
eMsg = eMsg & "You can view the new downloads by visiting " & strHomeUrl & "dl.asp?cmd=3" & vbCrLf
sendSubscriptionEmails intAppID,parent,cat,"0",eSubject,eMsg
'response.Write("<br>Email sent<br>" )
end if
%>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td class="leftPgCol">

</td>
<td class="mainPgCol">
<%
mwpThemeBlock_open()%>
<table cellpadding="0" cellspacing="0" width="100%">
<tr>
<td valign="middle" width=100%>
<center>
<% if mlev=4 then%>Your file has been added to our database
<%else%>Your File has been accepted for review.<br>
Please wait 1-3 days for your File to be reviewed and added.
<%end if%>
<table border="0" cellpadding="4" cellspacing="0" width="60%" align="center">
<tr>
<td valign=top width=30%>
<b>Name:</b>&nbsp;
</td>
<td valign=top align=left width=70%>
<% Response.write name %>
</td>
</tr>
<tr>
<td valign=top>
<b>URL:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write URL %>
</td>
</tr>
<tr>
<td valign=top>
<b>Keywords:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write key %>
</td>
</tr>
<tr>
<td valign=top>
<b>Email:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Email %>
</td>
</tr>
<tr>
<td valign=top>
<b>File Size:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Size %>
</td>
</tr>
<tr>
<td valign=top>
<b>License:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write License %>
</td>
</tr>
<tr>
<td valign=top>
<b>Language:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Language %>
</td>
</tr>
<tr>
<td valign=top>
<b>Platform:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Platform %>
</td>
</tr>
<tr>
<td valign=top>
<b>Publisher:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Publisher %>
</td>
</tr>
<tr>
<td valign=top>
<b>Publisher's Website:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Publisherurl %>
</td>
</tr>
<tr>
<td valign=top>
<b>Uploaded by:</b>&nbsp;
</td>
<td valign=top align=left>
<% Response.write Uploader %>
</td>
</tr>
<tr>
<td valign=top colspan=2>
<b>Description:</b>&nbsp;
</td>
</tr>
<tr>
<td valign=top colspan=2>
<% Response.write Description %>
</td>
</tr>
</table>
</td>
</tr></table>
<center><p><a href="dl.asp">Back to Download Categories </a></p>
</center>
<%
mwpThemeBlock_close()%>
</td>
</tr>
</table>
<meta http-equiv="Refresh" content="10; URL=dl.asp">
<%else
'They have made an error, delete their upload, if there is one
if FSOenabled = true and strAllowUploads = 1 then
on error resume next
set fso = Server.CreateObject("Scripting.FileSystemObject")
dirPath = server.MapPath(downloadDir) & "\" & uLoad
if fso.FileExists(dirPath) = true then
fso.DeleteFile dirPath
end if
set fso = nothing
end if %>
<br>
<table border="0" cellpadding="0" cellspacing="0" valign="top" width="100%">
<tr>
<td class="leftPgCol">

</td>
<td class="mainPgCol">
<%

mwpThemeBlock_open() %>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td valign=top align=center>
<p align="center"><span class="fSubTitle">There Was A Problem.</span></p>
<table align="center" border="0">
<tr>
<td>
<ul>
<% =sString %>
</ul>
</td>
</tr>
</table>
<p align="center"><a href="JavaScript:history.go(-1)">Go Back To Enter Data</a></p>
</td>
</tr>
</table>
<%mwpThemeBlock_close()%>
</td>
</tr>
</table>
<%end if%>
<!-- #INCLUDE file="inc_footer.asp" -->

[Spudhead]

Well, the problem is clearly with objUpload, isn't it?

But seeing as you fail to indicate (a) what objUpload is and where you're initiating it, (b) what you've done so far to debug the problem (like, say, pasting the error message into Google or even doing a search on this forum), (c) any further information at all as to why and how you might be getting this error (like, say, "I just deleted all this other code and now it's not working"), or (d) pretty much anything at all except for pasting nearly 400 lines of irrelevant HTML, then I'm not in much of a position to help you, am I?

[interkrome]

I try to use skyportal download features in maxwebportal.
here the codes for <!-- #INCLUDE file="includes/inc_clsUpload.asp" -->.when i change the objUpload.Fields to Request.Form the error is fixed but...the process doesnt save in database.

<%

dim objUpload,remotePathMapped
dim filename, sString, uString, grpsAllowed, bHasGrpAccess, max, upCntr
redim arrUplds(1,1)
arrUplds(0,0) = false
arrUplds(0,1) = ""
bHasGrpAccess = false
sString = ""
uString = ""
filename = ""
'####################################
Class clsUpload
Private mbinData
Private mlngChunkIndex
Private mlngBytesReceived
Private mstrDelimiter
Private CR
Private LF
Private CRLF
Private mobjFieldAry()
Private mlngCount

Private Sub RequestData
Dim llngLength
mlngBytesReceived = Request.TotalBytes
mbinData = Request.BinaryRead(mlngBytesReceived)
End Sub

Private Sub ParseDelimiter()
mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1)
End Sub

Private Sub ParseData()
Dim llngStart
Dim llngLength
Dim llngEnd
Dim lbinChunk
llngStart = 1
llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF)
While Not llngStart = 0
llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2
llngLength = llngEnd - llngStart
lbinChunk = MidB(mbinData, llngStart, llngLength)
Call ParseChunk(lbinChunk)
llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF)
Wend
End Sub

Private Sub ParseChunk(ByRef pbinChunk)
Dim lstrName
Dim lstrFileName
Dim lstrContentType
Dim lbinData
Dim lstrDisposition
Dim lstrValue
lstrDisposition = ParseDisposition(pbinChunk)
lstrName = ParseName(lstrDisposition)
lstrFileName = ParseFileName(lstrDisposition)
lstrContentType = ParseContentType(pbinChunk)
If lstrContentType = "" Then
lstrValue = CStrU(ParseBinaryData(pbinChunk))
Else
lbinData = ParseBinaryData(pbinChunk)
End If
Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData)
End Sub

Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData)
Dim lobjField
ReDim Preserve mobjFieldAry(mlngCount)
Set lobjField = New clsField
lobjField.Name = pstrName
lobjField.FilePath = pstrFileName
lobjField.ContentType = pstrContentType
If LenB(pbinData) = 0 Then
lobjField.BinaryData = ChrB(0)
lobjField.Value = pstrValue
lobjField.Length = Len(pstrValue)
Else
lobjField.BinaryData = pbinData
lobjField.Length = LenB(pbinData)
lobjField.Value = ""
End If
Set mobjFieldAry(mlngCount) = lobjField
mlngCount = mlngCount + 1
End Sub

Private Function ParseBinaryData(ByRef pbinChunk)
Dim llngStart
llngStart = InStrB(1, pbinChunk, CRLF & CRLF)
If llngStart = 0 Then Exit Function
llngStart = llngStart + 4
ParseBinaryData = MidB(pbinChunk, llngStart)
End Function

Private Function ParseContentType(ByRef pbinChunk)
Dim llngStart
Dim llngEnd
Dim llngLength
llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare)
If llngStart = 0 Then Exit Function
llngEnd = InStrB(llngStart + 15, pbinChunk, CR)
If llngEnd = 0 Then Exit Function
llngStart = llngStart + 15
If llngStart >= llngEnd Then Exit Function
llngLength = llngEnd - llngStart
ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength)))
End Function

Private Function ParseDisposition(ByRef pbinChunk)
Dim llngStart
Dim llngEnd
Dim llngLength
llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare)
If llngStart = 0 Then Exit Function
llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF)
If llngEnd = 0 Then Exit Function
llngStart = llngStart + 22
If llngStart >= llngEnd Then Exit Function
llngLength = llngEnd - llngStart
ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength))
End Function

Private Function ParseName(ByRef pstrDisposition)
Dim llngStart
Dim llngEnd
Dim llngLength
llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare)
If llngStart = 0 Then Exit Function
llngEnd = InStr(llngStart + 6, pstrDisposition, """")
If llngEnd = 0 Then Exit Function
llngStart = llngStart + 6
If llngStart >= llngEnd Then Exit Function
llngLength = llngEnd - llngStart
ParseName = Mid(pstrDisposition, llngStart, llngLength)
End Function
' ------------------------------------------------------------------------------
Private Function ParseFileName(ByRef pstrDisposition)
Dim llngStart
Dim llngEnd
Dim llngLength
llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare)
If llngStart = 0 Then Exit Function
llngEnd = InStr(llngStart + 10, pstrDisposition, """")
If llngEnd = 0 Then Exit Function
llngStart = llngStart + 10
If llngStart >= llngEnd Then Exit Function
llngLength = llngEnd - llngStart
ParseFileName = Mid(pstrDisposition, llngStart, llngLength)
End Function

Public Property Get Count()
Count = mlngCount
End Property

Public Default Property Get Fields(ByVal pstrName)
Dim llngIndex
If IsNumeric(pstrName) Then
llngIndex = CLng(pstrName)
If llngIndex > mlngCount - 1 Or llngIndex < 0 Then
Call Err.Raise(vbObjectError + 1, "inc_clsUpload.asp", "Object does not exist within the ordinal reference.")
Exit Property
End If
Set Fields = mobjFieldAry(pstrName)
Else
pstrName = LCase(pstrname)
For llngIndex = 0 To mlngCount - 1
If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then
Set Fields = mobjFieldAry(llngIndex)
Exit Property
End If
Next
End If
Set Fields = New clsField
End Property

Private Sub Class_Terminate()
Dim llngIndex
For llngIndex = 0 To mlngCount - 1
Set mobjFieldAry(llngIndex) = Nothing

Next
ReDim mobjFieldAry(-1)
End Sub

Private Sub Class_Initialize()
ReDim mobjFieldAry(-1)
CR = ChrB(Asc(vbCr))
LF = ChrB(Asc(vbLf))
CRLF = CR & LF
mlngCount = 0
Call RequestData
Call ParseDelimiter()
Call ParseData
End Sub

Private Function CStrU(ByRef pstrANSI)
Dim llngLength
Dim llngIndex
llngLength = LenB(pstrANSI)
For llngIndex = 1 To llngLength
CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1)))
Next
End Function

Private Function CStrB(ByRef pstrUnicode)
Dim llngLength
Dim llngIndex
llngLength = Len(pstrUnicode)
For llngIndex = 1 To llngLength
CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1)))
Next
End Function
End Class
'####################################
Class clsField
Public Name
Private mstrPath
Public FileDir
Public FileExt
Public FileName
Public ContentType
Public Value
Public BinaryData
Public Length
Private mstrText

Public Property Get BLOB()
BLOB = BinaryData
End Property

Public Function BinaryAsText()
Dim lbinBytes
Dim lobjRs
If Length = 0 Then Exit Function
If LenB(BinaryData) = 0 Then Exit Function

If Not Len(mstrText) = 0 Then
BinaryAsText = mstrText
Exit Function
End If
lbinBytes = ASCII2Bytes(BinaryData)
mstrText = Bytes2Unicode(lbinBytes)
BinaryAsText = mstrText
End Function

Public Sub SaveAs(ByRef pstrFileName)
Const adTypeBinary=1
Const adSaveCreateOverWrite=2
Dim lobjStream
Dim lobjRs
Dim lbinBytes
'check length
If Length = 0 Then Exit Sub
'check size
If LenB(BinaryData) = 0 Then Exit Sub

Set lobjStream = Server.CreateObject("ADODB.Stream")
lobjStream.Type = adTypeBinary
Call lobjStream.Open()
lbinBytes = ASCII2Bytes(BinaryData)
Call lobjStream.Write(lbinBytes)

On Error Resume Next

Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite)

if err<>0 then response.Write "<br>"&err.Description

Call lobjStream.Close()
Set lobjStream = Nothing
End Sub

Public Property Let FilePath(ByRef pstrPath)
mstrPath = pstrPath
If Not InStrRev(pstrPath, ".") = 0 Then
FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1)
FileExt = UCase(FileExt)
End If
If InStrRev(pstrPath, "\") = 0 Then
FileName=pstrPath
Else
FileName = Mid(pstrPath, InStrRev(pstrPath, "\") + 1)
End If
If Not InStrRev(pstrPath, "\") = 0 Then
FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "\") - 1)
End If
End Property

Public Property Get FilePath()
FilePath = mstrPath
End Property

private Function ASCII2Bytes(ByRef pbinBinaryData)
Const adLongVarBinary=205
Dim lobjRs
Dim llngLength
Dim lbinBuffer
llngLength = LenB(pbinBinaryData)
Set lobjRs = Server.CreateObject("ADODB.Recordset")
Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
Call lobjRs.Open()
Call lobjRs.AddNew()
Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
Call lobjRs.Update()
lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
Call lobjRs.Close()
Set lobjRs = Nothing
ASCII2Bytes = lbinBuffer
End Function

Private Function Bytes2Unicode(ByRef pbinBytes)
Dim lobjRs
Dim llngLength
Dim lstrBuffer
llngLength = LenB(pbinBytes)
Set lobjRs = Server.CreateObject("ADODB.Recordset")
Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)
Call lobjRs.Open()
Call lobjRs.AddNew()
Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes)
Call lobjRs.Update()
lstrBuffer = lobjRs.Fields("BinaryData").Value
Call lobjRs.Close()
Set lobjRs = Nothing
Bytes2Unicode = lstrBuffer
End Function
End Class
'######################################################################################


Function logActivity(txtToLog)
if FSOenabled then
'on error resume next
'log
if logFlag = "1" then
if logFile = "" then
logFile = "upload.txt "
end if
Set fsoLog = Server.CreateObject("Scripting.FileSystemObject")
Set logFile = fsoLog.OpenTextFile(remotePathMapped & "\" & logFile, 8, True)
logFile.WriteLine(txtToLog)
logFile.close
set logFile = nothing
set fsoLog = nothing
end if
end if
end function

function checkExt(byRef sName, byRef sExt)
dim allowed, upl
allowed = false
if ar = true then
for upl = 0 to ubound(extAllowed)
if lcase(sExt) = lcase(extAllowed(upl)) then
allowed = true
end if
next
else
if lcase(extAllowed) = lcase(sExt) then
allowed = true
end if
end if

if allowed = false then
sString = sString & "<li>" & txtFileNotAllowed & " - <b>." & sExt & "</b></li>"
'log
txt = txtDate & ": " & Date() & "- " & txtAction & ": " & txtBadFileType & "(" & sExt & ") - " & txtUsrName & ": " & session.contents("loggedUser") & " - " & txtFileName & ": " & sName & " - " & txtUploaded & ": " & txtNo
logActivity(txt)
end if
checkExt = allowed
end function

function checkSize(byRef sName, byRef sSize)
dim allowed
allowed = false
if sSize > sizeLimit then
allowed = false
else
allowed = true
end if

if allowed = false then
sString = sString & "<li>" & txtFileTooLg & " '<b>" & (sizeLimit/1000) & " kb</b>'</li>"
sString = sString & "<li>" & txtFileSzIs & " '<b>" & FormatNumber(sSize/1000,0) & " kb</b>'</li>"
'log
txt = txtDate & ": " & Date & "- " & txtAction & ": " & txtBadFileSize & "(" & FormatNumber(sSize/1000,0) & " kb) - " & txtUsrName & ": " & session.contents("loggedUser") & " - " & txtFileName & ": " & sName & " - " & txtUploaded & ": " & txtNo
logActivity(txt)
end if
checkSize = allowed
end function

function checkThere(byRef sName, byRef sSize)
dim allowed
if sSize > 0 then
if sName <> "" then
allowed = true
else
allowed = false
end if
else
allowed = false
end if

if allowed = false then
sString = sString & "<li>" & txtNoFile & "</li>"
end if
checkThere = allowed
end function

function DateToStr3(dtDateTime)
DateToStr3 = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & ""
end function

function doublenum(fNum)
if fNum > 9 then
doublenum = fNum
else
doublenum = "0" & fNum
end if
end function

function addslash(path)
if right(path,1)="\" then addslash=path else addslash=path & "\"
end function

sub Upload()
dim f,i,name,path,size,success,memID,ext

set objUpload=New clsUpload

success=false
'targetPath=objUpload.Fields("folder").Value
max=objUpload.Fields("max").Value
if max = "" or max < 1 then
max = 1
end if
upCntr = 0
memID = objUpload.Fields("memID").Value
today = datetostr3(now())

'if hasAccess(grpsAllowed) then
bHasGrpAccess = true
for i = 1 to max
name=objUpload.Fields("file" & i).FileName
filename=objUpload.Fields("file" & i).FileName
size=objUpload.Fields("file" & i).Length
ext = objUpload.Fields("file" & i).FileExt

if checkThere(name,size)=true and checkExt(name,ext)=true and checkSize(name,size)=true then
upCntr = upCntr + 1
uploadPg = true
redim preserve arrUplds(upCntr,1)
arrUplds(0,0) = true
arrUplds(0,1) = ""
arrUplds(upCntr,0) = filename

'build the full path name
filename = today & "_" & memID & "_" & i & "." & ext
path=addslash(remotePathMapped) & filename
'this line tells it to upload.
objUpload.Fields("file" & i).SaveAs path

arrUplds(upCntr,1) = filename

'check to validate the upload
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if objFSO.FileExists(path) then
'on error resume next
set f=objFSO.GetFile(path)
if IsObject(f) then
if f.Size=size then success=true else success=false
end if
set f=nothing
end if

'if upload is an image, attempt to resize if needed and create a thumbnail.
if (lcase(ext) = "gif" or lcase(ext) = "jpg" or lcase(ext) = "png" or lcase(ext) = "bmp") and success = true and intResize = 1 then '
if imgSizeChk(path, w, h, c, strType) = true then
if h > intMaxH or w > intMaxW then
' response.Write("remotePath:" & remotePath & "<br>")
'response.Write("remotePath mapped:" & server.MapPath(remotePath) & "<br>")
'response.Write("intMaxW:" & intMaxW & "<br>")
'response.Write("intMaxH:" & intMaxH & "<br>")
'response.Write("filename:" & filename & "<br>")
'response.Write("Start resize<br>")
ResizeUploadedFiles remotePath,"_rs",intMaxW,intMaxH,rsQuality,false,filename
'response.Write("finish resize<br>")
else
'rename
Old_ext = lcase("."&ext&"")
new_ext = lcase("_rs."&ext&"")
copyTo = replace(lcase(path),Old_ext,new_ext)
objFSO.CopyFile path,copyTo
end if
if intDoThumb = 1 then
'response.Write("<br>Start make thumb<br>")
if h > intMaxTH or w > intMaxTW then
'response.Write("Start thumb resize<br>")
ResizeUploadedFiles remotePath,"_sm",intMaxTW,intMaxTH,rsQualityThumb,false,filename
'response.Write("finish thumb resize<br>")
else
'response.Write("No resize needed<br>")
'rename
Old_ext = lcase("."&ext&"")
new_ext = lcase("_sm."&ext&"")
copyTo = replace(lcase(path),Old_ext,new_ext)
objFSO.CopyFile path,copyTo
end if
end if
end if
end if
set objFSO = nothing
if not success then
uString = uString & "<li><span class=""fAlert"">failed</span></li>"
end if
end if
next
'end if ':: hasAccess() check
'response.write "<br>" & w & " x " & h & " " & c & " colors"
'response.End()
end sub
'###########################################################################
function moveToLoc(loc)
on error resume next
set fso = Server.CreateObject("Scripting.FileSystemObject")
dirPath = server.MapPath(loc) & "\"
if fso.FolderExists(server.MapPath(loc)) = false then
fso.CreateFolder(server.MapPath(loc))
end if
if fso.FolderExists(server.MapPath(loc)) = false then
sString = sString & "<li>" & loc & " " & txtNotCreated & "</li>"
end if
if fso.FolderExists(dirPath & parent) = false and sString = "" then
fso.CreateFolder(dirPath & parent)
end if
if fso.FolderExists(dirPath & parent) = false and sString = "" then
sString = sString & "<li>" & loc & parent & "<br>" & txtNotCreated & "</li>"
end if
if fso.FolderExists(dirPath & parent & "\" & cat) = false and sString = "" then
fso.CreateFolder(dirPath & parent & "\" & cat)
end if
if fso.FolderExists(dirPath & parent & "\" & cat) = false and sString = "" then
sString = sString & "<li>" & loc & "\" & parent & "\" & cat & "<br>" & txtNotCreated & "</li>"
end if
if fso.FileExists(dirPath & uLoad) = true then
fso.MoveFile dirPath & uLoad, dirPath & parent & "\" & cat & "\" & uLoad
else
'sString = sString & "<li>Failed to Upload file</li>"
end if
if not fso.FileExists(dirPath & parent & "\" & cat & "\" & uLoad) = true then
if sString = "" then
sString = sString & "<li>" & txtFileNoMove & "</li>"
end if
end if
set fso = nothing
end function

function chkIsFileThere(daPath)
isThere = false
if FSOenabled then
set obFSO = Server.CreateObject("Scripting.FileSystemObject")
if obFSO.FileExists(daPath) = true then
isThere = true
end if
set obFSO = nothing
end if
chkIsFileThere = isThere
end function

function deleteFile(daPath)
if FSOenabled then
set obFSO = Server.CreateObject("Scripting.FileSystemObject")
if obFSO.FileExists(daPath) = true then
obFSO.DeleteFile(daPath)
end if
set obFSO = nothing
end if
end function


%>