'====================================================================
' AJPapps - Search russian text
' Линда Кайе 2010-2017. Посвящается Ариэль
' 
' Этот скрипт найдёт и сообщит, где в файле имеются строки на 
' русском. Он также отслеживает VB комментарии и не ищет в них 
' строки. Мне он был нужен для удаления сообщений на русском из 
' Make Tumblr post mail и Post pictures to Tumblr.
' 
' • 20.10.2009
'   Первая версия ^^
' 
' • 11.03.2010
'   [+] В сообщении с результатами выводится имя файла.
'   [+] Новый ключ /S.
' 
' • 30.06.2010
'   [-] Некорректно определялись русские буквы. В их число могли 
'       попасть всякие графические символы.
'   
' • 3.03.2017
'   [+] Из имени файла убраны пробелы.
'   [+] Поправлен вывод Usage.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходнй код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Search russian text"

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Dim TXT
Dim Lines
Dim TMP1
Dim TMP2
Dim Res
Dim SilentMode
Dim FileName
Dim Ch

Select Case WScript.Arguments.Count
  Case 1
    FileName = WScript.Arguments(0)
    SilentMode = False
  Case 2
    If UCase(WScript.Arguments(1)) = "/S" Then
      FileName = WScript.Arguments(0)
      SilentMode = True
    Else
      ShowUsage
      WScript.Quit
    End If
  Case Else
    ShowUsage
    WScript.Quit
End Select

Lines = GetFileLines(FileName)

For TMP1 = LBound(Lines) To UBound(Lines)
  TXT = Lines(TMP1)
  For TMP2 = 1 To Len(TXT)
    Ch = Asc(Mid(TXT, TMP2, 1))
    If (Ch >= 192 And Ch <= 223) Or (Ch >= 224 And Ch <= 255) Then
      ' Если до этого места был апостраф, то это коммент...
      If InStr(TXT, "'") = 0 Or InStr(TXT, "'") > TMP2 Then
        Res = Res & FormatNum(TMP1 + 1) & " :: " & Left(Trim(TXT), 55) & vbCrLf
        Exit For
      End If
    End If
  Next
Next

' Подавляем сообщение, если указан флаг...
If Res = "" And SilentMode Then WScript.Quit

MsgBox "All done! ^_^v" & vbCrLf & vbCrLf & _
       FileName & vbCrLf & vbCrLf & _
       IIf(Res = "", "None found...", Res), _
       vbInformation, AppTitle

'====================================================================
' Функция возвращает обработанное имя файла...
'====================================================================
Private Function GetFileLines(ByRef FileName)
  Dim FSO
  Dim File
  Dim TXT
  
  On Error Resume Next
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set File = FSO.OpenTextFile(FileName, ForReading, False)
  
  TXT = File.ReadAll
  GetFileLines = Split(TXT, vbCrLf)
  
  If Err Then 
    MsgBox FileName & vbCrLf & vbCrLf & _
           "Can't read file.", vbCritical, AppTitle
    WScript.Quit
  End If
  
  FileName = FSO.GetFile(FileName).Name
End Function

'====================================================================
Private Function ShowUsage()
  MsgBox "Использование:" & vbCrLf & vbCrLf & _
         WScript.ScriptName & " FileName [/S]" & vbCrLf & vbCrLf & _
         "Ищет в файле FileName строки на русском и выводит " & _
         "результаты поисков." & vbCrLf & vbCrLf & _
         "Необязательный параметр /S включает отображение результатов " & _
         "поиска только если найдена хоть одна строка на русском. " & _
         "Полезно для пакетных запусков. Должен быть вторым.", _
         vbInformation, AppTitle
End Function

'====================================================================
Private Function FormatNum(ByVal Num)
  FormatNum = CStr(Num)
  If Len(FormatNum) >= 4 Then Exit Function
  FormatNum = String(4 - Len(FormatNum), "0") & FormatNum
End Function

'====================================================================
Private Function IIf(ByVal Expression, _
                     ByVal TruePart, _
                     ByVal FalsePart)
  If Expression Then
    IIf = TruePart
  Else
    IIf = FalsePart
  End If
End Function