Total Commander

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

Windows Script Host
Строка:	13
Символ:	7
Ошибка:	Разрешение отклонено
Код:	800A0046

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

      .MoveFolder F, TargetPath

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

      F.Copy TargetPath & .GetFolder(N).Name
      F.Delete

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

' Выделение  в панелях одноимённых, но разноразмерных файлов и папок
' Необходима регистрация Script Helper ActiveX for TC
' Параметр: "%P" "%T"
'==================================================
With CreateObject("Scripting.FileSystemObject")
  Set P = .GetFolder(WScript.Arguments(0))
  Set T = .GetFolder(WScript.Arguments(1))
End With
Set D = CreateObject("Scripting.Dictionary")
Set G = CreateObject("Scripting.Dictionary")

For Each F in P.SubFolders
  D.Add F.Name, F.Size
Next
For Each F in T.SubFolders
  G.Add F.Name, F.Size
Next
For Each F in D.Keys
  If G.Exists(F) And D(F) <> G(F) Then S = S & vbnewline & F & "\"
Next
D.RemoveAll
G.RemoveAll

For Each F in P.Files
  D.Add F.Name, F.Size
Next
For Each F in T.Files
  G.Add F.Name, F.Size
Next
For Each F in D.Keys
  If G.Exists(F) And D(F) <> G(F) Then S = S & vbnewline & F
Next

With CreateObject("TCScript.Helper")
  T = .GetTextFromClip
  .SetTextToClip(S)
  .LockTC True
  .SendCommand 4001
  .SendCommand 2033
  .SendCommand 4002
  .SendCommand 2033
  .LockTC False
  .SetTextToClip(T)
End With

Wscript.Quit

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

' Отправить в буфер RGB-число

Do Until Main
Loop

Function Main
  Main = False
  L = vbNewLine
  A = InputBox(L&"      Введите через пробел три числа (0-255),"&_
  "            соответствующие своему цвету "& L & "      ""красный зелёный синий""",_
  "                          Конвертация в RGB-число","0 0 0")
If A = vbNullString Then WScript.Quit

  For i = 1 to Len(A)
    N = Mid(A,i,1)
    If N = " " Then Sp = Sp & N
  Next
  If Len(Sp) <> 2 Then
    MsgBox "Необходимо указать 3 числа с 2-мя пробелами !", vbExclamation,_
    "                            Конвертация в RGB-число"
    Exit Function
  End If

  R = Left(A, Instr(A," ")-1)
  C = Mid(A,Len(R)+2)
  G = Left(C, Instr(C," ")-1)
  B = Mid(A, InstrRev(A," ")+1)

  For Each E in Array(R,G,B)
    If IsNumeric(E)=False Then
      MsgBox "Все значения должны быть числовыми !", vbExclamation,_
      "                     Конвертация в RGB-число"
      Exit Function
    End if
    If E<0 Or E>255 Then
      MsgBox "Все числа должны лежать в диапазоне [0-255] !", vbExclamation,_
      "                             Конвертация в RGB-число"
      Exit Function
    End If
  Next
  Main = True

  Dim WSH
  Set WSH = CreateObject("WScript.Shell")
  P = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
  A = WSH.RegRead(P)
  If A > 0 Then WSH.RegWrite P, 0, "REG_DWORD"
  With CreateObject("InternetExplorer.Application")
    .Navigate("about:blank")
    .document.parentWindow.clipboardData.setData "text", Trim(RGB(R, G, B))
    .Quit
  End With
  If A > 0 Then WSH.RegWrite P, A, "REG_DWORD"
  Set WSH = Nothing

  WScript.Quit
End Function

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

'=====================================================================
' Вычисление RGB-числа
'=====================================================================
Option Explicit
Dim R, G, B, A, Flag, MM
Const Title = "Вычисление RGB-числа"

On Error Resume Next
Do
  A = InputBox("Введите через пробел три числа [0-255]," & vbnewLine & _
               "соответствующие своему цвету "           & vbNewLine & _
               """красный зелёный синий""", Title, "0 0 0")
  If A = "" Then WScript.Quit

  With New RegExp
    .Pattern    = "^ *(\d+) +(\d+) +(\d+) *$"
    .IgnoreCase = True
    .Global     = True
    Set MM      = .Execute(A)(0).SubMatches
  End With
  Flag = (Err.Number = 0)
  If Flag Then
    R = MM(0) : G = MM(1) : B = MM(2)
    Flag = (R <= 255 And G <= 255 And B <= 255)
    If Not Flag Then Mess 2
  Else
    Mess 1
    Err.Clear
  End If
Loop Until Flag
On Error GoTo 0

InputBox "Результат:", Title, RGB(R, G, B)
WScript.Quit

Sub Mess(Mode)
  Dim lStr
  Select Case Mode
    Case 1 lStr = "Необходимо указать 3 числа, разделённых пробелами!"
    Case 2 lStr = "Все числа должны лежать в диапазоне [0-255]!"
  End Select
  MsgBox lStr, vbExclamation, Title
End Sub

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

<html>
<head>
<!-- text/html; charset=windows-1251 from header (HC) -->

	<title>Хван Дмитрий Иванович. Обновление. Глава 7</title>
</head>

<body bgcolor="#E9E9E9">
<div align=right><h3>
Хван Дмитрий Иванович: <small><a href=/h/hwan_d_i/>другие произведения.</a></small>
</h3></div>

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

' Перемещение выделенных файлов в создаваемые рядом папки
' с именами начал 10-х строк этих файлов до двоеточия
' Параметр: %L
'========================================================
With CreateObject("Scripting.FileSystemObject")
  Set TF = .OpenTextFile(WScript.Arguments(0), 1)
  Do While Not TF.AtEndOfStream
    F = TF.ReadLine
    If F > vbNullString And .FileExists(F) Then
      FF = LTrim(Split(.OpenTextFile(F,,,-2).ReadAll, vbNewLine)(9))
      Trg = .GetParentFolderName(F) & "\" & Left(FF, InStr(FF, ":") - 1)
      If Not .FolderExists(Trg) Then .CreateFolder Trg
      .MoveFile F, Trg & "\"
    End If
  Loop
  TF.Close
End With