Total Commander

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

'====================================================
' Колонка 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

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

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

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

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
'=============================================================================

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

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

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

...
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) лень думать
...

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

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]

Section=BaseNameRev

[BaseNameRev]
Script=BaseNameRev.vbs

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

'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