УРБД: Автоматический обмен через интернет между центральной и периферийными базами в Windows 7 + 1С:Предприятие 7.7.

------------------------- начало цитаты -----------------------------

Создайте *.cmd или *.vbs, в котором пропишите команды по запуску автообмена.

'On Error Resume Next
Dim DShell
Set DShell = CreateObject("WScript.Shell")

cmdTpl = "C:\Progra~1\1Cv77\BIN\1cv7s.exe CONFIG /DF:\Bases\Centr /nАдминистратор /p265042 /@F:\Start\SharedSync.prm"
DShell.Run cmdTpl, 1, True

cmdTpl = "C:\Progra~1\1Cv77\BIN\1cv7s.exe CONFIG /DF:\Bases\FA_SQL /nАдминистратор /p265042 /@F:\Start\SharedSync.prm"
DShell.Run cmdTpl, 1, True

cmdTpl = "C:\Progra~1\1Cv77\BIN\1cv7s.exe CONFIG /DF:\Bases\Centr /nАдминистратор /p265042 /@F:\Start\SharedSync.prm"
DShell.Run cmdTpl, 1, True

Создайте файл пакетного режима работы (файл F:\Start\SharedSync.prm в данном примере).

[General]

AutoExchange=1
Quit=1

[AutoExchange]

SharedMode=1
ReadFrom=*
WriteTo=*

Настройте планировщик задач (Пуск - Программы - Стандартные - Служебные - Назначенные задания) на запуск созданного файла (первого) по расписанию.

------------------------- конец цитаты -----------------------------

------------------------- начало цитаты -----------------------------

Set Shell = WScript.CreateObject("WScript.Shell")

Set ArgObj = WScript.Arguments

Dim CodeIB
Dim pathIB
Dim Work
Dim pathWin

Set FS = CreateObject("Scripting.FileSystemObject")

Set Shell = WScript.CreateObject("WScript.Shell")
Set ArgObj = WScript.Arguments

Dim CodeIB
Dim pathIB
Dim Work
Dim pathWin

Dim path_nameUploadPRM
Dim path_nameUploadLog
Dim path_nameDownloadPRM
Dim path_nameDownloadLog
Dim path_nameFullLog

Dim path1cv7
Dim countBase

InitialsSub
WorkSub

Sub InitialsSub

If ArgObj.Count < 5 Then

WScript.Echo "Использование: Obmen.Center.vbs " 
WScript.Quit (GENERAL_FAILURE)

End If

CodeIB = ArgObj.Item(0)
pathIB = ArgObj.Item(1)
Work = ArgObj.Item(2)
pathWin = ArgObj.Item(3)
countBase = ArgObj.Item(4)

V77CLSID = Shell.RegRead("HKEY_CLASSES_ROOT\V77.Application\CLSID\")
path1cv7 = Shell.RegRead("HKEY_CLASSES_ROOT\CLSID\"&V77CLSID&"\LocalServer32\")

if FS.FolderExists(pathIB)=False Then

WScript.Echo "Указанный каталог информационной базы не существует: "+pathIB
WScript.Quit (GENERAL_FAILURE)

End if

pathPRM = pathIB&"\prm\"

If FS.FolderExists(pathPRM)=False Then

FS.CreateFolder(pathPRM)

End if

If Work = "UPLOAD1" Then

BaseCodeFromDisk

End If

nameUploadPRM = CodeIB & ".Upload.prm"
nameUploadLog = CodeIB & ".Upload.log"
nameDownloadPRM = CodeIB & ".Download.prm"
nameDownloadLog = CodeIB & ".Download.log"
nameFullLog = "Distr.log"

path_nameUploadPRM = pathPRM & nameUploadPRM
path_nameUploadLog = pathPRM & nameUploadLog
path_nameDownloadPRM = pathPRM & nameDownloadPRM
path_nameDownloadLog = pathPRM & nameDownloadLog
path_nameFullLog = pathPRM & nameFullLog

End Sub

Sub WorkSub

'Загрузка из
If Work = "UPLOAD" Then

UploadSub 

ElseIf Work = "DOWNLOAD" Then 

DownloadSub

End If

End Sub

Sub UploadSub

set filestream = FS.OpenTextFile(path_nameUploadPRM,2,1)

filestream.Write(_
"[General]" & vbNewLine & _
"Quit = 1" & vbNewLine & _
"AutoExchange = 1" & vbNewLine & _
"Output= """ & path_nameUploadLog &"""" & vbNewLine & _
"[AutoExchange]" & vbNewLine & _
"SharedMode = Y" & vbNewLine & _
"ReadFrom = " & CodeIB & vbNewLine & _
"")

filestream.Close()

If FS.FileExists(path_nameUploadLog) = True Then

FS.DeleteFile(path_nameUploadLog)

End If

Shell.Run """" & path1cv7 & """ config /d""" & pathIB & """ /NURBD /Purbd /@""" & path_nameUploadPRM & """" , vbNoFocus,True
rem Shell.Run """" C:\Program Files (x86)\1Cv77s\BIN\1cv7s.exe """ config /d""" & pathIB & """ /NURBD /Purbd /@""" & path_nameUploadPRM & """" , vbNoFocus,True

UploadFileName = ""
UploadErrorDescriprion = ""
UploadSucces = 0
UploadFail = 0
sMessage = ""

If FS.FileExists(path_nameUploadLog) = True Then

set filestream = FS.OpenTextFile(path_nameUploadLog,1)

While filestream.AtEndOfStream = False

sLine = filestream.ReadLine()

Ar = Split(sLine,";")
If UBound(Ar)>=7 Then

If Ar(4)="Distr" Then

Sobitie = Ar(5)
If Sobitie="DistUplBeg" Then

UploadFileName = Ar(7)
sMessage = sMessage & "Выполнена попытка загрузки из файла: " & UploadFileName & vbNewLine & vbNewLine

ElseIf Sobitie="DistUplErr" Then

sMessage = sMessage & "Во время загрузки возникла ошибка: " & Ar(7) & vbNewLine & vbNewLine
UploadCodeError = cCur(Ar(6))

ElseIf Sobitie="DistUplFail" Then

UploadFail = cCur(Ar(6))
sMessage = sMessage & "ЗАГРУЗКА НЕ БЫЛА ВЫПОЛНЕНА! " & vbNewLine & vbNewLine

ElseIf Sobitie="DistUplSuc" Then

UploadSucces = cCur(Ar(6))
sMessage = sMessage & "Загрузка успешно завершена! " & vbNewLine & vbNewLine

End If

End If

End if

Wend

filestream.Close()

Else

sMessage = sMessage & "Программа 1С:Предприятие не была запущена! " & vbNewLine & vbNewLine

End If

If UploadSucces = 1 Then

msgbox sMessage, vbOKOnly+vbInformation , "Загрузка выполнена успешно."

ElseIf UploadFail = 1 Then

msgbox sMessage, vbOKOnly + vbCritical , "ЗАГРУЗКА НЕ ВЫПОЛНЕНА !!!"

Else

msgbox sMessage, vbOKOnly + vbExclamation, "Результат работы неизвестен !!!"

End If

End Sub

Sub DownloadSub

set filestream = FS.OpenTextFile(path_nameDownloadPRM,2,1)

filestream.Write(_
"[General]" & vbNewLine & _
"Quit = 1" & vbNewLine & _
"AutoExchange = 1" & vbNewLine & _
"Output= """ & path_nameDownloadLog &"""" & vbNewLine & _
"[AutoExchange]" & vbNewLine & _
"SharedMode = Y" & vbNewLine & _
"WriteTo = " & CodeIB & vbNewLine & _
"")

filestream.Close()

If FS.FileExists(path_nameDownloadLog) = True Then

FS.DeleteFile(path_nameDownloadLog)

End If

Shell.Run """" & path1cv7 & """ config /d""" & pathIB & """ /NURBD /Purbd /@""" & path_nameDownloadPRM & """" , vbNoFocus,True

DownloadFileName = ""
DownloadErrorDescriprion = ""
DownloadSucces = 0
DownloadFail = 0
sMessage = ""

If FS.FileExists(path_nameDownloadLog) = True Then

set filestream = FS.OpenTextFile(path_nameDownloadLog,1)

While filestream.AtEndOfStream=False

sLine = filestream.ReadLine()

Ar = Split(sLine,";")
If UBound(Ar)>=7 Then

If Ar(4)="Distr" Then

Sobitie = Ar(5)

If Sobitie="DistDnldBeg" Then

DownloadFileName = Ar(7)
sMessage = sMessage & "Выполнена попытка выгрузки: " & DownloadFileName & vbNewLine & vbNewLine

ElseIf Sobitie="DistDnldErr" Then

sMessage = sMessage & "Во время выгрузки возникла ошибка: " & Ar(7) & vbNewLine & vbNewLine
DownloadCodeError = cCur(Ar(6))

ElseIf Sobitie="DistDnldFail" Then

DownloadFail = cCur(Ar(6))
sMessage = sMessage & "ВЫГРУЗКА НЕ БЫЛА ВЫПОЛНЕНА! " & vbNewLine & vbNewLine

ElseIf Sobitie="DistDnldSuc" Then

DownloadSucces = cCur(Ar(6))
sMessage = sMessage & "Выгрузка успешно завершена! " & vbNewLine & vbNewLine

End If

End if

End If 

Wend

filestream.Close()

Else

sMessage = sMessage & "Программа 1С:Предприятие не была запущена! " & vbNewLine & vbNewLine

End If

If DownloadSucces = 1 Then

msgbox sMessage, vbOKOnly + vbInformation, "Выгрузка выполнена успешно."

ElseIf DownloadFail = 1 Then

msgbox sMessage, vbOKOnly + vbCritical , "ВЫГРУЗКА НЕ ВЫПОЛНЕНА !!!"

Else

msgbox sMessage, vbOKOnly + vbExclamation, "Результат выгрузки неизвестен !!!"

End If

End Sub

------------------------- конец цитаты -----------------------------

------------------------- начало цитаты -----------------------------

' запись архива на FTP 
   ' сначала подготовим сценарий команд FTP 
   set f = fso.OpenTextFile("c:\ftp_cfg.tmp", 2, 1) 
   ' тут пишем адрес FTP (ftp.domain.com) и номера порта (21, если не сказано другое) 
   f.WriteLine "OPEN ftp.domain.com" 
   ' Ваш аккаунт на FTP. Во второй строчке просто пишется пароль. 
   f.WriteLine "anonymous" 
   f.WriteLine "" 
   ' выбор каталога на FTP сервере, куда сохранять ваш архив 
   f.WriteLine "CD pub"
   f.WriteLine "CD exchange.lutek.ru"
   f.WriteLine "bin"
   ' закачка архива 
   f.WriteLine "SEND " + filename 
   ' завершение сеанса FTP 
   f.WriteLine "BYE" 
   f.Close 
   ' запустим FTP-клиент с только что созданным сценарием 
   sh.Run "FTP -i -v -s:c:\ftp_cfg.tmp",10,1 
   ' удалим сценарий 
   fso.DeleteFile("c:\ftp_cfg.tmp") 

------------------------- конец цитаты -----------------------------

------------------------- начало цитаты -----------------------------

Set FS = CreateObject("Scripting.FileSystemObject")
Set Shell = WScript.CreateObject("WScript.Shell")
Set ArgObj = WScript.Arguments

Dim CodeIB
Dim pathIB
Dim Work
Dim pathWin

Dim path_nameUploadPRM
Dim path_nameUploadLog
Dim path_nameDownloadPRM
Dim path_nameDownloadLog
Dim path_nameFullLog

Dim path1cv7

InitialsSub
WorkSub

Sub InitialsSub

If ArgObj.Count < 3 Then
WScript.Echo "Использование: Obmen.Peref.vbs "
WScript.Quit (GENERAL_FAILURE)
End If

CodeIB = ArgObj.Item(0)
pathIB = ArgObj.Item(1)
Work = ArgObj.Item(2)

V77CLSID = Shell.RegRead("HKEY_CLASSES_ROOT\V77.Application\CLSID\")
path1cv7 = Shell.RegRead("HKEY_CLASSES_ROOT\CLSID\"&V77CLSID&"\LocalServer32\")

If FS.FolderExists(pathIB)=False Then
WScript.Echo "Указанный каталог информационной базы не существует: "+pathIB
WScript.Quit (GENERAL_FAILURE)
End if

pathPRM = pathIB&"\prm\"

If FS.FolderExists(pathPRM)=False Then
FS.CreateFolder(pathPRM)
End if

nameUploadPRM = CodeIB & ".Upload.prm"
nameUploadLog = CodeIB & ".Upload.log"
nameDownloadPRM = CodeIB & ".Download.prm"
nameDownloadLog = CodeIB & ".Download.log"
nameFullLog = "Distr.log"

path_nameUploadPRM = pathPRM & nameUploadPRM
path_nameUploadLog = pathPRM & nameUploadLog
path_nameDownloadPRM = pathPRM & nameDownloadPRM
path_nameDownloadLog = pathPRM & nameDownloadLog
path_nameFullLog = pathPRM & nameFullLog

End Sub

Sub WorkSub

'Загрузка из
If Work = "UPLOAD" Then
UploadSub
ElseIf Work = "DOWNLOAD" Then
DownloadSub
End If

End Sub

Sub UploadSub

set filestream = FS.OpenTextFile(path_nameUploadPRM,2,1)

filestream.Write(_
"[General]" & vbNewLine & _
"Quit = 1" & vbNewLine & _
"AutoExchange = 1" & vbNewLine & _
"Output= """ & path_nameUploadLog &"""" & vbNewLine & _
"[AutoExchange]" & vbNewLine & _
"SharedMode = Y" & vbNewLine & _
"ReadFrom = *" & vbNewLine & _
"")
filestream.Close()

If FS.FileExists(path_nameUploadLog) = True Then
FS.DeleteFile(path_nameUploadLog)
End If
Shell.Run """" & path1cv7 & """ config /d""" & pathIB & """ /NURBD /Purbd /@""" & path_nameUploadPRM & """" , vbNoFocus,True
UploadFileName = ""
UploadErrorDescriprion = ""
UploadSucces = 0
UploadFail = 0
sMessage = ""

If FS.FileExists(path_nameUploadLog) = True Then

set filestream = FS.OpenTextFile(path_nameUploadLog,1)

While filestream.AtEndOfStream = False

sLine = filestream.ReadLine()

Ar = Split(sLine,";")
If UBound(Ar)>=7 Then
If Ar(4)="Distr" Then

Sobitie = Ar(5)
If Sobitie="DistUplBeg" Then
UploadFileName = Ar(7)
sMessage = sMessage & "Выполнена попытка загрузки из файла: " & UploadFileName & vbNewLine & vbNewLine
ElseIf Sobitie="DistUplErr" Then
sMessage = sMessage & "Во время загрузки возникла ошибка: " & Ar(7) & vbNewLine & vbNewLine
UploadCodeError = cCur(Ar(6))
ElseIf Sobitie="DistUplFail" Then
UploadFail = cCur(Ar(6))
sMessage = sMessage & "ЗАГРУЗКА НЕ БЫЛА ВЫПОЛНЕНА! " & vbNewLine & vbNewLine
ElseIf Sobitie="DistUplSuc" Then
UploadSucces = cCur(Ar(6))
sMessage = sMessage & "Загрузка успешно завершена! " & vbNewLine & vbNewLine
End If

End If

End if

Wend

filestream.Close()

Else
sMessage = sMessage & "Программа 1С:Предприятие не была запущена! " & vbNewLine & vbNewLine
End If

If UploadSucces = 1 Then
msgbox sMessage, vbOKOnly+vbInformation , "Загрузка выполнена успешно."
ElseIf UploadFail = 1 Then
msgbox sMessage, vbOKOnly + vbCritical , "ЗАГРУЗКА НЕ ВЫПОЛНЕНА !!!"
Else
msgbox sMessage, vbOKOnly + vbExclamation, "Результат работы неизвестен !!!"
End If

End Sub

Sub DownloadSub

set filestream = FS.OpenTextFile(path_nameDownloadPRM,2,1)

filestream.Write(_
"[General]" & vbNewLine & _
"Quit = 1" & vbNewLine & _
"AutoExchange = 1" & vbNewLine & _
"Output= """ & path_nameDownloadLog &"""" & vbNewLine & _
"[AutoExchange]" & vbNewLine & _
"SharedMode = Y" & vbNewLine & _
"WriteTo = *" & vbNewLine & _
"SendTo = *" & vbNewLine & _
"")

filestream.Close()

If FS.FileExists(path_nameDownloadLog) = True Then
FS.DeleteFile(path_nameDownloadLog)
End If

Shell.Run """" & path1cv7 & """ config /d""" & pathIB & """ /NURBD /Purbd /@""" & path_nameDownloadPRM & """" , vbNoFocus,True

DownloadFileName = ""
DownloadErrorDescriprion = ""
DownloadSucces = 0
DownloadFail = 0
sMessage = ""

If FS.FileExists(path_nameDownloadLog) = True Then

set filestream = FS.OpenTextFile(path_nameDownloadLog,1)

While filestream.AtEndOfStream=False
sLine = filestream.ReadLine()

Ar = Split(sLine,";")
If UBound(Ar)>=7 Then
If Ar(4)="Distr" Then

Sobitie = Ar(5)
If Sobitie="DistDnldBeg" Then
DownloadFileName = Ar(7)
sMessage = sMessage & "Выполнена попытка выгрузки: " & DownloadFileName & vbNewLine & vbNewLine
ElseIf Sobitie="DistDnldErr" Then
sMessage = sMessage & "Во время выгрузки возникла ошибка: " & Ar(7) & vbNewLine & vbNewLine
DownloadCodeError = cCur(Ar(6))
ElseIf Sobitie="DistDnldFail" Then
DownloadFail = cCur(Ar(6))
sMessage = sMessage & "ВЫГРУЗКА НЕ БЫЛА ВЫПОЛНЕНА! " & vbNewLine & vbNewLine
ElseIf Sobitie="DistDnldSuc" Then
DownloadSucces = cCur(Ar(6))
sMessage = sMessage & "Выгрузка успешно завершена! " & vbNewLine & vbNewLine
End If

End if

End If

Wend

filestream.Close()

Else
sMessage = sMessage & "Программа 1С:Предприятие не была запущена! " & vbNewLine & vbNewLine
End If

If DownloadSucces = 1 Then
msgbox sMessage, vbOKOnly + vbInformation, "Выгрузка выполнена успешно."
ElseIf DownloadFail = 1 Then
msgbox sMessage, vbOKOnly + vbCritical , "ВЫГРУЗКА НЕ ВЫПОЛНЕНА !!!"
Else
msgbox sMessage, vbOKOnly + vbExclamation, "Результат выгрузки неизвестен !!!"
End If

End Sub

------------------------- конец цитаты -----------------------------