'------------------------------------------------------------------------
'               Copyright (C) 2002 Marios Polyzoes. marpoly@ geo.gr
'------------------------------------------------------------------------
'SN: 020329

L_Welcome_MsgBox_Message_Text   = "This searches for web addresses in a webpage index.htm " & Chr(13) & "and creates a file named 001.txt"
L_Welcome_MsgBox_Title_Text     = "Utility by Marios Polyzoes. marpoly@ geo.gr"
Call Welcome()

' ********************************************************************************

Dim WSHShell,sfile, dfile, fso, f, ts, sLine, done, MyFile, addr, redf, regEx, thisFolder, AllFiles, Fname, lfl
Set WSHShell = WScript.CreateObject("WScript.Shell")
sLine = "x"
n = 0
'------------------------------------------------


const pth = "./"
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
sfile = "index.htm" ' Give the name of the file you want to search
dfile = "001.txt" ' The output file
'-----------------------------------------------

Function RegExpTest(sLine)
   Set regEx = New RegExp   ' Create a regular expression.
   regEx.Pattern = "http://(\S+)"">"   ' Set pattern.
   regEx.IgnoreCase = True   ' Set case insensitivity.
   regEx.Global = True   ' Set global applicability.
   Set Matches = regEx.Execute(sLine)   ' Execute search.
   For Each Match in Matches   ' Iterate Matches collection.
   RetStr = RetStr & Match.Value 
   Next
   RegExpTest = RetStr
End Function
' MsgBox(RegExpTest("is.", "IS1 is2 IS3 is4"))


  Set fso = CreateObject("Scripting.FileSystemObject")
  fso.CreateTextFile (dfile)
  Set f = fso.GetFile(dfile)
  Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

'-----------------

Set fso = CreateObject("Scripting.FileSystemObject")
Set redf = fso.OpenTextFile(sfile, ForReading)
'-----------------------------------


Do While redf.AtEndOfStream <> True
sLine = redf.ReadLine
' WScript.Echo sLine
addr = (RegExpTest(sLine))

'WScript.Echo addr

If addr <> "" Then 
lfl = (Len(addr)-2)
addr = Left(addr,lfl)

ts.WriteLine (addr)

 End if


'DefResp = MsgBox ("Το " & sLine & ".com  domain?", vbYesNo)

Loop
  ts.Close

WScript.Echo "The work is done. Thanks!"


' ********************************************************************************
' *
' * Welcome
' *
Sub Welcome()
    Dim intDoIt

    intDoIt =  MsgBox(L_Welcome_MsgBox_Message_Text, _
                      vbOKCancel + vbInformation,    _
                      L_Welcome_MsgBox_Title_Text )
    If intDoIt = vbCancel Then
        WScript.Quit
    End If
End Sub