Script Content Plugin

dis8848

Batya писал(а):dis8848
Я опять ничего не понял.
Если ты хочешь остановиться "на html, другие не будем пока рассматривать", то зачем привёл пример xls-файла?
Ты хочешь переименовывать файлы по их содержимому, или информация для переименования должна браться из какого-то стороннего файла?

файлы, которые необходимо переименовать - это html файлы, в них же содержится и номер SIM, а вот сопоставление этого самого номера SIM с конкретной фамилией - в стороннем файле xls.
Прошу простить, что неясно выразился

Иными словами алгоритм такой:
- анализируется html файл: в нём ищется номер SIM (в тексте html этот номер находится после слов "Номер SIM-карты: ", например так: <br />Номер SIM-карты: 00000000000000000000</td>).
- этот номер сопоставляется с фамилией, при этом само соответствие указано в xls файле (как в файле-примере)
- производится переименование файла html из абракадабры в ФИО (новое имя файла - суть ФИО из таблицы xls)

Ранее я предполагал, что слова "Номер SIM-карты: находятся всегда на строго определенной позиции в тексте html, но практика показала, что позиция может меняться каждый раз.

Как вариант, вместо взятия номера после слов "Номер SIM-карты: " можно искать в тексте html номер SIM в xls методом перебора, и, поскольку номер SIM уникален и содержится в тексте всего 1 раз, то противоречий быть не должно.

примерно так что ли...

спасибо за помощь еще раз.

Batya · Сообщение **Batya** » Вт окт 04, 2011 17:53

dis8848

Код: Выделить всё

'====================================================
' Колонка Result  возвращает "Номер Sim-карты"
' Колонка Result1 возвращает имя владельца Sim-карты
'====================================================

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Const ForReading  = 1

On Error Resume Next
Select Case LCase(FSO.GetExtensionName(filename))
  Case "html"
    content = FromHtml(filename)
  Case "xml"
    content = FromXml (filename)
  Case "xls"
    content = FromXls (filename)
  Case Else
    content = ""
End Select
If Err.Number <> 0 Then content = ""
If content <> "" Then content1 = GetName(content)
If Err.Number <> 0 Then content1 = ""
On Error GoTo 0

Set FSO = Nothing

Function FromHtml(pFile)
  Dim P, P1, Text
  Const Str = "Номер SIM-карты:"
  FromHtml = ""
  With FSO.OpenTextFile(pFile, ForReading)
    Text = .ReadAll
    .Close
  End With
  P = InStr(1, Text, Str, 1)
    FromHtml = P
  If P > 0 Then
    P1 = InStr(P + Len(Str), Text, "<")
    If P1 > 0 Then FromHtml = Trim(Mid(Text, P + Len(Str), P1 - P - Len(Str)))
  End If
End Function

Function FromXml(pFile)
  FromXml = ""
  'Задача пока не формализована
'  With FSO.OpenTextFile(pFile, ForReading)
'    Do While Not .AtEndOfStream
'      .SkipLine
'    Loop
'    .Close
'  End With
End Function

Function FromXls(pFile)
  FromXls = ""
  With CreateObject("Excel.Application")
    .Workbooks.Open pFile, null, True
    On Error Resume Next
    FromXls = .Cells(5,3).Value
    On Error GoTo 0
    .Quit
  End With
End Function

Function GetName(pSim)
  Const NamesFile = "D:\work\номера_сим-карт.xls"
  Const ColSim    = 3 'Номер столбца с номерами
  Const ColName   = 2 'Номер столбца с именами
  Const Row       = 2 'Номер начальной строки
  GetName = ""
  Dim i, Sim
  i = Row
  With CreateObject("Excel.Application")
    .Workbooks.Open NamesFile, null, True
    On Error Resume Next
    Do
      Sim = .Cells(i,ColSim).Value
      If Sim = pSim Then
        GetName = .Cells(i,ColName).Value
        Exit Do
      End If
      i = i + 1
      If Err.Number <> 0 Then Exit Do
    Loop Until Sim = ""
    On Error GoTo 0
    .Quit
  End With
End Function

Исправь, при необходимости, параметры xls-файла в функции GetName (в конце скрипта).
Используй инструмент группового переименования (ИГП) по колонке Result1.

dis8848

спасибо! - буду пробовать.

dis8848

Попробовал - всё получилось!
Result1 сразу выдаёт правильное ФИО.

В скрипте ничего не менял кроме имени и пути файла xls, и отметил следующую особенность: скрипт не работает, если в пути к файлу xls есть кириллица. Пришлось переименовать на латиницу.

Очень Вам благодарен.

Batya · Сообщение **Batya** » Ср окт 05, 2011 08:57

dis8848 писал(а):и отметил следующую особенность: скрипт не работает, если в пути к файлу xls есть кириллица.

Странно. Может у тебя MS Office криво установлен? У меня всё работает нормально.
Ну и, конечно же, файл vbs-скрипта должен иметь кодировку Windows-1251 (ANSI).

aLLigator

Можно как-нибудь в одну колонку выводить результат работы нескольких скриптов?

Добавлено спустя 10 минут:

Anger писал(а):Немного доработал скрипт ув.ricobautsch:

Немного подредактировал под свои нужды:

Код: Выделить всё

const nCharStart = 24
const nCharCnt = 5

Set fso = CreateObject("Scripting.FileSystemObject")
Set oTextStream = fso.OpenTextFile(filename)

oTextStream.Skip(nCharStart)
If not oTextStream.AtEndOfStream Then
  content_str = oTextStream.Read(nCharCnt)

  content=Replace(content_str,Chr(0),Chr(1))

End If
oTextStream.Close

Подскажите как можно задать несколько промежутков?

Lev · Сообщение **Lev** » Чт дек 01, 2011 16:40

Можно как-нибудь в одну колонку выводить результат работы нескольких скриптов?

1) Написать скрипт интегрирующий в себе работу нескольких скриптов
или
2) Подключить копии плагина по кол-ву желаемых скриптов. Объединять в одну колонку стандартным способом TC или другими комбинирующими плагинами.

aLLigator

Помогите, пожалуйста, отредактировать предыдущий скрипт, чтобы выводились последние два байта каждого файла!

dis8848

Batya писал(а):Странно. Может у тебя MS Office криво установлен? У меня всё работает нормально.
Ну и, конечно же, файл vbs-скрипта должен иметь кодировку Windows-1251 (ANSI).

дело было в кодировках...

попытался с 8 Total-ом использовать - выдало ошибку

aLLigator

Помогите, пожалуйста, адаптировать данный скрипт для подключения к плагину и вывода информации не только для "C:\WINDOWS\notepad.exe", а всех файлов.

Код: Выделить всё

Option Explicit

Dim strFileName
Dim intByteCount

Dim objFSO
Dim objSpeechFileStream

Dim lngLength
Dim arrBuff


strFileName  = "C:\WINDOWS\notepad.exe"
intByteCount = 2

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objSpeechFileStream = WScript.CreateObject("SAPI.SpFileStream")

If objFSO.FileExists(strFileName) Then
	lngLength = objFSO.GetFile(strFileName).Size
	
	With objSpeechFileStream
		.Open strFileName
		
		On Error Resume Next
		
		.Seek lngLength - intByteCount
		
		If Err.Number = 0 Then
			On Error Goto 0
			
			If .Read(arrBuff, intByteCount) = intByteCount Then
				WScript.Echo ConvertByteArray2HexString(arrBuff)
			End If
		Else
			On Error Goto 0
		End If
		
		.Close
	End With
Else
	' Nothing to output
End If

WScript.Quit 0

'=============================================================================
Function ConvertByteArray2HexString(arrByteArray)
	Dim i
	Dim strValue
	
	strValue = ""
	
	For i = 1 To LenB(arrByteArray)
		strValue = strValue & Right("00" & Hex(AscB(MidB(arrByteArray, i, 1))), 2)
	Next
	
	ConvertByteArray2HexString = strValue
End Function
'=============================================================================

[/code]

Flasher

Тынс:

Код: Выделить всё

With CreateObject("SAPI.SpFileStream")
  .Open FileName
  .Seek CreateObject("Scripting.FileSystemObject").GetFile(FileName).Size - 2
  If .Read(F, 2) = 2 Then 
    For i = 1 To LenB(F)
      Content = Content & Right("00" & Hex(AscB(MidB(F, i, 1))), 2)
    Next
  End If
  .Close
End With

aLLigator

Аригато газеймашта, что означает - Премного благодарен!

Lev · Сообщение **Lev** » Пт май 04, 2012 17:05

Вы конвертируете весь файл в строку типа "FF D8 FF ...", что занимает длительное время
и уже в ней ищете вхождения ваших маркеров
в вашем коде InStr(S, "FF") - всегда будет равно единице (других jpg я в жизни не встречал), а InStr(S, "FFС4"), если оно будет найдено будет больше единицы, и DHT всегда будет отрицательным, а content="O" (будем считать, что перепутан порядок вычитания)
в общем на вашем месте я бы просто искал по файлу первое вхождение FFC4, после чего выходил бы из цикла.
Что-нибудь типа

Код: Выделить всё

...
For i = 1 To LenB(BinaryFile) 
   If AscB(MidB(BinaryFile, i, 1)) = 255 Then If AscB(MidB(BinaryFile, i+1, 1)) = 196 Then Exit For
DHT=i '(или DHT=i-2) лень думать
...

возможно и искать можно проще, а я просто подзабыл нужный оператор.

sancher

Помогите люди добрые.
Переношу настройки с TC 7.55 на 8.0
Перестал работать скрипт из этой темы, созданной мной
http://forum.wincmd.ru/viewtopic.php?p= ... 3ab603ebb2
Перенёс всю папку script без каких либо изменений.
Колонку настроил точно так же
Не выводится ничего, в колонке пусто

кратко опишу, что было сделано из предыдущей темы
установил плагин, создал BaseNameRev.vbs:

Код: Выделить всё

BN = LCase(CreateObject("Scripting.FileSystemObject").GetBaseName(FileName))
i = InStrRev(BN, "_")
y = Mid(BN, i + 1)
If i > 0 And IsNumeric(y) Then content = y

поправил Script.ini:

Код: Выделить всё

[Script]

Section=BaseNameRev

[BaseNameRev]
Script=BaseNameRev.vbs

настроил набор колонок ([=script.Result])

перестал выводится результат, колонка [=script.Result] пуста

Dreamer...

Наваял скрипт для отображения информации о Андроид .арк файлах.
Это мой первый скрипт на vbs - так что возможна куча ошибок и громоздкий код ))))
Для работы со скриптом необходим файл aapt.exe в папке с плагином.
Один небольшой минус - рядом с файлами арк создается текстовый файл для быстрого отображения. Хотел его хранить в папке со скриптом, но не вышло....

Тк я новичек - не могу запостить превьюшку...

Код: Выделить всё

'Script for Script Content Plugin
'(c)Lev Freidin, 2005-2008

'Show Android APK file info
'Script Autor - Dreamer... 

'It's my first vbs :)

Dim fso, sExt, ts, s, re, f, oExec, WshShell, tmp, tt, fnd
Set fso = CreateObject("Scripting.FileSystemObject")
sExt = lcase(fso.GetExtensionName(filename))
Const ForReading = 1

Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.MultiLine = True

'-------TEST ZONE---------
'f = "d:\Android\Games\Стрелять\com.gamelab3d.vampireadventuresbl_1_1.0.0.apk"
'-----TEST ZONE END-------

Select Case sExt
case "apk"


Set f = fso.GetFile(filename)
Fn = fso.GetFileName(Chr(34) & f & Chr(34))

'-------Check if db file not exist----------------
If (fso.FileExists("ApkList.txt")) Then
      
   Else
Set Nfile = FSO.CreateTextFile("ApkList.txt")
Nfile.Close
End If

list = "ApkList.txt"
Set ts = fso.OpenTextFile(list, ForReading)
Do Until ts.AtEndOfStream
s = ts.readLine
Loop
'-----------Check Filename in db-----------------
Fnd = inStr(s, Fn)
If Fnd = 0 Then 
'----------------If not in db---------------------
ts.Close
strPath = "C:\Temp"
strFileName = fso.GetTempName
strFullName = fso.BuildPath(strPath, strFileName)

Set WshShell = CreateObject("WScript.Shell")
oExec = WshShell.Run("cmd /C aapt d badging " & Chr(34) & f & Chr(34) & " >" & strFullName, 0, True)

Set tmp = fso.OpenTextFile(strFullName, ForReading)
Do Until tmp.AtEndOfStream
fStr = tmp.readAll
Loop

'-------PETRARKAAAAAAAAA------------

'--------Application Name---------------
re.Pattern = "application: label='(.*)' "
if re.Test(fStr) then
Set tt = re.Execute(fStr)
ApkName = re.replace (tt(0),"$1")
End If
'--------Application Version---------------
re.Pattern = "versionName='(.*)'"
if re.Test(fStr) then
Set tt = re.Execute(fStr)
Vers = re.replace (tt(0),"$1")
End If
'--------Android version---------------
re.Pattern = "sdkVersion:'(.*)'"
if re.Test(fStr) then
Set tt = re.Execute(fStr)
Pack = re.replace (tt(0),"$1")
If Pack = "16" Then
Andr = "Android 4.1.x"
End If
If Pack = "15" Then
Andr = "Android 4.0.3"
End If
If Pack = "14" Then
Andr = "Android 4.0"
End If
If Pack = "13" Then
Andr = "Android 3.2"
End If
If Pack = "12" Then
Andr = "Android 3.1.x"
End If
If Pack = "11" Then
Andr = "Android 3.0.x"
End If
If Pack = "10" Then
Andr = "Android 2.3.3"
End If
If Pack = "9" Then
Andr = "Android 2.3.0-2"
End If
If Pack = "8" Then
Andr = "Android 2.2.x"
End If
If Pack = "7" Then
Andr = "Android 2.1.x"
End If
If Pack = "6" Then
Andr = "Android 2.0.1"
End If
If Pack = "5" Then
Andr = "Android 2.0"
End If
If Pack = "4" Then
Andr = "Android 1.6"
End If
If Pack = "3" Then
Andr = "Android 1.5"
End If
If Pack = "2" Then
Andr = "Android 1.1"
End If
If Pack = "1" Then
Andr = "Android 1.0"
End If
If Pack = "10000" Then
Andr = "Current Dev. Build"
End If
Else
Andr = "Unknown"
End If
'--------ARM v7---------------
re.Pattern = " 'armeabi-(.*)'"
if re.Test(fStr) then
Set tt = re.Execute(fStr)
VArm = re.replace (tt(0),"$1")
Arm7 = " arm" & VArm
End if
'--------ARM v6---------------
re.Pattern = " 'armeabi'(.*)"
if re.Test(fStr) then
Set tt = re.Execute(fStr)
VArm = re.replace (tt(0),"$1")
Arm6 = " armv6"
End If
'-----------STOP PETRAAARKAAA---------------------
'--------------Write to ApkList db-----------------------
Const ForAppending = 8
Set ts2 = fso.OpenTextFile(list, ForAppending, true)
Line = Fn & " ------- " & "<name>" & ApkName & " v." & Vers & "</name> ------- <misc>" & Andr & " " & Arm6 & " " & Arm7 & "</misc>"
'Wscript.Echo Line
LineWright = ts2.WriteLine(Line)
tmp.Close
fso.DeleteFile(strFullName)
ts2.Close
End If

'-------------Read from db function----------------------

Set ts = fso.OpenTextFile(list, ForReading)
Do Until ts.AtEndOfStream
s = ts.readLine
Loop
re.Pattern = "<name>(.*)</name>"
if re.Test(s) then
Set tt = re.Execute(s)
ApkNV = re.replace (tt(0),"$1")
End If
re.Pattern = "<misc>(.*)</misc>"
if re.Test(s) then
Set tt = re.Execute(s)
Andr = re.replace (tt(0),"$1")
End If
content= ApkNV
content1= Andr
'-------TEST ZONE---------
'Wscript.Echo ApkNV & Andr
'-----TEST ZONE END-------
ts.Close

End Select

Total Commander

Script Content Plugin

ApkInfo