В 10-версии SET Retail разработчики сделали мультиплатформенную среду, способную работать как на Windows, так и на Linux. Обмен данными осуществляется через XML файлы и до недавнего времени (пока не вышел последний адейт) S-market не мог работать c 10-м SET-ом.
Поэтому, для получения возможности загружать товары на кассы SET Retail была придумана следующая программа:
On Error Resume Next ' Отключение реакции на ошибки
'===========================
Set WshShell = CreateObject("WScript.Shell") ' Подключаемся к шелу операционки
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(WshShell.CurrentDirectory) ' Определение рабочей папки
Set objFolderItem = objFolder.Self
Set objFSO = CreateObject("Scripting.FileSystemObject") ' Подключаемся к файловой системе
udlFile="sm.udl" ' Файл подключения к БД S-marketa через драйвер ODBC
PathF = objFolderItem.Path
iniFilePath=PathF & "\cash.ini" ' Имя файла настроек
Set objArgs = WScript.Arguments ' Параметры командной строки, здесь - интервал загрузки в днях
For I = 0 to objArgs.Count - 1
arg=objArgs(I)
Next
if arg="" then
LoadInterval=InputBox ("Загрузка измененных карточек. введите количество дней. По умолчанию 30 дней.", "Загрузка касс XML","30") 'Количество дней
if LoadInterval="" then wscript.quit ' Если аргумент пустой, спрашиваем у пользователя
Else
LoadInterval=Clng(arg)
end if
'===========================
strFilePath = PathF & "" & udlFile 'Читаем файл подключения
Const For_Reading = 1
Const Tristate_True = -1
Set objTS = objFSO.OpenTextFile(strFilePath, For_Reading, False, Tristate_True)
objTS.SkipLine
objTS.SkipLine
Udlread=objTS.Readline
Set DBConn = CreateObject("ADODB.Connection")
DBConn.Open(Udlread) 'Пробуем подключится
oneFilePath = INIread(2) ' Путь к 1 фалу для 1-й кассы
twoFilePath = INIread(4) ' Путь к 1 фалу для 2-й кассы
Set oneXMLfile = objFSO.CreateTextFile(oneFilePath, true, true)
Set twoXMLfile = objFSO.CreateTextFile(twoFilePath, true, true)
oneXMLfile.Write "<?xml version="+Chr(34)+"1.0"+Chr(34)+" encoding="+Chr(34)+"UTF-8"+Chr(34)+" standalone="+Chr(34)+"no"+Chr(34)+"?>"+vbCRlf+"<goods-catalog>"+vbCRlf
twoXMLfile.Write "<?xml version="+Chr(34)+"1.0"+Chr(34)+" encoding="+Chr(34)+"UTF-8"+Chr(34)+" standalone="+Chr(34)+"no"+Chr(34)+"?>"+vbCRlf+"<goods-catalog>"+vbCRlf
Dim ValuesXML(11) ' Массив, для хранения данных запроса.
CardsData="select " &_
" classif.name_classif, " &_
" classif.id_classif, " &_
" classif.parent_classif, " &_
" cardscla.articul, " &_
" cardscla.name, " &_
" mesuriment.name_mesuriment, " &_
" country.name_country, " &_
" mesuriment.quantity_mesurim, " &_
" country.id_country, " &_
" disccard.price_rub, " &_
" cardscla.place_index, " &_
" mesuriment.id_mesuriment " &_
" from cardscla " &_
" inner join disccard on (cardscla.articul = disccard.articul) " &_
" left outer join classif on (cardscla.classif = classif.id_classif) " &_
" left outer join mesuriment on (cardscla.mesuriment = mesuriment.id_mesuriment) " &_
" left outer join country on (cardscla.country = country.id_country) " &_
" where disccard.price_kind=0 and disccard.moddate>'"+Cstr(now-LoadInterval)+"'"
' Запрос возвращает необходимые для загрузки касс данные. Количество дней для загрузки определяется датой изменения цены.
Set DBCards=DBConn.Execute(CardsData)
if not(DBCards.EOF) then
While not DBCards.EOF
For i=0 To DBCards.Fields.Count-1
if isNull(DBCards.Fields(i).Value) then
ValuesXML(i)="NULL"
Else
ValuesXML(i)=Cstr(DBCards.Fields(i).Value)
end if
Next
GoodsXML="<good marking-of-the-good="+Chr(34)+ValuesXML(3)+Chr(34)+">"+vbCRlf+"<shop-indices>2</shop-indices>"
GoodsXML=GoodsXML+"<name>"+Cstr(DBCards(4).Value)+"</name>"+vbCRlf
BcodData="select bar.barcode from bar where articul='"+Cstr(DBCards(3).Value)+"'"
Set DBbars=DBConn.Execute(BcodData) ' Требуется выяснить все штрихкоды для карточки
While not DBbars.EOF
if isNull(DBbars(0).Value) then
barcode="NULL"
Else
barcode=DBbars(0).Value
end if
GoodsXML=GoodsXML+"<bar-code code="+Chr(34)+barcode+Chr(34)+">"+vbCRlf+"<price-entry price="+Chr(34)+ValuesXML(9)+Chr(34)+"/>"+vbCRlf+"<count>1.00</count>"+vbCRlf+"</bar-code>"
DBbars.movenext
Wend
GoodsXML=GoodsXML+"<product-type>ProductPieceEntity</product-type>"+vbCRlf
GoodsXML=GoodsXML+"<price-entry price="+Chr(34)+ValuesXML(9)+Chr(34)+">"+vbCRlf+"<number>1</number>"+vbCRlf
GoodsXML=GoodsXML+"<begin-date>2013-05-07T00:00:00.000</begin-date>"+vbCRlf+"<end-date>2061-05-07T23:59:59.000</end-date>"+vbCRlf
GoodsXML=GoodsXML+"<department number="+Chr(34)+"1"+Chr(34)+">"+vbCRlf+"<name>1</name>"+vbCRlf+"</department>"+vbCRlf
GoodsXML=GoodsXML+"</price-entry>"+vbCRlf+"<vat>0.00</vat>"+vbCRlf+"<group id="+Chr(34)+ValuesXML(1)+Chr(34)+">"+vbCRlf
GoodsXML=GoodsXML+"<name>"+ValuesXML(0)+"</name>"+vbCRlf+"<parent-group id="+Chr(34)+ValuesXML(2)+Chr(34)+"/>"+vbCRlf
GoodsXML=GoodsXML+"</group>"+vbCRlf+"<measure-type id="+Chr(34)+ValuesXML(11)+Chr(34)+">"+vbCRlf
GoodsXML=GoodsXML+"<name>"+ValuesXML(5)+"</name>"+vbCRlf+"</measure-type>"+vbCRlf
GoodsXML=GoodsXML+"<country id="+Chr(34)+ValuesXML(8)+Chr(34)+">"+vbCRlf+"<name>"+ValuesXML(6)+"</name>"+vbCRlf
GoodsXML=GoodsXML+"</country>"+vbCRlf+"</good>"+vbCRlf
' Заполняем файл записями из сапроса с XML тегами
oneXMLfile.Write GoodsXML
twoXMLfile.Write GoodsXML
DBCards.movenext
Wend
end if
oneXMLfile.Close
twoXMLfile.Close
If Err.Number = 0 Then
Else
msgbox "Ошибка №" & Cstr(Err.Number) & vbCRlf & Err.Description,vbCRlfitical, "Касса не загружена"
msgbox GoodsXML
wscript.quit
End If
Msgbox "Кассы загружены", vbInformation, "Готово"
Function INIread(iLineNumber)' Чтение файла настроек по номеру строки
Set objTSini = objFSO.OpenTextFile(iniFilePath, 1)
For i=1 To (iLineNumber-1)
objTSini.SkipLine
Next
INIread=objTSini.Readline
End Function
#Касса №1
g:\vbs\set10\catalog-goods_01.xml
#Касса №2
g:\vbs\set10\catalog-goods_02.xml
Новые комментарии