| View previous topic :: View next topic |
| Author |
Message |
dis8848
Joined: 06 Apr 2011
Posts: 10
|
 (Separately) Posted: Tue Oct 04, 2011 11:34 Post subject: |
 |
|
| Batya wrote: | 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 раз, то противоречий быть не должно.
примерно так что ли...
спасибо за помощь еще раз. |
|
| Back to top |
|
 |
Batya
Joined: 15 Dec 2004
Posts: 2226
Location: Москва, Россия
|
| (Separately) Posted: Tue Oct 04, 2011 17:53 Post subject: |
|
|
dis8848
| Code: | '====================================================
' Колонка 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.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
dis8848
Joined: 06 Apr 2011
Posts: 10
|
| (Separately) Posted: Tue Oct 04, 2011 18:00 Post subject: |
|
|
| спасибо! - буду пробовать. |
|
| Back to top |
|
|
dis8848
Joined: 06 Apr 2011
Posts: 10
|
| (Separately) Posted: Tue Oct 04, 2011 23:53 Post subject: |
|
|
Попробовал - всё получилось!
Result1 сразу выдаёт правильное ФИО.
В скрипте ничего не менял кроме имени и пути файла xls, и отметил следующую особенность: скрипт не работает, если в пути к файлу xls есть кириллица. Пришлось переименовать на латиницу.
Очень Вам благодарен. |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2226
Location: Москва, Россия
|
| (Separately) Posted: Wed Oct 05, 2011 08:57 Post subject: |
|
|
| dis8848 wrote: | | и отметил следующую особенность: скрипт не работает, если в пути к файлу xls есть кириллица. |
Странно. Может у тебя MS Office криво установлен? У меня всё работает нормально.
Ну и, конечно же, файл vbs-скрипта должен иметь кодировку Windows-1251 (ANSI).
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
aLLigator
Joined: 01 Dec 2011
Posts: 167
Location: из тех ворот, что и весь народ...
|
| (Separately) Posted: Thu Dec 01, 2011 14:51 Post subject: |
|
|
Можно как-нибудь в одну колонку выводить результат работы нескольких скриптов?
Добавлено спустя 10 минут:
| Anger wrote: | | Немного доработал скрипт ув.ricobautsch: |
Немного подредактировал под свои нужды:
| Code: |
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
|
Подскажите как можно задать несколько промежутков? |
|
| Back to top |
|
|
Lev
Joined: 02 Mar 2005
Posts: 392
|
| (Separately) Posted: Thu Dec 01, 2011 16:40 Post subject: |
|
|
| Quote: | | Можно как-нибудь в одну колонку выводить результат работы нескольких скриптов? |
1) Написать скрипт интегрирующий в себе работу нескольких скриптов
или
2) Подключить копии плагина по кол-ву желаемых скриптов. Объединять в одну колонку стандартным способом TC или другими комбинирующими плагинами. |
|
| Back to top |
|
|
aLLigator
Joined: 01 Dec 2011
Posts: 167
Location: из тех ворот, что и весь народ...
|
| (Separately) Posted: Sat Dec 03, 2011 12:03 Post subject: |
|
|
| Помогите, пожалуйста, отредактировать предыдущий скрипт, чтобы выводились последние два байта каждого файла! |
|
| Back to top |
|
|
dis8848
Joined: 06 Apr 2011
Posts: 10
|
| (Separately) Posted: Sun Dec 04, 2011 11:57 Post subject: |
|
|
| Batya wrote: | Странно. Может у тебя MS Office криво установлен? У меня всё работает нормально.
Ну и, конечно же, файл vbs-скрипта должен иметь кодировку Windows-1251 (ANSI). |
дело было в кодировках...
попытался с 8 Total-ом использовать - выдало ошибку |
|
| Back to top |
|
|
aLLigator
Joined: 01 Dec 2011
Posts: 167
Location: из тех ворот, что и весь народ...
|
| (Separately) Posted: Wed Dec 07, 2011 20:03 Post subject: |
|
|
Помогите, пожалуйста, адаптировать данный скрипт для подключения к плагину и вывода информации не только для "C:\WINDOWS\notepad.exe", а всех файлов.
| Code: | 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] |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Dec 07, 2011 21:10 Post subject: |
|
|
Тынс:
| Code: | 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 |
|
|
| Back to top |
|
|
aLLigator
Joined: 01 Dec 2011
Posts: 167
Location: из тех ворот, что и весь народ...
|
| (Separately) Posted: Thu Dec 08, 2011 11:04 Post subject: |
|
|
| Аригато газеймашта, что означает - Премного благодарен! |
|
| Back to top |
|
|
Lev
Joined: 02 Mar 2005
Posts: 392
|
| (Separately) Posted: Fri May 04, 2012 17:05 Post subject: |
|
|
Вы конвертируете весь файл в строку типа "FF D8 FF ...", что занимает длительное время
и уже в ней ищете вхождения ваших маркеров
в вашем коде InStr(S, "FF") - всегда будет равно единице (других jpg я в жизни не встречал), а InStr(S, "FFС4"), если оно будет найдено будет больше единицы, и DHT всегда будет отрицательным, а content="O" (будем считать, что перепутан порядок вычитания)
в общем на вашем месте я бы просто искал по файлу первое вхождение FFC4, после чего выходил бы из цикла.
Что-нибудь типа
| Code: | ...
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) лень думать
... |
возможно и искать можно проще, а я просто подзабыл нужный оператор. |
|
| Back to top |
|
|
sancher
Joined: 04 Nov 2011
Posts: 12
Location: Piter
|
| (Separately) Posted: Fri Jun 22, 2012 10:41 Post subject: |
|
|
Помогите люди добрые.
Переношу настройки с TC 7.55 на 8.0
Перестал работать скрипт из этой темы, созданной мной
http://forum.wincmd.ru/viewtopic.php?p=85756&sid=274e807bbf53d4a8b3b3433ab603ebb2
Перенёс всю папку script без каких либо изменений.
Колонку настроил точно так же
Не выводится ничего, в колонке пусто 
кратко опишу, что было сделано из предыдущей темы
установил плагин, создал BaseNameRev.vbs:
| Code: | 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:
| Code: | [Script]
Section=BaseNameRev
[BaseNameRev]
Script=BaseNameRev.vbs |
настроил набор колонок ([=script.Result])
перестал выводится результат, колонка [=script.Result] пуста |
|
| Back to top |
|
|
Dreamer...
Joined: 19 Jul 2012
Posts: 1
|
| (Separately) Posted: Thu Jul 19, 2012 18:22 Post subject: ApkInfo |
|
|
Наваял скрипт для отображения информации о Андроид .арк файлах.
Это мой первый скрипт на vbs - так что возможна куча ошибок и громоздкий код ))))
Для работы со скриптом необходим файл aapt.exe в папке с плагином.
Один небольшой минус - рядом с файлами арк создается текстовый файл для быстрого отображения. Хотел его хранить в папке со скриптом, но не вышло....
Тк я новичек - не могу запостить превьюшку...
| Code: | '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 |
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
