offline
- dr_Bora
- 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 ), 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!"
|