I get the following error when I try to post a request from a form in my ASP application.
Microsoft VBScript runtime error '800a004c'
Path not found
/build-your-own-report/stjreport/includes/includes.inc, line 16
This is my includes.inc file
includes.inc
<%
thisPage = Request.ServerVariables("SCRIPT_NAME")
thisPage = Right(thisPageName,Len(thisPage) - InStrRev(thisPage,"/"))
session.timeout = 5
webDir = "/stjreport"
pdf_path = server.MapPath("/") & webDir & "/pdfs"
tmp_path = server.MapPath("/") & webDir & "/temp"
Function RoundUp(n)
roundUp = Int(n) - CBool(CDbl(n) <> CLng(n))
End Function
Sub cleanItUp(tt)
set incFS = server.createobject("scripting.FileSystemObject")
/*line 16*/ set incFO = incFS.GetFolder(tmp_path)
for each incF in incFO.files
'if instr(1,incF.name,".pdf",1) > 0 then
set tmpF = incFS.GetFile(incF)
if DateDiff("s",tmpF.DateCreated,now) > tt then incFS.deleteFile(tmpF)
'end if
next
set incFO = nothing
set incFS = nothing
End Sub
Function makeRandomString(incLength)
makeRandomString = ""
seedStr = "1,N,O,P,Q,3,W,X,Y,Z,$,4,0,A,B,C,D,E,F,8,G,H,I,J,5,6,7,9,K,L,M,R,2,S,U,V,T,"
rndAry = Split(seedStr,",")
rndName = ""
For inc = 1 to incLength
Randomize
iRandom = Int( UBound( rndAry ) * Rnd )
rndName = rndName & rndAry( iRandom )
next
makeRandomString = rndName
End Function
Sub displayMessage (incMsg,incReturnUrl)
if Len(incMsg) > 0 then
Response.write("<br /><br /><p style='text-align:center; font-family:arial; font_size:larger;'>" & incMsg & "</p>")
%>
<script language="javascript">
alert("<%=Replace(Replace(incMsg,"<br />","\n"),"<br>","\n")%>");
<%
if Len(incReturnUrl) > 0 then
%>
top.location.href = "<%=incReturnUrl%>";
<%
else
%>
top.history.go(-1);
<%
end if
%>
</script>
<%
Response.end()
end if
End Sub
Function isPermittedFile(incFileType,incFile)
incFile = replace(incFile, "\", "/")
if inStr(incFile,"/") > 0 then
incAry = split(incFile,"/")
incFile = incAry(uBound(incFile)-1)
end if
if inStr(incFile,".") = 0 then call (displayMessage("Image file: " & incFile & " sounds not to be a recognized image format",""))
incFileAry = split(incFile,".")
incExt = incFileAry(1)
Select Case LCase(incFileType)
Case "image"
incAllowedStr = ",gif,png,jpg,jpeg,bmp,tiff,"
Case "document"
'incAllowedStr = ",pdf,doc,docx,txt,rtf,doc,docx,xls,xlsx,"
incAllowedStr = ",pdf,"
End Select
isPermittedFile = False
if inStr(1,incAllowedStr,","& LCase(incExt) &",",1) > 0 then isPermittedFile = True
End Function
%>
Related
I don't know too much about ASP, here is my code:
<%
dim objCmd, objRS1, objRS2, strDate1, strDate2, strName, strStyle, datDate, strLastGroup, datNow
set objCmd = Server.CreateObject("ADODB.Command")
Set objRS1 = Server.CreateObject("ADODB.Recordset")
Set objRS2 = Server.CreateObject("ADODB.Recordset")
set objCmd.ActiveConnection = objConn
objCmd.CommandText = "Select Site_Pages.Filename, HeadingName, MatrixName, Site_Matrices.MatrixID, TurnaroundOverride, TurnaroundName, MAX(Turnaround) AS AutoTurnaround, TurnaroundGroup FROM Site_Headings, Site_Pages, Site_Matrices, Site_Items, Site_Items_Prices, Items WHERE Site_Headings.HeadingID = Site_Pages.HeadingID AND Site_Pages.ProdPageID = Site_Matrices.ProdPageID AND Site_Matrices.MatrixID = Site_Items.MatrixID AND Site_Items.ItemID = Site_Items_Prices.ItemID AND Site_Items_Prices.PriceID = Items.PriceID AND SiteID = 0 AND TurnaroundPage = 1 GROUP BY HeadingName, MatrixName, TurnaroundOverride, TurnaroundName, Site_Pages.Filename, TurnaroundGroup, TurnaroundSortOrder, Site_Matrices.MatrixID ORDER BY TurnaroundGroup, TurnaroundSortOrder, HeadingName, MatrixName, TurnaroundName"
set objRS1 = objCmd.Execute
if not objRS1.eof then
Call NewTable(objRS1("TurnaroundGroup"))
strLastGroup = objRS1("TurnaroundGroup")
end if
do until objRS1.eof
if strLastGroup <> objRS1("TurnaroundGroup") then
Call EndTable()
Call NewTable(objRS1("TurnaroundGroup"))
end if
strLastGroup = objRS1("TurnaroundGroup")
'decide todays date for checking dated turnaround overrides
datNow = dateadd("h", GetSetting("TimeOffset"), now())
'if before 7am, knock off a day
if hour(datnow) < 7 then datnow = dateadd("d", -1, datnow)
objCmd.CommandText = "SELECT Turnaround FROM DatedTurnarounds WHERE MatrixID = " & CLng(objRS1("MatrixID")) & " AND TDate = '" & Year(datNow) & PadWithZeros(Month(datNow)) & PadWithZeros(Day(datNow)) & " 00:00'"
set objRS2 = objCmd.Execute
if objRS1("TurnaroundOverride") = 0 OR IsNull(objRS1("TurnaroundOverride")) then
if objRS2.eof then 'use automatic (3-last)
datDate = AddDays(objRS1("AutoTurnaround")-1)
else 'use dated turnaround override (2-second)
datDate = AddDays(objRS2("Turnaround")-1)
end if
else 'use matrix overrride (1-first - overrides all)
datDate = AddDays(objRS1("TurnaroundOverride")-1)
end if
strDate1 = Left(WeekDayName(DatePart("w", datDate)), 3) & " " & DateSuffix(DatePart("d", datDate)) & " of " & MonthName(DatePart("m", datDate))
if objRS1("TurnaroundOverride") = 0 OR IsNull(objRS1("TurnaroundOverride")) then
if objRS2.eof then 'use automatic (3-last)
datDate = AddDays(objRS1("AutoTurnaround"))
else 'use dated turnaround override (2-second)
datDate = AddDays(objRS2("Turnaround"))
end if
else 'use matrix overrride (1-first - overrides all)
datDate = AddDays(objRS1("TurnaroundOverride"))
end if
objRS2.close
strDate2 = Left(WeekDayName(DatePart("w", datDate)), 3) & " " & DateSuffix(DatePart("d", datDate)) & " of " & MonthName(DatePart("m", datDate))
if objRS1("TurnaroundName") = "" OR IsNull(objRS1("TurnaroundName")) then
if objRS1("MatrixName") = "" OR IsNull(objRS1("MatrixName")) then
strName = objRS1("HeadingName")
else
strName = objRS1("MatrixName")
end if
else
strName = objRS1("TurnaroundName")
end if
if strStyle = "PriceMatrixRow1" then
strStyle = "PriceMatrixRow2"
else
strStyle = "PriceMatrixRow1"
end if
%>
I think the problem should be somewhere here
objCmd.CommandText = "SELECT Turnaround FROM DatedTurnarounds WHERE MatrixID = " & CLng(objRS1("MatrixID")) & " AND TDate = '" & Year(datNow) & PadWithZeros(Month(datNow)) & PadWithZeros(Day(datNow)) & " 00:00'"
set objRS2 = objCmd.Execute
I'm not sure if I can execute another object in an object though
Any help would be very much appreciated.
I use this code to show pagination of recordset in classic asp + Mysql:
<ul class="pagination">
<% IF Cint(PageNo) > 1 then %>
<li><a rel="1" href="#" data-topic="<%=Request.QueryString("TOPIC_ID")%>" data-page="1">Prime</a></li>
<li><a rel="<%=PageNo-1%>" href="#" data-topic="<%=Request.QueryString("TOPIC_ID")%>" data-page="<%=PageNo-1%>"><</a></li>
<% End IF%>
<% For intID=1 To TotalPage%>
<% if intID=Cint(PageNo) Then%>
<li><%=intID%></li>
<%Else%>
<li><a rel="<%=intID%>" href="#" data-topic="<%=Request.QueryString("TOPIC_ID")%>" data-page="<%=intID%>"><%=intID%></a></li>
<%End IF%>
<%Next%>
<% IF Cint(PageNo) < TotalPage Then %>
<li><a rel="<%=PageNo+1%>" href="#" data-topic="<%=Request.QueryString("TOPIC_ID")%>" data-page="<%=PageNo+1%>">></a></li>
<li><a rel="<%=TotalPage%>" href="#" data-topic="<%=Request.QueryString("TOPIC_ID")%>" data-page="<%=TotalPage%>">Ultime</a></li>
<% End IF%>
</ul>
But If I have a lot of pageresults, it show a long line of number.... How could show only 5 page an when change page, show next?
like so:
first < 1 2 3 4 5 > last
and if I click on 5
first < 5 6 7 8 9 > last
etc...
This code works also if you want to keep some other querystring parameters. It removes the page value, adds the new page value and builds the paging control html.
It uses the Twitter Bootstrap Styles: http://twitter.github.io/bootstrap/components.html#pagination
Usage:
Response.Write PagingControl(10, 30, "?field-keywords=whatever&page=7")
Code:
Public Function RemoveEmptyQueryStringParameters(strQueryString)
If IsNullOrEmpty(strQueryString) Then Exit Function
Dim strNewQueryString: strNewQueryString = ""
strQueryString = Replace(strQueryString, "&", "&")
strQueryString = Replace(strQueryString, "?", "&")
Dim arrQueryString: arrQueryString = Split(strQueryString ,"&")
For i=0 To UBound(arrQueryString)
strTempParameter = Left( arrQueryString(i), Instr( arrQueryString(i) & "=", "=" ) - 1 )
strTempParameterValue = Right( arrQueryString(i), Len( arrQueryString(i) ) - InstrRev( arrQueryString(i), "=" ) )
If Not IsNullOrEmpty(strTempParameterValue) Then
strNewQueryString = strNewQueryString & "&" & arrQueryString(i)
End If
Next
If InStr(strNewQueryString,"&") = 1 Then
strNewQueryString = "?" & Right(strNewQueryString, Len(strNewQueryString) - 1)
End If
strNewQueryString = Replace(strNewQueryString, "&", "&")
Erase arrQueryString
Set arrQueryString = Nothing
RemoveEmptyQueryStringParameters = Trim(strNewQueryString)
End Function
Public Function AddQueryStringParameter(ByVal strQueryString, ByVal strParameter, ByVal strValue)
Dim strNewQueryString: strNewQueryString = ""
strNewQueryString = Replace(strQueryString, "&", "&")
strNewQueryString = Replace(strNewQueryString, "?", "&")
strNewQueryString = strNewQueryString & "&" & strParameter & "=" & strValue
If InStr(strNewQueryString,"&") = 1 Then
strNewQueryString = "?" & Right(strNewQueryString, Len(strNewQueryString) - 1)
End If
strNewQueryString = Replace(strNewQueryString, "&", "&")
AddQueryStringParameter = Trim(strNewQueryString)
End Function
Public Function PagingControl(ByVal intPage, ByVal intPageCount, ByVal strQueryString)
If intPageCount <= 1 Then
PagingControl = ""
Exit Function
End If
strQueryString = RemoveEmptyQueryStringParameters(strQueryString)
strQueryString = RemoveQueryStringParameter(strQueryString, "page")
Dim strQueryStringPaging: strQueryStringPaging = ""
Dim strHtml: strHtml = "<div class=""pagination""><ul>"
If cInt(intPage) > 1 Then
strQueryStringPaging = AddQueryStringParameter(strQueryString, "page", "1")
strHtml = strHtml & "<li>Anfang</li>"
strQueryStringPaging = AddQueryStringParameter(strQueryString, "page", CInt(intPage - 1))
strHtml = strHtml & "<li>< Zurück</li>"
Else
strHtml = strHtml & "<li class=""disabled"">Anfang</li>" & _
"<li class=""disabled"">< Zurück</li>"
End If
Dim intPagesToShow: intPagesToShow = 10
If intPageCount >= intPagesToShow Then
If Cint(intPage)>Int(intPagesToShow/2) Then
If Cint(intPage)>(intPageCount-Int(intPagesToShow/2)) Then
intStart = intPageCount-intPagesToShow
intEnd = intPageCount
Else
intStart = intPage-Int(intPagesToShow/2)
intEnd = intPage+Int(intPagesToShow/2)
End If
Else
intStart = 1
intEnd = intPagesToShow
End If
Else
intStart=1
intEnd=intPageCount
End If
If intStart=0 Then
intStart=1
End If
For i = intStart To intEnd
If Cint(intPage)=i Then
strHtml = strHtml & "<li class=""active"">" & i & "</li>"
Else
strQueryStringPaging = AddQueryStringParameter(strQueryString, "page", Cint(i))
strHtml = strHtml & "<li>" & i & "</li>"
End If
Next
If cInt(intPage) < cInt(intPageCount) Then
strQueryStringPaging = AddQueryStringParameter(strQueryString, "page", CInt(intPage + 1))
strHtml = strHtml & "<li>Vorwärts ></li>"
strQueryStringPaging = AddQueryStringParameter(strQueryString, "page", Cint(intPageCount))
strHtml = strHtml & "<li>Ende</li>"
Else
strHtml = strHtml & "<li class=""disabled"">Vorwärts ></li>" & _
"<li class=""disabled end"">Ende</li>"
End If
strHtml = strHtml & "</ul></div>"
PagingControl = Trim(strHtml)
End Function
I needed a simular solution in ASP.
I could not find anything usefull, so I made something myself.
I normally only program in PHP, but that wasn't possible in the case where I made this.
So if my code is a bit slopy, feel free to improve ;)
A little function I cooked up:
<%
page = cInt(Request.QueryString("pg"))
pages = cInt(number of pages)
if page <1 then page = 1
if page > pages then page = pages
Function paginationHTML(page, lastPage, URL)
if page >1 then
paginationHTML = "prev"
paginationHTML = paginationHTML & "1"
end if
if page >2 then
paginationHTML = paginationHTML & "<a>...</a>"
end if
if page >0 then
paginationHTML = paginationHTML & "<a href=""" & URL & page & """ class='jp-current'>"& page &"</a>"
end if
if lastPage >2 then
if page < lastPage-1 then
paginationHTML = paginationHTML & "<a>...</a>"
end if
end if
if page < lastPage then
paginationHTML = paginationHTML & ""&lastPage&""
paginationHTML = paginationHTML & "next"
end if
End Function
%>
use like so:
<%=paginationHTML(page,pages,"?pg=")%>
Would I just use MSXML and import as binary? Or is there another more efficient way?
There are gigs and gigs of JPEGs to fetch.
I have written something in the past, the code below will save remote image on the server disk. It's classic ASP and pretty efficient:
<%
Const CONTENT_FOLDER_NAME = "StoredContents"
Dim strImageUrl
strImageUrl = "http://www.gravatar.com/avatar/8c488f9c3d3da5bb756507179a3d53fd?s=32&d=identicon&r=PG"
Call SaveOnServer(strImageUrl, "bill_avatar.jpg")
Sub SaveOnServer(url, strFileName)
Dim strRawData, objFSO, objFile
Dim strFilePath, strFolderPath, strError
strRawData = GetBinarySource(url, strError)
If Len(strError)>0 Then
Response.Write("<span style=""color: red;"">Failed to get binary source. Error:<br />" & strError & "</span>")
Else
strFolderPath = Server.MapPath(CONTENT_FOLDER_NAME)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not(objFSO.FolderExists(strFolderPath)) Then
objFSO.CreateFolder(strFolderPath)
End If
If Len(strFileName)=0 Then
strFileName = GetCleanName(url)
End If
strFilePath = Server.MapPath(CONTENT_FOLDER_NAME & "/" & strFileName)
Set objFile = objFSO.CreateTextFile(strFilePath)
objFile.Write(RSBinaryToString(strRawData))
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Response.Write("<h3>Stored contents of " & url & ", total of <span style=""color: blue;"">" & LenB(strRawData) & "</span> bytes</h3>")
Response.Write("<a href=""" & CONTENT_FOLDER_NAME & "/" & strFileName & """ target=""_blank""><span style=""color: blue;"">" &_
strFileName & "</span></a>")
End If
End Sub
Function RSBinaryToString(xBinary)
''# Antonin Foller, http://www.motobit.com
''# RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
''# to a string (BSTR) using ADO recordset
Dim Binary
'' #MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Else
RSBinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
''# © 2000 Antonin Foller, http://www.motobit.com
''# MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
''# Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function GetBinarySource(url, ByRef strError)
Dim objXML
Set objXML=Server.CreateObject("Microsoft.XMLHTTP")
GetBinarySource=""
strError = ""
On Error Resume Next
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
Err.Clear
Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
strError = "Error " & Err.Number & ": " & Err.Description
Err.Clear
Exit Function
End If
End If
On Error Goto 0
GetBinarySource=objXML.ResponseBody
Set objXML=Nothing
End Function
Function GetCleanName(s)
Dim result, x, c
Dim arrTemp
arrTemp = Split(s, "/")
If UBound(arrTemp)>0 Then
For x=0 To UBound(arrTemp)-1
result = result & GetCleanName(arrTemp(x)) & "_"
Next
result = result & GetPageName(s)
Else
For x=1 To Len(s)
c = Mid(s, x, 1)
If IsValidChar(c) Then
result = result & c
Else
result = result & "_"
End If
Next
End If
Erase arrTemp
GetCleanName = result
End Function
Function IsValidChar(c)
IsValidChar = (c >= "a" And c <= "z") Or (c >= "A" And c <= "Z") Or (IsNumeric(c))
End Function
Function GetPageName(strUrl)
If Len(strUrl)>0 Then
GetPageName=Mid(strUrl, InStrRev(strUrl, "/")+1, Len(strUrl))
Else
GetPageName=""
End If
End Function
%>
Just call SaveOnServer sub routine passing the URL and desired file name, you can also omit the file name and in that case, the file name will be taken from the URL itself.
The server folder is defined as constant and will be in the same place as .asp file.
Here is the gist of how to download and save files in script:-
Function DownloadAndSave(sourceUrl, destinationFile)
Dim req : Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
req.Open "GET", sourceUrl, false
req.Send
Dim stream : Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ''# adTypeBinary
stream.Open
stream.Write req.ResponseBody
stream.SaveToFile destinationFile, 2
stream.Close
End Function
The site is a buy/sell site and the page the code comes from is the "add product" page.
The problem is that the session("change") becomes nothing by some reason, I can't find any errors. The payment.aspx have a button that sends me back to the page with a session("change").
The reason I see the problem is that when I try to edit something the category gets restetted to the first in the list. and when I debug I see that the session is nothing, though it should be something
Heres the code:
Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtnSubmit.Click
If Not stats > 0 Then
If Session("change") IsNot Nothing Then
Dim dc As New DataClassesDataContext
Dim getP = From prod In dc.Products _
Where prod.ProductID = CInt(Session("change")) _
Select prod
If getP.Any Then
If rdbSell.Checked = True Then
getP.FirstOrDefault.BuySell = True
Else
getP.FirstOrDefault.BuySell = False
End If
If ddlSubSubcat.SelectedValue IsNot String.Empty Then
getP.FirstOrDefault.CategoryID = CInt(ddlSubSubcat.SelectedValue)
Else
getP.FirstOrDefault.CategoryID = CInt(ddlSubCat.SelectedValue)
End If
getP.FirstOrDefault.Content = txtContent.Text.Replace(Environment.NewLine, "<br />")
getP.FirstOrDefault.CountyID = CInt(ddlCounty.SelectedValue)
getP.FirstOrDefault.E_mail = txtEmail.Text
getP.FirstOrDefault.Date = DateTime.Now
getP.FirstOrDefault.Active = 0
getP.FirstOrDefault.Alias = txtAlias.Text.Replace("'", "''")
getP.FirstOrDefault.ShowEmail = 0
Dim PreID As Integer = getP.FirstOrDefault.ProductID
If chkShowEmail.Checked = True Then
getP.FirstOrDefault.ShowEmail = 1
Else
getP.FirstOrDefault.ShowEmail = 0
End If
If chkShowPhone.Checked = True Then
getP.FirstOrDefault.ShowPhone = 1
Else
getP.FirstOrDefault.ShowPhone = 0
End If
getP.FirstOrDefault.Headline = txtHeadline.Text
getP.FirstOrDefault.Password = txtPassword.Text
getP.FirstOrDefault.Phone = txtPhone.Text
getP.FirstOrDefault.Price = txtPrice.Text
If chkUnknown.Checked = True Then
getP.FirstOrDefault.YearModel = String.Empty
Else
getP.FirstOrDefault.YearModel = ddlYear.SelectedValue
End If
For Each item In libPictures.Items
Dim i As String = item.ToString
Dim imagecheck = From img In dc.Pictures _
Where img.Name = i And img.ProductID = CInt(Session("change")) _
Select img
If imagecheck.Any Then
Else
Dim img As New Picture
img.Name = item.ToString
img.ProductID = CInt(Session("change"))
dc.Pictures.InsertOnSubmit(img)
dc.SubmitChanges()
End If
Next
dc.SubmitChanges()
Session.Remove("change")
Response.Redirect("~/precheck.aspx?id=" + PreID.ToString)
End If
Else
Dim dc As New DataClassesDataContext
Dim prod As New Product
If rdbSell.Checked = True Then
prod.BuySell = True
Else
prod.BuySell = False
End If
If ddlSubSubcat.DataValueField IsNot String.Empty Then
prod.CategoryID = CInt(ddlSubSubcat.SelectedValue)
Else
prod.CategoryID = CInt(ddlSubCat.SelectedValue)
End If
prod.Content = txtContent.Text.Replace(Environment.NewLine, "<br />")
prod.CountyID = CInt(ddlCounty.SelectedValue)
prod.E_mail = txtEmail.Text
prod.Date = DateTime.Now
prod.Active = 0
prod.Alias = txtAlias.Text.Replace("'", "''")
prod.ShowEmail = 0
If chkShowEmail.Checked = True Then
prod.ShowEmail = 1
Else
prod.ShowEmail = 0
End If
If chkShowPhone.Checked = True Then
prod.ShowPhone = 1
Else
prod.ShowPhone = 0
End If
prod.Headline = txtHeadline.Text
prod.Password = txtPassword.Text
prod.Phone = txtPhone.Text
prod.Price = txtPrice.Text
If chkUnknown.Checked = True Then
prod.YearModel = String.Empty
Else
prod.YearModel = ddlYear.SelectedValue
End If
dc.Products.InsertOnSubmit(prod)
dc.SubmitChanges()
Dim PreID As Integer = prod.ProductID
For Each item In libPictures.Items
Dim img As New Picture
img.Name = item.ToString
img.ProductID = prod.ProductID
dc.Pictures.InsertOnSubmit(img)
dc.SubmitChanges()
Next
Session.Remove("change")
Response.Redirect("./precheck.aspx?id=" + PreID.ToString, False)
End If
End If
stats = 0
'Catch ex As Exception
'End Try
End Sub
It depends upon how the application is managing session state. If your session state is managed InProc then if the application pool is recycled then all your session information will be lost. If that is happening then it could be a good option to store session state in SQL Server which will persist between app pool recycling.
More info:
ASP.NET Session State Overview
ASP.NET State Management Recommendations
I was given an HTA that I think was created by the HTA_Helpomatic. They want it converted into a classic ASP page. So I made a few basic changes, and I think I almost have it working. But I'm running into a problem - the ole 'VBScript Object Required' bit. It's doing this on the line Set objlst_groupnames = document.getElementById( "list_servicenames" )
Here's the original HTA script - can anyone help me figure out how to properly convert this to ASP? I had a similar page created, but it didn't work the way they wanted (You had to click on each service to toggle it, vs just clicking on a check box). Thanks.
<head>
<title>Start/Stop/Restart Windows Services</title>
<HTA:APPLICATION
APPLICATIONNAME="Start/Stop/Restart Windows Services"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Sub Window_OnLoad
Set objlst_groupnames = document.getElementById( "list_servicenames" )
If objlst_groupnames Is Nothing Then
MsgBox "A problem was encountered while creating the listview." & vbCRLF & "Please see your administrator."
Else
With objlst_groupnames
.View = 3
.Width = 800
.Height = 600
.SortKey = 0
.Arrange = 0
.LabelEdit = 1
.SortOrder = 0
.Sorted = 1
.MultiSelect = 0
.LabelWrap = -1
.HideSelection = -1
.HideColumnHeaders = 0
.OLEDragMode = 0
.OLEDropMode = 0
.Checkboxes = 1
.FlatScrollBar = 0
.FullRowSelect = 1
.GridLines = 0
.HotTracking = 0
.HoverSelection = 0
.PictureAlignment = 0
.TextBackground = 0
.ForeColor = -2147483640
.BackColor = -2147483643
.BorderStyle = 1
.Appearance = 1
.MousePointer = 0
.Enabled = 1
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "Caption", 150
.ColumnHeaders.Add , , "State", 150
.ColumnHeaders.Add , , "Name", 150
.ColumnHeaders.Add , , "Description", 150
.ColumnHeaders.Add , , "Start Mode", 150
.ListItems.Clear
End With
End If
sComputer = MachineName.Value
ListServices(sComputer)
End Sub
Sub ListServices(sComputer)
ON ERROR RESUME NEXT
sServiceName = ServiceName.Value
Set objList = document.getElementById( "list_servicenames" )
objList.ListItems.Clear
set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
if sServiceName = "" then
Set colItems = objWMIService.ExecQuery("Select * from Win32_Service")
else
Set colItems = objWMIService.ExecQuery("Select * From Win32_Service where DisplayName like '%" & sServiceName & "%'")
end if
For Each objItem in colItems
Set objListItem = objList.ListItems.Add
objListItem.Text = objItem.Caption
objListItem.ListSubItems.Add.Text = objItem.State
objListItem.ListSubItems.Add.Text = objItem.Name
objListItem.ListSubItems.Add.Text = objItem.Description
objListItem.ListSubItems.Add.Text = objItem.StartMode
Next
End Sub
Sub btn_start_onClick()
sComputer = MachineName.Value
for n = 1 to list_servicenames.ListItems.Count
if list_servicenames.ListItems(n).checked = True then
strService = list_servicenames.ListItems(n).ListSubItems(2).Text
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
For each objService in colServiceList
errReturn = objService.StartService()
Next
end if
next
ListServices(sComputer)
End Sub
Sub btn_stop_onClick()
sComputer = MachineName.Value
for n = 1 to list_servicenames.ListItems.Count
if list_servicenames.ListItems(n).checked = True then
strService = list_servicenames.ListItems(n).ListSubItems(2).Text
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
For each objService in colServiceList
errReturn = objService.StopService()
Next
end if
next
ListServices(sComputer)
End Sub
Sub btn_restart_onClick()
sComputer = MachineName.Value
'Stop services
for n = 1 to list_servicenames.ListItems.Count
if list_servicenames.ListItems(n).checked = True then
strService = list_servicenames.ListItems(n).ListSubItems(2).Text
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
For each objService in colServiceList
errReturn = objService.StopService()
Next
end if
next
'Start services
for n = 1 to list_servicenames.ListItems.Count
if list_servicenames.ListItems(n).checked = True then
strService = list_servicenames.ListItems(n).ListSubItems(2).Text
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
For each objService in colServiceList
errReturn = objService.StartService()
Next
end if
next
ListServices(sComputer)
End Sub
Sub btn_Refresh_onClick()
sComputer = MachineName.Value
ListServices(sComputer)
End Sub
Sub btn_exit_onClick()
Window.Close
End Sub
function list_servicenames_ColumnClick(colheader)
list_servicenames.SortKey = colheader.index-1
end Function
</script>
<body>
Enter Machine Name: <Input Type = "Text" Name = "MachineName">
<Input Type = "Button" Value = "Get Services" Name = "Run_Button" onClick = "Window_OnLoad"> Filter Services by Name: <Input Type = "Text" Name = "ServiceName"><P>
<input type="button" value="Refresh" name="btn_Refresh" id="btn_Refresh" title="Click to refresh the services list">
<input type="button" value="Start" name="btn_start" id="btn_start" title="Click to Start the Services">
<input type="button" value="Stop" name="btn_stop" id="btn_stop" title="Click to Stop the Service">
<input type="button" value="Restart" name="btn_restart" id="btn_restart" title="Click to Restart the Services">
<input type="button" value="Exit" name="btn_exit" id="btn_exit" title="Click to Exit Form ">
<br/>
<OBJECT id="list_servicenames" name="list_servicenames" classid="clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628"></OBJECT>
</body>
To get a client-side click event to activate something on the server you must use something like AJAX.