Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript

Модерирует : ShIvADeSt

ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

   

ViSiToR



Silver Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
azamapendrus 16:47 06-11-2008
Цитата:
как написать скрипт

 
Примерно можно так:
 

Код:
Set WshShell     = WScript.CreateObject("WScript.Shell")
Set FSO         = CreateObject("Scripting.FileSystemObject")
 
Set oRoot         = FSO.GetFolder("C:\Execs")
Set oFiles         = oRoot.Files
 
iCounter         = 0
 
Dim iExec_1, iExec_2
 
For Each oFile in oFiles
    iCounter = iCounter + 1
    
    Set oExec1 = WshShell.Exec (oFile.Path)
    
    If (iCounter Mod 2) = 0 Then 'Every two calls
        Set oExec2 = WshShell.Exec (oFile.Path)
        
        While oExec1.Status = 0 Or oExec2.Status = 0
            WScript.Sleep 100
        WEnd
        
        If iCounter = 10 Then
            ShutDown_Comp()
            WScript.Quit
        End If
    End If
Next
 
Function ShutDown_Comp()
    sComputer = "."
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & sComputer & "\root\cimv2")
    Set colOperating Systems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    
    For Each objOperatingSystem in colOperatingSystems
        objOperatingSystem.Win32Shutdown(1)
    Next
End Function

 
Сразу напишу, не тестировал.

----------
ViSiToR a.k.a CreatoR
CreatoR это не ник, CreatoR это стиль жизни!

Всего записей: 3251 | Зарегистр. 01-04-2006 | Отправлено: 00:52 07-11-2008
danygug



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Привет
 
я не программист ...
 
Нужен скрипт который определит букву системного диска SYSTEMDRIVE и добавит в registry  
 
[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]
"Stage1"="SYSTEMDRIVE:\\temp\\stage1.cmd"
 

Всего записей: 58 | Зарегистр. 23-01-2004 | Отправлено: 10:39 07-11-2008
alroy

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
danygug
ЭТо подойдет ??????
 

Код:
 
 
Dim WshShell  
Set WshShell = CreateObject("WScript.Shell")  
 win_disk =  WshShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
 WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\Stage1", win_disk&"\temp\stage1.cmd","REG_SZ"
 
 
 WScript.Echo "Работа скрипта завершена"
 

 

Всего записей: 59 | Зарегистр. 15-06-2005 | Отправлено: 12:05 07-11-2008
azamapendrus



Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Удалено автором

Всего записей: 19 | Зарегистр. 24-08-2008 | Отправлено: 20:04 07-11-2008 | Исправлено: azamapendrus, 14:27 08-11-2008
ViSiToR



Silver Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
azamapendrus 20:04 07-11-2008
Цитата:
Скрипт не работает

Это слишком громко сказано, что конкретно не работает?
 

Цитата:
В папке C:\Execs находятся десять ехе-файлов(1.exe, 2.exe, 3.exe и.т.д.). Нужно, чтобы скрипт запустил 1.exe, и нажало  ЕNТЕR, следом включает 2.exe и также нажимает ENTER

Имена файлов заранее известно? Тогда можно их не искать, а просто в массив поместить и перебирать:
 

Код:
Set WshShell = WScript.CreateObject("WScript.Shell")
 
sPath        = "C:\Execs"
aFilesArr     = Array(10, "1.exe", "2.exe", "3.exe", "4.exe", "5.exe", "6.exe", "7.exe", "8.exe", "9.exe", "10.exe")
 
For i = 1 To aFilesArr(0)
    sFile = sPath & "\" & aFilesArr(i)
    
    If (i Mod 2) > 0 Then
        Set oExec1 = WshShell.Exec(sFile)
        
        'Если у приложения нет диалога, то цикл можно опустить, но не понятно для чего отсылать Enter
        While Not WshShell.AppActivate (oExec1.ProcessID)
            WScript.Sleep 100
        WEnd
        
        WshShell.SendKeys "~"
    Else 'Every two calls
        Set oExec2 = WshShell.Exec(sFile)
        
        While Not WshShell.AppActivate (oExec2.ProcessID)
            WScript.Sleep 100
        WEnd
        
        WshShell.SendKeys "~"
        
        While oExec1.Status = 0 Or oExec2.Status = 0
            WScript.Sleep 100
        WEnd
        
        If i = aFilesArr(0) Then
            ShutDown_Comp()
            WScript.Quit
        End If
    End If
Next
 
Function ShutDown_Comp()
    sComputer = "."
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & sComputer & "\root\cimv2")
    Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    
    For Each objOperatingSystem in colOperatingSystems
        objOperatingSystem.Win32Shutdown(1)
    Next
End Function

 
Этот код тестировал, вроде работет.
 

Цитата:
чтобы работу выполняли всегда по две проги, как только одна вырубается, подгружается следующая

Как только одна пара выгружается, или одна программа? Если программа то нужно в коде заменить это:
 

Код:
While oExec1.Status = 0 Or oExec2.Status = 0

 
на это:
 

Код:
While oExec1.Status = 0 And oExec2.Status = 0


----------
ViSiToR a.k.a CreatoR
CreatoR это не ник, CreatoR это стиль жизни!

Всего записей: 3251 | Зарегистр. 01-04-2006 | Отправлено: 21:37 07-11-2008
azamapendrus



Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добавлено:
ViSiToR
Спасибо, работает отлично, как и надо.
Хотелось бы ещё добавить после окончания работы, перед выключением компа звуковой сигнал,, типа:
Set WMPlayer = CreateObject("WMPlayer.OCX")
WMPlayer.settings.autoStart = False
WMPlayer.settings.enableErrorDialogs = False
WMPlayer.URL = "C:\WINDOWS\Media\1.wav"
WMPlayer.controls.play()
While WMPlayer.playState <> 1
WScript.Sleep 1000
Wend
 
И выскакивало бы сообщение : Выключить компьютер? Если в течении 3 -х минут не нажал "Отмена, то тогда бы выключался.  

Всего записей: 19 | Зарегистр. 24-08-2008 | Отправлено: 12:37 08-11-2008 | Исправлено: azamapendrus, 15:34 08-11-2008
GuitarloverX

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
 Помогите плиз..
Вот строка бат файла:
echo Do Until v>=1  >> %temp%\temp.vbs
а созданная строка в temp.vbs получается такая:
Do Until v
 
А если в бате так:
echo Do Until v<=40 >> %temp%\temp.vbs
то в скрипт строка не пишется вообще.
 
Мне что-то не допереть, что надо сделать, чтобы строка писалась целиком...
 
И ещё вопросик:
как убить  процесс, например explorer?
Что-то вроде этого? :
s.run "Rundll32 explorer.exe, ???exit???"
  или как нить по другому?
как загрузить процесс, к примеру его же?
 
 
О! Вспомнил, ещё интересует как сделать чтобы скрипт срабатывал к примеру через 20 минут после загрузки компа? или вообще каждые 20 минут?  )))
 
Эх, когда нибудь я стану большим и умным, а пока помогите плиз  =)

Всего записей: 8 | Зарегистр. 22-01-2008 | Отправлено: 22:15 08-11-2008
ViSiToR



Silver Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
azamapendrus 12:37 08-11-2008
Цитата:
выскакивало бы сообщение : Выключить компьютер? Если в течении 3 -х минут не нажал "Отмена, то тогда бы выключался.

Вот тут придётся запускать MsgBox во внешнем скрипте:
 

Код:
Set WshShell     = WScript.CreateObject("WScript.Shell")
Set oFSO         = CreateObject("Scripting.FileSystemObject")
 
 
sPath            = "C:\Execs"
aFilesArr         = Array(10, "1.exe", "2.exe", "3.exe", "4.exe", "5.exe", "6.exe", "7.exe", "8.exe", "9.exe", "10.exe")
 
For i = 1 To aFilesArr(0)
    sFile = sPath & "\" & aFilesArr(i)
    
    If (i Mod 2) > 0 Then
        Set oExec1 = WshShell.Exec(sFile)
        
        While Not WshShell.AppActivate (oExec1.ProcessID)
            WScript.Sleep 100
        WEnd
        
        WshShell.SendKeys "~"
    Else 'Every two calls
        Set oExec2 = WshShell.Exec(sFile)
        
        While Not WshShell.AppActivate (oExec2.ProcessID)
            WScript.Sleep 100
        WEnd
        
        WshShell.SendKeys "~"
        
        While oExec1.Status = 0 And oExec2.Status = 0
            WScript.Sleep 100
        WEnd
        
        If i = aFilesArr(0) Then
            sTmpDir         = WshShell.ExpandEnvironmentStrings("%Temp%")
            sMsgBoxFile        = sTmpDir & "\~MsgBox.vbs"
            
            sScriptData     = "iAsk = MsgBox(""Выключить компьютер?"", 262144+36, ""Внимание!"")"
            sScriptData     = sScriptData & vbCRLF & "WScript.StdOut.WriteLine iAsk"
            
            iReboot         = ExecExternalScript(sMsgBoxFile, sScriptData, 60 * 3, 6)
            
            If iReboot = 6 Then ShutDown_Comp()
            WScript.Quit
        End If
    End If
Next
 
 
'========== Functions ==========
Function ShutDown_Comp()
    sComputer = "."
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & sComputer & "\root\cimv2")
    Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    
    For Each objOperatingSystem in colOperatingSystems
        objOperatingSystem.Win32Shutdown(1)
    Next
End Function
 
Function ExecExternalScript(sScriptFile, sScriptContent, iTime, sDefaultRet)
    FileCreate sScriptFile, sScriptContent
    
    Set oExec = WshShell.Exec("Wscript.exe " & sScriptFile)
    
    sStdOutRead = ""
    iTimerInit = 0
    
    If iTime Then iTimerInit = Timer
    
    Do While oExec.Status <> 1
        WScript.Sleep 10
        
        If iTime And (Timer - iTimerInit) > iTime Then
            oExec.Terminate
            sStdOutRead = sDefaultRet
            Exit Do
        End If
    Loop
    
    oFSO.DeleteFile sScriptFile
    
    If sStdOutRead = "" Then sStdOutRead = oExec.StdOut.Read(1)
    ExecExternalScript = sStdOutRead
End Function
 
Function FileCreate(sFile, sData)
    Set oTF = oFSO.CreateTextFile(sFile, True)
    
    oTF.Write(sData)
    oTF.Close
End Function

 
Добавлено:
GuitarloverX 22:15 08-11-2008
Цитата:
что надо сделать, чтобы строка писалась целиком

Это вопрос в тему по батникам, а вообще нужно перед спец-символами добавлять ^:
 

Код:
echo Do Until v^<=40 >> %temp%\temp.vbs

 

Цитата:
как убить  процесс, например explorer?

 
Так:
 

Код:
ProcessClose("Explorer.exe")
 
Function ProcessClose(sProcName)
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
    Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & sProcName & "'")
    
    For Each objProcess in colProcessList
        objProcess.Terminate()
    Next
End Function

 

Цитата:
как загрузить процесс

 
Так:
 

Код:
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("Explorer.exe")

 

 

Цитата:
как сделать чтобы скрипт срабатывал к примеру через 20 минут после загрузки компа? или вообще каждые 20 минут?

Можно поместить скрипт в автозапуск, а в скрипте использовать Timer.
А если нужно именно скрипт запускать, то наверное лучше через «Назначение задач».

----------
ViSiToR a.k.a CreatoR
CreatoR это не ник, CreatoR это стиль жизни!

Всего записей: 3251 | Зарегистр. 01-04-2006 | Отправлено: 00:12 09-11-2008
GuitarloverX

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ViSiToR
Спасибо огромное!!!
    Во я дятел, мог бы и сам допереть
 
Цитата
 (А если нужно именно скрипт запускать, то наверное лучше через «Назначение задач».)
 
Ну, вот до этого точно не допру.  
Реально добавить задачу с помощью реестра? (Хотя наверное нет)
  А скриптом можно назначить задачу? Как-нибудь так:
   
Dim A,B,Sel  
Set A=WScript.CreateObject("НАЗНАЧАТЕЛЬ ЗАДАЧ.Application")
Set B=A.ЗАДАЧА.Add  
A.Visible=false    
Sel...      'Устанавливаем параметры задачи
Sel...

Всего записей: 8 | Зарегистр. 22-01-2008 | Отправлено: 18:32 09-11-2008 | Исправлено: GuitarloverX, 19:46 09-11-2008
ViSiToR



Silver Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
GuitarloverX 18:32 09-11-2008
Цитата:
 скриптом можно назначить задачу?

Не думаю, хотя не исключено.
 
Я имел в виду самому назначить задание
Но всё же лучше будет просто запустить скрипт с автозапуска, и каждые 20 минут (через цикл) делать то что нужно. Примерно так:
 

Код:
iSleepTime = 1 'Каждые сколько минут запускать функцию MyProc
 
While True
    WScript.Sleep (iSleepTime * 1000 * 60)
    
    MyProc()
WEnd
 
Function MyProc()
    'Тут может выполняться то что нужно каждые N минут
    MsgBox "Минут прошло: " & iSleepTime, 64, "Внимание!"
End Function


----------
ViSiToR a.k.a CreatoR
CreatoR это не ник, CreatoR это стиль жизни!

Всего записей: 3251 | Зарегистр. 01-04-2006 | Отправлено: 23:10 09-11-2008 | Исправлено: ViSiToR, 23:23 09-11-2008
GuitarloverX

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ViSiToR
Усё ясно...
 
А если например я хочу скрыть процесс из диспетчера задач, и мне мозгов не хватает слепить  DLL и вызвать из неё функцию, прилепив её к какому нить системмному процессу, то можно ли скрыть его скриптом ходя бы из диспетчера?  
 
Получаю список процессов
 Dim Proc() As System.Diagnostics.Process
 Proc = System.Diagnostics.Process.GetProcesses()  
Нахожу нужный....  И скрываю...  
 
Можно, конечно скрыть диспетчер задач и запретить регэдит, но это не красиво

Всего записей: 8 | Зарегистр. 22-01-2008 | Отправлено: 20:18 10-11-2008
TJmike

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здравствуйте. Помогите пожалуйста. Нужен скрипт на VBScript
Есть домен,2 сервера. Пользователи с рабочих станций через ярлыки на раб. столе заходят на сервер в базу данных. Ярлыки настроены на шаренную папку первого сервера. Как сделать скрипт, который бы запускался по шедуллеру,проверял доступность сетевого ресурса и в случае его недоступности переделывал бы ярлыки пользователей на другой сервер. Спасибо.

Всего записей: 4 | Зарегистр. 04-12-2007 | Отправлено: 20:20 10-11-2008
ViSiToR



Silver Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
GuitarloverX 20:18 10-11-2008
Цитата:
если например я хочу скрыть процесс из диспетчера задач

Через vbs вроде никак. На AutoIt уже будет проще.

----------
ViSiToR a.k.a CreatoR
CreatoR это не ник, CreatoR это стиль жизни!

Всего записей: 3251 | Зарегистр. 01-04-2006 | Отправлено: 21:55 10-11-2008
gap5



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Встала задача сделать что-то вроде будильника по модему. Т.е. есть модем USR COURIER (COM PORT), подключен к серваку под WIN2003, нужно по шедулеру запускать скрипт который будет дозваниваться по определенному номеру и после ответа на том конце класть трубку. Дозваниваться до тех пор пока ответа не последует.

Всего записей: 1033 | Зарегистр. 30-05-2006 | Отправлено: 23:34 10-11-2008
GuitarloverX

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ViSiToR

Цитата:
 Через vbs вроде никак. На AutoIt [?] уже будет проще.

Вот спасибо, хорошо, положите на комод....     "AutoIt" черт, я и слова то такого не слыхал до сегодняшнего дня.
  Теперь и в АПИ придется лезть уже по полной программе...  
 
Зато допер как ДЛЛ-ку слепить на дельфи и запускаться от имени Winlogon , правда пока не знаю, есть ли в этом смысл, т.к. процесс WScript.exe один черт в диспетчере виден будет.

Всего записей: 8 | Зарегистр. 22-01-2008 | Отправлено: 23:19 11-11-2008 | Исправлено: GuitarloverX, 23:20 11-11-2008
stydik



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Доброго времени суток. Ребята, помогите со скриптом, пожалуйста.  
Нужно сотворить скриптик для FTP сервера, с диалоговым окном, или окном протоколирования, и сохранением в лог. Чтобы, можно было видеть на экране в этом окшке обмен???  Адрес нашего ФТП 192.168.1.1. Имя и пароль - аноним. Очень прошу. Или подскажите сцылку на существующий скрипт....

Всего записей: 1510 | Зарегистр. 03-03-2008 | Отправлено: 10:29 12-11-2008
RuStn



Junior Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Внесу свою лепту:
Замена путей в ярлыках, старый путь на новый, с возможностью поиска по всему диску

Код:
'********************************************************************
'*http://www.tek-tips.com/viewthread.cfm?qid=1207618&page=1
'*Скрипт по замене свойств ярлыков, заменяет пути в ярлыках
'*Запускать /localFolderToSearch:"c:\xyz\pqr" /targetToReplace:"\\OldServer\" /replacementTarget:"\\NewServer\"
'*
'********************************************************************
Dim sarg1,sarg2,sarg3,sarg4,objFSO,objDrive,oFso,oFolder,oFiles,oFile,oLnk
 
Set oShell = CreateObject("WScript.Shell")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 
'********************************************************************
'*Определим аргументы запущенные в коммандной строке
'********************************************************************
With wscript.arguments.Named
    sarg1=LCase(.item("localFolderToSearch"))
    sarg2=LCase(.item("targetToReplace"))
    sarg3=LCase(.item("replacementTarget"))
End With
 
'********************************************************************
'*Проверим эти аргументы на условия:
'*Desktop, AllUsersDesktop, MyDocuments, Startup
'*Но можно указать поиск на всех жёстких дисках
'*аргумент /localFolderToSearch:"AllDrivers" заставит пробежать по всем дискам
'*и проверить все папки и подпапки
'********************************************************************
If sarg1="" Or sarg2="" or sarg3="" Then
    msgbox "Запускайте с такими параметрами:" & vbCr & vbCr &_
    "/localFolderToSearch:""c:\xyz\pqr"" /targetToReplace:""\\OldServer\"" /replacementTarget:""\\NewServer\""" & vbCr & vbCr &_
    "Путь где искать" & vbTab & "Что менять в пути" & vbTab & vbTab & "Что должно стать в пути" & vbCr &_
    "c:\xyz\pqr" & vbTab & "\\OldServer\" & vbTab & vbTab & "\\NewServer\" & vbCr & vbCr &_
    "Можно указать Desktop, AllUsersDesktop, MyDocuments, Startup" & vbCr & vbCr &_
    "А можно поискать на всех дисках: AllDrivers", vbInformation, "Внимание"
ElseIf sarg1="desktop" Then  
    sarg4=oShell.SpecialFolders("Desktop")  
    ReplaceShortcut sarg4,sarg2,sarg3
ElseIf sarg1="allusersdesktop" Then
       sarg4=oShell.SpecialFolders("AllUsersDesktop")
       ReplaceShortcut sarg4,sarg2,sarg3
ElseIf sarg1="mydocuments" Then
       sarg4=oShell.SpecialFolders("MyDocuments")
       ReplaceShortcut sarg4,sarg2,sarg3
ElseIf sarg1="startup" Then
       sarg4=oShell.SpecialFolders("Startup")
       ReplaceShortcut sarg4,sarg2,sarg3
ElseIf sarg1="alldrivers" Then
    FindDrivers
End If
 
'*Ну и обязательно выйдем из скрипта
WScript.Quit 0
 
'********************************************************************
'*Процедура поиска в папке файлов с расширением lnk,  
'*Производит замену старого пути на новый в ярлыках
'*при условии что будет найден ярлык со старым путём
'********************************************************************
Sub ReplaceShortcut (localFolderToSearch, targetToReplace, replacementTarget)
  if objFSO.folderExists(localFolderToSearch) then
    Set oFolder = objFSO.GetFolder(localFolderToSearch)
    Set oFiles = oFolder.Files
    For Each oFile In oFiles
      If LCase(objFSO.GetExtensionName(oFile.name)) = "lnk" Then
        Set oLnk = oShell.CreateShortcut(oFile.path)
        If instr(1, LCase(oLnk.TargetPath), targetToReplace, 1)<>0 Then
          oLnk.TargetPath = replace(oLnk.TargetPath, targetToReplace, replacementTarget,1,-1,1)
          oLnk.Save
          'MsgBox "Отон он, нашёл его!"
        End If
        set oLnk=nothing
      End If
    Next
    FindSubFolders localFolderToSearch
    set oFiles=nothing  
    set oFolder=nothing
  else
     'folder does not even exist---do nothing?
  end if
End Sub
 
'********************************************************************
'*Процедура поиска дисков у пользователя
'*Ищутся локальные диски, и как параметр отсылается на растерзание
'*процедуре поиска папок
'********************************************************************
Sub FindDrivers
    For Each objDrive In objFSO.Drives
        If objDrive.DriveType = 2 Then
            If objDrive.IsReady Then
                FindSubFolders objDrive.RootFolder
            End If
        End If
    Next
End Sub
 
'********************************************************************
'*Ну и сама процедура поиска папок, с подпапками
'*Передаёт процедуре папки с аргументами (типа поищи тут)
'********************************************************************
Sub FindSubFolders (objFolderForFind)
    On Error Resume Next
    For Each objFolder In objFolderForFind.SubFolders
         If Err.Number = 0 Then
            ReplaceShortcut objFolder,sarg2,sarg3
        Else
            Err.Clear
        End If
    Next
    On Error Goto 0
End Sub

 
Ремап дисков, на новый ресурс, сервер, путь и т.д.

Код:
'*******************************************************************
'*Скрипт для замены старых путей в сетевых дисках на новые
'*Запускать с таким параметром /localOldTarget:"Старый путь" /localNewTarget:"Новый путь"
'*******************************************************************
 
On Error Resume Next
Dim sarg1,sarg2,objNetwork,colDrives,strNetworks,strDriveLette,strNetworkPath
 
With wscript.Arguments.Named
    sarg1=LCase(.item("localOldTarget"))
    sarg2=LCase(.item("localNewTarget"))
End With
'*******************************************************************
'*Проверим аргументы, переменные запуска
'*******************************************************************
If sarg1="" Or sarg2="" Then
    MsgBox "Запускайте с такими параметрами:" & vbCr & vbCr &_
    "/localOldTarget:""Старый путь"" /localNewTarget:""Новый путь""", vbinformation, "Внимание!"
    'выйдем из скрипта, условие то нарушено!
    WScript.Quit 0
End If
'*******************************************************************
'*Создадим объект Network, чтобы узнать какие диски смаплены
'*******************************************************************
Set objNetwork = CreateObject("Wscript.Network")
Set colDrives = objNetwork.EnumNetworkDrives
'*******************************************************************
'*Пробежимся по всем смапленным дискам и если условие localOldTarget
'*совпадёт, заменим на localNewTarget
'*******************************************************************
For i = 0 to colDrives.Count-1 Step 2
    strDriveLetter = colDrives.Item(i)
    strNetworkPath =  LCase(colDrives.Item(i + 1))
'*Сохраним пути для будущего
    strNetworks = strNetworks & strDriveLetter & "    " & strNetworkPath & vbCr
'*Проведём манипуляции для проверки условий
If InStr (1, strNetworkPath, sarg1) <>0 Then
    strNewPath = Replace (strNetworkPath, sarg1, sarg2)
    'Отмапим чтоб с концами
    objNetwork.RemoveNetworkDrive strDriveLetter, True, True
    'Подождём малость
    WScript.Sleep 3000
    'И примапим так чтоб надолго
    objNetwork.MapNetworkDrive strDriveLetter, strNewPath, True
    'Ну и скажем на что поменяли...
    strNewNetworks = "Заменён на:" & vbCr & strNewNetworks & strDriveLetter & "    " & strNewPath & vbCr & vbCr
End If
Next
'MsgBox "На компьютере найдены сетевые диски" & vbCr &_
    strNetworks & vbCr & vbCr & strNewNetworks, vbInformation, "Внимание!"

 
Делал для своих нужд, переезжаем на новый сервер со сменой путей и т.д.

Всего записей: 156 | Зарегистр. 27-08-2001 | Отправлено: 15:43 13-11-2008 | Исправлено: RuStn, 21:22 13-11-2008
stydik



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добрый вечер. Вопросик по сриптику. Хелп плиз.
 
Имеется ФТП скрипт:
 

Код:
set WSHShell = WScript.CreateObject("WScript.Shell")
WScript.Sleep 500
'WshShell.SendKeys()
'Do While ftp <> True
 
' Function WriteFtpLog()
' MyLog.WriteLine(Cstr(Date)&" "&Cstr(Time) & ftp.LastErrorText)
' MyLog.Close
' WScript.Quit
' End Function
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
' If (fso.FileExists("ftplog.log")) Then
'    Set MyLog = fso.OpenTextFile("ftplog.log", 8, True)
' Else
'    Set MyLog = fso.CreateTextFile("ftplog.log")
' end if
 
'dim ftp
set ftp = CreateObject("ChilkatFtp.ChilkatFtp")
ftp.Username = "anonymous"
ftp.Password = "anonymous"
ftp.Hostname = "192.168.1.1"
 
ok = ftp.Connect()
'ok = ftp.Sleep (100)
'Do While ftp.Connect <> True
 
Do While ftp.LastErrorText <> True
if (ok <> 1) then
MsgBox ftp.LastErrorText
end if
 
localDir = "c:\1\"
remotePattern = "\\*.*"
numDownloaded = ftp.MGetFiles(remotePattern, localDir)  
'Do While MGetFiles <> True
 
MsgBox ftp.LastErrorText
 
'If (success <> 1) Then WriteFtpLog () End if
 
ok = ftp.Connect()
if (ok <> 1) then
MsgBox ftp.LastErrorText
end if
 
'ftp.ChangeRemoteDir "\\"
ftp.MPutFiles "*.txt"
'Do While MPutFiles <> False
 
MsgBox ftp.LastErrorText
 
'If (success <> 1) Then WriteFtpLog () End If
Loop  
'Loop

 
 
Я заремил логи, поскольку не знал куда вставить SLEEP, а он ругается на логи. Вопросы: Как мне сделать чтобы обмен проводился независимо от MSGBOXов (нажал я окей или нет).???? И как все таки сделать вывод  всего обмена в ЛОГ ??? Очень прошу,помогите, пожалуйста. Я уже запарился его клепать... Начинающий........

Всего записей: 1510 | Зарегистр. 03-03-2008 | Отправлено: 21:58 13-11-2008
stydik



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Hi to all. Это VB скрипт для FTP. Работатет по циклу. Есть вопросик, точнее два. Как мне сделать чтобы, скрипт проверял если на ФТП дата файла отличается, то копировать, если нет то не копировать. И еще, как мне ему подсунуть список юзеров и пасвордов, а то он сечайс пашет только как "anonymous" ????
 

Код:
Function WriteFtpLog()
 MyLog.WriteLine(Cstr(Date)&" "&Cstr(Time) & ftp.LastErrorText)
 End Function
set WSHShell = WScript.CreateObject("WScript.Shell")
'WScript.Sleep 1000
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
 If (fso.FileExists("log.log")) Then
 Set MyLog = fso.OpenTextFile("log.log", 8, True)
 Else
 Set MyLog = fso.CreateTextFile("log.log")
 end if
 
set ftp = CreateObject("ChilkatFtp.ChilkatFtp")
ftp.Username = ""
ftp.Password = ""
ftp.Hostname = "192.168.1.1"
 
ok = ftp.Connect()
Do While ftp.Connect <> True
 
 
localDir = "c:\"
remotePattern = "\\*.*"
numDownloaded = ftp.MGetFiles(remotePattern, localDir)
 
set oShell = WScript.CreateObject ("WScript.Shell")
oShell.Popup ftp.LastErrorText, 3
 
If (success <> 1) Then WriteFtpLog () End if
 
ftp.MPutFiles "*.txt"
 
set oShell = WScript.CreateObject ("WScript.Shell")
oShell.Popup ftp.LastErrorText, 3
 
If (success <> 1) Then WriteFtpLog () End If
Loop
 


Всего записей: 1510 | Зарегистр. 03-03-2008 | Отправлено: 15:00 17-11-2008
coherent

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Уважаемые!
Подскажите, пожалуйста, какое-нибудь пособие, учебник по языку VBScript.
Заранее благодарен!

Всего записей: 3881 | Зарегистр. 20-02-2007 | Отправлено: 11:14 18-11-2008
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript
ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru