offline
- dr_Bora

- Anti Malware Fighter
Rank 2
- Pridružio: 24 Jul 2007
- Poruke: 12280
- Gde živiš: Höganäs, SE
|
IvanC ::btw: u koliko bi želio izvući samo keywords pretpostavljam da mogu samo zamijeniti ovu liniju koda- nPos1 = InStr(1, sLine, "name=""description"" content=""", vbTextCompare)
sa ovom linijom - nPos1 = InStr(1, sLine, "name=""keywords"" content=""", vbTextCompare)
Nije dovoljno (nisam se baš toliko potrudio oko skripte ). Dve linije niže imaš:
nPos2 = nPos1 + 28
Ovih 28 je dužina ovoga dole (tj. ofset od pozicije gde je string pronađen do pozicije gde ono što tebe zanima počinje):
name="Description" content="
pa bi za keywords trebalo da upišeš broj 25.
- nPos1 = InStr(1, sLine, "name=""description"" content=""", vbTextCompare)
- If nPos1 > 0 Then
- nPos2 = nPos1 + 25
Ovo radi (testirano).
IvanC ::ali ako bi htio izvući TITLE kako onda ide linija koda jer nemam ovaj dio taga "name"?
pozdrav
Znači, string koji koristiš za prepoznavanje linije je <title> pa prva izmena mora da bude:
nPos1 = InStr(1, sLine, "<title>", vbTextCompare)
Ovime si dobio poziciju znaka < u <title>.
Sledeći korak je da se pomeriš u napred na poziciju gde počinje tekst koji ti želiš:
nPos2 = nPos1 + 7
Na kraju uklanjamo višak teksta sa kraja linije. Ranije je to bilo:
sLine = Replace(sLine, """/>", "") da bi uklonio "/> a sada će biti:
sLine = Replace(sLine, "</title>", "")
+ Kompletna proceduraSub GetAndWrite(sFilePath)
If FileIsUnicode(sFilePath) Then
Set oHtml = objfso.OpenTextFile(sFilePath, 1, False, -1)
Else
Set oHtml = objfso.OpenTextFile(sFilePath, 1, False, 0)
End If
sAll = sAll & sFilePath & " - "
bFound = False
If Not oHtml.AtEndOfStream Then
Do While (Not oHtml.AtEndOfStream) And (Not bFound)
sLine = oHtml.ReadLine
nPos1 = InStr(1, sLine, "<title>", vbTextCompare)
If nPos1 > 0 Then
nPos2 = nPos1 + 7
sLine = Mid(sLine, nPos2)
sLine = Replace(sLine, "</title>", "")
sAll = sAll & sLine
bFound = True
End If
Loop
End If
oHtml.Close
Set oHtml = Nothing
sAll = sAll & vbCrLf
End Sub
Naravno, alternativa je da se ovo odradi na ispravan način i da ne moraš da menjaš skriptu svaki put:
+ Kompletan kod- Set objFSO = CreateObject("Scripting.FileSystemObject")
-
- If WScript.Arguments.length = 0 Then
- MsgBox "Drag and drop a folder with html files"
- WScript.Quit
- End If
-
- objStartFolder = WScript.Arguments(0)
-
-
- sLineID = InputBox("Uneti string za identifikaciju linije. Npr:" & vbCrLf & vbCrLf & "name=""description"" content=""" & vbCrLf & vbCrLf & "name=""author"" content=""" & vbCrLf & vbCrLf & "<title>",, "name=""description"" content=""")
- nOffset = Len(sLineID)
- sLineEnd = InputBox("Uneti string za ukloniti sa kraja linije. Npr:" & vbCrLf & vbCrLf & """/>" & vbCrLf & vbCrLf & "</title>",, """/>")
-
- On Error Resume Next
-
- Sub ShowSubFolders(Folder)
- For Each Subfolder In Folder.SubFolders
- Set objFolder = objFSO.GetFolder(Subfolder.Path)
- Set colFiles = objFolder.Files
- For Each objFile In colFiles
- If LCase(objfso.GetExtensionName(objFile.Path)) = "html" Then GetAndWrite objFile.Path
- Next
- ShowSubFolders Subfolder
- Next
- End Sub
-
- Function FileIsUnicode(File_Name_To_Test)
-
- On Error Resume Next
-
- FileIsUnicode = False
- Set TestFile = FSO.OpenTextFile(File_Name_To_Test)
- If Err <> 0 Then
- On Error Goto 0
- Exit Function
- End If
- char1 = TestFile.Read(1)
- char2 = TestFile.Read(1)
- TestFile.Close
- If Asc(char1) = 255 And Asc(char2) = 254 Then FileIsUnicode = True
-
- On Error Goto 0
-
- End Function
-
-
-
- Sub GetAndWrite(sFilePath)
-
-
- If FileIsUnicode(sFilePath) Then
- Set oHtml = objfso.OpenTextFile(sFilePath, 1, False, -1)
- Else
- Set oHtml = objfso.OpenTextFile(sFilePath, 1, False, 0)
- End If
- sAll = sAll & sFilePath & " - "
- bFound = False
-
- If Not oHtml.AtEndOfStream Then
-
- Do While (Not oHtml.AtEndOfStream) And (Not bFound)
-
- sLine = oHtml.ReadLine
- nPos1 = InStr(1, sLine, sLineID, vbTextCompare)
- If nPos1 > 0 Then
- nPos2 = nPos1 + nOffset
- sLine = Mid(sLine, nPos2)
- sLine = Replace(sLine, sLineEnd, "")
- sAll = sAll & sLine
- bFound = True
- End If
- Loop
-
- End If
- oHtml.Close
- Set oHtml = Nothing
-
- sAll = sAll & vbCrLf
- End Sub
-
- sAll = vbCrLf & vbCrLf & "Folder: " & WScript.Arguments(0) & vbCrLf & vbCrLf & vbCrLf
-
- Set objFolder = objFSO.GetFolder(objStartFolder)
-
- Set colFiles = objFolder.Files
- For Each objFile In colFiles
- If LCase(objfso.GetExtensionName(objFile.Path)) = "html" Then GetAndWrite objFile.Path
- Next
-
-
- ShowSubfolders objFSO.GetFolder(objStartFolder)
-
-
- Set oDescFile = objfso.OpenTextFile(objfso.GetParentFolderName(WScript.ScriptFullName) & "\Descriptions from html.txt", 8, True, -1)
-
- oDescFile.Write(sAll)
-
- oDescFile.Close
- MsgBox "Done!"
Ovime bi trebalo da možeš izvući bilo koju liniju... I da, jasno mi je da sam ovo mogao odmah da uradim umesto da mudrujem bez potrebe.
|