' Functions.vbs
'========================   Описание   =====================================
' Скрипт с различными Функциями, которые можно использовать в других скриптах AkelPad
' следует положить в ...AkelFiles\Plugs\Scripts\Include\
'================   Примеры  использования   ===============================
' AkelPad.Include("Functions.vbs")
' Path = GetPath("%WINDIR%")

' Автор:           Аверин Андрей
' Версия:          5.0 (18.04.2011 - 18.10.2012)
' Mail:            Averin-And@yandex.ru
' Site:            http://tc-image.3dn.ru/forum/9-346-1076-16-1333500845
'===========================================================================
' Функция определения к-ва раз встречающейся фразы\символа pLine в тексте pText
' возвращает число
Function CountLineInText(pText, pLine)
  CountLineInText = 0
  If Len(pText) > 0 And Len(pLine) > 0 And Len(pText) > Len(pLine) Then
    For i = 1 To Len(pText)
      sss = InStr(UCase(pText), UCase(pLine))
      If sss > 0 Then
        pText = Mid(pText, sss + 1) : countt = countt + 1
      Else
       Exit For
      End If
    Next
    CountLineInText = countt
  End If
End Function

' Функция возвращает строку начальных пробелов
Function SpaceLineBegin(LLine) : SpaceLineBegin = RegExpSearchInText(LLine, "^( +)") : End Function

' Функция возвращает строку без начальных пробелов
Function SpaceLineEnd(eLine) : SpaceLineEnd = Mid(eLine, Len(SpaceLineBegin(eLine)) + 1) : End Function

' Возвращает полный путь для заданного относительного пути
Function GetPath(pppPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(Replace(pppPath, "%a\", AkelPad.GetAkelDir(0) & "\")) : End Function

' Функция замены с помощью регулярных выражений
' pText - текст, в котором будет происходить поиск\замена
' pFindStr - строка для поиска
' pNewStr - строка для замены
' mm - 1 - Мультистрочно 0 - нет
' ic - 1 - Игнорировать регистр символов 0 - учитывать регистр символов
' gl - 1 - Проверять по всему тексту 0 - Проверять до первого соответствия
Function RegExpReplace(pText, pFindStr, pNewStr, mm, ic, gl)
  pNewStr = Replace(pNewStr, "\n", Chr(13))
  Set objRegExp = New RegExp
  With objRegExp
    If mm = 1 Then .Multiline = True Else .Multiline = False End If
    If ic = 1 Then .IgnoreCase = True Else .IgnoreCase = False End If
    If gl = 1 Then .Global = True Else .Global = False End If
    .Pattern = pFindStr : RegExpReplace = .Replace(pText, pNewStr)
  End With
  Set objRegExp = Nothing
End Function

' Функция поиска с помощью регулярных выражений
' (текст, строка для поиска)
Function RegExpSearchInText(SeachText, pFindStr)
  With New RegExp
    .Pattern = pFindStr : .Global = True : .Multiline = True : .IgnoreCase = True
    Set Matches = .Execute(SeachText)
    If Matches.Count > 0 Then RegExpSearchInText = Matches.Item(0)
    Set Matches = Nothing
  End With
End Function

' Функция изменений цифр в тексте на xN единиц
Function ChangeNumbersInText(xT, xN)
  With CreateObject("VBScript.RegExp") : .Pattern = "[\d]+" : .Global = True : Set objM = .Execute(xT) : End With : xS = xT
  For ii = 0 To objM.Count - 1
    xV = objM.Item(ii) + xN : With objM.Item(ii) : xF = .FirstIndex : xL = .Length : End With
    xS = Left(xS, xF + xK) & xV & Mid(xS, xF + xK + xL + 1) : xK = xK + Len(xV) - xL
  Next
  ChangeNumbersInText = xS
End Function

' Функция возвращает дату в формате 2011.05.16
Function YearMonthDay : YearMonthDay = Year(Date) & "." & Right(0 & Month(Date), 2) & "." & Right(0 & Day(Date), 2) : End Function

' Функция возвращает дату в формате 2011.05.16 04-19
Function YearMonthDayHourMinute : YearMonthDayHourMinute = Year(Date) & "." & Right(0 & Month(Date), 2) & "." & Right(0 & Day(Date), 2) & Chr(32) & Right(0 & Hour(Time), 2) & "-" & Right(0 & Minute(Time), 2) : End Function

' Функция возвращает дату в формате 16.05.2011
Function DayMonthYear : DayMonthYear = Right(0 & Day(Date), 2) & "." & Right(0 & Month(Date), 2) & "." & Year(Date) : End Function

' Функция возвращает дату в формате 16.05.2011 04-19
Function DayMonthYearHourMinute : DayMonthYearHourMinute = Right(0 & Day(Date), 2) & "." & Right(0 & Month(Date), 2) & "." & Year(Date) & Chr(32) & Right(0 & Hour(Time), 2) & "-" & Right(0 & Minute(Time), 2) : End Function

' Функция возвращает дату в заданном формате
' где YYYY - год YY - короткий год, MM - месяц, DD - день , HH - час, NN - минуты, SS - секунды
' DateTimeFormat("YYYY.MM.DD - HH.NN.SS") вернёт результат: 2012.08.20 - 15.12.53
Function DateTimeSpecifiedFormat(Form)
  xSyn = Mid(Form, 1, 1) : xD = Date : xT = Time : xSD = "YMDHNS" : xDD = Array(Year(xD), Month(xD), Day(xD), Hour(xT), Minute(xT), Second(xT)) : xAD = Array("Y", "M", "D", "H", "N", "S")
  For ii = 1 To Len(Form)
    xSym = Mid(Form, ii, 1)
    If InStr(xSD, xSym) = 0 Or xSyn <> xSym Then
      If Len(xST) > 0 Then : xFD = xFD & Right("0" & xDD(InStr(xSD, xSyn) - 1), Len(xST)) : xST = "" : End If
      If xSyn <> xSym Then : xSym = "" : ii = ii - 1 : End If
      xFD = xFD & xSym : xSyn = Mid(Form, ii + 1, 1)
    Else
      If xSyn = xSym Then : xST = xST & xSym : Else : xFD = xFD & Right("0" & xDD(InStr(xSD, xSyn) - 1), Len(xST)) : xST = "" : End If
    End If
  Next
  DateTimeSpecifiedFormat = xFD & Right("0" & xDD(InStr(xSD, xSyn) - 1), Len(xST))
End Function

' Функция получения позиции с выключением переноса по словам с отключением прорисовки окна
Function OnOffWordWrap(PL)
  With AkelPad hWnd = .GetEditWnd() : OnOffWordWrap = 0
    If hWnd > 0 Then
      Call SetRedraw(hWnd, False)
      bNoSelEOL = .IsPluginRunning("SmartSel::NoSelEOL") : If bNoSelEOL Then Call .Call(pFuncEOL)
      nWordWrap = .SendMessage(hWnd, 3241, 0, 0)
      If nWordWrap > 0 Then : Call .SendMessage(.GetMainWnd(), 273, 4209, 0)
      Select Case PL
        Case 1 OnOffWordWrap = .SendMessage(hWnd, 187, .SendMessage(hWnd, 1078, 0, .GetSelStart()), 0)
        Case 2 OnOffWordWrap = .SendMessage(hWnd, 187, .SendMessage(hWnd, 1078, 0, .GetSelEnd()) , 0) + .SendMessage(hWnd, 193, .GetSelEnd(), 0)
      End Select
      If bNoSelEOL Then Call .Call(pFuncEOL)
      If nWordWrap > 0 Then : Call .SendMessage(.GetMainWnd(), 273, 4209, 0)
      Call SetRedraw(hWnd, True)
    End If
  End With
End Function

' Функция дополнения выделения строк
' kk = 0 - дополняет выделения строк
' kk = 1 - возвращает дополнение выделения строк
' kk = 2 - возвращает начало дополнение выделения строк
' kk = 3 - возвращает конец дополнение выделения строк
Function SupplementSelectionLines(kk)
  With AkelPad hWnd = .GetEditWnd()
    nLine1 = .SendMessage(hWnd, 1078, 0, .GetSelStart())
    nLine2 = .SendMessage(hWnd, 1078, 0, .GetSelEnd())
    nBegSel = .SendMessage(hWnd, 187, nLine1, 0)
    nEndSel = .SendMessage(hWnd, 187, nLine2, 0) + .SendMessage(hWnd, 193, .SendMessage(hWnd, 187, nLine2, 0), 0)
    Select Case kk
      Case 0 Call .SetSel(nBegSel, nEndSel)
      Case 1 ssL = .GetTextRange(nBegSel, nEndSel)
      Case 2 ssL = nBegSel
      Case 3 ssL = nEndSel
    End Select
  End With
  SupplementSelectionLines = ssL
End Function

' Функция получения позиции начала строки
Function PosBegLine : PosBegLine = OnOffWordWrap(1) : End Function

' Функция получения позиции конца строки
Function PosEndLine : PosEndLine = OnOffWordWrap(2) : End Function

' Функция перемещения курсора в начало строки
Function CursorBegLine : nBegSel = PosBegLine : Call AkelPad.SetSel(nBegSel, nBegSel) : End Function

' Функция перемещения курсора в конец строки
Function CursorEndLine : nEndSel = PosEndLine : Call AkelPad.SetSel(nEndSel, nEndSel) : End Function

' Функция выделения строки
Function SelectLine : nBegSel = PosBegLine : nEndSel = PosEndLine : If nBegSel < nEndSel Then : Call AkelPad.SetSel(nBegSel, nEndSel) : End If : End Function

' Функция получения строки
Function GetLine : nBegSel = PosBegLine : nEndSel = PosEndLine : If nBegSel < nEndSel Then : GetLine = AkelPad.GetTextRange(nBegSel, nEndSel) : End If : End Function

' Функция выделения строки вправо от курсора
Function SelectLineRight : With AkelPad nStart = .GetSelStart() : nEndSel = PosEndLine : If nStart < nEndSel Then : Call .SetSel(nStart, nEndSel) : End If : End With : End Function

' Функция получения строки вправо от курсора
Function GetLineRight : With AkelPad nStart = .GetSelStart() : nEndSel = PosEndLine : If nStart < nEndSel Then : GetLineRight = .GetTextRange(nStart, nEndSel) : End If : End With : End Function

' Функция выделения строки влево от курсора
Function SelectLineLeft : With AkelPad nStart = .GetSelStart() : nBegSel = PosBegLine : If nBegSel < nStart Then : Call .SetSel(nBegSel, nStart) : End If : End With : End Function

' Функция получения строки влево от курсора
Function GetLineLeft : With AkelPad nStart = .GetSelStart() : nBegSel = PosBegLine : If nBegSel < nStart Then : GetLineLeft = .GetTextRange(nBegSel, nStart) : End If : End With : End Function

' Функция выделения слова левее курсора
Function SelectWordLeft : poz = GetPositionWord(0) : Call AkelPad.SetSel(poz(0), poz(1)) : End Function

' Функция получения слова левее курсора
Function GetWordLeft : poz = GetPositionWord(0) : GetWordLeft = AkelPad.GetTextRange(poz(0), poz(1)) : End Function

' Функция выделения слова правее курсора
Function SelectWordRight : poz = GetPositionWord(2) : Call AkelPad.SetSel(poz(0), poz(1)) : End Function

' Функция получения слова правее курсора
Function GetWordRight : poz = GetPositionWord(2) : GetWordRight = AkelPad.GetTextRange(poz(0), poz(1)) : End Function

' Функция получения позиции слова. nCnt=2 правее курсора, nCnt=0 левее курсора 
Function GetPositionWord(nCnt)
  Dim nW(1) : With AkelPad hWnd = .GetEditWnd() : nW(0) = .SendMessage(hWnd, 1100, 0, .GetSelStart() + CInt(nCnt)) : nW(1) = .SendMessage(hWnd, 1100, 7, nW(0)) : GetPositionWord = nW : End With
End Function

' Функция получения позиции слова, даже если курсор стоит перед первой и после последней буквы слова
Function GetWordRangeLR
  nCaretPos = AkelPad.GetSelStart() : poz = GetPositionWord(0) : If poz(1) < nCaretPos Then poz = GetPositionWord(1)
  GetWordRangeLR = poz
End Function

' Функция выделения слова
Function SelectWord : poz = GetWordRangeLR : Call AkelPad.SetSel(poz(0), poz(1)) : End Function

' Функция получения слова
Function GetWord : poz = GetWordRangeLR : GetWord = AkelPad.GetTextRange(poz(0), poz(1)) : End Function

' Функция выделения символа левее курсора
Function SelectSymLeft : With AkelPad nStart = .GetSelStart() : Call .SetSel(nStart - 1, nStart) End With : End Function

' Функция получения символа левее курсора
Function GetSymLeft : With AkelPad nStart = .GetSelStart() : GetSymLeft = .GetTextRange(nStart - 1, nStart) End With : End Function

' Функция выделения символа правее курсора
Function SelectSymRight : With AkelPad nStart = .GetSelStart() : Call .SetSel(nStart, nStart + 1) End With : End Function

' Функция получения символа правее курсора
Function GetSymRight : With AkelPad nStart = .GetSelStart() : GetSymRight = .GetTextRange(nStart, nStart + 1) End With : End Function

' Функция выделения N символов правее курсора
Function SelectNSymRight(nS) : With AkelPad nStart = .GetSelStart() : Call .SetSel(nStart, nStart + nS) End With : End Function

' Функция получения N символов правее курсора
Function GetNSymRight(nS) : With AkelPad nStart = .GetSelStart() : GetNSymRight = .GetTextRange(nStart, nStart + nS) End With : End Function

' Функция выделения N символов левее курсора
Function SelectNSymLeft(nS) : With AkelPad nStart = .GetSelStart() : Call .SetSel(nStart, nStart - nS) End With : End Function

' Функция получения N символов левее курсора
Function GetNSymLeft(nS) : With AkelPad nStart = .GetSelStart() : GetNSymLeft = .GetTextRange(nStart, nStart - nS) End With : End Function

' Функция выделения текста от курсора вверх
Function SelectTextUp : With AkelPad Call .SetSel(0, .GetSelStart()) End With : End Function

' Функция получения текста от курсора вверх
Function GetTextUp : With AkelPad GetTextUp = .GetTextRange(0, .GetSelStart()) End With : End Function

' Функция выделения текста от курсора вниз
Function SelectTextDown : With AkelPad Call .SetSel(.GetSelStart(), -1) End With : End Function

' Функция получения текста от курсора вниз
Function GetTextDown : With AkelPad GetTextDown = .GetTextRange(.GetSelStart(), -1) End With : End Function

' Функция выделения всего текста
Function SelectTextAll : Call AkelPad.SetSel(0, -1) : End Function

' Функция получения номера последней строки файла без переноса строк
Function nLastLine
  With AkelPad hWnd = .GetEditWnd() : wrpLine  = .SendMessage(hWnd, 1078, 0, -2) : nLastLine = .SendMessage(hWnd, 3143, wrpLine, 0)
    If nLastLine > wrpLine Then nLastLine = wrpLine
  End With
End Function

' Функция получения первой не пустой строки
Function GetFirstNonEmptyLine(rText)
rText = rText & Chr(13)
Do While mm = 0
  nn = InStr(rText, Chr(13))
  If nn = 1 Then
    rText = Mid(rText, nn + 1) : kk = kk + nn : jj = jj + 1
  Else
    rLine =  AkelPad.GetTextRange(kk, nn + jj - 1)
  If Len(rLine) > 0 Then Exit Do
  End If
Loop
GetFirstNonEmptyLine = rLine
End Function

' Функция получения всего текста
Function GetTextAll : GetTextAll = AkelPad.GetTextRange(0, -1) : End Function

' Функция получения пути в строке (если есть)
' 0 - получить путь, 1 - получить и выделить
Function GetPathLine(RS)
  gText = GetLine : gLine = LineInstrPath(gText) : If Len(gLine) = 0 Then Exit Function
  bPos = Split(gLine, ";")
  gLine = LineInstrPath(ReplaceSymPath(ClearLineLeft(gText))) : If Len(gLine) = 0 Then Exit Function
  ePos = Split(gLine, ";")
  phl = PosBegLine - 1 : nBegSel = phl + bPos(0) : nEndSel = phl + bPos(0) + ePos(1) - 1
  nb = PosEndLine : If nEndSel > nb Then nEndSel = nb
  GetPathLine = AkelPad.GetTextRange(nBegSel, nEndSel)
  If RS > 0 Then Call AkelPad.SetSel(nBegSel, nEndSel)
End Function

' Функция выделения текста от ссылки вниз
Function SelectURLDown : nBegSel = InStr(GetTextAll, "http://") : If nBegSel > 0 Then : Call AkelPad.SetSel(nBegSel - 1, -1) : End If : End Function

' Функция получения текста от ссылки вниз
Function GetURLDown : nBegSel = InStr(GetTextAll, "http://") : If nBegSel > 0 Then GetURLDown = AkelPad.GetTextRange(nBegSel - 1, -1) : End If : End Function

' Функция выделения текста от ссылки вниз
Function SelectURLUp : nBegSel = InStr(GetTextAll, "http://") : If nBegSel > 0 Then Call AkelPad.SetSel(nBegSel - 1, -1) : End If : End Function

' Функция получения текста от ссылки вниз
Function GetURLUp : nBegSel = InStr(GetTextAll, "http://") : If nBegSel > 0 Then GetURLUp = AkelPad.GetTextRange(nBegSel - 1, -1) : End If : End Function

' Функция выделения первой ссылки в документе
Function SelectURL : uText = GetTextAll : nBegSel = InStr(uText, "http://")
  If nBegSel > 0 Then Call AkelPad.SetSel(nBegSel - 1, nBegSel + InStr(Mid(uText, nBegSel), Chr(13)) - 2)
End Function

' Функция получения первой ссылки в документе
Function GetURL : uText = GetTextAll : nBegSel = InStr(uText, "http://")
  If nBegSel > 0 Then GetURL = AkelPad.GetTextRange(nBegSel - 1, nBegSel + InStr(Mid(uText, nBegSel), Chr(13)) - 2)
End Function

' Функция получения ссылки из текста uText, где nEnd - конец ссылки. GetTextURL(Text, vbNewLine)
Function GetTextURL(uText, nEnd)
  GetTextURL = "" : nBeg = InStr(uText, "http://")
  If nBeg > 0 Then
    uText = Mid(uText, nBeg) : uu = InStr(uText, nEnd) : If Len(uu) > 0 Then uText = Left(uText, uu - 1)
    GetTextURL = uText
  End If
End Function

' Функция получения сайта из ссылки
Function GetSiteURL(uText)
  If Len(uText) > 0 Then
    nu = InStr(uText, ":/") + 3 : mu = InStr(Mid(uText, nu), "/") : If mu > 0 Then uText = Left(uText, mu + nu - 1)
  End If
  If Right(uText, 1) = "/" Then uText = Mid(uText, 1, Len(uText) - 1)
  GetSiteURL = uText
End Function

' Функция выделения сайта ссылки
Function SelectSiteURL(uText) : SU = GetSiteURL(uText) : nSelStart = AkelPad.GetSelStart() : If Len(SU) > 0 Then Call AkelPad.SetSel(nSelStart, nSelStart + Len(SU)) : End If : End Function

' Функция получения различных частей ссылки
' uText - ссылка, sf - параметр, где возвращается из ссылки, если есть файл
' 1 - имя файла с расширением
' 2 - расширение файла
' 3 - имя без расширения
' 4 - "родительский" путь со слешем
' 5 - "родительский" путь без слеша
' 6 - "родительский" путь без слеша
 Function GetFileURL(uText, sf)
  GetFileURL = ""
  If Len(uText) > 0 Then
    tf = InStrRev(uText, ".") : th = InStrRev(uText, "/")
      Select Case sf
        Case 1 uFile = Mid(uText, th + 1)
        Case 2 If tf > th Then uFile = Mid(uText, tf + 1)
        Case 3 If tf > th Then uFile = Mid(uText, th + 1, tf - th - 1)
        Case 4 uFile = Mid(uText, 1, th)
        Case 5 uFile = Mid(uText, 1, th - 1)
      End Select
  End If
  GetFileURL = uFile
End Function

' Функция выделения различных частей ссылки
' uText - ссылка, sf - параметр, где выделяется из ссылки, если есть файл
' 1 - имя файла с расширением
' 2 - расширение файла
' 3 - имя без расширения
' 4 - "родительский" путь со слешем
' 5 - "родительский" путь без слеша
 Function SelectFileURL(uText, sf)
  SelectFileURL = ""
  If Len(uText) > 0 Then
    With AkelPad
      nSelStart = .GetSelStart() : nSelEnd = .GetSelEnd() : tf = InStrRev(uText, ".") : th = InStrRev(uText, "/")
        Select Case sf
          Case 1 Call .SetSel(nSelStart + th, nSelEnd)
          Case 2 If tf > th Then Call .SetSel(nSelStart + tf, nSelEnd)
          Case 3 If tf > th Then Call .SetSel(nSelStart + th, nSelStart + tf - 1)
          Case 4 Call .SetSel(nSelStart , nSelStart + th)
          Case 5 Call .SetSel(nSelStart, nSelStart + th - 1)
        End Select
    End With
  End If
  SelectFileURL = uFile
End Function

' Функция выделения ссылки под курсором
' возвращает 0 - если ничего не выделено, 1 - если выделено
Function SelectLinkUnderCaret
  With AkelPad SelectLinkUnderCaret = 0
    If X64 Then : cc = 24 : vv = 56 : Else : cc = 12 : vv = 28 : End If
    lpCaret = .MemAlloc(cc)
    If Len(lpCaret) > 0 Then
      hWE = .GetEditWnd()
      Call .SendMessage(hWE, 3130, 5, lpCaret) : lpSel = .MemAlloc(vv)
      If Len(lpSel) > 0 Then
        If .SendMessage(hWE, 3149, lpCaret, lpSel) Then : Call .SendMessage(hWE, 3126, lpCaret, lpSel) : SelectLinkUnderCaret = 1 : End If
      End If
    End If
  End With
End Function

' Функция получения ссылки под курсором или позиции, где cpCnt
' 0 - ссылка, 1 - начало позиции, 2 - конец позиции
Function GetLinkUnderCaret(cpCnt)
  With AkelPad Res = ""
    If X64 Then : cc = 24 : vv = 48 : Else : cc = 12 : vv = 24 : End If
    lpCaret = .MemAlloc(cc)
    If Len(lpCaret) > 0 Then
      hWE = .GetEditWnd()
      Call .SendMessage(hWE, 3130, 5, lpCaret) : lpRange = .MemAlloc(vv)
      If Len(lpRange) > 0 Then
        If .SendMessage(hWE, 3149, lpCaret, lpRange) Then
        cpMin = .SendMessage(hWE, 3136, 0, lpRange)
        cpMax = .SendMessage(hWE, 3136, 0, lpRange + cc)
        Select Case cpCnt
          Case 0 Res = .GetTextRange(cpMin, cpMax)
          Case 1 Res = cpMin
          Case 2 Res = cpMax
        End Select
        End If
      End If
    End If
  End With
  GetLinkUnderCaret = Res
End Function

' Процедура перемещение курсора в позицию мышки
Sub SetCaretAtCursor
  With AkelPad
    Set oSys = .SystemFunction() : hWnd = .GetEditWnd() : nCurs = -1 : lpPoint = .MemAlloc(8)
    If Len(lpPoint) > 0 Then
      Call oSys.Call("user32::GetCursorPos", lpPoint)
      Call oSys.Call("user32::ScreenToClient", hWnd, lpPoint)
      nCurs = .SendMessage(hWnd, 215, 0, lpPoint)
      .MemFree(lpPoint)
    End If  
    if nCurs => 0 Then Call .SetSel(nCurs, nCurs)
  End With
  Set oSys = Nothing
End Sub

' Функция получения имени файла открытого на редактирование без расширения
Function GetNameFile : GetNameFile = GetOtherObjectFile(AkelPad.GetEditFile(0), 2) : End Function

' Функция получения расширения файла открытого на редактирование
Function GetExtFile : GetExtFile = GetOtherObjectFile(AkelPad.GetEditFile(0), 1) : End Function

' Функция получения родительского пути файла открытого на редактирование
Function GetParentFolderFile : GetParentFolderFile = GetOtherObjectFile(AkelPad.GetEditFile(0), 4) : End Function

' Функция получения имени с расширением файла открытого на редактирование
Function GetNameExtFile : GetNameExtFile = GetOtherObjectFile(AkelPad.GetEditFile(0), 3) : End Function

' Функция получения различных объектов файла и каталога
Function GetOtherObjectFile(yyFile, yyN)
  With CreateObject("Scripting.FileSystemObject")
      Select Case yyN
        Case 0 yyF = .GetParentFolderName(yyFile) & "\" & .GetBaseName(yyFile) & ".ini" ' расширение
        Case 1 yyF = .GetExtensionName(yyFile) ' расширение
        Case 2 yyF = .GetBaseName(yyFile) ' имя без расширения
        Case 3 yyF = .GetFileName(yyFile) ' имя с расширением
        Case 4 yyF = .GetParentFolderName(yyFile) ' родительский путь
        Case 5 yyF = .GetParentFolderName(.GetParentFolderName(yyFile)) ' дедушкин путь
        Case 6 yyF = .GetFile(yyFile).ShortPath ' короткий путь к файлу в формате 8.3
        Case 7 yyF = .GetFile(yyFile).ShortName ' короткое имя к файлу в формате 8.3
        Case 8 yyF = .GetFile(yyFile).Drive.DriveLetter ' буква диска, на котором находится файл
        Case 9 yyF = .GetFile(yyFile).DateCreated ' дата создания
        Case 10 yyF = .GetFile(yyFile).DateLastAccessed ' дата последнего доступа
        Case 11 yyF = .GetFile(yyFile).DateLastModified ' дата последней модификации
        Case 12 yyF = .GetFile(yyFile).Size  ' размер
        Case 13 yyF = .GetFile(yyFile).Type  ' тип файла
  
        Case 14 yyF = .GetFolder(yyFile).ShortPath ' короткий путь к каталогу в формате 8.3
        Case 15 yyF = .GetFolder(yyFile).ShortName ' короткое имя к каталогу в формате 8.3
        Case 16 yyF = .GetFolder(yyFile).Drive.DriveLetter ' буква диска, на котором находится каталог
        Case 17 yyF = .GetFolder(yyFile).DateCreated ' дата создания
        Case 18 yyF = .GetFolder(yyFile).DateLastAccessed ' дата последнего доступа
        Case 19 yyF = .GetFolder(yyFile).DateLastModified ' дата последней модификации
        Case 20 yyF = .GetFolder(yyFile).Size  ' размер
        Case 21 yyF = .GetFolder(yyFile).Type  ' тип каталога
        Case 22 yyF = .GetFolder(yyFile).IsRootFolder   '  корневой каталог (True|False)
      End Select
  End With
  GetOtherObjectFile = yyF
End Function

' Функция получения нового пути файла , путём замены имени xxN (если в xxN нет расширения берётся из xxP)
Function ReplacingFileName(xxP, xxN)
  If Len(GetOtherObjectFile(xxN, 1)) = 0 Then xxN = xxN & "." & GetOtherObjectFile(xxP, 1)
  ReplacingFileName = GetOtherObjectFile(xxP, 4) & "\" & xxN
End Function

' Функция добавления расширения nnExt, если в имени или пути nnPath расширение больше 10 или равно или в расширении есть русские буквы
Function CheckExtension(nnPath, nnExt)
  eExt = GetOtherObjectFile(nnPath, 1) : jn = Len(RegExpSearchInText(eExt, "[а-я|ё|А-Я|Ё]")) : je = Len(eExt) : If je > 10 Or je < 1 Or jn > 0 Then nnPath = nnPath & "." & nnExt
  CheckExtension = nnPath
End Function

' Функция возвращает имя используемого coder-файла ("псевдорасширение")
Function GetActiveSyntax(hWndE)
  With AkelPad lpFile = .MemAlloc(256)
    If Len(lpFile) > 0 Then : Call .Call("Coder::Settings", 16, hWndE, lpFile, 256) : GetActiveSyntax = GetOtherObjectFile(.MemRead(lpFile, 1), 2) : .MemFree(lpFile) : End If
  End With
End Function

' Функция создаёт новую вкладку со всеми параметрами исходного файла
Function CreateNewTab
  With AkelPad hWnd = .GetEditWnd()
    nCodePage = .GetEditCodePage(hWnd) : bBOM = .GetEditBOM(hWnd) : nNewLine = .GetEditNewLine(hWnd)
    Call .SendMessage(.GetMainWnd(), 273, 4101, 1)
    Call .SaveFile(0, "", nCodePage, bBOM)
    Call .SendMessage(.GetMainWnd(), 1230, 0, nNewLine)
    Call .Call("Coder::Settings", 1, GetActiveSyntax(hWnd))
  End With
End Function

' Функция замены в InText символов из строки FindStr на Repl
Function ReplSymbols(InText, FindStr, Repl)
  If Len(InText) > 0 And Len(FindStr) > 0 Then
    For i = 1 To Len(FindStr) ' очистка текста от мусора
      InText = Replace(InText, Mid(FindStr, i, 1), Repl)
    Next
  End If
  ReplSymbols = InText
End Function

' Функция удаления последних строк, если она\они пустые
Function DelLastEmptyLine(InText)
  For iii = 1 To Len(InText)
    If Right(InText, Len(vbNewLine)) <> vbNewLine Then Exit For
    InText = Left(InText, Len(InText) - Len(vbNewLine))
  Next
  DelLastEmptyLine = InText
End Function

' Функция удаления первых строк, если она\они пустые
Function DelFirstEmptyLine(InText)
  For iii = 1 To Len(InText)
    If Left(InText, Len(vbNewLine)) = vbNewLine Then : InText = Right(InText, Len(InText) - Len(vbNewLine)) : Else : Exit For : End If
  Next
  DelFirstEmptyLine = InText
End Function

' Функция удаления последней строки, если она пустая
Function DelEndEmptyLine(xxxText) : If Right(xxxText, Len(vbNewLine)) = vbNewLine Then : DelEndEmptyLine = Left(xxxText, Len(xxxText) - Len(vbNewLine)) : End If : End Function

' Функция сортировки элементов строки между разделителем Delim по возрастанию
Function SelectingStr(dLine, Delim) : If Len(dLine) > 0 Then : SelectingStr = Join(SelectingArrUp(Split(dLine, Delim)), Delim) : End If : End Function

' Функция сортировки текста по возрастанию
Function Selecting(Txtss) : If Len(Txtss) > 0 Then : Selecting = Join(SelectingArrUp(Split(Txtss, vbNewLine)), vbNewLine) : End If : End Function

' Функция сортировки элементов текстового массива по убыванию
Function SelectingArrDown(ArrS)
  nn = Ubound(ArrS) : Call SortingUp(ArrS, 0, nn - 1)
  Text = Join(ArrS, vbNewLine)
  For ii = 0 To nn \ 2
    xx = ArrS(i) : ArrS(ii) = ArrS(nn - ii) : ArrS(nn - ii) = xx
  Next
  SelectingArrDown = ArrS
End Function

' Функция сортировки элементов текстового массива по возрастанию
Function SelectingArrUp(ArrS) : Call SortingUp(ArrS, 0, Ubound(ArrS) - 1) : SelectingArrUp = ArrS : End Function

' процедура быстрой сортировки по возрастанию
Sub SortingUp(sArr, ll, rr)
  Dim ii, jj, xx, yy
  ii = ll : jj = rr : xx = sArr((ll + rr) \ 2)
  Do
    While sArr(ii) < xx : ii = ii + 1 : Wend
    While xx < sArr(jj) : jj = jj - 1 : Wend
    If ii <= jj Then
      If sArr(ii) <> sArr(jj) Then
        yy = sArr(ii) : sArr(ii) = sArr(jj) : sArr(jj) = yy
      End If
      ii = ii + 1 : jj = jj - 1
    End If
  Loop Until ii > jj
  If ll < jj Then SortingUp sArr, ll, jj
  If ii < rr Then SortingUp sArr, ii, rr
End Sub

' Функция сортировки элементов цифрового массива по возрастанию
Function SelectingArrUpNum(ArrS)
  uu = Ubound(ArrS)
  If uu > 0 Then
    For jj = 0 To uu - 1
      For nn = 0 To uu - 2 - jj
        If CLng(ArrS(nn)) > CLng(ArrS(nn + 1)) Then
          Tmp = ArrS(nn) : ArrS(nn) = ArrS(nn + 1) : ArrS(nn + 1) = Tmp
        End If
      Next
    Next
    SelectingArrUpNum = ArrS
  End If
End Function

' Функция сортировки элементов цифрового массива по убыванию
Function SelectingArrDownNum(ArrS)
  uu = Ubound(ArrS)
  If uu > 0 Then
    For jj = 0 To uu - 1
      For nn = 0 To uu - 2 - jj
        If CLng(ArrS(nn)) < CLng(ArrS(nn + 1)) Then
          Tmp = ArrS(nn) : ArrS(nn) = ArrS(nn + 1) : ArrS(nn + 1) = Tmp
        End If
      Next
    Next
    SelectingArrDownNum = ArrS
  End If
End Function

' Функция удаления из массива одинаковых значений
Function DelDublicateArr(Arrr)
  Dim oDict, Item, Key
  Set oDict = CreateObject("Scripting.Dictionary")
  oDict.RemoveAll : oDict.CompareMode = 0
  For Each Item In Arrr
    If Len(Item) > 0 Then
      If Not oDict.Exists(Item) Then oDict.Add Item, Item
    End If
  Next
  Key = oDict.Keys : Set oDict = Nothing : DelDublicateArr = Key
End Function

' Функция удаления из массива уникальных значений, остаются только повторяющиеся в одном экземпляре
Function DelUniqueArr(Arrr)
  Dim oDict, oDict2, Item, Key2
  Set oDict = CreateObject("Scripting.Dictionary")
  Set oDict2 = CreateObject("Scripting.Dictionary")
  oDict.RemoveAll : oDict.CompareMode = 0
  oDict2.RemoveAll : oDict2.CompareMode = 0
  For Each Item In Arrr
    If Len(Item) > 0 Then
      If Not oDict.Exists(Item) Then
        oDict.Add Item, Item
      Else
         If Not oDict2.Exists(Item) Then oDict2.Add Item, Item
      End If    
    End If
  Next
  Key2 = oDict2.Keys : Set oDict = Nothing : Set oDict2 = Nothing : DelUniqueArr = Key2
End Function

' Функция удаления элементов строки между разделителем Delim по возрастанию
Function DelDublicateStr(dLine, Delim) : If Len(dLine) > 0 Then : DelDublicateStr = Join(DelDublicateArr(Split(dLine, Delim)), Delim) : End If : End Function

' Функция возвращает массив начальных путей
Function ArrayBeginPath
  ArrayBeginPath = Array("C:\","D:\","E:\","F:\","G:\","H:\","%COMMANDER_PATH%","%WINDIR%",_
                         "%PROGRAMFILES%","%PUBLIC%","%TEMP%","%APPDATA%",_
                         "%USERPROFILE%","%ALLUSERSPROFILE%","%LOCALAPPDATA%",_
                         "%COMMONPROGRAMFILES%","%A\","A:\","B:\","I:\","J:\","K:\","L:\","M:\",_
                         "N:\","O:\","P:\","Q:\","R:\","S:\","T:\","U:\","V:\","W:\","X:\","Y:\","Z:\")
End Function

' Функция возвращает относительный путь из заданного абсолютного
Function RelativePathName(AbsolutePathName)
  RelativePath = Array("%COMMANDER_PATH%","%WINDIR%","%PROGRAMFILES%","%PUBLIC%",_
                       "%TEMP%","%APPDATA%","%USERPROFILE%","%ALLUSERSPROFILE%",_
                       "%LOCALAPPDATA%","%COMMONPROGRAMFILES%")
  For ll = 0 To Ubound(RelativePath)
    AbsolutePathName = Replace(AbsolutePathName, GetPath(RelativePath(ll)), RelativePath(ll))
    If InStr(AbsolutePathName, "%") > 0 Then
      RelativePathName = AbsolutePathName : Exit Function
    End If
  Next
  RelativePathName = AbsolutePathName
End Function

' Функция очистки в конце строки ненужных символов ; clStroka - строка ненужных символов
Function ClearEndLine(clLine, clStroka)
  nn = 0
  Do While nn = 0
    If Len(clLine) > 0 Then
      If Instr(clStroka,Right(clLine,1)) > 0 Then : clLine = Left(clLine, Len(clLine) - 1) : Else : nn = 1 : End If
    End If
  Loop
  ClearEndLine = clLine
End Function

' Функция удаления по краям ddText символа\строки (delLine), если таковые присутствуют в ddText
' Line = DeleteOnEdges(строка, ";")
Function DeleteOnEdges(ddText, delLine)
  ddn = Len(ddText) : dln = Len(delLine)
  If Right(ddText, dln) = delLine Then ddText = Left(ddText, ddn - dln)
  If Left(ddText, dln) = delLine Then ddText = Mid(ddText, dln + 1)
  DeleteOnEdges = ddText
End Function

' Функция замены необходимых символов
Function ReplaceSymPath(ReplText)
  ReplText = Trim(ReplText)
  arFind = Split("%a\;%%;.dll,;%\'';] [;.dll'';) && (;.exe ;) ;.ini ;.exe'';\'';\\;.exe,;.exe=;\nВ;В;.bar -;.ico,0;.EXE,0;.vbs\n;.exe  ", ";")
  arRepl = Split(AkelPad.GetAkelDir() & "\;%;.dll*;%\*;< >;.dll*;*;.exe*;*;.ini*;.exe*;*;\;.exe*;.exe*;*;*;.bar*;.ico*;.EXE*;.vbs*;.exe", ";")
  For rr = 0 To Ubound(arFind)
    If Instr(ReplText, arFind(rr)) > 0 Then ReplText = Replace(ReplText, arFind(rr), arRepl(rr))
  Next
  ' если ReplText является одной строкой
  If InStr(ReplText, Chr(13)) > 0 Or InStr(ReplText, vbNewLine) > 0 Then
  Else
    ' удаление последнего символа
    arEnd = Split(Chr(34) & ";[;]", ";")
    For rr = 0 To Ubound(arEnd)
      If Right(ReplText, 1) = arEnd(rr) Then ReplText = Left(ReplText, Len(ReplText) - 1)
    Next
    If Instr(ReplText, "=") > 0 Then ReplText = Mid(ReplText, Instr(ReplText, "=") + 1)
    If Instr(ReplText, "::") > 0 Then ReplText = Left(ReplText, Instr(ReplText, "::") - 1) & "-Rus.txt"
    If Left(ReplText, 1) = Chr(34) Then ReplText = Mid(ReplText, 2)
  End If
  ReplaceSymPath = Trim(ReplText)
End Function

'====================   Описание функции  ==================================
' GetExistsPath(gNum, gFile, StrFilter, StrIgnore, StrOcurrences)
' Извлекает пути файлов из текста или файла
'=======================   Параметры  =====================================
' gNum - Номер задачи
' 0 - извлекаются все пути
' 1 - извлекаются пути, имеющие пробелы
' 2 - извлекаются пути, имеющие русские символы
' 3 - извлекаются все пути и проверяются на физическое существование (к несуществующим добавляется надпись)
' 4 - извлекаются только существующие пути
' 5 - извлекаются только не существующие пути
' (любой 2-й символ в 1-ом параметре означает, что пути будут отображены с относительными путями)
' 0+ -  - извлекаются все пути и отображаются с относительными путями

' gFile - Текст или путь\к\файлу из которого будут извлечены пути
' (можно использовать относительные пути)
'
' StrFilter - строка фильтра типов файлов, которые необходимо извлечь
' (если StrFilter = ";vbs;txt;js|", то будут извлекаться файлы с расширениями vbs, txt, js)
'
' StrIgnore - строка, того, что не должно входить в результат извлечения
' (если StrIgnore = ";Readme.txt;%COMMANDER_PATH%\WinDirMenu.ini", то файлы с именами Readme.txt и %COMMANDER_PATH%\WinDirMenu.ini - не войдут в результат
'
' StrOcurrences - строка вхождений, обязательных для изменения
' (если StrOcurrences=";Program;Utilities", то в результат извлечения войдут только те пути, которые имеют в себе либо Program либо Utilities)
'
' (если в StrFilter или в StrIgnore или в StrOcurrences имеется символ "|", то пути папок не выводятся)
'
' (09.07.2011)
Function GetExistsPath(gNum, gFile, StrFilter, StrIgnore, StrOcurrences)
  GetExistsPath = ""
  If Len(gFile) = 0 Then Exit Function
  If InStr(gFile, Chr(13)) > 0 Then
    gText = gFile
  Else
    On Error Resume Next
    gText  = AkelPad.ReadFile(GetPath(ReplaceSymPath(gFile)))
  End If
  gText = ReplaceSymPath(gText)
  gText = DelDublicateStr(gText, Chr(13))
  Relative = 0
  lnm = Len(gNum)
  If lnm > 1 Then : gNum = CInt(Left(gNum, 1)) : Relative = 1 : End If
  If lnm = 0 Then gNum = 0
  If gNum = 1 Then SymRus = Split("П,С,О,Н,В,Р,К,З,Б,Д,М,Т,У,Г,И,Й,Ь,Л,А,Ы,Ч,Ш,Ф,Х,Ж,Э,Ц,Е,Ё,Я,Щ,Ю,Ъ", ",")
  gLine = LineInstrPath(gText)
  If Len(gLine) = 0 Then Exit Function
  If Len(StrFilter) > 0 Or Len(StrIgnore) > 0  Or Len(StrOcurrences) > 0 Then fl = 1
  arrLn = Split(gLine, ";")
  For gg = 0 To Ubound(arrLn) - 1
    kk = 0
    gPath = Mid(gText, arrLn(gg), arrLn(gg + 1) - arrLn(gg))
    LinePath = ReplaceSymPath(ClearLineLeft(gPath))
    LinePath = DeleteOnEdges(LinePath, "\")
    If fl = 1 Then LinePath = PathFilter(LinePath, StrFilter, StrIgnore, StrOcurrences)
    If Len(LinePath) > 3 Then
      Select Case gNum
        Case 1 If Symbols(LinePath, SymRus) = 0 Then LinePath = ""
        Case 2 If InStr(LinePath, Chr(32)) = 0 Then LinePath = ""
      End Select
      If InStr(LinePath, "%") > 0 Then LinePath = GetPath(LinePath)
      If gNum > 2 Then
        With CreateObject("Scripting.FileSystemObject")
          If Len(.GetExtensionName(LinePath)) > 0 Then
            If Not .FileExists(LinePath) Then : LinePath = LinePath & " - такого файла не существует" : kk = 1 : End If
          Else
            If Not .FolderExists(LinePath) Then : LinePath = LinePath & " - такой папки не существует" : kk = 1 : End If
          End If
        End With
        Select Case gNum
          Case 4 If kk = 1 Then LinePath = ""
          Case 5 If kk <> 1 Then LinePath = ""
        End Select
      End If
    End If
    If Len(LinePath) > 3 Then
      If Relative = 1 Then LinePath = RelativePathName(LinePath)
      gTxt = gTxt & LinePath & vbNewLine
    End If
  Next
  GetExistsPath = DelLastEmptyLine(gTxt)
End Function

Sub MsgReplaceSel(mTxt, tFil)
  With AkelPad SFN = WScript.ScriptFullName
    mText = "://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://:" & vbNewLine & _
            "В 3-ем параметре Вы указали " & Chr(34) & tFil & Chr(34) & vbNewLine & _
            "т.е. желание использовать фильтр №" & tFil & " для извлечения путей, но:" & vbNewLine & _
            mTxt & vbNewLine & "Для использования фильтра необходимо в открытом файле" & vbNewLine & _
            FileSetting &  vbNewLine & "произвести его настройку ''под себя''..." & vbNewLine & _
            "Если Вы не знаете как это сделать,"  & vbNewLine & "прочитайте информацию в комментариях скрипта" & vbNewLine & _
            SFN & vbNewLine & "://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://://:"
    Call .OpenFile(SFN)
    Call .OpenFile(FileSetting)
    Call .SendMessage(.GetMainWnd(), 273, 4101, 0)
    Call .ReplaceSel(mText)
    Call .SendMessage(.GetEditWnd(), 3087, False, 0)
    Call .SendMessage(.GetEditWnd(), 3079, 0, 0)
  End With
End Sub

' Функция фильтрации пути
Function PathFilter(fLinePath, fStrFilter, fStrIgnore, fStrOcurrences)
  PathFilter = fLinePath
  On Error Resume Next
  Ext = GetOtherObjectFile(fLinePath, 1)
  InfStr = InStr(fStrFilter & fStrIgnore & fStrOcurrences, "|")
  If Len(Ext) > 0 Then
    fExt = ";" & Ext
    If Len(fStrFilter) > 0 Then
      If InStr(LCase(fStrFilter), LCase(fExt)) = 0 Then
        PathFilter = "" : Exit Function
      End If
    End If
    If Len(fStrIgnore) > 0 Then
      fName = GetOtherObjectFile(fLinePath, 3)
      arFilt = Array(fExt, fName, fLinePath)
      For ff = 0 To Ubound(arFilt)
        If InStr(LCase(fStrIgnore), LCase(arFilt(ff))) > 0 Then
          PathFilter = "" : Exit Function
        End If
      Next
    End If
    If Len(fStrOcurrences) > 0 Then PathFilter = OcurrencesInLine(fLinePath, fStrOcurrences)
  Else
    If InfStr > 0 Then
      PathFilter = ""
    Else
      PathFilter = OcurrencesInLine(fLinePath, fStrOcurrences)
    End If
  End If
End Function

' Функция фильтрации пути
Function OcurrencesInLine(oLinePath, oStrOcurrences)
  oStrOcurrences = DeleteOnEdges(oStrOcurrences, ";")
  oStrOcurrences = Replace(oStrOcurrences, "|", "")
  If InStr(oStrOcurrences, ";") > 0 Then
    arOcur = Split(oStrOcurrences, ";")
    For os = 0 To Ubound(arOcur)
      If Len(arOcur(os)) > 0 Then
        If InStr(LCase(oLinePath), LCase(arOcur(os))) > 0 Then
          OcurrencesInLine = oLinePath
          Exit Function
        End If
      End If
    Next
  Else
    If InStr(LCase(oLinePath), LCase(oStrOcurrences)) > 0 Then
      OcurrencesInLine = oLinePath : Exit Function
    End If
  End If
  OcurrencesInLine = ""
End Function

' Функция проверки всех вхождений в текст начальных и относительных путей
' возвращает строку, всех вхождений, перечисленных через ";"
Function LineInstrPath(pText)
  LineInstrPath = "" : cText = UCase(pText) : StrPath = ArrayBeginPath : InLine = "" : lt = Len(cText)
  For cc = 0 To Ubound(StrPath)
    cText = Replace(cText, StrPath(cc), String(3, "Ь") & String(Len(StrPath(cc)) - 3, "0"))
  Next
  lt = Len(cText) : nk = 1 : ll = 0
  For cc = 0 To lt
    nk = InStr(nk + ll, cText, "ЬЬЬ", 1)
    If nk > 0 Then : InLine = InLine & ";" & nk : ll = 3 : Else : Exit For : End If
  Next
  If Left(InLine, 1) = ";" Then InLine = Mid(InLine, 2)
  If Len(InLine) > 0 Then  InLine = InLine & ";" & lt + 1
  LineInstrPath = InLine
End Function

' Функция проверяет входит ли какой-либо элемент массива arSym в текст ssText
' Возвращает 1 - если входит, 0 - если нет
Function Symbols(ssText, arSym)
  Symbols = 0 : ub = Ubound(arSym)
  If Len(ssText) = 0 Or ub = 0 Then Exit Function
  For yy = 0 To ub
    If InStr(UCase(ssText), arSym(yy)) > 0 Then Symbols = 1 : Exit Function End If
  Next
End Function

' Функция проверяет входит ли какой-либо элемент массива arSym в текст ssText
' Возвращает 1 - если входит, 0 - если нет
Function InstrSymbolsRus(ssText)
  InstrSymbolsRus = 0
  SymRus = Split("П,С,О,Н,В,Р,К,З,Б,Д,М,Т,У,Г,И,Й,Ь,Л,А,Ы,Ч,Ш,Ф,Х,Ж,Э,Ц,Е,Ё,Я,Щ,Ю,Ъ", ",")
  If Len(ssText) = 0 Then Exit Function
  For yy = 0 To Ubound(SymRus)
    If InStr(UCase(ssText), SymRus(yy)) > 0 Then InstrSymbolsRus = 1 : Exit Function End If
  Next
End Function

' Функция очистки строки справа ненужных отрезков, начинающихся с элементов массива ClearStr
Function ClearLineLeft(cLine)
  ClearStrs = Array("/","*","?",">","<", "|", ",", vbTab, vbVerticalTab, vbNewLine, vbLf, vbFormFeed, vbCr, vbCrLf, Chr(34))
  For cr = 0 To Ubound(ClearStrs)
    cl = InStr(cLine, ClearStrs(cr)) : If cl > 0 Then cLine = Left(cLine, cl - 1)
  Next
  ClearLineLeft = cLine
End Function

' Функция проверки вхождения в строку начальных и относительных путей
' если такое вхождение есть, извлекается полный путь
Function GetPathInstrArrey(LinePath)
  GetPathInstrArrey = ""
  ArrPath = ArrayBeginPath
  If InStr(LinePath, "%%") > 0 Then LinePath = Replace(LinePath, "%%", "%")
  If Instr(LinePath, "\\") > 0 Then LinePath = Replace(LinePath, "\\", "\")
  For jp = 0 To Ubound(ArrPath)
    pozz = InStr(UCase(LinePath), ArrPath(jp))
    If pozz > 0 Then
      LinePath = Mid(LinePath, pozz)
      If InStr(LinePath, "%") > 0 Then LinePath = GetPath(LinePath)
      GetPathInstrArrey = LinePath
      Exit For
    End If
  Next
End Function

' Функция проверки пути, возвращает:
' 1 - если путь является файлом
' 2 - если путь является папкой
' 0 - если путь не является ни папкой ни файлом
Function CheckPath(chPath)
  With CreateObject("Scripting.FileSystemObject")
    If InStr(chPath, "%") > 0 Then chPath = GetPath(chPath)
    If .FileExists(chPath) Then
      CheckPath = 1
    Else
      If .FolderExists(chPath) Then
        CheckPath = 2
      Else
        CheckPath = 0
      End If
    End If
  End With
End Function

' Функция создания недостающих папок в пути
' CreateFolderInPath("Путь\к\папке\или\файлу")
' Возвращает:
' 0 - если в пути диск, которого нет
' 1 - если такая папка уже есть
' 2 - если были созданы недостающих папки
Function CreateFolderInPath(crFolder)
  With CreateObject("Scripting.FileSystemObject")
    If InStr(crFolder, "%") > 0 Then crFolder = GetPath(crFolder)
    If Len(.GetExtensionName(crFolder)) > 0 Then crFolder = .GetParentFolderName(crFolder)
    If .FolderExists(crFolder) Then
      CreateFolderInPath = 1
    Else
      Drive = .GetDriveName(crFolder)
      If .DriveExists(Drive) Then
        crF = Split(crFolder, "\") : pFolder = Drive
        For cr = 1 To Ubound(crF)
          pFolder =  pFolder & "\" &crF(cr)
          If Not .FolderExists(pFolder) Then
            Call .CreateFolder(pFolder) : CreateFolderInPath = 2
          End If
        Next
      Else
        CreateFolderInPath = 0
      End If
    End If
  End With
End Function

' Процедура создания списка всех, открытых на редактирование файлов
' TabList - путь\к\файлу.lst
Sub CreateAllTabLists(TabList)
  With AkelPad xxx = 1 : xText = ""
    If InStr(TabList, "%") > 0 Then TabList = GetPath(TabList)
    With CreateObject("Scripting.FileSystemObject")
      If .FileExists(File) Then .DeleteFile TabList
    End With
    MainWnd = .GetMainWnd()
    Call SetRedraw(MainWnd, False)
    Do While xxx = 1
      xFile = .GetEditFile(0)
      If Len(xFile) > 0 Then
        If InStr(LCase(xText), LCase(xFile)) > 0 Then
          Exit Do
        Else
          xText = xText & xFile & vbNewLine
          Call .SendMessage(.GetMainWnd(), 273, 4316, 0)
        End If
      Else
        Call .SendMessage(.GetMainWnd(), 273, 4316, 0)
      End If
    Loop
    xText = DelEndEmptyLine(xText)
    Call .SendMessage(.GetMainWnd(), 273, 4101, 0)
    Call .ReplaceSel(xText)
    Call .SaveFile(0, TabList, 65001, 1, 1)
    Call SetRedraw(MainWnd, True)
    Call .SendMessage(.GetMainWnd(), 273, 4104, 0)
  End With
End Sub

' Функция удаления ненужного мусора из строки слева и справа
Function ClearNameOrPath(nLinePath)
If InStr(nLinePath, "%%") > 0 Then nLinePath = Replace(nLinePath, "%%", "%")
If Instr(nLinePath, "file:") > 0 Then nLinePath = Replace(RegExpReplace(nLinePath, "(file:[/]+)", "", 0, 0, 0), "%20", Chr(32))
If Instr(nLinePath, "\\") > 0 Then nLinePath = Replace(nLinePath, "\\", "\")

Dim LeftPath(37), RightPath(27)
  k = Chr(34) : s = Chr(32)
  ' массив того, что надо удалить слева от имени\пути файла
  LeftPath(0) = "Main" & k & ", 1, " & k
  LeftPath(1) = "Main" & k & ", 1," & k
  LeftPath(2) = "Main" & k & ",1," & k
  LeftPath(3) = "Main" & k & ", 2, " & k
  LeftPath(4) = "Main" & k & ", 2," & k
  LeftPath(5) = "Main" & k & ",2," & k
  LeftPath(6) = "Main" & k & ", 3, " & k
  LeftPath(7) = "Main" & k & ", 3," & k
  LeftPath(8) = "Main" & k & ",3," & k
  LeftPath(9) = "Exec(`WScript "
  LeftPath(10) = k & s & k & "Filter"
  LeftPath(11) = "Insert(" & k
  LeftPath(12) = "Exec(`" & k & "%a\AkelPad.exe" & k & " " & k
  LeftPath(13) =  "/OpenFile" & s & k
  LeftPath(14) =  "/Open" & s & k
  LeftPath(15) =  "\AutoIt3.exe  " & k
  LeftPath(16) =  "\AutoIt3.exe " & k
  LeftPath(17) =  k & ">>" & s  & k
  LeftPath(18) =  "cm_List" & s
  LeftPath(19) =  s & "@" & k
  LeftPath(20) =  "OPENBAR" & s
  LeftPath(21) =  "Call(" & k
  LeftPath(22) =  "wscript.exe " & k
  LeftPath(23) =  "OPENTABS" & s
  LeftPath(24) =  "~$folder.nircmd$\"
  LeftPath(25) = "[" & "+"& "]"
  LeftPath(26) =  "nclude(" & k
  LeftPath(27) = "AutoIt3.exe" & k & s & k
  LeftPath(28) = "="  & k
  LeftPath(29) = "Exec(`" & k
  LeftPath(30) = "][b]"
  LeftPath(31) = "ath(" & k
  LeftPath(32) = "]" & s
  LeftPath(33) = "'" & s & k
  LeftPath(34) =   s & "в" & s
  LeftPath(35) = "="  & s & k
  LeftPath(36) = "%L"  & s & k
  LeftPath(37) = "["
  LeftPath(37) = "["

  ' массив того, что надо удалить справа от имени\пути файла
  RightPath(0) = "[/b]["
  RightPath(1) = k & ",  " & k
  RightPath(2) = k & ", " & k
  RightPath(3) = k & "," & k
  RightPath(4) = k & ")   Icon"
  RightPath(5) = k & ")  Icon"
  RightPath(6) = k & ") Icon"
  RightPath(7) = k & ")Icon"
  RightPath(8) = k & ",  `" & k
  RightPath(9) = k & ", `" & k
  RightPath(10) = k & ",`" & k
  RightPath(11) = k & ", `"
  RightPath(12) = k & ")"
  RightPath(13) = " " & k & "%a"
  RightPath(14) = k & "`) Icon"
  RightPath(15) = k & ", '"
  RightPath(16) = s & k & "1 |"
  RightPath(17) = k & s & "1"
  RightPath(18) = s & k & "%"
  RightPath(19) = k & s & "^."
  RightPath(20) = k & s & "win"
  RightPath(21) = ","
  RightPath(22) = k & "-" & s
  RightPath(23) = k & s & "'"
  RightPath(24) = s & "-N" & s & "%"
  RightPath(25) = s & "-L" & s & "%"
  RightPath(26) = s & "-" & s
  RightPath(27) = "]"

  For iii = 0 To Ubound(LeftPath)
    nn = Instr(nLinePath, LeftPath(iii))
    If nn > 0 Then : nLinePath = Right(nLinePath, Len(nLinePath) - nn - Len(LeftPath(iii)) + 1) : Exit For : End If
  Next

  For iii = 0 To Ubound(RightPath)
    nn = InstrRev(nLinePath, RightPath(iii))
    If nn > 0 Then : nLinePath = Left(nLinePath, nn - 1) : Exit For : End If
  Next
  ClearNameOrPath = nLinePath
End Function

' функция создания уникального имени
Function GuidName : NewGUID = CreateObject("Scriptlet.TypeLib").Guid : GuidName = Left(NewGUID, Len(NewGUID) - 2) : End Function

' Процедура удаления из папки заданных типов файлов
' FFolder - папка в которой удаляются файлы
' StrExt - строка расширений ";txt;bar;br2;" удаляемых файлов
Sub DeleteInFolderFilesExt(FFolder, StrExt)
  Dim Folder, Files
  StrExt = LCase(StrExt)
  With CreateObject("Scripting.FileSystemObject")
    Set Folder = .GetFolder(FFolder)
    For Each Files In Folder.Files
      If Instr(StrExt, ";" & LCase(.GetExtensionName(Files)) & ";") > 0 Then Call .DeleteFile (Files)
    Next
  End With
  Set Folder = Nothing
End Sub

' Процедура удаления из папки всех типов файлов, КРОМЕ заданных
' FFolder - папка в которой удаляются файлы
' StrExt - строка расширений ";txt;bar;br2;" не удаляемых файлов
Sub DeleteInFolderFilesNoExt(FFolder, StrExt)
  Dim Folder, Files
  StrExt = LCase(StrExt)
  With CreateObject("Scripting.FileSystemObject")
    Set Folder = .GetFolder(FFolder)
    For Each Files In Folder.Files
      If Instr(StrExt, ";" & LCase(.GetExtensionName(Files)) & ";") = 0 Then Call .DeleteFile (Files)
    Next
  End With
  Set Folder = Nothing
End Sub

' Процедура удаления из папки заданных имён файлов
' FFolder - папка в которой удаляются файлы
' StrExt - строка имён ";Readme.txt;Create.bar;Create.br2;" удаляемых файлов
Sub DeleteInFolderFilesNames(FFolder, StrExt)
  Dim Folder, Files
  StrExt = LCase(StrExt)
  With CreateObject("Scripting.FileSystemObject")
  Set Folder = .GetFolder(FFolder)
    For Each Files In Folder.Files
      If Instr(StrExt, ";" & LCase(.GetFileName(Files)) & ";") > 0 Then Call .DeleteFile (Files)
    Next
  End With
  Set Folder = Nothing
End Sub

' Процедура удаления из папки всех файлов, КРОМЕ заданных имён
' FFolder - папка в которой удаляются файлы
' StrExt - строка имён ";Readme.txt;Create.bar;Create.br2;" не удаляемых файлов
Sub DeleteInFolderFilesNoNames(FFolder, StrExt)
  Dim Folder, Files
  StrExt = LCase(StrExt)
  With CreateObject("Scripting.FileSystemObject")
  Set Folder = .GetFolder(FFolder)
    For Each Files In Folder.Files
      If Instr(StrExt, ";" & LCase(.GetFileName(Files)) & ";") = 0 Then Call .DeleteFile (Files)
    Next
  End With
  Set Folder = Nothing
End Sub

' Функция создания списка всех папок по указанному пути
Function ListFolders(FFolder)
  Set FF = CreateObject("Scripting.FileSystemObject").GetFolder(FFolder)
  For Each SubFolder In FF.SubFolders
    fText = fText & SubFolder.Path & vbNewLine
  Next
  Set FF = Nothing : ListFolders = DelEndEmptyLine(fText)
End Function

' Функция создания списка всех файлов по указанному пути
Function ListFiles(FFolder)
  Set FF = CreateObject("Scripting.FileSystemObject").GetFolder(FFolder)
  For Each Files In FF.Files
    fText = fText & Files & vbNewLine
  Next
  Set FF = Nothing : ListFiles = DelEndEmptyLine(fText)
End Function

' Функция создания списка всех папок и файлов по указанному пути
Function ListFoldersAndFiles(FFolder)
  Set FF = CreateObject("Scripting.FileSystemObject").GetFolder(FFolder)
  For Each SubFolder In FF.SubFolders
    fText = fText & SubFolder.Path & vbNewLine
  Next
  For Each Files In FF.Files
    fText = fText & Files & vbNewLine
  Next
  Set FF = Nothing : ListFoldersAndFiles = DelEndEmptyLine(fText)
End Function

' Функция создания списка файлов по указанному пути
' FFolder - папка в которой ищутся файлы
' StrExt - строка имён ";txt;bar;br2;" файлов, входящих в список
Function ListFilesExt(FFolder, StrExt)
  With CreateObject("Scripting.FileSystemObject")
    Set FF = .GetFolder(FFolder)
    For Each Files In FF.Files
      If Instr(StrExt, ";" & LCase(.GetExtensionName(Files)) & ";") > 0 Then fText = fText & Files & vbNewLine
    Next
  End With
  Set FF = Nothing : ListFilesExt = DelEndEmptyLine(fText)
End Function

' Функция создания списка файлов по указанному пути
' FFolder - папка в которой ищутся файлы
' StrExt - строка имён ";txt;bar;br2;" файлов, НЕ входящих в список
Function ListFilesNoExt(FFolder, StrExt)
  With CreateObject("Scripting.FileSystemObject")
    Set FF = .GetFolder(FFolder)
    For Each Files In FF.Files
      If Instr(StrExt, ";" & LCase(.GetExtensionName(Files)) & ";") = 0 Then fText = fText & Files & vbNewLine
    Next
  End With
  Set FF = Nothing : ListFilesNoExt = DelEndEmptyLine(fText)
End Function

' Функция возвращает размер папки ffPath
Function GetFolderSize(ffPath)
  fSize = 0
  Set ctFolder = CreateObject("Scripting.FileSystemObject").GetFolder(ffPath)
  On Error Resume Next
  For Each cFile In ctFolder.Files
    fSize = fSize + cFile.Size
  Next
  For Each cFolder In ctFolder.SubFolders
      fSize = fSize + GetFolderSize(cFolder.Path)
  Next
  Set ctFolder = Nothing : GetFolderSize = fSize
End Function

'Функция возвращает количество заглавных русских букв в строке
Function GetQuantity(strText)
    bLet = 0
    For ii = 1 To Len(strText)
        chCode = Asc(Mid(strText, ii, 1))
        If chCode >= 192 And chCode <= 223 Then bLet = bLet + 1
    Next
    GetQuantity = bLet
End Function

'Функция завершение процессаKProcess - имя процесса (пример: "TOTALCMD.EXE")
Function KillProcess(KProcess)
  Set ProcessList = GetObject("winmgmts://.").InstancesOf("win32_process")
  For Each Process In ProcessList
    If Process.Name = KProcess Then Process.Terminate
  Next
End Function

' Функция транслитерации
' trText - исправляемый текст.
' RuOrEn=0 - Из русского в английский. RuOrEn=1 - Из английского в русский
Function Transliterate(tranText, RuOrEn)
  If Len(tranText) = 0 Then Exit Function
  trText = tranText
  If RuOrEn = 0 Then
    Source = Array("а", "б", "в", "г", "д", "е", "ё",  "ж",  "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
    Target = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "ts", "ch", "sh", "shh", "`", "y", "'", "je", "ju", "ja")
  Else
    Source = Array("jo", "yo", "\xF6", "ch", "w", "shh", "sh", "je", "\xE4", "ju", "yu", "\xFC", "ja", "ya", "zh", "ts", "c", "h", "x", "j", "'", "y", "#", "`", "a", "b", "v", "g", "d", "e", "z", "i", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f")
    Target = Array("ё",  "ё",  "ё", "ч", "щ", "щ", "ш", "э", "э", "ю", "ю", "ю", "я", "я", "ж", "ц", "ц", "х", "х", "й", "ь", "ы", "ъ", "ъ", "а", "б", "в", "г", "д", "е", "з", "и", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф")
  End If

  For t = 0 To Ubound(Source)
    trText = RegExpReplace(trText, Source(t), Target(t), 0, 1, 1)
  Next
  Transliterate = trText
End Function

' функция извлечения из файла Desctop.ini номера иконки
Function NIconDesctop(DesPath)
  NIconDesctop = "WcmFiles_002"
  If FSO.FileExists(DesPath) Then
    dsText = UCase(AkelPad.ReadFile(DesPath))
    If InStr(dsText, "ICONINDEX=") > 0 Then
      dText = Mid(dsText, InStr(dsText, "ICONINDEX=") + Len("ICONINDEX="))
      dText = Left(dText, InStr(dText, vbNewLine) - 1)
      If dText = "0" Then
        dText = Mid(dsText, InStr(dsText, "ICONFILE=") + Len("ICONFILE="))
        dText = Left(dText, InStr(dText, ".") - 1)
      End If
    Else
      drText = Mid(dsText, InStr(dsText, "ICONRESOURCE=") + Len("ICONRESOURCE="))
      dText = Mid(drText, InStr(drText, ",") + 1)
      dText = Left(dText, InStr(dText, vbNewLine) - 1)
      If dText = "0" Then dText = Left(drText, InStr(drText, vbNewLine) - 1)
    End If
    NIconDesctop = dText
  End If
End Function

' Функция извлечения из файла Wincmd.ini секции [Associations] ассоциаций номер иконки
Function NumberImg(AssExt)
  NumberImg = ""
  AssExt = UCase(AssExt)
  If InStr(AssText, AssExt) > 0 Then
    tText = Left(AssText, InStr(AssText, AssExt))
    tText = Mid(tText, InStrRev(tText, vbNewLine) + Len(vbNewLine))
    tText = Left(tText, InStr(tText, "=") - 1)
    tText = tText & ".ICON="
    If InStr(AssText, tText) > 0 Then
      tText = Mid(AssText, InStr(AssText, tText) + Len(tText))
      tText = Left(tText, InStr(tText, vbNewLine) - 1)
      If InStr(tText, ",") > 0 Then tText = Mid(tText, InStr(tText, ",") + 1)
    End If
  End If
  NumberImg = tText
End Function

Function NIconFolder(icName)
  NIconFolder = icName
  ArrName = Array("LANGUAGE","AkelFiles","Backup","Bar","Downloads","Files","Games","Keys","Original","Plugins","Programs","Scripts","Utilities","TC Image")
  ArrNumber = Array("1088","1877","2025","1087","2044","1092","1555","1588","0566","1089","1091","1548","1090","1589")
  For ic = 0 To Ubound(ArrName)
    If LCase(icName) = LCase(ArrName(ic)) Then : NIconFolder = ArrNumber(ic) : Exit For : End If
  Next
End Function

' Функция добавление счётчика к имени файла, если есть такой в папке
' NextName(Полной имя файла, чило цифр для добавления)
Function NextName(pFilePath, Rank)
  Dim lPath, lName, lExt, li, lNum, lNewPath
  With CreateObject("Scripting.FileSystemObject")
    lExt = NameCheck(.GetExtensionName(pFilePath))
    lName = NameCheck(.GetBaseName(pFilePath))
    lPath = .GetParentFolderName(pFilePath)
    pFilePath = lPath  & "\" & lName & "." & lExt
    If Len(lExt)  = 0 Then pFilePath = pFilePath & "txt"
    If Len(lName) = 0 Then pFilePath = lPath & lName & "\1." & lExt
    If Len(lPath) > 0 Then lPath = lPath & "\"
    If Not .FileExists(pFilePath) Then
      NextName = pFilePath
      Exit Function
    End If
    Do
      li = li + 1
      If li < 10^Rank Then
        lNum = Right(String(Rank, "0") & li, Rank)
      Else
        lNum = li
      End If
      lNewPath = lPath & lName & lDlm & lNum & "." & lExt
    Loop While .FileExists(lNewPath)
  End With
  NextName = lNewPath
End Function

' Функция проверки существует ли папка\файл
' если да, то возвращает новое полное имя с добавлением к имени счётчика
Function FFNoExistCount(FileOrFolder)
  With CreateObject("Scripting.FileSystemObject")
    ffPath = .GetParentFolderName(FileOrFolder) & "\"
    ffName = .GetBaseName(FileOrFolder)
    ffExt = .GetExtensionName(FileOrFolder)
    exPath = FileOrFolder
    Do While (.FileExists(exPath) Or .FolderExists(exPath))
      ff = ff + 1
      exPath = ffPath & ffName & "_" & ff \100 & (ff Mod 100)\10 & (ff Mod 10) & "." & ffExt
    Loop
  End With
  FFNoExistCount = exPath
End Function

' Функция проверки имени файла\папки на несовместимые симолы (остаётся левая часть от несовместимого символа)
Function NameCheck(AnyName)
  arrStr = Array(vbNewLine, vbCr, VbCrLf, vbFormFeed, vbLf, vbTab, vbVerticalTab, Chr(13), Chr(10), "\","/","*","?","""",">","<", ":")
  For uu = 0 To Ubound(arrStr)
    nm = InStr(AnyName, arrStr(uu)) : If nm > 0 Then AnyName = Left(AnyName, nm - Len(arrStr(uu)))
  Next
  NameCheck = AnyName
End Function

' Функция проверки имени файла\папки на несовместимые симолы (удаление)
Function NameCheckDelNoSym(AnyName)
  arrStr = Array(vbNewLine, vbCr, VbCrLf, vbFormFeed, vbLf, vbTab, vbVerticalTab, Chr(13), Chr(10), "\","/","*","?","""",">","<", ":")
  For uu = 0 To Ubound(arrStr)
    nm = InStr(AnyName, arrStr(uu)) : If nm > 0 Then AnyName = Replace(AnyName, arrStr(uu), "")
  Next
  NameCheckDelNoSym = AnyName
End Function

' Функция возвращает полный путь по имени процесса, если таковой запущен
Function GetPathProcessName(prsName)
  GetPathProcessName = ""
  For Each PSS In GetObject("WinMgmts:\\.\Root\CIMV2").ExecQuery("SELECT * FROM Win32_Process",,48)
    If LCase(PSS.Name) = LCase(prsName) Then GetPathProcessName = PSS.ExecutablePath : Exit For : End If
  Next
End Function

' Функция поиска в скриптах необходимой информации
Function nSearch(nText, Line)
  On Error Resume Next
  If Left(Line, 1) = "+" Then : aLine = Split(Line, ",") : mm = Ubound(aLine) : kk = 1 : Cnt = 1 : Else : mm = 0 : kk = 0 : Cnt = 0 : End If
  For jj = kk To mm
    If  Cnt = 1 Then Line = aLine(jj)
    nn = InStr(UCase(nText), UCase(Line))
    If nn > 0 Then
      Txt = Mid(nText, nn + Len(Line)) : Txt = Trim(Left(Txt, InStr(Txt, vbNewLine) - Len(vbNewLine) + 1)) : nSearch = Txt
      Exit Function
    End If
  Next
End Function

' Функция очистки Content'a от мусора
' cLine ="", если содержит один из элементов CharArr
Function ClearStr(cLine)
  CharArr = Array("[","]","{",";",Chr(34),"Pos2","erCl","&&","WS_",").","%%")
  For cc = 0 To Ubound(CharArr)
    If InStr(cLine, CharArr(cc)) > 0 Then : ClearStr = "" : Exit Function : End If
  Next
  ClearStr = cLine
End Function

' Функция преобразование текста в шестнадцатеричный код и наоборот
' pInput - Текст для преобразования.
' pPrefix - Строка перед кодом символа.
' pSuffix - Строка после кода символа.
' FLAGS (сумма членов): По умолчанию: 8+16=24.
'    1  текст в шестнадцатеричный код.
'    2  шестнадцатеричный код в текст.
'    4  однобайтовое преобразование (Ansi).
'    8  двухбайтовое преобразование (Unicode).
'   16  выделить результат преобразования.
' Text = GetHex(hxText, "", "", 26)
' HexText = GetHex(Text, "", "", 25)
Function GetHex(pInput, pPrefix, pSuffix, pFlags)
  With AkelPad
   If Len(pInput) > 0 Then
     If X64 Then : vv = 8 : Else : vv = 4 : End If
     lpOutput = .MemAlloc(vv)
     If Len(lpOutput) > 0 Then
       Call .Call("HexSel::Main", 1, pFlags, pPrefix, pSuffix, pInput, Len(pInput), 0, lpOutput)
       lpOutputPtr = .MemRead(lpOutput, 2) : pOutput = .MemRead(lpOutputPtr, 1)
       Call .MemFree(lpOutputPtr) : Call .MemFree(lpOutput)
       GetHex = pOutput
     End If
   End If
  End With 
End Function

' Процедура сохранения файла открытого на редактирование
Sub SaveEditFile : With AkelPad If Len(.GetEditFile(0)) > 0 Then : Call .SendMessage(.GetMainWnd(), 273, 4105, 0) : End If : End With : End Sub

' Функция получение сегмента текста kText между kBegin и kEnd
Function ExtractSegmentText(kText, kBegin, kEnd)
  kValue = Mid(kText, InStr(kText, kBegin) + Len(kBegin))
  nn = InStr(kValue, kEnd)
  If nn > 0 Then kValue = Left(kValue, nn - 1)
  ExtractSegmentText = kValue
End Function

' Функция проверки бинарный файл или нет (возвращает -4 если бинарный)
Function DetectBinaryFile(sFile)
  With AkelPad lpFile = .MemStrPtr(sFile) : lpDF = .MemAlloc(200)
    Call .MemCopy(lpDF, lpFile, 3) : Call .MemCopy(lpDF + 4, 1024, 3) : Call .MemCopy(lpDF + 8, 1, 3)
    DetectBinaryFile = .SendMessage(.GetMainWnd(), 1177, 0, lpDF)
    .MemFree(lpFile) : .MemFree(lpDF)
  End With
End Function

' Функция отключения/включения прорисовки окна
' SetRedraw(hhWnd, False) - выключить прорисовку, SetRedraw(hhWnd, True) - включить прорисовку
Function SetRedraw(hhWnd, bRedraw)
  With AkelPad .SendMessage hhWnd, 11, bRedraw, 0 : If bRedraw Then : .SystemFunction().Call "user32::InvalidateRect", hhWnd, 0, True : End If : End With
End Function

' Процедура включения прорисовки окна
Sub EndRedraw : Call SetRedraw(AkelPad.GetEditWnd(), True) : WScript.Quit : End Sub

' Функция проверки расширения, если coder, то обновляется кеш
Function UpdateCash
  If LCase(GetExtFile) = "coder" Then Call AkelPad.Call("Coder::Settings", 2, 4)
End Function

' Функция возващает путь исполняемого файла AkelPad (даже если он переименован)
Function GetExeAkel
  With AkelPad
    If .IsOldWindows() Then : TSIZE = 1 : TSTR = 0 : TCHAR = "A" : Else : TSIZE = 2 : TSTR = 1 : TCHAR = "W" : End If
    lpEA = .MemAlloc(256 * TSIZE)
    If Len(lpEA) > 0 Then
      Call .SystemFunction().Call("kernel32::GetModuleFileName" + TCHAR, .GetInstanceExe(), lpEA, 256)
      GetExeAkel = .MemRead(lpEA, TSTR) : .MemFree(lpEA)
    End If
  End With
End Function