Simple HTA script to resize folder of photos - hta

I am using a command line version of resize.exe (a program to resize images)
I am trying to create a simple HTA application that will receive user input and pass it to a CMD. The problem here is that my batch script is failing when placing it in the VBS.
Am I escaping this wrong or is there something else that needs to be added?
<html>
<head>
<title>HTA Test</title>
<HTA:APPLICATION
ID="objTest"
APPLICATIONNAME="HTA Test"
SCROLL="no"
SINGLEINSTANCE="yes"
>
</head>
<SCRIPT LANGUAGE="VBScript">
Sub TestSub
Dim height
Dim width
height = h.Value
width = w.Value
myCMD = "CMD for /r ""C:\hta\photos\"" %%X in (*) do (""C:\hta\resize.exe"" -i""C:\hta\photos\%%~nX%%~xX"" -o""C:\hta\resized\%%~nX%%~xX"" -s800x600) PAUSE"
Set WshShell = CreateObject("WScript.Shell")
WshShell.exec(myCMD)
End Sub
</SCRIPT>
<body>
Width <input type="text" name="w" size="10" value="320"><br>
Height <input type="text" name="h" size="10" value="240"><br>
<input type="submit" name="" value="sub" onClick="TestSub">
</body>


I just downloaded the Resize.exe and i made a little batch to test it on my PC and it works 5/5 with this batch, i know you tagged for HTA, so just test this batch and i will try to integrate it on the HTA.
Just give a try for this batch for this moment :
#echo off
Title Batch Photos ReSizer
set RootFolder=C:\hta
set InputFolder=C:\hta\Photos\
set OutputFolder=%RootFolder%\Resized-photos
set /p Width=Choose the Width :
set /p Height=Choose the Height :
echo.
echo You have choosen to resize your photos in this resolution %Width%x%Height%
echo.
pause
echo. & echo Resizing photos is in Progress ...
if not exist %OutputFolder% MD %OutputFolder%
for /r %InputFolder% %%A in (*) do ("C:\hta\resize.exe" -i"%InputFolder%\%%~nxA" -o"%OutputFolder%\%%~nxA" -s%Width%x%Height%)
pause
Start Explorer "%OutputFolder%"


Here is the HTA that can write the batch file and execute it :
<html>
<head>
<title>HTA Photos Resizer by Hackoo</title>
<HTA:APPLICATION
SCROLL="no"
ICON="nslookup.exe"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="no"
CAPTION="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
SYSMENU="yes"
BORDER="thin"
BORDERSTYLE="Normal"
CONTEXTMENU="no"
SELECTION="no">
<style type="text/css">
body {
font-family:Verdana;
font-size: 12px;
color: #49403B;
background: Cyan;
text-align: center;
}
</style>
</head>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim Title,fso
Title = "HTA to Batch Resizer Photos by Hackoo"
Set fso = CreateObject("Scripting.FileSystemObject")
Sub Window_OnLoad()
CenterWindow 350,260
If Not fso.FileExists("resize.exe") Then
MsgBox "You must check "& DblQuote("resize.exe") &" is in the same folder of this HTA",VbCritical+VbSystemModal,Title
Exit Sub
End If
End Sub
'************************************************************************************************
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x,y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft,itop
End Sub
'************************************************************************************************
Sub ResizePhotos()
Dim Title,fso,InputFolder,ParentFolder,OutputFolder,MyTab,height,width,objOutputFile,BatchFile,WshShell,Exec
Title = "HTA to Batch Resizer Photos by Hackoo"
BatchFile = "Resizer.bat"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = fso.OpenTextFile(BatchFile,2,True)
height = h.Value
width = w.Value
InputFolder = TxtInputFolder.value
If InputFolder = "" Then
MsgBox "You must select the source folder",VbCritical+VbSystemModal,Title
Exit Sub
End If
ParentFolder = fso.GetParentFolderName(InputFolder)
MyTab = Split(InputFolder,"\")
OutPutFolder = ParentFolder & "\" & MyTab(UBound(MyTab)) & "_Resized"
objOutputFile.WriteLine "#echo off & mode con cols=70 lines=6 & color 9B"
objOutputFile.WriteLine "Title Batch Photos ReSizer"
objOutputFile.WriteLine "set InputFolder="& InputFolder &""
objOutputFile.WriteLine "set OutputFolder="& OutPutFolder &""
objOutputFile.WriteLine "echo."
objOutputFile.WriteLine "echo You have choosen to resize your photos in this resolution "& width &"x"& height &""
objOutputFile.WriteLine "echo."
objOutputFile.WriteLine "pause"
objOutputFile.WriteLine "Cls & echo. & echo Resizing photos is in Progress ..."
objOutputFile.WriteLine "if not exist %OutputFolder% MD %OutputFolder%"
objOutputFile.WriteLine "for /r "& DblQuote(InputFolder) &" %%A in (*) do (resize.exe -i"& DblQuote(InputFolder &"\%%~nxA") &" -o"& DblQuote(OutputFolder &"\%%~nxA")&" -s"& width&"x"& height &")"
objOutputFile.WriteLine "Start Explorer ""%OutputFolder%"""
objOutputFile.Close
Set objOutputFile = Nothing
Set WshShell = CreateObject("WScript.Shell")
Exec = WshShell.Run(BatchFile,1,True)
fso.DeleteFile BatchFile
End Sub
'***********************************************************************
Function PickFolder(strStartDir)
Dim SA,F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0,"Choose the source folder",1,strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function
'***********************************************************************
Sub BrowseSource_OnClick()
Dim strStartDir
strStartDir = "c:\Programs"
TxtInputFolder.value = PickFolder(strStartDir)
End Sub
'***********************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'***********************************************************************
</SCRIPT>
<body>
Select the source folder :
<input type = "text" Value="c:\hta\photos" name = "TxtInputFolder" size="40"/><br><br>
<input type = "button" value = "Browse for the source Folder" Name="BrowseSource"><br><br>
Width <input type="text" name="w" size="6" value="320"><br>
Height <input type="text" name="h" size="6" value="240"><br><br>
<input type="submit" name="" value="Resize my photos" onClick="ResizePhotos">
</body>

Related

Cannot pass value to page through HtmlGenericControl Property

Here is the .aspx file
<form id="form1" runat="server">
<input type="text" id="StringValue" runat="server"/>
<datalist id="dataList" runat="server"></datalist>
<% CreateContent(_sql)%>
</form>
And here is the .vb file (CreateContent)
Protected Sub CreateContent(ByVal sql As String)
Dim optList As New List(Of String)
optList = GetData(sql)
Dim table As New DataTable()
table.Columns.Add(New DataColumn("DataOptions"))
For Each opt In optList
table.Rows.Add(opt)
Next
For Each row In table.Rows
dataList.InnerHtml = dataList.InnerHtml & vbCrLf & String.Format("<option value='{0}'>", row(0))
Next
MsgBox(dataList.InnerHtml)
End Sub
When I tested the page, the MsgBox could actually show all the <option> elements. However, these contents can only exist in server side. <datalist> is always empty in page source. Anyone can explain what prevent the content being passed to the page and how to solve it?

asp.net and vb.net code for sending emails to multiple email address via smtp

I am a new in coding asp.net and vb.net. I have a web form built with asp.net and vb.net .
In the front end of the there are four fields constructed as below.
Recipient Mailing List : Drop down List (the options in the drop down list are such as Managers, HR, Admin, IT etc. Each option name contains multiple email addresses. i.e selecting one option means The user selects one group of of email address in the recipient field )
From Field : Text box (Read Only )
Subject : Text box
Message : Textarea
Send email button
The asp.net front end code is like below.
<asp:Content ID="Content1" ContentPlaceHolderID="MainContent" runat="Server">
<div class="aux-body">
<div class="aux-body-content">
<div class="form-element">
<label>Recipient Mailing list </label>
<select runat="server" class="" id="comMailingList" datatextfield="name" datavaluefield="id"></select>
</div>
<div class="form-element">
<label> From </label>
<input style="width: 98%;" runat="server" id="txtFrom" type="text" value="Careers portal" readonly="readonly" />
</div>
<div class="form-element">
<label> Subject </label>
<input style="width: 98%;" runat="server" id="txtSubject" class="msubject" type="text" />
</div>
<div class="form-element">
<label> Message </label>
<textarea style="width: 98%; height: 100px;" runat="server" id="txtText" ></textarea>
</div>
<div id="button-group">
<asp:LinkButton runat="server" ID="btnSend" CssClass="btn" Text="Send Email"></asp:LinkButton>
</div>
</div>
</div>
</asp:Content>
In the back end i have structured the VB.net code like following. But i am unable to write the code that will send the email.
Partial Class E4_Candidate_broadcast
Inherits System.Web.UI.Page
Protected Sub Page_Load(sender As Object, e As EventArgs) Handles Me.Load
If Not IsPostBack Then
If Not IsNothing(Request("b")) Then
cid.Value = Request("b")
End If
litMyEmail.Text = UserEmail
comMailingList.DataSource = Lists
comMailingList.DataBind()
End If
End Sub
Public ReadOnly Property Lists() As DataTable
Get
Return DB.GetData("select ml.id, ml.name + ' (' + cast( count(mlc.mailinglistid) as nvarchar(10)) + ' contacts)' name from mailinglist ml join mailinglistcontact mlc on ml.id = mlc.mailinglistid where ml.deleted = 0 and ml.createdby in (select userid from employeruser where employerid = #eid) group by ml.id, ml.name having count(mlc.mailinglistid) > 0 order by ml.name", DB.SIP("eid", LocalHelper.UserEmployerID()))
End Get
End Property
Protected Sub btnSend_Click(sender As Object, e As EventArgs) Handles btnSend.Click
If Not String.IsNullOrWhiteSpace(txtSubject.Value) Then
''Selects the recipients name and email address
Dim contacts = DB.GetData("select title, name, surname, email from mailinglistcontact where mailinglistid = #mlid", DB.SIP("mlid", comMailingList.Value)), _
mailers = New DataTable(), _
mailerqueue = New DataTable(), _
scheduleat = Now
For Each contact As DataRow In contacts.Rows
''''Code for sending email''''
Next
Response.Redirect("broadcast-sent-complete.aspx?i=" & cbId)
End If
End Sub
End Class
I have seen several examples by googling and found several links. But I am surely not understanding many things which are essential to code for sending emails.
I will be very much obliged if you help me write the code to send emails.
Thank you
Update
I have tried the following code. but its not working. i.e. the email is not sending.the code is going to the exception and saying message sending mailed. please have a look at my code and point me my error.
Dim message As New MailMessage()
For Each contact As DataRow In contacts.Rows
Try
Dim Client As New System.Net.Mail.SmtpClient
With Client
If WebConfigurationManager.AppSettings("smtpserver").Length > 0 Then
.DeliveryMethod = Net.Mail.SmtpDeliveryMethod.SpecifiedPickupDirectory 'Net.Mail.SmtpDeliveryMethod.Network
.PickupDirectoryLocation = "c:/outbox/"
.Host = WebConfigurationManager.AppSettings("smtpserver")
Else
.DeliveryMethod = Net.Mail.SmtpDeliveryMethod.PickupDirectoryFromIis
End If
With message
Dim FromAddress As MailAddress = New MailAddress("noreply#mypeoplebiz.com")
.From = FromAddress
.[To].Add(contact.Item("email").ToString())
.Subject = txtSubject.Value
.IsBodyHtml = True
.Priority = MailPriority.Normal
.BodyEncoding = Encoding.Default
If Not String.IsNullOrWhiteSpace(txtHtml.Value) Then
.Body = txtHtml.Value
End If
If Not String.IsNullOrWhiteSpace(txtText.Value) Then
.Body = txtText.Value
End If
End With
.Send(message)
End With
Catch Ex As Exception
_error = Ex.Message
End Try
Next

Stop ASP script auto-running on page load

I'm having a problem here. I've created a page for adding records into a database, it's working fine however the asp script is running every time the page loads, inputting a blank record to the database each time the page is loaded, this is very annoying as it messes with other scripts I have. I feel I am being very stupid but all I need is for the script to run only once the submit button has been clicked, how do I get it to do this?
<!DOCTYPE html>
<html>
<title>
Teacher Registration
</title>
<body>
<h1>
Teacher registration
</h1>
<form name="teacherReg" action="Registration.asp" method="POST">
First name:<input type="text" name="firstname"><br>
Last name:<input type="text" name="lastname"><br>
Password :<input type="password" name="password">
<input type="submit" value="submit">
</form>
<%
set conn=Server.CreateObject("ADODB.Connection")
conn.Open ="Driver={SQL Server}; Server=QuizDynamics.db.11989315.hostedresource.com; Database=QuizDynamics; Uid=QuizDynamics; Pwd=Compostheap12!;"
set rs=Server.CreateObject("ADODB.recordset")
rs.Open "Select * from teachers", conn
sql="INSERT INTO teachers (firstname, password, lastname)"
sql=sql & " VALUES "
sql=sql & "('" & Request.Form("firstname") & "',"
sql=sql & "'" & Request.Form("password") & "',"
sql=sql & "'" & Request.Form("lastname") & "')"
on error resume next
conn.Execute sql,recaffected
if err<>0 then
Response.Write("No update permissions!")
else
Response.Write("<h3>" & recaffected & " record added</h3>")
end if
conn.close
%>
</body>
</html>

Give your submit input a name attribute - eg submitbutton - then do something like
if request.form("submitbutton") <> "" then
'put your insert code here
End if

Add and Remove HTA components dynamically

Can anybody help me how to remove textboxes dynamically in HTA?
This code adds textboxes dynamically:
Sub AddTextBox
strHTML = DataArea.InnerHTML strHTML=strHTML&"<tr><td>Source Path</td><td><input type="&Chr(34)& _ "text"&Chr(34)&">"&"</td><td><button type="&Chr(34)&"button"&Chr(34)& _ "onclick="&Chr(34)&"RemoveTextBox"&Chr(34)&">"&"x"&"</button></td></tr>"
DataArea.InnerHTML = strHTML
tabHTML = tabHTML & strHTML
End Sub

I believe this is similar to what you are looking for, this will at least give you a working example you can build from. The Window_OnLoad subroutine loads the initial content then the newly created content contains a button which when clicked removes the textbox/button and adds a new button labeled Add Again?. This new button can call the Window_OnLoad subroutine again and reload the original content.
<html>
<head>
<title>Dynamically Add Controls</title>
<HTA:APPLICATION
APPLICATIONNAME="Dynamically Add Controls"
ID="Dynamically_Add_Controls"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
strHTML = "<tr><td>Source Path</td><td><input type="& Chr(34)& "text"&Chr(34)&">"&"</td><td><button type="&Chr(34)&"button"&Chr(34)& "onclick="&Chr(34)&"RemoveTextBox"&Chr(34)&">"&"Remove All?"&"</button></td></tr>"
DataArea.InnerHTML = strHTML
End Sub
Sub RemoveTextBox()
strHTML = "<td><button type="&Chr(34)&"button"&Chr(34)& "onclick="&Chr(34)&"Window_OnLoad"&Chr(34)&">"&"Add Again?"&"</button></td></tr>"
DataArea.InnerHTML = strHTML
End Sub
</script>
<body bgcolor="white">
<table border="0" cellspacing="0" cellpadding="0">
<tr>
<td valign="top"><Div id="DataArea"></Div></td>
</tr>
</table>
</body>
</html>

Multiple Uploads

hey I need the help with the following.
I have a website,
altough I was not a 100% programmer, I am trying to navigate within the programming of the site. It work in asp.net 2.0.
I have an image gallery, but the only problem is that I can only upload 1 image at a time. I need some help how i can integrate multiple images on the site.
below is the coding for album.asp
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!-- #INCLUDE file="inc/settings.asp" -->
<!-- #INCLUDE file="inc/functions.asp" -->
<!-- #INCLUDE file="inc/db_connect.asp" -->
<!-- #INCLUDE file="inc/check_login.asp" -->
<!--#INCLUDE file="fckeditor/fckeditor.asp" -->
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<script type="text/javascript" src="js/script.js"></script>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Xaghra Scouts</title>
<link href="styles.css" rel="stylesheet" type="text/css" />
<%
cat = decrypt(request("cat") & "")
set fs=Server.CreateObject("Scripting.FileSystemObject")
isSub = true
%>
</head>
<body>
<!-- #INCLUDE file="layout_top.asp" -->
<%if loggedin then%>
<table align="center" border="0" cellspacing="0" cellpadding="5" class="main">
<tr >
<td align="center" style="padding:15px;" colspan="2">
<form action="album.asp" method="post" id="selectCategory">
<b>SELECT CATEGORY: </b>
<select name="cat" style="font-size:12px; width:160px; height:19px;" onChange="javascript: document.getElementById('selectCategory').submit();">
<option selected>Uncategorized</option>
<%
set fo=fs.GetFolder(Server.MapPath("images/gallery"))
for each x in fo.SubFolders
Response.write("<option value='" & encrypt(x.Name) & "'")
if cat = x.Name then
response.write("selected")
end if
Response.write(">" & x.Name & "</option>")
next
%>
</select>
</form>
</td>
</tr>
<tr style="color:#666666; font-size:12px;">
<td colspan="2" align="left">
<br>
<%
if cat <> "" and fs.FolderExists(Server.MapPath("images/gallery/" & cat)) then
set fo=fs.GetFolder(Server.MapPath("images/gallery/" & cat))
path = "gallery/" & cat
else
set fo=fs.GetFolder(Server.MapPath("images/gallery"))
path = "gallery"
end if
for each file in fo.files
if right(lcase(file.Name),3) = "jpg" then%>
<div style="height:120px; width:160px; text-align:center; float:left;"><img src="thumbnail.aspx?picture=<%=server.URLEncode("images/" & path & "/" & file.Name)%>&maxWidth=160&maxHeight=100" style="border:1px solid #ffffff;"><br>
<a onClick="javascript:ConfirmChoice('Are you sure you wish to delete this picture?','delete_image.asp?cat=<%=encrypt(cat)%>&file=<%=Server.URLEncode("images/" & path & "/" & file.Name)%>');"href="#" style="font-size:10px">DELETE</a></div>
<%end if
next
%>
</tr>
<tr style="color:#666666; font-size:12px;">
<td colspan="2" align="left">
<div style="text-align:center;">
<form action="file_upload.asp?FileName=<%=Server.URLEncode(uniqueName())%>&FilePath=<%=Server.URLEncode("images/" & path)%>&AcceptedFiles=<%=Server.URLEncode("JPG")%>&Redirect=<%=Server.URLEncode("album.asp")%>&MaxHeight=480&MaxWidth=640" enctype="multipart/form-data" method="post">
<table align="center" border="0" cellspacing="0" cellpadding="20" class="main">
<tr>
<td align="center" class="details">
<div style="color:#FF0000; font-size:10px;"><%if (request.QueryString("formatError") & "") <> "" then%>INVALID FILE FORMAT ( .JPG ONLY )<%end if%> </div><br>
<input name="file" type="file" accept="jpg/jpeg" class="input"> <input name="upload" value="Upload" type="submit" ></td>
</tr>
</table>
</form>
</div>
<br>
</td>
</tr>
<tr style="font-size:12px;">
<td class="list_title" align="center" style="padding:15px;">
<form action="add_category.asp" method="post" id="addCategory">
<span><b>NEW CATEGORY:</b></span>
<input name="cat" type="text" style="width:140; font-size:12px;">
<input name="" type="submit" value="ADD" style="font-size:10px;">
</form>
</td>
<td class="list_title" align="center" style="padding:15px;">
<form action="delete_category.asp" method="post" id="deleteCategory">
<span><b>DELETE CATEGORY: </b></span>
<select name="cat" style="font-size:12px; width:130px; height:19px;">
<option selected>-- select --</option>
<%
set fo=fs.GetFolder(Server.MapPath("images/gallery"))
for each x in fo.SubFolders
Response.write("<option value='" & x.Name & "'>" & x.Name & "</option>")
next
%>
</select>
<input type="button" value="REMOVE" style="font-size:10px;" onClick="javascript:ConfirmFormChoice('Are you sure you wish to delete this category and all of its contents?','deleteCategory');">
</form>
</td>
</tr>
</table>
<%else%>
<table width="700" border="0" cellspacing="0" cellpadding="0">
<tr>
<td align="center" style="padding-left:30px">
<div style="float:none;">
<%if cat <> "" and fs.FolderExists(Server.MapPath("images/gallery/" & cat)) then
set fo=fs.GetFolder(Server.MapPath("images/gallery/" & cat))
path = "images/gallery/" & cat
else
set fo=fs.GetFolder(Server.MapPath("images/gallery"))
path = "images/gallery"
end if
for each folder in fo.subfolders ' display categorises
isSub = false%>
<a href="album.asp?cat=<%=encrypt(folder.Name)%>" style="text-decoration:none; cursor:pointer;">
<div class="text" style="width:90px; height:120px;background-image:url(images/layout/folder.jpg); background-repeat:no-repeat; float:left; text-align:center;"><br /><br />
<%set fi=fs.GetFolder(Server.MapPath("images/gallery/" & folder.Name))
for each file in fi.files
if right(lcase(file.Name),3) = "jpg" then%>
<br><img src="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & folder.Name & "/" & file.Name)%>&maxWidth=40&maxHeight=30" style="border:1px solid #ffffff; cursor:default;" /><%
exit for
end if
next
%><br><br><span style="font-size:9px; font-weight:normal; color:#000"><%=folder.Name%></span></div>
</a>
<%next%>
</div>
</td>
</tr>
<tr>
<td align="center" style="padding-left:30px;">
<br />
<hr noshade="noshade" size="1px" color="#ffb883" width="400px" />
<%for each file in fo.files ' display uncategorized pics
if right(lcase(file.Name),3) = "jpg" then%>
<a href="thumbnail.aspx?picture=<%=server.URLEncode(path & "/" & file.Name)%>&maxWidth=640&maxHeight=480" target="_blank" style="text-decoration:none; cursor:pointer;">
<img src="thumbnail.aspx?picture=<%=server.URLEncode(path & "/" & file.Name)%>&maxWidth=160&maxHeight=100" style="border:1px solid #ffffff; margin:5px; margin-top:14px;">
</a>
<%end if
next%>
<br /><br />
<%if isSub then%>
<hr noshade="noshade" size="1px" color="#ffb883" width="400px" />
<div align="center" style="padding-left:20px;">BACK TO MAIN ALBUM</div>
<%end if%>
</td>
</tr>
</table>
<%end if%>
<!-- #INCLUDE file="layout_bottom.asp" -->
</body>
</html>
BELOW IS THE CODING FOR FILE_UPLOAD.ASP
<%
Option Explicit
' used to track various positions
dim PosB, PosBBound, PosEBound, PosEHead, PosBFld, PosEFld
' these handle the data
dim Boundary, BBoundary, PartBHeader, PartAHeader, PartContent, PartContent2, Binary
' for writing and converting
dim fso, fle, rst, DataString, FileName
' various other
dim I, Length, ContType, PartName, LastPart, BCrlf, PartContentLength
dim MaxWidth, MaxHeight, NewFileName, FilePath, AcceptedFiles, Redirect, Extension, SavedFileName, Image, NewHeight, otherExtension
Session.Timeout = 30
'Allow 300 seconds for file to upload
Server.ScriptTimeout = 300
MaxWidth = CINT(Request.QueryString("MaxWidth"))
MaxHeight = CINT(Request.QueryString("MaxHeight"))
NewFileName = Request.QueryString("FileName")
FilePath = Request.QueryString("FilePath")
AcceptedFiles = Request.QueryString("AcceptedFiles")
Redirect = Request.QueryString("Redirect")
' ado constants
const adLongVarBinary = 205
const adLongVarchar = 201
' must be submitted using POST
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
ContType = Request.ServerVariables("HTTP_Content_Type")
' must be "multipart/form-data"
If LCase(Left(ContType, 19)) = "multipart/form-data" Then
PosB = InStr(LCase(ContType), "boundary=") 'get boundary
If PosB > 0 Then Boundary = Mid(ContType, PosB + 9) 'we have one
'bugfix IE5.01 - double header
PosB = InStr(LCase(ContType), "boundary=")
If PosB > 0 then
PosB = InStr(Boundary, ",")
If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)
End If
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
End If
If Length > 0 And Boundary <> "" Then
Boundary = "--" & Boundary
' get request, binary
Binary = Request.BinaryRead(Length)
' convert boundry to binary
For I=1 to len(Boundary)
BBoundary = BBoundary & ChrB(Asc(Mid(Boundary,I,1)))
Next
' binary crlf
BCrlf = ChrB(Asc(vbCr)) & ChrB(Asc(vbLf))
' get begin and end of first boundary
PosBBound = InStrB(Binary, BBoundary)
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary, 0)
' keep doing until we had them all
Do While (PosBBound > 0 And PosEBound > 0)
' get position of the end of the header
PosEHead = InStrB(PosBBound + LenB(BBoundary), Binary, BCrlf & BCrlf)
' get content of header and convert to string
PartBHeader = MidB(Binary, PosBBound + LenB(BBoundary) + 2, PosEHead - PosBBound - LenB(BBoundary) - 2)
PartAHeader = ""
For I=1 to lenb(PartBHeader)
PartAHeader = PartAHeader & Chr(AscB(MidB(PartBHeader,I,1)))
Next
' make sure we end it with ;
If Right(PartAHeader,1) <> ";" Then PartAHeader = PartAHeader & ";"
' get content of this part
PartContent = MidB(Binary, PosEHead + 4, PosEBound - (PosEHead + 4) - 2)
' get name of part
PosBFld = Instr(lcase(PartAHeader),"name=")
If PosBFld > 0 Then
' name found
PosEFld = Instr(PosBFld,lcase(PartAHeader),";")
If PosEFld > 0 Then
' well-formed name header
PartName = Mid(PartAHeader,PosBFld+5,PosEFld-PosBFld-5)
End If
' chop of leading and trailing "'s
Do Until Left(PartName,1) <> """"
PartName = Mid(PartName,2)
Loop
Do Until Right(PartName,1) <> """"
PartName = Left(PartName,Len(PartName)-1)
Loop
End If
' get file name of part (if any)
PosBFld = Instr(lcase(PartAHeader),"filename=""")
If PosBFld > 0 Then
' content header found
PosEFld = Instr(PosBFld + 10,lcase(PartAHeader),"""")
If PosEFld > 0 Then
' well-formed content header
FileName = Mid(PartAHeader,PosBFld+10,PosEFld-PosBFld-10)
End If
' chop of leading and trailing "'s
Do Until Left(FileName,1) <> """"
FileName = Mid(FileName,2)
Loop
Do Until Right(FileName,1) <> """"
FileName = Left(FileName,Len(FileName)-1)
Loop
Else
FileName = ""
End If
' ikkonverti minn binary ghal data regolari
' at the end, datastring will contain 'readable' data
' is this wide-byte binary data?
if vartype(PartContent) = 8 then
' need to do some conversion
Set rst = CreateObject("ADODB.Recordset")
PartContentLength = LenB(PartContent)
if PartContentLength > 0 then
' data, so add to recordset to speed up conversion
rst.Fields.Append "data", adLongVarBinary, PartContentLength
rst.Open
rst.AddNew
rst("data").AppendChunk PartContent & ChrB(0)
rst.Update
PartContent2 = rst("data").GetChunk(PartContentLength)
rst.close
set rst = nothing
else
' no data?
PartContent2 = ChrB(0)
End If
Else
' no need for conversion
PartContent2 = PartContent
End If
PartContentLength = LenB(PartContent2)
if PartContentLength > 0 then
' we have data to convert
Set rst = CreateObject("ADODB.Recordset")
rst.Fields.Append "data", adLongVarChar, PartContentLength
rst.Open
rst.AddNew
rst("data").AppendChunk PartContent2
rst.Update
DataString = rst("data")
rst.close
set rst = nothing
Else
' nothing to convert
dataString = ""
End If
' conversion has been done, now what to do with it
If FileName <> "" Then
' we have a file, let's save it to disk
FileName = Mid(Filename,InstrRev(FileName,"\")+1)
Extension = UCASE(Mid(Filename,InstrRev(FileName,".")+1))
' response.Write(Extension)
IF AcceptedFiles <> "" THEN
'Check if file is acceptable
IF INSTR(1, UCASE(AcceptedFiles), Extension) = 0 THEN
Response.redirect(redirect & "&formatError=true")
Response.End
End If
End IF
If NewFileName = "" THEN
'l-isem tal-file jibqa l-istess / differend extension
NewFileName = replace(lcase(FileName),"." & lcase(extension),".jpg")
END IF
' response.Write(NewFileName)
' response.end
IF FilePath <> "" THEN
IF RIGHT(FilePath,1) <> "\" THEN Filepath = FilePath & "\"
END IF
SavedFileName = FilePath & NewFileName
' response.Write(savedfilename)
' iftah il-file (textstream)
set fso = Server.CreateObject("Scripting.Filesystemobject")
set fle = fso.CreateTextFile(Server.MapPath(SavedFileName & "." & lcase(extension)))
' write the data
fle.write DataString
fle.close
' cleanup
set fle = nothing
set fso = nothing
End If
'remove other type of file if exists--------------------
' if lcase(extension) = "jpg" then
' otherExtension = "pdf"
' elseif lcase(extension) = "pdf" then
' otherExtension = "jpg"
' end if
'
' dim fs
' dim f
' set fs=Server.CreateObject("Scripting.FileSystemObject")
' if fs.FileExists(Server.MapPath(SavedFileName & "." & otherExtension))=true then
' set f=fs.GetFile(Server.MapPath(SavedFileName & "." & otherExtension))
' f.delete
' end if
'
' set fs = nothing
' set f = nothing
'------------------------------
LastPart = MidB(Binary, PosEBound + LenB(BBoundary), 2)
If LastPart = ChrB(Asc("-")) & ChrB(Asc("-")) Then
' don't look for others
PosBBound = 0
PosEBound = 0
ELSE
' look for others
PosBBound = PosEBound
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary)
End If
loop
ELSE
' Response.Write "<P>Invalid or empty request, no fields processed. Make sure that the content type is multipart/form-data"
Response.End
End If
ELSE
' Response.Write "<P>Form must be submitted using the POST method"
Response.End
End If
'Response.Write "<BR>Execution ended: " & Now & "<BR>"
'Response.Write "Filename = " & SavedFileName & "<BR>"
'Response.Write "MaxWidth = " & MaxWidth & "<BR>"
'Response.Write "MaxHeight = " & MaxHeight & "<BR>"
'///Biddel id-daqs tal-istampa jekk tkun akbar minn kemm suppost///
'IF MaxHeight > 0 AND MaxWidth > 0 THEN
' Set Image = Server.CreateObject("csImageFile.Manage")
' Image.ReadFile Server.MapPath(SavedFileName)
' IF Image.Height > MaxHeight OR Image.Width > MaxWidth THEN
' NewHeight = ((Image.Height/Image.Width) * MaxWidth)
' IF NewHeight > MaxHeight THEN
' 'Resizing Based On Height
' Image.Resize 0, MaxHeight
' ELSE
' 'Resizing Based On Width
' Image.Resize MaxWidth, 0
' End If
' Image.JpegQuality = 85
' Image.WriteFile Server.MapPath(SavedFileName)
' End If
' Image.HasFileInfo = False
' Set Image = Nothing
'END IF
'\\\\\\\\\\\\\\\\\\\\\\
IF Redirect <> "" AND lcase(extension) = "jpg" AND MaxWidth > 0 AND MaxHeight > 0 THEN
Response.redirect "resize_picture.aspx?Picture=" & server.URLEncode(Server.MapPath(SavedFileName)) & "." & lcase(extension) & "&MaxWidth=" & server.URLEncode(maxWidth) & "&maxHeight=" & server.URLEncode(maxHeight) & "&Redirectto=" & server.URLEncode(Redirect)
ELSEIF Redirect <> "" THEN
Response.redirect(redirect)
END IF
%>
CAN ANYONE HELP ME INTEGRATE MULTIPLE UPLOADS IN THE ABOVE MENTIONED FRAMEWORK :) ?

Perhaps a Flash-based upload tool would work better. Many sites that support multiple uploads on a single page are moving to this kind of solution.
Here are a couple that a Google search unearthed:
Multiple File Upload With Progress Bar Using Flash and ASP.NET
MultiPowUpload

FYI, these pages are classic ASP and unrelated to the more recently introduced ASP.NET technology.
I don't know how to fix your problem, but a long, long time ago, I've used the commercially available SoftArtisans FileUp component to allow reliable multi-file uploads in classic ASP.

Did you try using multiple <input type="file"> 's?
EDIT:
What you might try also then, is dynamically creating an IFRAME with the file input field in it and submit that form, holding the file in a temporary location on the server and somehow indicating to the user that they have uploaded one of the files.

Resources