Const strInputFile = "input.txt"
Const strOutputFile = "output.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInput = objFSO.OpenTextFile(strInputFile, 1, False)
Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
Set objIE = CreateObject("InternetExplorer.Application")
'objIE.Visible = True
While Not objInput.AtEndOfStream
strUrl = objInput.ReadLine
objIE.Navigate strUrl
While objIE.busy = True Or objIE.ReadyState <> 4
WScript.Sleep 100
Wend
objOutput.WriteLine strUrl & vbTab & objIE.LocationURL
Wend
objIE.Quit
MsgBox "done"
objIE.Silent = True
Option Explicit
Const strInputFile = "input.txt"
Const strOutputFile = "output.txt"
Const strLogFile = "log.txt"
Dim objFSO, objInput, objOutput, objLog, objIE, strUrl, intCount, blnBusy, intReadyState
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInput = objFSO.OpenTextFile(strInputFile, 1, False)
Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
Set objLog = objFSO.CreateTextFile(strLogFile, True)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Silent = True
While Not objInput.AtEndOfStream
strUrl = objInput.ReadLine
objLog.WriteLine Now() & " url = " & strUrl
objIE.Navigate strUrl
intCount = 0
blnBusy = objIE.busy
intReadyState = objIE.ReadyState
While (blnBusy = True Or intReadyState <> 4) And intCount < 20
WScript.Sleep 1000 ' increased to 1 second
intCount = intCount + 1
objLog.WriteLine Now() & " count = " & intCount
If blnBusy <> objIE.busy Then
objLog.WriteLine Now() & " busy changed from " & blnBusy & " to " & objIE.busy
blnBusy = objIE.busy
intCount = 0
End If
If intReadyState <> objIE.ReadyState Then
objLog.WriteLine Now() & " readystate changed from " & intReadyState & " to " & objIE.ReadyState
intReadyState = objIE.ReadyState
intCount = 0
End If
Wend
If strUrl = objIE.LocationURL Then
objLog.WriteLine Now() & " no redirect detected"
Else
objLog.WriteLine Now() & " success, writing output and continue to next line"
objOutput.WriteLine strUrl & vbTab & objIE.LocationURL
End If
Wend
objLog.WriteLine Now() & " done"
objInput.Close
Set objInput = Nothing
objOutput.Close
Set objOutput = Nothing
objLog.Close
Set objLog = Nothing
Set objFSO = Nothing
objIE.Quit
Set objIE = Nothing
MsgBox "done"
Option Explicit
Const strInputFile = "Redirection-input.txt"
Const strOutputFile = "Redirection-output.txt"
Const strLogFile = "log.txt"
Dim objFSO, objInput, objOutput, objLog, objIE, strUrl, strPrevUrl, intCount, blnBusy, intReadyState
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInput = objFSO.OpenTextFile(strInputFile, 1, False)
Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
Set objLog = objFSO.CreateTextFile(strLogFile, True)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Silent = True
While Not objInput.AtEndOfStream
strUrl = objInput.ReadLine
objLog.WriteLine Now() & " url = " & strUrl
objIE.Navigate strUrl
intCount = 0
blnBusy = objIE.busy
intReadyState = objIE.ReadyState
While (blnBusy = True Or intReadyState <> 4) And intCount < 20
WScript.Sleep 1000 ' increased to 1 second
intCount = intCount + 1
objLog.WriteLine Now() & " count = " & intCount
If blnBusy <> objIE.busy Then
objLog.WriteLine Now() & " busy changed from " & blnBusy & " to " & objIE.busy
blnBusy = objIE.busy
intCount = 0
End If
If intReadyState <> objIE.ReadyState Then
objLog.WriteLine Now() & " readystate changed from " & intReadyState & " to " & objIE.ReadyState
intReadyState = objIE.ReadyState
intCount = 0
End If
Wend
If strPrevUrl = objIE.LocationURL Then ' navigation failed!
objLog.WriteLine Now() & " website not available"
Else
If strUrl = objIE.LocationURL Then
objLog.WriteLine Now() & " no redirect detected"
Else
objLog.WriteLine Now() & " success, writing output and continue to next line"
objOutput.WriteLine strUrl & vbTab & objIE.LocationURL
End If
strPrevUrl = objIE.LocationURL
End If
Wend
objLog.WriteLine Now() & " done"
objInput.Close
Set objInput = Nothing
objOutput.Close
Set objOutput = Nothing
objLog.Close
Set objLog = Nothing
Set objFSO = Nothing
objIE.Quit
Set objIE = Nothing
MsgBox "done"
13/01/2013 10:28:37 url = http://answers.microsoft.com/en-us/windows/forum/windowsvista-system/blue-screen-error-memory-management-stop/f9aff112-da38-46e7-9697-a206a182758f?msgId=7940c4d1-afac-4787-abb5-b2d8165a2c39
13/01/2013 10:28:38 count = 1
13/01/2013 10:28:39 busy changed from True to False
13/01/2013 10:28:39 readystate changed from 1 to 4
13/01/2013 10:28:39 success, writing output and continue to next line
13/01/2013 10:28:39 done
Option Explicit
Const strInputFile = "Redirection-input.txt"
Const strOutputFile = "Redirection-output.txt"
Const strLogFile = "log.txt"
Const strErrFile = "errors.txt"
Const C_MAX_LOOP = 20
Const C_WAIT_MSEC = 1000 ' 1000 = 1 sec
Dim objFSO, objInput, objOutput, objLog, objErr, objIE, strUrl, strPrevUrl, intCount, blnBusy, intReadyState
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInput = objFSO.OpenTextFile(strInputFile, 1, False)
Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
Set objLog = objFSO.CreateTextFile(strLogFile, True)
Set objErr = objFSO.CreateTextFile(strErrFile, True)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Silent = True
On Error Resume Next
While Not objInput.AtEndOfStream
strUrl = objInput.ReadLine
objLog.WriteLine Now() & " url = " & strUrl
intCount = 0
objIE.Navigate strUrl
If Err.Number <> 0 Then
objErr.WriteLine strUrl
objLog.WriteLine Now() & " ERROR" ' "ERROR #" & Err.Number & " (0x" & Hex(Err.Number) & "): " & Err.Description
intCount = C_MAX_LOOP ' skip loop
Err.Clear
End If
blnBusy = objIE.busy
intReadyState = objIE.ReadyState
While (blnBusy = True Or intReadyState <> 4) And intCount < C_MAX_LOOP
WScript.Sleep C_WAIT_MSEC
intCount = intCount + 1
objLog.WriteLine Now() & " count = " & intCount
If blnBusy <> objIE.busy Then
objLog.WriteLine Now() & " busy changed from " & blnBusy & " to " & objIE.busy
blnBusy = objIE.busy
intCount = 0
End If
If intReadyState <> objIE.ReadyState Then
objLog.WriteLine Now() & " readystate changed from " & intReadyState & " to " & objIE.ReadyState
intReadyState = objIE.ReadyState
intCount = 0
End If
Wend
If strPrevUrl = objIE.LocationURL Then ' navigation failed!
objLog.WriteLine Now() & " website not available"
Else
If strUrl = objIE.LocationURL Then
objLog.WriteLine Now() & " no redirect detected"
Else
objLog.WriteLine Now() & " success, writing output and continue to next line"
objOutput.WriteLine strUrl & vbTab & objIE.LocationURL
End If
strPrevUrl = objIE.LocationURL
End If
Wend
objLog.WriteLine Now() & " done"
objInput.Close
Set objInput = Nothing
objOutput.Close
Set objOutput = Nothing
objLog.Close
Set objLog = Nothing
objErr.Close
Set objErr = Nothing
Set objFSO = Nothing
objIE.Quit
Set objIE = Nothing
MsgBox "done"
Note that I usually don't like using "On Error" unless in a confined subroutine, because it's possible that you get stuck in an endless loop. In this case it seems safe.
private void DoProcess() {
foreach (string u in textBox1.Lines) {
string sts = "?";
string u2 = string.Empty;
try {
toolStripStatusLabel1.Text = string.Format("Processing url: {0}", u);
Application.DoEvents();
HttpWebRequest hwr = WebRequest.Create(new Uri(u)) as HttpWebRequest;
hwr.AllowAutoRedirect = true;
WebResponse wr = hwr.GetResponse();
u2 = wr.ResponseUri.AbsoluteUri;
wr.Close();
if (u2.Equals(u)) {
sts = "no redirect detected";
} else if (true) {
sts = "redirect ok";
}
} catch (Exception ex) {
u2 = string.Empty;
sts = "error: " + ex.Message;
}
dataGridView1.Rows.Add(u, u2, sts);
}
toolStripStatusLabel1.Text = "Processing complete.";
}
Open in new window