AspGerman Wiki

Bearbeiten

Bedienung:

Datei als ripper.vbs in einem Ordern mit HTML Dateien ablegen. Die HTML Datei/en auswählen und auf die soeben erstellte VBS Datei ziehen und loslassen. Für jede HTML Datei wird eine TXT Datei angelegt mit den darin enthaltenen Links und Namen.

Bearbeiten

Script:

'**************************************************************
'*  This script reads a HTML page and return all links in it
'*
'*  Idea and coding by Hubert Daubmeier
'*  Created on 12. Mar 2001
'*  Last change on 16. Jan 2008
'**************************************************************

Option Explicit
Dim i, objArgs, a
Dim fso, fh, f2, sAllString
Const ForReading = 1
Const ForWriting = 2

Set fso = CreateObject("Scripting.FileSystemObject")
Set objArgs = Wscript.Arguments

For i = 0 to objArgs.Count - 1
	Set fh = fso.OpenTextFile(objArgs(I), ForReading)
	a = fh.ReadAll
	fh.Close

	Set f2 = fso.OpenTextFile(objArgs(I) & ".txt", ForWriting, True)
	a = Split(objArgs(I), "\")
	f2.Write "Datei: " & vbTab & a(UBound(a)) & vbcrlf
	Call ScanFile
	f2.close
Next

Sub ScanFile()
	Dim i, a, b, c, d
	Const CVBTEXTCOMPARE = 1
	Do While Instr(1, sAllString, "<a ", CVBTEXTCOMPARE)
		a = cdr(sAllString, "<a ")
		b = split(car(a, "</a>"), ">")
		c = split(b(0), " ")
		For i = 0 to UBound(c)
			d = split(c(i), "=", 2)
			If d(0) = "href" Then
				f2.Write replace(d(1), chr(34), "") & vbTab & b(1) & vbcrlf       
			ElseIf d(0) = "name" Then
				f2.Write "Name" & vbTab & replace(d(1), chr(34), "") & vbcrlf       
			End If
		Next
		sAllString = cdr(a, "</a>")
	Loop
End Sub

' ********************************************************************************
' *
' * String Funktionen
' *

Function car(sString, sDelim)
	Dim i
	i = InStr(1, sString, sDelim, vbTextCompare)
	If i = 0 Then
		car = ""
	Else
		car = Trim(Left(sString, max(0, i - 1)))
	End If
End Function

Function max(a, b)
	If a > b Then max = a Else max = b
End Function

Function Min(a, b)
	If a < b Then Min = a Else Min = b
End Function

Function cdr(sString, sDelim)
	Dim i
	i = InStr(1, sString, sDelim, vbTextCompare)
	If i = 0 Then
		cdr = ""
	Else
		cdr = Trim(Mid(sString, max(0, i + Len(sDelim))))
	End If
End Function

ScrewTurn Wiki version 2.0.33. Some of the icons created by FamFamFam.