Тема: VBScript: Функция докачки файла
Качаем файлик mdb из одной части города в другую, инет плохой идет постоянный разрыв,
подскажите можно как то докачивать его скриптом ?
вот чем копирую сейчас
'скрипт автоматического копирования файлов
pType = "sklad"
StartFolder = "\\sklad\PR" ' откуда копируем
EndFolder = "\\skull\Data\Install\SMB\" ' куда копируем
'***********************************************
Set StartFiles = CreateObject("Scripting.FileSystemObject")
Set WSNetwork = CreateObject("WScript.Network")
num = 0
'копируем файлы
on error resume next
dim errorString, tmpstr, mailtext
dim ErrorNumber : ErrorNumber=0
set FilesList = StartFiles.GetFolder(StartFolder).Files
For Each File in FilesList
If LCase(StartFiles.GetExtensionName(File)) = "mdb" Then
tmpstr = GetDateFormat(Cdate(Now()), "YMDHMS")
tmpstr = AddToFname(File.Name, tmpstr, pType)
StartFiles.CopyFile File, EndFolder & tmpstr, True
num = num+1
End If
If Err.Number<>0 Then
errorString = errorString & "Ошибка копирования файла: " & File & vbnewline
ErrorNumber = ErrorNumber + 1
Err.Clear
end if
Next
on error goto 0
'сообщаем о результатах копирования
If ErrorNumber>0 Then
mailtext = errorString & "Обновление SKLAD прошло с ошибками. Сообщите об этом администратору."
else
mailtext = "Обновление файлов SKLAD прошло успешно. Скопировано " & num & " файлов."
End if
SendToSMTPRUS "mail.ru", "xxx@yyy.ru", "xxx@yyy.ru", "", "XA xa " & Now(), mailtext, ""
function GetDateFormat(NowDate, DateFormatStr)
Dim m_Day, m_Month, m_Year, m_Hour, m_Minute, m_Second
if Day(NowDate)<10 then m_Day=Cstr("0"&Day(NowDate)) else m_Day=Cstr(Day(NowDate)) end if
if Month(NowDate)<10 then m_Month=Cstr("0"&Month(NowDate)) else m_Month=Cstr(Month(NowDate)) end if
m_Year = cstr(Year(NowDate))
if Hour(NowDate)<10 then m_Hour="0"&Hour(NowDate) else m_Hour=Hour(NowDate) end if
if Minute(NowDate)<10 then m_Minute="0"&Minute(NowDate) else m_Minute=Minute(NowDate) end if
if Second(NowDate)<10 then m_Second="0"&Second(NowDate) else m_Second=Second(NowDate) end if
select case DateFormatStr
case "YMD": GetDateFormat = m_Year&m_Month&m_Day
case "MYD": GetDateFormat = m_Month&m_Year&m_Day
case "DMY": GetDateFormat = m_Day&m_Month&m_Year
case "YMDHMS": GetDateFormat = m_Year&m_Month&m_Day&m_Hour&m_Minute&m_Second
case "MYDHMS": GetDateFormat = m_Month&m_Year&m_Day&m_Hour&m_Minute&m_Second
case "DMYHMS": GetDateFormat = m_Day&m_Month&m_Year&m_Hour&m_Minute&m_Second
case else : GetDateFormat = m_Year&m_Month&m_Day
end select
End function
function AddToFname(fname, iStr, suf)
Dim regEx, mth, sReplStr
Set regEx = New RegExp
regEx.Pattern = "\.[a-zа-я]{1,}$"
regEx.IgnoreCase = true
regEx.Global = true
if regEx.Test(fname) then
Set mth = regEx.Execute(fname)
sReplStr = "_" & suf & "_" & iStr & mth.Item(0).value
AddToFname = regEx.Replace(fname, sReplStr)
else
AddToFname = fname & "_" & suf & "_" & iStr
end if
End function
Function SendToSMTPRUS(server, FromAdr, ToAdr, CcAdr, Subject, Body, Fname)
dim SmtpRus, fso
Set SmtpRus = CreateObject("smtprus.smtprus.1")
'SmtpRus.Host = "pop3"
SmtpRus.Host = server
'SmtpRus.Port = Request.Form("port")
SmtpRus.From = FromAdr
SmtpRus.To = ToAdr
SmtpRus.Cc = CcAdr
'SmtpRus.Bcc = ""
'SmtpRus.Charset = ""
'SmtpRus.AdditionalHeader = ""
SmtpRus.Subject = Subject
SmtpRus.Body = Body
if trim(Fname & "")<>"" then
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists( trim(Fname & "") ) Then
SmtpRus.Attach = trim(Fname & "")
end if
Set fso = Nothing
end if
SmtpRus.SendLetter
SendToSMTPRUS = SmtpRus.ErrorCode
Set SmtpRus=Nothing
End Function
