VBS Url redirect generator

clade · 18 Jan 2010 at 16:16

Im trying to write a vbs script to generate a html file with the following html after prompting for the url and the filename to save it as. im new to this and having problems with the html " sections. could anyone give me some advise, ive tryed writing my own code and am quite frankly ashamed to post it here lol

Can anyone recommend any resources to help me learn?

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Please Wait</title>
<meta http-equiv="REFRESH" content=0;url= &urladdress "></HEAD>
<BODY>
Please wait while we redirect you to the registration page.
</BODY>
</HTML>

clade · 18 Jan 2010 at 18:35

Option Explicit
Dim urladdress, oFilesys, oFiletxt, sFilename, sPath, ofilename
urladdress = InputBox("Please enter the full url to redirect the browser to","Browser Forwarder")
ofilename = InputBox("Please enter filename to save as","Browser Forwarder")
If urladdress = "" Then
WScript.Echo UserAborted
Else
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(ofilename, True)
sPath = oFilesys.GetAbsolutePathName(ofilename)
sFilename = oFilesys.GetFileName(sPath)
' oFiletxt.WriteLine("<html33>" & urladdress )
oFiletxt.WriteLine("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">")
oFiletxt.WriteLine("<html>")
oFiletxt.WriteLine("<head>")
oFiletxt.WriteLine("<title>Please Wait</title>")
oFiletxt.WriteLine("<meta http-equiv=""REFRESH"" content=""0;url= & urladdress "">")
oFiletxt.WriteLine("</HEAD>")
oFiletxt.WriteLine("<BODY>")
oFiletxt.WriteLine("Please wait while we redirect you to the registration page.")
oFiletxt.WriteLine("</BODY>")
oFiletxt.WriteLine("</HTML>")
oFiletxt.Close'
End IF
If oFilesys.FileExists(sPath) Then Wscript.Echo "The File has been saved as:",sFilename&"."

thats the code I have, yes its not very pretty but seems to be working apart from the below line, any ideas? it just shows the & urladdress instead of the inputed url

oFiletxt.WriteLine("<meta http-equiv=""REFRESH"" content=""0;url= & urladdress "">")

MrB · 18 Jan 2010 at 18:45

Isn't this what you need?

oFiletxt.WriteLine("<meta http-equiv=""REFRESH"" content=""0;url=" & urladdress & """>")

clade · 19 Jan 2010 at 09:38

oFiletxt.WriteLine("<meta http-equiv=""REFRESH"" content=""0;url=" & urladdress & " "">")

worked but it not outputting the full url its cutting of the end. Im thinking its input limit on input box

MrB · 19 Jan 2010 at 12:01

How many characters does it output before chopping off the end? I wouldn't have thought there'd be a small limit to InputBox.

clade · 19 Jan 2010 at 12:30

aparntly the limit is 128 chars. the url im inputting has 227 and this is the first sample so it could be more in the future!

clade · 19 Jan 2010 at 14:21

still havent overcome the problem of large urls but changed abit of the code today so its ready for when i find a fix to this.

Dim urladdress, inputcheck, welcomescreen

Welcomescreen = MsgBox ("This program has been created for the purpose of creating a redirect page for long urls. It will create a webpage that will forward any browser to the site you specify on the next steps",vbOKOnly+vbInformation+vbDefaultButton1+vbApplicationModal, "Program Information")

urladdress = InputBox("Please enter the full url to redirect the browser to","Browser Forwarder",,7000,5000)

IF urladdress = False Then
WScript.Quit

ElseIF urladdress = "" Then
DO until urladdress <> ""
IF urladdress = False Then
WScript.Quit
Else
inputcheck = MsgBox ("You have not input a Valid URL, would you like to try again?",vbRetryCancel+vbExclamation+vbDefaultButton1+vbApplicationModal, "No Valid Url Input")
Select Case inputcheck
Case vbRetry
urladdress = InputBox("Please enter the full url to redirect the browser to","Browser Forwarder")
Case vbcancel
WScript.Quit
End Select
END IF
Loop

END IF

Set objDialog = CreateObject("SAFRCFileDlg.FileSave")

objDialog.FileName = ""
objDialog.FileType = "*.*"
intReturn = objDialog.OpenFileSaveDlg

If intReturn Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(objDialog.FileName)
objFile.WriteLine ("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">")
objFile.WriteLine ("<html>")
objFile.WriteLine ("<head>")
objFile.WriteLine ("<title>Please Wait</title>")
objFile.WriteLine ("<meta http-equiv=""REFRESH"" content=""0;url=" & urladdress & " "">")
objFile.WriteLine ("</HEAD>")
objFile.WriteLine ("<BODY>")
objFile.WriteLine ("Please wait while we redirect you to the registration page.")
objFile.WriteLine ("If your browser does not automaticily redirect you to the registration page please <a href="" "& urladdress &" "">click here</a>")
objFile.WriteLine ("</BODY>")
objFile.WriteLine ("</HTML>")
objFile.Close
Else
Wscript.Quit
End If

MrB · 19 Jan 2010 at 22:12

I think this is a slightly better way to do the loop at the top. Looks like the SAFRCFileDlg code isn't compatible with W7 by the way.

urlAddress = ""
DO until urladdress <> ""
urladdress = InputBox("Please enter the full url to redirect the browser to", "Browser Forwarder")
IF urladdress = False Then
WScript.Quit
END IF
If urlAddress = "" Then
inputcheck = MsgBox ("You have not input a Valid URL, would you like to try again?", vbYesNo+vbExclamation+vbDefaultButton1+vbApplicationModal, "No Valid Url Input")
If inputcheck = vbNo Then
WScript.Quit
End If
END IF
Loop