[Riješeno] Kako izbrojati karaktere u "description" i "keywords" tagovima unutar HTML files

[Riješeno] Kako izbrojati karaktere u "description" i "keywords" tagovima unutar HTML files

offline
  • IvanC 
  • Ugledni građanin
  • Pridružio: 30 Jun 2009
  • Poruke: 403

Imam problem koji trebam riješiti, pa me zanima ima li tko ideju pomoću neke VBS skripte ili link do programa iz iskustva.

Radi se o HTML files unutar nekog foldera koji sadrži subfoldere. Svekupno ima preko 1500 *.html datoteka.

Trebam dvije skripte

PRVA skripta bi trebala uraditi slijedeće
1. Pokretanjem skripte treba tražiti path do foldera (form input message)
2. Druga input message treba tražiti da se upiše u kojem tagu trebam izbrojati karaktere (opcija "keywords" ili "description")
3. Skripta treba pregledati sve HTML files u navedenom folderu i svim subfolderima za postavljeni uvjet i kao rezultat vratiti TXT file sa slijedećim podacima
A. Path: C:/temp/name.html (C:/temp/subfolder1/name1.html)
B. Cijeli tekst keywords ili description (zavisno što sam mu zadao) odvojen od prethodnog pojma "A" sa "#" znakom radi uvoza u Excel
C. Broj karaktera uključujući blanko znakove (space) odvojen od "B" radi uvoza u Excel

Nešto kao A # B # C ( da bi mogao uvesti u Excel i rasporediti u kolone jer znak # mi služi kao separator, a može biti i neki drugi znak)

U Excelu bi prepravio sve description ili keywords i snimio kao CSV ili TXT file

DRUGA skripta bi trebala napraviti obrnuto
Pokupiti sve sve podatke, path iz *.CSV (*.txt) file i pronaći dotični *.html file i napraviti Replace "description" preko starog a isto tako u slučaju kada se radi o keywords

Ako je ovo komplicirano može i tri-četiri skripte (program) svaka za određeni zadatak.
Možda ima neki program koji bi ovo mogao odraditi pa bi bio zahvalan za linkove (ako je free)

Primjer source HTML datoteke (keywords i description )možete pogledati na www.ic.ims.hr/index.html
Ovdje želim napomenuti da ovi tagovi nisu konstantno u određenoj liniji (redu) u svim html files.
U nekim HTML su četvrti ili peti a u nekim šesti ili sedmi red koda.

U principu trebam
1. pronaći
2. automatski snimiti u *.txt
3. uvesti u Excel
4. prepraviti
5. snimiti kao *.csv ili *.txt
3. Find/Replace iz *.csv (*.txt) u *.html

Osobno mi se ne žuri, može li tko pomoći ako ima vremena za bacanje i da mu se "igrati"? Wink



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • dr_Bora  Male
  • Anti Malware Fighter
    Rank 2
  • Pridružio: 24 Jul 2007
  • Poruke: 12280
  • Gde živiš: Höganäs, SE

Drag & drop foldera da bi dobio file sa željenim podacima. Nakon obrade, dropuj taj file na istu skriptu kako bi ažurirao html file-ove.
Nije baš optimalno (koristih stare skripte pa kad to naravno nije radilo onda se snalazih Mr. Green ), ali mislim da radi.

Set objFSO = CreateObject("Scripting.FileSystemObject") 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   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, "")         sLine = sFilePath & " # " & sLine & " # " & Len(sLine)         sAll = sAll & sLine         bFound = True       End If     Loop   End If   oHtml.Close   Set oHtml = Nothing   sAll = sAll & vbCrLf End Sub Sub ModifyTheFile(s1, s2)     On Error Resume Next   objFSO.DeleteFile s1 & ".old", True   objfso.MoveFile s1, s1 & ".old"     If FileIsUnicode(s1 & ".old") Then     Set oHtml = objfso.OpenTextFile(s1 & ".old", 1, False, -1)     Set oHtmlNew = objfso.OpenTextFile(s1, 2, True, -1)   Else     Set oHtml = objfso.OpenTextFile(s1 & ".old", 1, False, 0)     Set oHtmlNew = objfso.OpenTextFile(s1, 2, True, 0)   End If   If Not oHtml.AtEndOfStream Then     Do While Not oHtml.AtEndOfStream       sLine = oHtml.ReadLine       nPos1 = InStr(1, sLine, sLineID, vbTextCompare)       If nPos1 > 0 Then         nPos2 = nPos1 + nOffset - 1         sLine = Left(sLine, nPos2) & s2 & """>"       End If       oHtmlNew.WriteLine(sLine)     Loop   End If   oHtml.Close   oHtmlNew.Close   End Sub If WScript.Arguments.length = 0 Then   MsgBox "Drag and drop a folder or a file"   WScript.Quit End If objStartFolder = WScript.Arguments(0) sInfoFile = WScript.Arguments(0) sLineEnd = """>" If objFSO.FolderExists(objStartFolder) Then   sLineID = InputBox("Uneti tag za obradu (d za description; k za keywords):")   If sLineID = "k" Then     sLineID = "name=""keywords"" content="""   ElseIf sLineID = "d" Then     sLineID = "name=""description"" content="""   Else     MsgBox "Greška!"     WScript.Quit   End If   nOffset = Len(sLineID)    sAll = ""     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 ElseIf objFSO.FileExists(sInfoFile) Then   sLineID = InputBox("Uneti tag za modifikovati (d za description; k za keywords):")   If sLineID = "k" Then     sLineID = "name=""keywords"" content="""   ElseIf sLineID = "d" Then     sLineID = "name=""description"" content="""   Else     MsgBox "Greška!"     WScript.Quit   End If   nOffset = Len(sLineID)     Set oDescFile = objfso.OpenTextFile(sInfoFile, 1, False, -1)     If Not oDescFile.AtEndOfStream Then     Do While Not oDescFile.AtEndOfStream       sLine = oDescFile.ReadLine       aArr = Split(sLine, "#")       For i = 0 To 2         aArr(i) = Trim(aArr(i))       Next       If objFSO.FileExists(aArr(0)) Then ModifyTheFile aArr(0), aArr(1)     Loop   End If End If MsgBox "Done!"



offline
  • IvanC 
  • Ugledni građanin
  • Pridružio: 30 Jun 2009
  • Poruke: 403

Napisano: 27 Dec 2014 8:45

Hvala @dr_Bora
U međuvremenu ja sam pomoću onih skripti od prije izvukao Description i importirao u Excel pa pomoću formule izbrojao karaktere.
Međutim pojavili su se problemi kod konvertiranja txt2columns jer u descriptions ima znakova "-" pa sam morao "čačkati mečku" a na kraju nisam bio siguran da je sve odrađeno kako treba pa nisam znao kako da to vratim nazad u *.html jer bi morao svaki file zasebno sa find/replace

Pogledat ću to kada budem imao vremena pa ću se javiti

Dopuna: 27 Dec 2014 10:09

Na žalost dr_Bora, ne radi Sad
dropanjem foldera koji sadrži subfoldere na *VBS skriptu nakratko se pojavi cmd/Dos prozor i nestane
Nikakvih ostalih događanja niti kreirani file?

evo tvoje skripte u txt formatu koju koristim
https://www.mycity.rs/must-login.png

offline
  • dr_Bora  Male
  • Anti Malware Fighter
    Rank 2
  • Pridružio: 24 Jul 2007
  • Poruke: 12280
  • Gde živiš: Höganäs, SE

Nešto je čudno u tom file-u vezano za encoding.


https://www.mycity.rs/must-login.png

offline
  • IvanC 
  • Ugledni građanin
  • Pridružio: 30 Jun 2009
  • Poruke: 403

Hvala ti
Ovaj tvoj file radi bez problema. Zašto ne radi moj ne znam, kopirao sam code sa web stranice.
Moram samo skontati kako sve to obraditi između tvoje dvije radnje

btw: radio sam usporedbu tvog i kopiranog koda (sa UE i u Wordu) i nisam našao nikakvu razliku (bar nisam vidio). Vrlo interesantno. Code sam kopirao sa web stranice u Excel (da izbjegnem brojeve naredbenih linija) jer u NotePadu++ i UE mi se pastuju i brojevi.
Možda je Excel nešto loše odradio?
pozdrav i svako dobro u Novoj 2015

Ko je trenutno na forumu
 

Ukupno su 720 korisnika na forumu :: 38 registrovanih, 4 sakrivenih i 678 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3028 - dana 22 Nov 2019 07:47

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: A.R.Chafee.Jr., aramis s, bankulen, beowl, Botovac, dac, dekao, Doca, EmilKovac, FOX, Insan, Joja, kaptain, Kibice, krkalon, KUZMAR, Libertas, ljubo70, manda87, MB120mm, Mercury, Milan A. Nikolic, misa1xx, Mixelotti, Nebo_M, nemkea71, Recce, S-lash, shone34, Sirius, Skywhaler, StepskiVuk, Toni, Trpe Grozni, vathra, Vlad000, VP6919, Webb