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.
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 want is after i login i want to change my label.text in my home.aspx
what is should i do
.
Problems in VB.net than ASP.net
Always i do is
Home.aspx.label.text = userTxt.text
But on this asp i got a problem on that
If userTxt.Text <> "" And passTxt.Text <> "" Then
cmd = New OleDbCommand("Select * from loginClient where emailaddress = '" & userTxt.Text & "' and password = '" & passTxt.Text & "'", cnn)
rdoleb = cmd.ExecuteReader
Response.Redirect("main.aspx")
rdoleb.Close()
If rdoleb.Read = True Then
If userTxt.Text = rdoleb.Item(2) And passTxt.Text = rdoleb.Item(3) Then
rdoleb.Close()
End If
My form takes me to an internal error page upon submission. I have all the fields defined, and my SMTP info passing through. It looks as if everything should work. But it simply doesn't.
Any suggestions is appreciated.
<%
'Declaring Variables
Dim smtpserver,youremail,yourpassword,ContactUs_Name,ContactUs_Email
Dim ContactUs_Subject,ContactUs_Body,Action,IsError
' Edit these 3 values accordingly
smtpserver = "mysmtperserver"
youremail = "myemail"
yourpassword = "mypassword"
' Grabbing variables from the form post
ContactUs_Name = Server.HTMLEncode(Request("ContactUs_Name"))
ContactUs_Email = Server.HTMLEncode(Request("ContactUs_Email"))
ContactUs_Subject = Server.HTMLEncode(Request("ContactUs_Subject"))
ContactUs_Body = Server.HTMLEncode(Request("ContactUs_Body"))
ContactUs_Captcha = Request("recaptcha_response_field")
Action = Request("Action")
' Used to check that the email entered is in a valid format
Function IsValidEmail(Email)
Dim ValidFlag,BadFlag,atCount,atLoop,SpecialFlag,UserName,DomainName,atChr,tAry1
ValidFlag = False
If (Email <> "") And (InStr(1, Email, "#") > 0) And (InStr(1, Email, ".") > 0) Then
atCount = 0
SpecialFlag = False
For atLoop = 1 To Len(Email)
atChr = Mid(Email, atLoop, 1)
If atChr = "#" Then atCount = atCount + 1
If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
Next
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
If (UserName = "") Or (DomainName = "") Then BadFlag = True
If Mid(DomainName, 1, 1) = "." then BadFlag = True
If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
ValidFlag = True
End If
End If
If BadFlag = True Then ValidFlag = False
IsValidEmail = ValidFlag
End Function
%>
<%
If Action = "SendEmail" Then
' Here we quickly check/validate the information entered
' These checks could easily be improved to look for more things
If IsValidEmail(ContactUs_Email) = "False" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter valid Email address.</font><br>")
End If
If ContactUs_Name = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter your Name.</font><br>")
End If
If ContactUs_Subject = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter a Subject.</font><br>")
End If
If ContactUs_Body = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please include Message.</font><br>")
End If
if ContactUs_Captcha = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Captcha Required.</font><br>")
End If
End If
' If there were no input errors and the action of the form is "SendEMail" we send the email off
If Action = "SendEmail" And IsError <> "Yes" Then
Dim strBody
' Here we create a nice looking html body for the email
strBody = strBody & "<font face=""Arial"">Contact Us Form submitted at " & Now() & vbCrLf & "<br><br>"
strBody = strBody & "From http://" & Request.ServerVariables("HTTP_HOST") & vbCrLf & "<br>"
strBody = strBody & "IP " & Request.ServerVariables("REMOTE_ADDR") & vbCrLf & "<br>"
strBody = strBody & "Name" & " : " & " " & Replace(ContactUs_Name,vbCr,"<br>") & "<br>"
strBody = strBody & "Email" & " : " & " " & Replace(ContactUs_Email,vbCr,"<br>") & "<br>"
strBody = strBody & "Subject" & " : " & " " & Replace(ContactUs_Subject,vbCr,"<br>") & "<br>"
strBody = strBody & "<br>" & Replace(ContactUs_Body,vbCr,"<br>") & "<br>"
strBody = strBody & "</font>"
Dim ObjSendMail
Set ObjSendMail = CreateObject("CDO.Message")
'This section provides the configuration information for the remote SMTP server.
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = youremail
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = yourpassword
ObjSendMail.Configuration.Fields.Update
'End remote SMTP server configuration section==
ObjSendMail.To = youremail
ObjSendMail.Subject = ContactUs_Subject
ObjSendMail.From = ContactUs_Email
' we are sending a html email.. simply switch the comments around to send a text email instead
ObjSendMail.HTMLBody = strBody
'ObjSendMail.TextBody = strBody
ObjSendMail.Send
Set ObjSendMail = Nothing
' change the success messages below to say or do whatever you like
' you could do a response.redirect or offer a hyperlink somewhere.. etc etc
%>
If you can't do much with custom error pages then you can use "On Error Resume Next" to trap errors, something like:
On Error Resume Next
'Put your code in here
'Write out error messages
If err.number > 0 then
response.write "Error: err.description & " on line number <strong>" & err.line & "</strong>"
END IF
On Error Goto 0
Caveat: I'd just recommend taking this out once you've got your code working as can mask issues if not used carefully. Instead look at getting some proper error handling and logging in place using custom error pages.
Just at a quick glance... this section looks to be missing an END IF
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
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
%>
my tool is in asp. i am using this code for a query in sql
dim req_id
req_id=Request.Form("Req_id")
if req_id<>"" then
Set conn=server.CreateObject("adodb.connection")
conn.Open session("Psrconnect")
Set rs=CreateObject("Adodb.Recordset")
rs.Open "select * from passwords where REQ_ID='"&req_id&"'", conn
i want to put the results of this query into a drop down list. how do i do it? any help is very much appreciated.
Slightly edited code from my working pages :
function HtmlFormOption( byval psReturnValue, byval psDisplayValue ,byval psCurrentDefault)
dim x
if IsNull(psCurrentDefault) then psCurrentDefault = ""
if IsNull(psReturnValue) then psReturnValue = ""
if lCase( cStr(psReturnValue) ) = lCase( cStr(psCurrentDefault)) then
x = "selected "
else
x = ""
end if
HtmlFormOption = "<option " & x & "value='" & psReturnValue & "'>" & psDisplayValue & "</option>"
end function
dim Result, sCode, sWaarde
Result = "<select name='NameCombobox' size='1'>" & vbCrlf
while not objRecLookup.Eof
sCode = objRecLookup.Fields(0) ' first field in result set
sWaarde = objRecLookup.Fields(1) ' second field in result set
if not IsNull(sCode) and not IsNull(sWaarde) then
Result = Result & HtmlFormOption( sCode, sWaarde , psCurrentDft )
end if
objRecLookup.MoveNext
wend
objRecLookup.Close
Result = Result & "</select>" & vbCrlf
And than Response.Write(Result)
Here's a simple solution:
<%
Dim objCommand, objRS
Set objCommand = Server.CreateObject("ADODB.Command")
with objCommand
.ActiveConnection = objConn
.CommandType = adCmdText
.CommandText = "SELECT * FROM PASSWORDS WHERE REQ_ID= '" & req_id & "'"
Set objRS = .Execute
end with
%><select name="selectbox"><%
While NOT objRS.EOF
%><option value="<%=objRS("COLUMN_NAME")%>"><%=objRS("COLUMN_NAME")%></option><%
objRS.MoveNext
Wend
%></select><%
objRS.Close
Set objRS = Nothing
Set objCommand = Nothing
%>