Batya
|
 Posted: Mon May 21, 2007 17:15 Post subject: |
 |
|
Значит так...
Информации много, поэтому разбиваю на 3 части.
Внимание! Первоначально настраивать абсолютно в точности по описанию. Когда все будет работать нормально, уже тогда можно играться с настройками.
1. В папке TC создать файл My.bar с содержимым:
| Code: |
[Buttonbar]
Buttoncount=6
button1=wcmicons.dll,15
cmd1=%COMMANDER_PATH%\DEFAULT.BAR
menu1=Наверх
button2=
button3=shell32.dll,21
cmd3=%COMMANDER_PATH%\Utils\WHS\AddRec.vbs
param3=""%PCustomers.csv""
menu3=Добавление записей для папок
button4=shell32.dll,87
cmd4=%COMMANDER_PATH%\Utils\WHS\FillCsv.vbs
param4=""%PCustomers.csv""
menu4=Заполнение пустых ячеек в csv-файле
button5=shell32.dll,67
cmd5=%COMMANDER_PATH%\Utils\WHS\MakeDirs.vbs
param5=""%PCustomers.csv""
menu5=Создание папок по новым записям в csv-файле
button6=shell32.dll,77
cmd6=%COMMANDER_PATH%\Utils\WHS\RemRec.vbs
param6=""%PCustomers.csv""
menu6=Удаление записи из csv-файла при отсутствии аналогичной папки
|
2. В папке TC создать папку Utils, а в ней папку файл WHS.
3. В папке %COMMANDER_PATH%\Utils\WHS создать 4 файла:
3.1. AddRec.vbs:
| Code: |
'=====================================================================
' Добавление в csv-файл (имя которого передано первым параметром)
' соответствующей строки, если в текущем каталоге существует папка,
' запись о которой отсутсвует в csv-файле
' Для вызова скрипта по кнопке (команде меню) TC
' можно в параметрах указать:
' %P%N
' или, например, если имя файла жестко задано:
' "%PCustomers.csv"
' В первом случае скрипт вызывается, когда фокус на этом файле,
' во втором - когда фокус в любом месте каталога файла
'=====================================================================
Option Explicit
'============= Изменяемые параметры ==================================
Dim Header
'Можно задать несколько колонок по умолчанию через ;
Header = "Имя;Район;Сельский совет;Целевое назначение"
'=====================================================================
If WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbCritical, "Внимание!"
Wscript.Quit
End If
Dim OTF, FSO, CustomFile, CustomDir, Customers, i, F, AddToRec, SF
Dim Arr1, Rec, oFile
Set FSO = CreateObject("Scripting.FileSystemObject")
CustomFile = WScript.Arguments(0)
If Not FSO.FileExists(CustomFile) Then
Dim Button
Button = MsgBox("Файл " & CustomFile & " не существует!" & _
vbNewLine & "Создать?", vbYesNo + vbExclamation, "Внимание!")
If Button = vbNo Then
Set FSO = Nothing
WScript.Quit
Else
On Error Resume Next
Set OTF = FSO.CreateTextFile(CustomFile)
If Err.Number <> 0 Then
MsgBox "Невозможно создать файл " & CustomFile & _
" по причине ошибки:" & vbNewLine & _
Err.Description , vbOKOnly + vbCritical, "Внимание!"
Set FSO = Nothing
WScript.Quit
Else
On Error GoTo 0
OTF.Write Header
Set oFile = FSO.GetFile(CustomFile)
oFile.Attributes = oFile.Attributes Or 2 'Hidden
Customers = Split(Header, vbNewLine, -1, 1)
End If
End If
Else
'Прочитаем содержимое csv-файла
Set OTF = FSO.OpenTextFile(CustomFile, 1, False)
Customers = Split(OTF.ReadAll, vbNewLine, -1, 1)
OTF.Close()
'Откроем csv-файл для добавления
Set OTF = FSO.OpenTextFile(CustomFile, 8, False)
End If
'Окончание строки для формирования колонок в csv-файле
AddToRec = String(UBound(Split(Header, ";", -1, 1)), ";")
'Текущий каталог csv-файла
CustomDir = FSO.GetFile(CustomFile).ParentFolder
'Формируем массив значений из первой колонки (имена)
'Обрамляем символом * (в именах папок недопустим),
' чтобы проверять имена на полное совпадение
'В цикле исключаем первую строку (индекс 0) - это заголовки
For i = 1 To UBound(Customers)
Rec = Customers(i)
If Rec <> "" Then
Arr1 = Arr1 & ";*" & Split(Rec, ";", -1, 1)(0) & "*"
End If
Next
Arr1 = Split(Mid(Arr1, 2), ";", -1, 1)
'Добавляем строку с именем папки, если такой нет в csv
For Each SF In FSO.GetFolder(CustomDir).SubFolders
If UBound(Filter(Arr1, "*" & SF.Name & "*", True, 1)) = -1 Then
OTF.Write vbNewLine & SF.Name & AddToRec
End If
Next
OTF.Close()
Set OTF = Nothing
Set FSO = Nothing
WScript.Quit
|
3.2. FillCsv.vbs:
| Code: |
'=====================================================================
' Заполнение пустых ячеек csv-файла (имя которого передано первым
' параметром) данными
' Для вызова скрипта по кнопке (команде меню) TC
' можно в параметрах указать:
' %P%N
' или, например, если имя файла жестко задано:
' "%PCustomers.csv"
' В первом случае скрипт вызывается, когда фокус на этом файле,
' во втором - когда фокус в любом месте каталога файла
'=====================================================================
Option Explicit
If WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbCritical, "Внимание!"
Wscript.Quit
End If
Dim FSO, OTF, CustomFile, Rec, NewText, NewRec, i, Arr, Cell, _
Header, HeaderArr
Set FSO = CreateObject("Scripting.FileSystemObject")
CustomFile = WScript.Arguments(0)
'Проверяем наличие csv-файла
If Not FSO.FileExists(CustomFile) Then
MsgBox "Файл " & CustomFile & " не существует!", _
vbOKOnly + vbCritical, "Внимание!"
Set FSO = Nothing
WScript.Quit
End If
'Откроем csv-файл для чтения
Set OTF = FSO.OpenTextFile(CustomFile, 1, False)
'Читаем заголовки
Header = OTF.ReadLine
HeaderArr = Split(Header, ";", -1, 1)
'Читаем остальные строки
Do While Not OTF.AtEndOfStream
Rec = OTF.ReadLine
NewRec = ""
If Len(Rec) > 0 Then
Arr = Split(Rec, ";", -1, 1)
i = 0
For Each Cell in Arr
If Len(Cell) = 0 Then
Cell = InputBox("Введите значение """ & HeaderArr(i) & _
""" для записи с именем """ & Arr(0) & """:", _
Arr(0), "")
End If
NewRec = NewRec & ";" & Cell
i = i + 1
Next
NewRec = Mid(NewRec, 2)
End If
NewText = NewText & vbNewLine & NewRec
Loop
OTF.Close()
'Добавляем заголовки
NewText = Header & NewText
'Откроем csv-файл для записи
Set OTF = FSO.OpenTextFile(CustomFile, 2, False)
OTF.Write NewText
OTF.Close()
Set OTF = Nothing
Set FSO = Nothing
WScript.Quit
|
3.3. MakeDirs.vbs:
| Code: |
'=====================================================================
' Создание недостающих папок по первой колонке csv-файла,
' имя которого передано первым параметром, в каталоге это файла
' Для вызова скрипта по кнопке (команде меню) TC
' можно в параметрах указать:
' %P%N
' или, например, если имя файла жестко задано:
' "%PCustomers.csv"
' В первом случае скрипт вызывается, когда фокус на этом файле,
' во втором - когда фокус в любом месте каталога файла
'=====================================================================
Option Explicit
If WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbCritical, "Внимание!"
Wscript.Quit
End If
Dim OTF, FSO, CustomFile, CustomDir, Customers, i, F
Set FSO = CreateObject("Scripting.FileSystemObject")
CustomFile = WScript.Arguments(0)
If Not FSO.FileExists(CustomFile) Then
MsgBox "Неверно указан параметр!" & vbNewLine & _
"Файл " & CustomFile & " не существует!", _
vbOKOnly + vbCritical, "Внимание!"
Set FSO = Nothing
WScript.Quit
End If
Set OTF = FSO.OpenTextFile(CustomFile, 1, False)
Customers = Split(OTF.ReadAll, vbNewLine, -1, 1)
OTF.Close()
CustomDir = FSO.GetFile(CustomFile).ParentFolder
' В цикле исключаем первую строку (индекс 0) - это заголовки
For i = 1 To UBound(Customers)
If Len(Customers(i)) > 0 Then
F = CustomDir & "\" & Split(Customers(i), ";", -1, 1)(0)
If Not FSO.FolderExists(F) Then
FSO.CreateFolder(F)
End If
End If
Next
Set FSO = Nothing
WScript.Quit
|
3.4. RemRec.vbs:
| Code: |
'=====================================================================
' Удаление из csv-файла, имя которого передано первым параметром,
' записи, если отсутствует соотв. папка в каталоге это файла
' Для вызова скрипта по кнопке (команде меню) TC
' можно в параметрах указать:
' %P%N
' или, например, если имя файла жестко задано:
' "%PCustomers.csv"
' В первом случае скрипт вызывается, когда фокус на этом файле,
' во втором - когда фокус в любом месте каталога файла
'=====================================================================
Option Explicit
If WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbCritical, "Внимание!"
Wscript.Quit
End If
Dim OTF, FSO, CustomFile, CustomDir, SF, Arr1, Rec, NewText, Header
Set FSO = CreateObject("Scripting.FileSystemObject")
CustomFile = WScript.Arguments(0)
'Проверяем наличие csv-файла
If Not FSO.FileExists(CustomFile) Then
MsgBox "Файл " & CustomFile & " не существует!", _
vbOKOnly + vbCritical, "Внимание!"
Set FSO = Nothing
WScript.Quit
End If
'Текущий каталог csv-файла
CustomDir = FSO.GetFile(CustomFile).ParentFolder
'Формируем массив имен папок
'Обрамляем символом * (в именах папок недопустим),
' чтобы проверять имена на полное совпадение
For Each SF In FSO.GetFolder(CustomDir).SubFolders
Arr1 = Arr1 & ";*" & SF.Name & "*"
Next
Arr1 = Split(Mid(Arr1, 2), ";", -1, 1)
'Откроем csv-файл для чтения
Set OTF = FSO.OpenTextFile(CustomFile, 1, False)
'Пропускаем заголовки
Header = OTF.ReadLine
'Читаем остальные строки
Do While Not OTF.AtEndOfStream
Rec = OTF.ReadLine
If UBound(Filter(Arr1, "*" & Split(Rec, ";", -1, 1)(0) & "*")) >= 0 Then
NewText = NewText & vbNewLine & Rec
End If
Loop
OTF.Close()
'Добавляем заголовки
NewText = Header & NewText
'Откроем csv-файл для записи
Set OTF = FSO.OpenTextFile(CustomFile, 2, False)
OTF.Write NewText
OTF.Close()
Set OTF = Nothing
Set FSO = Nothing
WScript.Quit
|
4. На основной панели TC создать кнопку:
| Code: |
TOTALCMD#BAR#DATA
%COMMANDER_PATH%\My.bar
wcmicons.dll,3
Моя панель
-1
|
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
