Volniy
|
 Posted: Fri Feb 04, 2005 23:41 Post subject: |
 |
|
Другой скрипт (3-ая версия, можно взять его отсюда) . Создает многострочные files.bbs. Упрощенный: без рекурсии и без обработки уже существующих записей в файле .bbs. Цифра в выражении Space(2) определяет отступ строк в многострочных комментариях. Меньше 2 не делать, ибо не работает. Строка dos="..." это сконвертированная в DOS-кодировку строчка win="..." (тут в HTML она глючит). В коде отмечены две строки, которые при комментировании убирают URL загрузки и дату сохранения файла соответственно.
| Code: | '=========================[ Start of file ]=========================
' File: LogsToFileBBS.vbs
' Description: Вычитывает описания файлов из FlasGet-овских
' log-ов в указанной папке и заносит их
' в стандартный Files.bbs в этой папке
' Installation: Создайте кнопку на панели TC
' Команда: "диск:\путь\к\файлу\LogsToFileBBS.vbs"
' Параметры: "%P" [Внимание! Именно в кавычках!]
' Version: 3-ая
' Copyright: (c) 2005, Volniy
Option Explicit
Dim Fso, LogsCnt
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(WScript.Arguments(0)) = False Then
MsgBox "Указана неверная директория!", vbCritical, "Ошибка"
Else
Call EditFilesBBS(Fso.GetFolder(WScript.Arguments(0)))
MsgBox "Операция успешно завершена." & vbCr & _
"Всего LOG-файлов FlashGet: " & LogsCnt, vbInformation, "Сообщение"
End If
Set Fso = Nothing
WScript.Quit
Sub EditFilesBBS(curFolder)
Dim F, fExt
For Each F In curFolder.Files
fExt = UCase(Fso.GetExtensionName(F.Name))
If fExt = "LOG" Then
LogsCnt = LogsCnt + 1
' Обработка исходного файла только если
' LOG был именно FlashGet-овский
If FilesBBSFromLOG(curFolder.Path, F.Path) Then
' Переименование LOG в TXT
' F.Name = Fso.GetBaseName(F.Name) & ".txt"
' или просто их удаление:
' F.Delete True
End If
End If
Next
End Sub
Function FilesBBSFromLOG(Path, LogFile)
Dim dscNew, tmp, forFile, IsFlashLOG
Dim DateTime, URL
Dim TS1, TS2, Entry, pos, pos2, TargetION
TargetION = Fso.BuildPath(Path, "FILES.BBS")
Const ForReading = 1, ForWriting = 2
' Ищем описание для файла в log-файле
Set TS1 = Fso.OpenTextFile(LogFile, ForReading)
Do While TS1.AtEndOfStream <> True
tmp = TS1.ReadLine
'URL:
pos2 = InStr(1, tmp, "URL:", vbTextCompare)
If pos2 Then
URL = Mid(tmp, pos2 + Len("URL:")) ' Нашли URL и сохранили
IsFlashLOG = IsFlashLOG + 1
End If
'Время Сохранения:
pos2 = InStr(1, tmp, "Время Сохранения:", vbTextCompare)
If pos2 Then
DateTime = Mid(tmp, pos2 + Len("Время Сохранения:")) ' Нашли Время Сохранения
IsFlashLOG = IsFlashLOG + 1
End If
'Имя:
pos2 = InStr(1, tmp, "Имя:", vbTextCompare)
If pos2 Then
forFile = Mid(tmp, pos2 + Len("Имя:")) ' Нашли имя и сохранили
IsFlashLOG = IsFlashLOG + 1
End If
pos = InStr(1, tmp, "Комментарий:", vbTextCompare)
If pos Then
Entry = Mid(tmp, pos + Len("Комментарий:")) ' Комментарий сохранили в Entry
IsFlashLOG = IsFlashLOG + 1
ElseIf IsFlashLOG = 4 Then ' За 1-ой строкой комментария - тоже комментарий
Entry = Entry & vbCrLf & Space(2) & "| " & tmp
End If
Loop
' Закомментируйте ненужные Вам строки:
Entry = Entry & vbCrLf & Space(2) & "| " & URL
Entry = Entry & vbCrLf & Space(2) & "| " & DateTime
TS1.Close
Set TS1 = Nothing
If Not Fso.FileExists(Fso.BuildPath(Path, forFile)) Then Exit Function
If Len(Entry) Then ' Если комментарий был найден
' Добавляем имя описываемого файла в формате 8.3
Dim aFile
Set aFile = Fso.GetFile(Fso.BuildPath(Path, forFile))
Entry = WIN2DOS(aFile.ShortName & " " & Entry)
tmp = ""
If Fso.FileExists(TargetION) Then ' Если уже есть файл FILES.BBS
Set TS2 = Fso.OpenTextFile(TargetION, ForReading)
tmp = TS2.ReadAll & vbCrLf ' Добавим перевод строки на всякий пожарный
TS2.Close
End If
dscNew = tmp & Entry
On Error Resume Next
Set TS2 = Fso.OpenTextFile(TargetION, ForWriting, True)
TS2.Write dscNew ' Пишем целевой файл файл
TS2.Close
End If
Set TS2 = Nothing
' Возвратим True, если это был действительно FlashGet-овский LOG
FilesBBSFromLOG = CBool(IsFlashLOG = 4)
End Function
Function WIN2DOS(InputText)
Const win = "абвгдежзийклмнопрстуфхцчшщъыьэюяёАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯЁ"
Const dos = " ЎўЈ¤Ґ¦§Ё©Є«¬®ЇабвгдежзийклмнопсЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџр"
Dim tmp, i, pos, char
For i = 1 To Len(InputText)
char = Mid(InputText, i, 1)
pos = InStr(1, win, char)
If pos > 0 Then
tmp = tmp & Mid(dos, pos, 1)
Else
tmp = tmp & char
End If
Next
WIN2DOS = tmp
End Function
'=========================[ End of file ]=========================
|
Last edited by Volniy on Wed Apr 13, 2005 12:51; edited 4 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
