*:*********************************************************************
*: Pogram: Server pro vycepy Novotny
*:*********************************************************************
param gcini_file

SET ENGINEBEHAVIOR 70
if param() = 0
    if empt( getenv("FoodServCfg") )
        gcini_file = "i:\foodserv.ini"
    else
        gcini_file = getenv("FoodservCfg")
    endif
ELSE
  m.gcini_file = ALLTRIM(m.gcini_file)
endif
CLEAR
gio_scrwidth = _screen.width
gio_scrheight = _screen.height
gio_scrcapt   = _screen.Caption 



declare integer GetPrivateProfileString in Win32API  as GetPrivStr ;
    string cSection, string cKey, string cDefault, string @cBuffer, integer nBufferSize, string cINIFile

declare integer WritePrivateProfileString in Win32API as WritePrivStr ;
    string cSection, string cKey, string cValue, string cINIFile

DECLARE INTEGER GetSystemMetrics IN user32;
    INTEGER nIndex

DECLARE INTEGER ShowWindow IN user32; 
    INTEGER hwnd,; 
    INTEGER nCmdShow

gcTypZarizeni = ALLTRIM(get_ini("Config", "TypZarizeni"))
gcini_path    = ALLTRIM(get_ini("Config", "IniPath"))
gchom_path    = ALLTRIM(get_ini("Config", "HomPath"))
gchom_path2   = ALLTRIM(get_ini("Config", "HomPath2"))
gchom_path3   = ALLTRIM(get_ini("Config", "HomPath3"))
gccen_path    = ALLTRIM(get_ini("Config", "CenPath"))
gckas_path    = ALLTRIM(get_ini("Config", "KasPath"))
gckas_kmen    = ALLTRIM(get_ini("Config", "KasKmen"))
gcid_master   = ALLTRIM(get_ini("Config", "id_master"))
m.gcImportSkeleton = ALLTRIM(get_ini("Config", "ImportSkeleton"))
m.gcImportSekund = VAL(ALLTRIM(get_ini("Config", "ImportSekund")))
gcTypSluzby   = ALLTRIM(get_ini("Config", "TypSluzby"))
gccollate     = ALLTRIM(get_ini("Config", "Collate"))
gcdefa_font   = ALLTRIM(get_ini("Config", "DefaultFont1"))
gcdefa_font2  = ALLTRIM(get_ini("Config", "DefaultFont2"))
gcIDMisto     = ALLTRIM(get_ini("Config", "IDMisto"))
gcHraniceDne  = ALLTRIM(get_ini("Config", "HraniceDne"))
gchk_ignore   = VAL(ALLTRIM(get_ini("Config", "PocetIgnorovanychZnaku")))
gchk_valid    = VAL(ALLTRIM(get_ini("Config", "PocetPlatnychZnaku")))
gcHk_ChkChar  = ALLTRIM(get_ini("Config", "KontrolniZnak"))
gcDelkaKodu   = VAL(ALLTRIM(get_ini("Config", "DelkaKodu")))
gcmindodch    = VAL(ALLTRIM(get_ini("Config", "MinDobaSekund")))
gcPrinterNumber = ALLTRIM(get_ini("Config", "PrinterNumber"))
gcPrichodOdchodButts=UPPER(ALLTRIM(get_ini("Config", "PrichodOdchodButt")))
gcPrichodOdchodButt = IIF(INLIST(gcPrichodOdchodButts,"ANO","YES"), .T., .F.)
gcCheckIfRunnings = UPPER(ALLTRIM(get_ini("Config", "CheckIfRunning")))
gcCheckIfRunning = IIF(INLIST(gcCheckIfRunnings,"ANO","YES"), .T., .F.)
gcis_zurnals = UPPER(ALLTRIM(get_ini("Config", "KomunikaceDoZurnalu")))
gcis_zurnal = IIF(INLIST(gcis_zurnals,"ANO","YES"), .T., .F.)
gcTest       = IIF(INLIST(get_ini("Config", "Simulace"),"ANO", "YES"), .T., .F.)
gcNoLeadZeros = IIF(INLIST(get_ini("Config", "PokojBezNul"),"ANO", "YES"), .T., .F.)
gcNotUseAck = IIF(INLIST(get_ini("Config", "NepouzivatACK"),"ANO", "YES"), .T., .F.)
gcNotUseCheckSum = IIF(INLIST(get_ini("Config", "NepouzivatCheckSum"),"ANO", "YES"), .T., .F.)
gcLanguage = ALLTRIM(get_ini("Config", "Language"))
gcLcdPrnName = ALLTRIM(get_ini("Config", "LcdPrnName"))
gcLcdTyp = ALLTRIM(get_ini("Config", "LcdTyp"))
m.gcSouborDta = ALLTRIM(get_ini("Config", "SouborDta"))
m.gcSouborDta = IIF(EMPTY(m.gcSouborDta), "cesk_dta.dbf", m.gcSouborDta)
m.gcStredSkup = ALLTRIM(get_ini("Config", "StredSkup"))
m.hores_http_logovat = IIF(INLIST(get_ini("Config", "hores_http_logovat"),"ANO", "YES"), .T., .F.)
*
gcreadertype  = ALLTRIM(get_ini("Reader", "ReaderType"))
gcreadercode  = ALLTRIM(get_ini("Reader", "ReaderCoding"))
gccomm        = VAL(ALLTRIM(get_ini("Reader", "RComm")))
gcbaud        = VAL(ALLTRIM(get_ini("Reader", "RBaud")))
gcParity      = VAL(ALLTRIM(get_ini("Reader", "RParity")))
gcDatbit      = VAL(ALLTRIM(get_ini("Reader", "RDatBit")))
gcStopBit     = VAL(ALLTRIM(get_ini("Reader", "RStopBit")))
gcEndChar     = VAL(ALLTRIM(get_ini("Reader", "EndChar")))
gcRTSValStr   = ALLTRIM(get_ini("Reader", "RTSValue"))
gcDTRValStr   = ALLTRIM(get_ini("Reader", "DTRValue"))
gcScrWidths   = ALLTRIM(get_ini("Windows", "ScreenWidth"))
gcScrHeights  = ALLTRIM(get_ini("Windows", "ScreenHeight"))
gcScrWidth    = VAL(ALLTRIM(gcScrWidths))
gcScrHeight   = VAL(ALLTRIM(gcScrHeights))
*
gcLclPort     = ALLTRIM(get_ini("Turniket", "LocalPort"))
gcRemAddr     = ALLTRIM(get_ini("Turniket", "RemoteAdresa"))
gcRemPort     = ALLTRIM(get_ini("Turniket", "RemotePort"))
gcIdVstup     = ALLTRIM(get_ini("Turniket", "IdentifikaceVstup"))
gcIdVystup    = ALLTRIM(get_ini("Turniket", "IdentifikaceVystup"))
gcMaxPokVst   = VAL(ALLTRIM(get_ini("Turniket", "MaxPokusuVstup")))
gcTOutVstup   = VAL(ALLTRIM(get_ini("Turniket", "TimeoutBlokVstupSek")))
gcZonaTurniket= ALLTRIM(get_ini("Turniket", "ZonaTurniket"))
gcZonyDefault = ALLTRIM(get_ini("Turniket", "ZonyDefault"))
*
gcZpusob      = ALLTRIM(get_ini("Kredit", "WayOfDispense"))
gcid_sez      = ALLTRIM(get_ini("Kredit", "POSList"))
gcArchCas     = ALLTRIM(get_ini("Kredit", "WhenArchive"))
gcStulDebetni = VAL(ALLTRIM(get_ini("Kredit", "StulDebetni")))
*
gcVelFontuHlaseni   = VAL(ALLTRIM(get_ini("Zurnal", "VelikostFontu")))
gcMaxDelkaHlaseni   = VAL(ALLTRIM(get_ini("Zurnal", "MaxDelkaRadkuHlaseni")))
gcPocRadkuHlaseni   = VAL(ALLTRIM(get_ini("Zurnal", "PocetRadkuHlaseni")))
m.gcStulFilterTimeout = VAL(ALLTRIM(get_ini("Zurnal", "StulFilterTimeout")))
*IF m.gcStulFilterTimeout = 0
  m.gcStulFilterTimeout = 30000
*ENDIF 

gcMonitorKuchynVlevo = VAL(ALLTRIM(get_ini("KuchynMonitor", "MonitorKuchynVlevo")))
gcMonitorKuchynSirka = VAL(ALLTRIM(get_ini("KuchynMonitor", "MonitorKuchynSirka")))
gcMonitorKuchynVyska = VAL(ALLTRIM(get_ini("KuchynMonitor", "MonitorKuchynVyska")))
gcMonitorZakazniciSirka = VAL(ALLTRIM(get_ini("KuchynMonitor", "MonitorZakazniciSirka")))
gcMonitorZakazniciVyska = VAL(ALLTRIM(get_ini("KuchynMonitor", "MonitorZakazniciVyska")))
m.gcSouborMonitorKuchyn = ALLTRIM(get_ini("KuchynMonitor", "SouborMonitorKuchyn"))
m.gcSouborMonitorKuchyn = IIF(EMPTY(m.gcSouborMonitorKuchyn), "kuchyn.dbf", m.gcSouborMonitorKuchyn)
m.gcPoPolozkachs = UPPER(ALLTRIM(get_ini("KuchynMonitor", "VyberPoPolozkach")))
m.gcPoPolozkach = IIF(INLIST(m.gcPoPolozkachs,"ANO","YES"), .T., .F.)
m.gcTypZobrazeni = ALLTRIM(get_ini("KuchynMonitor", "TypZobrazeni"))
m.gcZobrazeneBonovky = ALLTRIM(get_ini("KuchynMonitor", "ZobrazeneBonovky"))
m.gcSouborObrazekHlavicka = ALLTRIM(get_ini("KuchynMonitor", "SouborObrazekHlavicka"))
IF EMPTY(m.gcSouborObrazekHlavicka) OR !FILE(m.gcSouborObrazekHlavicka)
	m.gcSouborObrazekHlavicka = ADDBS(m.gcIni_Path)+"BITMAPS\OBRAZEK_HLAVICKA.JPG"
ENDIF 

gcVariantaZakaznik = ALLTRIM(get_ini("Vydej", "VariantaZakaznik"))
gnCisloJidla = VAL(ALLTRIM(get_ini("Vydej", "CisloJidla")))
gcZacatekSnidane = ALLTRIM(get_ini("Vydej", "ZacatekSnidane"))
gcZacatekObed = ALLTRIM(get_ini("Vydej", "ZacatekObed"))
gcZacatekVecere = ALLTRIM(get_ini("Vydej", "ZacatekVecere"))
gcWebObjAdresa = ALLTRIM(get_ini("Vydej", "WebObjAdresa"))
gnIdCanteen = VAL(ALLTRIM(get_ini("Vydej", "CisloJidelny")))

glUpdateDSFiles = IIF(INLIST(get_ini("Vydej", "UpdateJidelak"),"ANO","YES"), .T., .F.)

m.gcPocetMonitoru = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "PocetMonitoru")))
m.gcPocetMonitoru = IIF(EMPTY(m.gcPocetMonitoru), 2, m.gcPocetMonitoru)
m.gcCisloVidea = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "CisloVidea")))
m.gcCisloVidea = IIF(EMPTY(m.gcCisloVidea), 1, m.gcCisloVidea)
m.gcNazevVidea = ALLTRIM(get_ini("BumpbarKuchyn", "NazevVidea"))
m.gcNazevVidea = IIF(EMPTY(m.gcNazevVidea), "Teplá", m.gcNazevVidea)
m.gcLevaSouradniceVidea = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "LevaSouradniceVidea")))
m.gcLevaSouradniceVidea = IIF(EMPTY(m.gcLevaSouradniceVidea), 0, m.gcLevaSouradniceVidea)
m.gcSirkaVidea = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "SirkaVidea")))
m.gcSirkaVidea = IIF(EMPTY(m.gcSirkaVidea), 1600, m.gcSirkaVidea)
m.gcVyskaVidea = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "VyskaVidea")))
m.gcVyskaVidea = IIF(EMPTY(m.gcSirkaVidea), 800, m.gcVyskaVidea)
m.gcZvukObjednavky = ALLTRIM(get_ini("BumpbarKuchyn", "SouborZvukuObjednavky"))
*m.gcZvukObjednavky = IIF(EMPTY(m.gcZvukObjednavky), ADDBS(GETENV('windir'))+"MEDIA\ALTO.WAV", ADDBS(GETENV('windir'))+"MEDIA\"+m.gcZvukObjednavky)
m.gcZvukObjednavky = IIF(EMPTY(m.gcZvukObjednavky), ADDBS(m.gcIni_Path)+"ZVUKY\ALTO.WAV", ADDBS(m.gcIni_Path)+"ZVUKY\"+m.gcZvukObjednavky)
m.gcSouborKuchyn = ALLTRIM(get_ini("BumpbarKuchyn", "SouborKuchyn"))
m.gcSouborKuchyn = IIF(EMPTY(m.gcSouborKuchyn), "kuchyn.dbf", m.gcSouborKuchyn)
m.gcPozadiSolari = ALLTRIM(get_ini("BumpbarKuchyn", "PozadiSolari"))
m.gcPozadiSolari = IIF(!EMPTY(m.gcPozadiSolari), m.gcini_path+"bitmaps\"+m.gcPozadiSolari, "")
m.gcBarvaPismaSolari = RGB(255,255,255)		&& Default bílá
m.localPathRoot = ""
IF FILE(m.gcPozadiSolari)
  IF "skrabane_pozadi" $ LOWER(m.gcPozadiSolari)
    m.gcBarvaPismaSolari = RGB(128,64,0)
  ELSE 
    m.gcBarvaPismaSolari = ALLTRIM(get_ini("BumpbarKuchyn", "BarvaPismaSolari")) && text ve tvaru RGB(x,y,z)
    m.gcBarvaPismaSolari = &gcBarvaPismaSolari
  ENDIF 
ENDIF 
m.gcPocetSekundSolari = VAL(ALLTRIM(get_ini("BumpbarKuchyn", "PocetSekundSolari")))
IF m.gcPocetSekundSolari = 0
  m.gcPocetSekundSolari = 300		&& 300 sekund do vyrizeni objednavky
ENDIF 
m.gcModifikaceZobrazeni = ALLTRIM(get_ini("BumpbarKuchyn", "ModifikaceZobrazeni"))
m.gcPrefix = ALLTRIM(get_ini("Fidelio", "PrefixRecepce"))
*** JQ Zacatek FULL SQL

m.isPOSsql = .F.
m.isPOSsql = get_ini("Config", "POSSQL")
DO CASE
CASE INLIST(LOWER(m.isPOSsql),"1",".t.","t","a","y","2")
	m.isPOSsql=.T.
CASE INLIST(LOWER(m.isPOSsql),"0",".f.","f","n")
	m.isPOSsql=.F.
OTHERWISE
	m.isPOSsql=.F.
ENDCASE
*** JQ Konec FULL SQL



#DEFINE HCRLF CHR(13)+CHR(10)

*_screen.ForeColor = RGB(255,0,128)	&& cervena



m.gcSouborUctenkyCCTV = ALLTRIM(get_ini("CCTV", "SouborUctenekProZurnal"))

IF EMPTY(gcRTSValStr)
  gcRTSVal = 1
ELSE
  gcRTSVal = VAL(gcRTSValStr)
  IF !INLIST(gcRTSVAl, 0, 1)
    gcRTSVal = 1
  ENDIF 
ENDIF 
IF EMPTY(gcDTRValStr)
  gcDTRVal = 1
ELSE
  gcDTRVal = VAL(gcDTRValStr)
  IF !INLIST(gcDTRVAl, 0, 1)
    gcDTRVal = 1
  ENDIF 
ENDIF 

IF EMPTY(m.gcVelFontuHlaseni)
  m.gcVelFontuHlaseni = 15
ENDIF 
IF EMPTY(m.gcMaxDelkaHlaseni)
  m.gcMaxDelkaHlaseni = 70
ENDIF 
IF EMPTY(m.gcPocRadkuHlaseni)
  m.gcPocRadkuHlaseni = 25
ENDIF 

m.hk_url = ALLTRIM(get_ini("Datastore", "DatastoreAdresa"))
m.datastore_pwd = ALLTRIM(get_ini("Datastore", "DatastoreJmenoHeslo"))

*gcMaxDobaPruchod = 120
*gcMaxDobaPruchod = VAL(get_ini("Turniket", "MaxDobaPruchod"))

m.STX = 2
m.ETX = 3
m.ACK = 6
m.NAK = 21		&& tady byla chyba - NAK prohozeno s ENQ
m.ENQ = 5
m.ct_eof = -1

*LCTITLE = "Dispensing machine Server"
LCTITLE = IIF(!EMPTY(gcTypZarizeni), gcTypZarizeni, "Accessories Server")
DECLARE INTEGER FindWindow ;
	IN USER32 STRING@, STRING@
IF FindWindow(NULL,LCTITLE)#0
	MESSAGEBOX("Server already runs!",64,"",2000)
    DO shut_dn
	*Cancel
ELSE
	_SCREEN.CAPTION = LCTITLE
	WAIT wind time 0.2 "Checking duplicate launch..."
ENDIF


IF EMPTY(gcini_path)
  MESSAGEBOX("Není nastavena proměná IniPath !",64,"",5000)
  DO shut_dn
ENDIF 

IF ADIR(abc,gcIni_Path, "D") = 0
  MESSAGEBOX("Neexistuje nebo není přístupný adresář "+gcIni_Path, 64, "", 5000)
  DO shut_dn
ENDIF  

on error do err_hand with error(), message(), message(1), line()

ON SHUTDOWN do shut_dn2


STORE "" TO m.gcpri_path, m.machine
m.gcdefapath = SET("default")
set defa to (m.gcini_path)

set path to progs, forms, libs, data, other, reports, include, help, bitmaps, texty
set classlib to "_app" addi
on error do err_hand with error(), message(), message(1), line()

SET PROCEDURE TO wwUtils   ADDITIVE
SET PROCEDURE TO wwAPI     ADDITIVE
*!*	SET CLASSLIB  TO wwIPStuff ADDITIVE

*systolb = createobject ('_systoolbars', .t.)

SET PROCEDURE TO cDataSrc ADDITIVE 
*
IF m.isPOSSql
	m.sqlPOSConnecstring = sql_ini("POSSQL", "SQL POS Spojeni")
	IF EMPTY(m.sqlPOSConnecstring)
		m.isPOSSql = .F. 
		=MESSAGEBOX("Nenastavené připojení na sql server pro interface!"+CHR(10)+CHR(13)+"Program bude ukončen.", 0+48, "Informace pro obsluhu")
  		DO shut_dn
	ENDIF
	IF m.isPOSSql
		PUBLIC oDataSrcPOS
		oDataSrcPOS = .NULL.
		IF !createDataConection(IIF(m.isPOSSql, "ODBC", "FREETABLE"), IIF(m.isPOSSql, m.sqlPOSConnecstring, m.hom_path), "food600", @oDataSrcPOS)
			m.isPOSSql = .F.
			=MESSAGEBOX("Selhalo připojení na sql server pro interface!"+CHR(10)+CHR(13)+"Program bude ukončen.", 0+48, "Informace pro obsluhu")
  			DO shut_dn
		ELSE
			m.lcprikaz = "CREATE SCHEMA IF NOT EXISTS food600;"
			m.iii = SQLEXEC(oDataSrcPOS.ndatasource, m.lcprikaz)
		ENDIF 
	ENDIF 
ENDIF 
*
IF !EMPTY(m.hk_url)		&& Fitko datastore jen pro sluzby na turniket!!
    m.libname = m.gcini_path+"LIBS\JSON.FLL"      && Json
    SET LIBRARY TO &libname ADDITIVE
	m.http_logovat = .T.
	m.http_auth_token = "x"
	IF EMPTY(m.datastore_pwd)
		m.datastore_pwd = "1991.Altopraha"
	ENDIF 
  	DO http_ppgm_n WITH m.hk_url, m.datastore_pwd
ENDIF 


do ini_set
DO GetPriPath
do del_pripath with m.gcpri_path
DO mk_dir WITH m.gcpri_path

DO FORM licence

CLEA TYPE
m.last_uzav = DATE()

declare hlaseni(25)
m.hlaseni = space(30)
SET SYSMENU SAVE
SET SYSMENU OFF  
_screen.MinButton = .T.
_screen.MaxButton = .T.
_screen.Closable = .T.
_screen.LockScreen = .F.

DO CASE 
CASE m.gcTypSluzby = "VYDEJ"
  IF !FILE(m.gchom_path+"hot_kred.dbf")
    WAIT "Neni vytvoren soubor karet HOT_KRED. Program bude ukoncen" WINDOW TIMEOUT 5
    DO shut_dn
  ENDIF
CASE m.gcTypSluzby = "DOCHAZKA"
  IF !FILE(m.gchom_path+"hk_doch.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\hk_doch")
    COPY TO (m.gchom_path+"hk_doch") WITH cdx 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "TURNIKET"
  IF !FILE(m.gchom_path+"crdzamky.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\crdzamky")
    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "TURNIKETWLNS"
* Presunuto do load formulare
*!*	  IF !FILE(m.gchom_path+"crdzamky.dbf")
*!*	    SELECT 0
*!*	    USE (m.gcini_path + "DATA\crdzamky")
*!*	    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
*!*	    USE 
*!*	  ENDIF 
CASE m.gcTypSluzby = "TURNIKETCAS"
  IF !FILE(m.gchom_path+"crdzamky.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\crdzamky")
    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "TURNIKETNTC"
  IF !FILE(m.gchom_path+"crdzamky.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\crdzamky")
    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "TURNIKETINP"
  IF !FILE(m.gchom_path+"crdzamky.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\crdzamky")
    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "TURNIKETINPTM"
  IF !FILE(m.gchom_path+"crdzamky.dbf")
    SELECT 0
    USE (m.gcini_path + "DATA\crdzamky")
    COPY TO (m.gchom_path+"crdzamky") WITH CDX 
    USE 
  ENDIF 
CASE m.gcTypSluzby = "VYCEP"
  If ! file (m.gccen_path + "vycepdta.dbf")
    Create table (m.gccen_path + "vycepdta.dbf");
     (typ C (5), stav C (2), id_kas C(2), datum D, cas C (8), stul N(6,1),;
      markovano C(30), nazev C(30), mnozstvi N(4), plu C(4), cisnik C(15), user_id C(4), retrans N (1), accepted N(4), rejected N(4))
    * typ        .... typ zpravy
    * stav       .... stav zpravy (vyrizena ...)
    * id_kas     .... cislo kasy
    * datum      .... datum  pocitace kde bezi interface
    * cas        .... cas
    * stul       .... cislo stolu
    * markovano  .... nazev markovane polozky
    * nazev      .... nazev polozky na kredit
    * mnozstvi   .... pocet davek na kredit
    * plu        .... kod polozky v postmix
    * cisnik     .... jmeno cisnika
    * retrans    .... pocet opakovani vysilani
    * accept     .... Akceptovane kredity
    * reject     .... Odmitnute ktedity
  ELSE
    IF f_acc_ex(m.gccen_path + "vycepdta.dbf")
      DELETE FOR datum < DATE() - 7
      PACK 
      USE 
    ENDIF 
  Endif
  IF !FILE(m.gcCen_path+"vycep_st.dbf")
    SELECT 0
    CREATE TABLE (m.gcCen_path+"vycep_st") (lastzazn C(4))
    INSERT INTO (m.gcCen_path+"vycep_st") (lastzazn) VALUES ("0001")
    USE 
  ENDIF 
  *If ! file (m.gccen_path + "vycepzur.dbf")
  *  SELECT 0
  *  CREATE TABLE (m.pri_path + "vycepzur.dbf");
  *   (typ C (5), datum D, cas C (6), dc N(2), plu N(5), user_id N(3), day_pmx N(6), sec_pmx N(10), stul N(6.1), pgm_id C(2))
  *  COPY TO (m.cen_path+"reconpmx") TYPE FOX2X AS 852
  *  USE
  *  ERASE(m.pri_path+"reconpmx.dbf")
  *endif
CASE m.gcTypSluzby = "KAVOVAR"
CASE m.gcTypSluzby = "RANCILIO"
CASE m.gcTypSluzby = "DC14"
  IF !EMPTY(m.gcKas_kmen)
    SELECT 0
    USE (m.gcHom_path+"food_dat") NOUPDATE 
    SELECT * FROM (m.gcHom_path+"food_dat") INTO TABLE (m.gcPri_path+"fd") WHERE (UPPER(ALLTRIM(pgm))="K32") AND (pgm_param = "MASTER") AND ("PMX" $ comment)
    USE IN food_dat
  ENDIF 
  IF m.gcCheckIfRunning
   IF !EMPTY(m.gcKas_kmen)
    SELECT fd
    SCAN
      if !file(alltr(fd.dat_path)+"running.dbf")
        SELECT 0
        crea table (alltr(fd.dat_path)+"running") (dt_pmx D, sec_pmx N(6), tm_pmx C(8), dt_off D, tm_off C(8))
        insert into (alltr(fd.dat_path)+"running") (dt_pmx, sec_pmx, tm_pmx) values (date(), secon(), time())
      ELSE 
        sele 0  
        use (alltr(fd.dat_path)+"running")
        REPLACE dt_pmx WITH DATE(), sec_pmx WITH SECONDS(), tm_pmx WITH TIME()
      endif
      USE 
    ENDSCAN 
   ELSE 
    if !file(m.gcKas_path+"running.dbf")
      SELECT 0
      crea table (m.gcKas_path+"running") (dt_pmx D, sec_pmx N(6), tm_pmx C(8), dt_off D, tm_off C(8))
      insert into (m.gcKas_path+"running") (dt_pmx, sec_pmx, tm_pmx) values (date(), secon(), time())
    ELSE 
      sele 0  
      use (m.gcKas_path+"running")
      REPLACE dt_pmx WITH DATE(), sec_pmx WITH SECONDS(), tm_pmx WITH TIME()
    endif
    USE 
   ENDIF 
  ENDIF 
  *
  IF !EMPTY(m.gcKas_kmen)
    SELECT fd
    SCAN
      SELE 0
      If !file (ALLTRIM(fd.dat_path) + "PMX.DBF")
        Create table (m.gcKas_path + "PMX.DBF");
         (Cisnik c (3), Stul_c c(5), kod_pmx c (4), mnozstvi n(3), dat_cas c(15),;
          Pozn c(20))
        USE 
    Endif
    ENDSCAN 
  ELSE 
    SELE 0
    If ! file (m.gcKas_path + "PMX.DBF")
      Create table (m.gcKas_path + "PMX.DBF");
       (Cisnik c (3), Stul_c c(5), kod_pmx c (4), mnozstvi n(3), dat_cas c(15),;
        Pozn c(20))
      USE 
    Endif
  ENDIF
CASE "KDS" $ m.gcTypSluzby
  * Soubor kdstemp je vytvaren kasou
CASE m.gcTypSluzby = "ZURNAL"
  * Zurnal je vytvaren 
CASE m.gcTypSluzby = "IMPORTSLUZBY"
CASE m.gcTypSluzby = "ZAMKYENDRST"
CASE m.gcTypSluzby = "FIDELIO"
CASE m.gcTypSluzby = "FIDELIOTCP"
CASE m.gcTypSluzby = "KUCHYNMONITOR"
CASE m.gcTypSluzby = "SOLARIBOARD"
  SET CLASSLIB TO solaris ADDITIVE 
  m.imagePath = m.gcini_path + "bitmaps\"
  m.home_path = m.gchom_path
CASE m.gcTypSluzby = "BUMPBARSOLARI"
  SET CLASSLIB TO solaris ADDITIVE 
  m.imagePath = m.gcini_path + "bitmaps\"
  m.home_path = m.gchom_path
CASE m.gcTypSluzby = "BUMPBARKUCHYN"
  SET CLASSLIB TO solaris ADDITIVE 
  m.imagePath = m.gcini_path + "bitmaps\"
  m.home_path = m.gchom_path
CASE m.gcTypSluzby = "ZURNALCCTV"
CASE m.gcTypSluzby = "UPDATEKREDIT"
CASE m.gcTypSluzby = "BUMPBARDRIVEIN"
  SET CLASSLIB TO solaris ADDITIVE 
  m.imagePath = m.gcini_path + "bitmaps\"
  m.home_path = m.gchom_path
CASE m.gcTypSluzby = "HOTELSTRAVA"
ENDCASE 
CLOSE DATA


IF m.gcComm > 0
  SET LIBRARY TO m.gcini_path + "Libs\cvf50.fll"
  hndcom = 5
  ret = w8250_init(hndcom, m.gcComm, m.gcBaud, m.gcDatBit, m.gcParity, m.gcStopBit, 8192, 8192)
  IF m.ret < 0
    WAIT "Nejde otevrit comport!" WINDOW TIMEOUT 5
    SET LIBRARY TO  
    DO shut_dn
  ENDIF 
  =c_rxflush(hndcom, 0)
  =c_txflush(hndcom, 0)
ENDIF 
*
DO CASE 
CASE m.gcTypSluzby = "VYDEJ"
  _screen.width = INT(SYSMETRIC(1)*0.99)
  _screen.height = INT(SYSMETRIC(2)*0.91)
  ON KEY LABEL Alt+F12 do shut_dn
  DO FORM vydej
CASE m.gcTypSluzby = "DOCHAZKA"
  do form dochazka to m.jq
CASE m.gcTypSluzby = "TURNIKET"
  do form turniket to m.jq
CASE m.gcTypSluzby = "TURNIKETWLNS"
  IF !m.isPOSSql
  	do form turniketwlns to m.jq
  ELSE
  	do form turniketwlnssql to m.jq
  ENDIF 
CASE m.gcTypSluzby = "TURNIKETCAS"
  do form turniktm to m.jq
CASE m.gcTypSluzby = "TURNIKETNTC"
  do form turnikntc to m.jq
CASE m.gcTypSluzby = "TURNIKETINP"
  do form turniketinp to m.jq
CASE m.gcTypSluzby = "TURNIKETINPTM"
  do form turniketinptm to m.jq
CASE m.gcTypSluzby = "VYCEP"
  do form vycep to m.jq
CASE m.gcTypSluzby = "KAVOVAR"
  =set_parm(hndcom, 4, m.gcRTSVal)	&&RTS  
  =set_parm(hndcom, 20, m.gcDTRVal)	&&DTR
  do form kavovar to m.jq
CASE m.gcTypSluzby = "RANCILIO"
  =set_parm(hndcom, 4, m.gcRTSVal)	&&RTS  
  =set_parm(hndcom, 20, m.gcDTRVal)	&&DTR
  do form rancilio to m.jq
CASE m.gcTypSluzby = "DC14"
  do form dc14 to m.jq
CASE "KDS" $ m.gcTypSluzby
  do form kds to m.jq
CASE m.gcTypSluzby = "ZURNAL"
  * Zurnal je vytvaren 
  _screen.width = SYSMETRIC(1)
  _screen.height = SYSMETRIC(2)
  DO FORM zurnal TO m.jq
*CASE m.gcTypSluzby = "MSR206"
*  _screen.width = SYSMETRIC(1)
*  _screen.height = SYSMETRIC(2)
*  DO FORM msr206 TO m.jq
CASE m.gcTypSluzby = "IMPORTSLUZBY"
  DO FORM importsluzby TO m.jq
CASE m.gcTypSluzby = "IMPORTCSSZ"
  DO FORM importcssz TO m.jq
CASE m.gcTypSluzby = "ZAMKYENDRST"
  DO FORM zamkyendrst
CASE m.gcTypSluzby = "FIDELIO"
  DO FORM fidelio WITH m.gcTest
CASE m.gcTypSluzby = "FIDELIOTCP"
  DO FORM fideliotcp WITH m.gcTest
CASE m.gcTypSluzby = "MONITORKUCHYN"
  * Pro tento rezim chci celou obrazovku
  * To je ta kuchyn siucasne s monitorem pro zakazniky
  _screen.width  = gcScrWidth
  _screen.height = gcScrHeight
  *_screen.width = 3450
  *_screen.height = 900
  *IF m.gcMonitorZakaznici
  IF "EXE" $ VERSION(1)
    _screen.MinButton = .F.
    _screen.Closable = .F.
    _screen.LockScreen = .T.
    _screen.Movable = .F. 
	_screen.TitleBar = 0 
  ELSE 
    _screen.MinButton = .T.
    _screen.Closable = .T.
    _screen.LockScreen = .F.
    _screen.Movable = .T. 
	_screen.TitleBar = 1 
  ENDIF 
  IF !(gcMonitorZakazniciSirka = -1 AND gcMonitorZakazniciVyska = -1)
    DO FORM monitorZakaznici
  ENDIF 
  *ENDIF 
  DO FORM monitorkuchyn
  IF TYPE("monitorzakaznici") == 'O'
    monitorzakaznici.Release
  ENDIF 
CASE m.gcTypSluzby = "MONITORZAKAZNICI2" OR m.gcTypSluzby = "MONITORZAKAZNICI4"
  * Pro tento rezim chci celou obrazovku
  _screen.width  = gcScrWidth
  _screen.height = gcScrHeight
  *_screen.width = 3450
  *_screen.height = 900
  *IF m.gcMonitorZakaznici
  IF "EXE" $ VERSION(1)
    _screen.MinButton = .F.
    _screen.Closable = .F.
    _screen.LockScreen = .T.
    _screen.Movable = .F. 
	_screen.TitleBar = 0 
  ELSE 
    _screen.MinButton = .T.
    _screen.Closable = .T.
    _screen.LockScreen = .F.
    _screen.Movable = .T. 
	_screen.TitleBar = 1 
  ENDIF 
  ON KEY LABEL Alt+F12 do shut_dn
  IF m.gcTypSluzby = "MONITORZAKAZNICI2"
  	DO FORM monitorzakaznici2
  ELSE
  	DO FORM monitorzakaznici4
  ENDIF 
CASE m.gcTypSluzby = "MONITORZAKAZNICI3"
  * Pro tento rezim chci celou obrazovku na vysku!
  _screen.width  = gcScrWidth
  _screen.height = gcScrHeight
  *_screen.width = 3450
  *_screen.height = 900
  *IF m.gcMonitorZakaznici
  IF "EXE" $ VERSION(1)
    _screen.MinButton = .F.
    _screen.Closable = .F.
    _screen.LockScreen = .T.
    _screen.Movable = .F. 
	_screen.TitleBar = 0 
  ELSE 
    _screen.MinButton = .T.
    _screen.Closable = .T.
    _screen.LockScreen = .F.
    _screen.Movable = .T. 
	_screen.TitleBar = 1
  ENDIF 
  ON KEY LABEL Alt+F12 do shut_dn
  DO FORM monitorzakaznici3
CASE m.gcTypSluzby = "SOLARIBOARD"
*!*	  IF "EXE" $ VERSION(1)
*!*	    _screen.MinButton = .F.
*!*	    _screen.Closable = .F.
*!*	    _screen.LockScreen = .T.
*!*	    _screen.Movable = .F. 
*!*	  ELSE 
*!*	    _screen.MinButton = .T.
*!*	    _screen.Closable = .T.
*!*	    _screen.LockScreen = .F.
*!*	    _screen.Movable = .T. 
*!*	  ENDIF 
  DO FORM demoultrawide
CASE m.gcTypSluzby = "BUMPBARSOLARI"
  IF "EXE" $ VERSION(1)
    _screen.Left = m.gcLevaSouradniceVidea
    _screen.Width = m.gcSirkaVidea
  ENDIF 
  DO FORM demosolari
CASE m.gcTypSluzby = "BUMPBARKUCHYN"
  _screen.Left = m.gcLevaSouradniceVidea
  _screen.Width = m.gcSirkaVidea
  DO FORM demokuchyn
CASE m.gcTypSluzby = "ZURNALCCTV"
  IF FILE(m.gchom_path+"zurnalcctv_par.dbf")
    m.RemoteAdresa = ""
    m.RemotePort = 0
    IF EMPTY(m.gcSouborUctenkyCCTV)
      m.gcSouborUctenkyCCTV = "C:\ALTO\D_GLOBUS\UCTYCCTV.TXT"
    ENDIF 
    SELECT 0
    USE (m.gchom_path+"zurnalcctv_par") ALIAS cctv
    LOCATE FOR id = m.gcid_master
    IF FOUND()
      m.RemoteAdresa = ALLTRIM(cctv.ipadr)
      m.RemotePort = cctv.rempor
    ENDIF
    USE IN cctv
    IF !EMPTY(m.RemoteAdresa)
      DO FORM zurnalcctv WITH m.gcSouborUctenkyCCTV, m.RemoteAdresa, m.RemotePort
    ENDIF   
  ELSE
    WAIT "Chybí soubor CCTV_PAR.DBF!" WINDOW TIMEOUT 5 
  ENDIF 
CASE m.gcTypSluzby = "UPDATEKREDIT"
  DO FORM updatekredit
CASE m.gcTypSluzby = "BUMPBARDRIVEIN"
  _screen.Left = m.gcLevaSouradniceVidea
  _screen.Width = m.gcSirkaVidea
  DO FORM demodrivein
CASE m.gcTypSluzby = "HOTELSTRAVA"
  _screen.width  = gcScrWidth
  _screen.height = gcScrHeight
	DO FORM hotelstrava
ENDCASE 

do del_pripath with m.gcpri_path

SET DEFAULT TO (m.gcdefapath)

IF m.gcComm > 0
  =deinit_port(hndcom)
ENDIF 
SET LIBRARY TO 

DO shut_dn

*!*****************************************************************************
*!      Procedure: INI_SET
*!*****************************************************************************
procedure ini_set
clear program
clear window
clear macros

set collate to   m.gccollate
set sysformats   on
set talk         off
set bell to      888,1
set bell         off
set carry        off
set clock        off
set century      on
set confirm      on
set dele         on
set date         germ
set escape       off
set exact        on
set excl         off
set hours to     24
set exclusive    off
set resource     off
set reprocess to auto
set status       off
set scoreboard   off
set safety       off
SET STATUS BAR OFF
SET POINT TO "."

*_screen.width = SYSMETRIC(1)
*_screen.height = SYSMETRIC(2)
_screen.width =  m.gio_scrwidth
_screen.height =  m.gio_scrheight
_screen.caption = m.LCTITLE
_screen.TitleBar = 1
*@ 0,0,SROWS()-2,SCOLS()-1 BOX "°°°°°°°°°"
*@ SROWS()-3,SCOLS()-55 SAY " VOKNO " 



*!*****************************************************************************
*!      Function: GET_INI
*!*****************************************************************************
function get_ini
lparam section, klic, defa_value
if param() < 3
    m.defa_value = ""
endif
lcbuffer = space(999) + chr(0)
libufsize = getprivstr(m.section, m.klic, m.defa_value, @lcbuffer, len(lcbuffer), m.gcini_file)
if libufsize = 0
*    do put_ini with section, klic, defa_value
    wait "neni klic" + m.klic + " v sekci " + section wind time 0.1
    return ""
else
    return left( m.lcbuffer,m.libufsize )
endif

*!*****************************************************************************
*!      Function: PUT_INI
*!*****************************************************************************
function put_ini
lparam section, klic, hodnota
pom = writeprivstr( m.section, m.klic, m.hodnota, m.gcini_file )
return (pom = 1)


*!*	*!*****************************************************************************
*!*	*!      Procedure: ERR_HAND
*!*	*!*****************************************************************************
*!*	procedure err_hand
*!*	parameters err_num, mssg, line_txt, mlineno
*!*	private sta_debug, can_susp, lastw, old_errh, old_row, old_col, prog_chain, iii, otevreno
*!*	* takhle se aktivuje : ON ERROR DO err_hand WITH ERROR(), MESSAGE(), MESSAGE(1), LINE()
*!*	push key clear

*!*	mssg = str(m.err_num, 5) + ":" + left(m.mssg, 222)
*!*	line_txt = strtr(m.line_txt, "   ", " ")
*!*	line_txt = strtr(m.line_txt, "   ", " ")
*!*	line_txt = allt(strtr(m.line_txt, "  ", " "))
*!*	line_txt = str(m.mlineno, 5) + ":" + left(m.line_txt, 222)
*!*	otevreno = dbf() + iif(empty(dbf()), "", " as " + alias() + iif(empty(order()), " not ordered", " tag " + order()))
*!*	otevreno = substr(strtr( m.otevreno, ".DBF", ""), 4)
*!*	prog_chain = program(2)
*!*	iii = 3
*!*	do while (program(iii) # program()) .and. (m.iii < 32)
*!*	    prog_chain = allt(iif ("..." $ program(iii), "", program(iii) + " ") + m.prog_chain)
*!*	    iii = m.iii + 1
*!*	enddo

*!*	define popup pop_errh from 11,0 title " P R O G R A M O V A   C H Y B A " in screen
*!*	define bar  1 of pop_errh prompt "\<Ignore . . . ignoruj chybu"
*!*	define bar  2 of pop_errh prompt "\<Retry. . . . opakuj akci"
*!*	define bar  3 of pop_errh prompt "\<Suspend. . . prerus" skip for "upport" $ vers()
*!*	define bar  4 of pop_errh prompt "\<Cancel . . . ukonci program"
*!*	define bar  5 of pop_errh prompt "\-"
*!*	define bar  6 of pop_errh prompt "Err :" + padr(trim(m.mssg),      99)
*!*	define bar  7 of pop_errh prompt "Line:" + padr(trim(m.line_txt),  99)
*!*	define bar  8 of pop_errh prompt "Prog:" + padr(trim(m.prog_chain),99)
*!*	define bar  9 of pop_errh prompt "Used:" + m.otevreno
*!*	*define bar 10 of pop_errh prompt "Pozn:" + m.err_h_info
*!*	*!*    DEFINE BAR 11 OF pop_errh PROMPT "\" + PADR(m.pgm,8) + " " + PADR(m.verze,6) + "; " + m.pgm_id + " " + ;
*!*	*!*                                     PADR(m.pgm_param,12) + " (" + m.machine + ") " +  " " + LEFT(RIGHT(m.gchom_path, 9), 8)

*!*	on selection popup pop_errh deactivate popup pop_errh
*!*	activate popup pop_errh bar 4
*!*	do while bar() = 0 .or. bar() > 4
*!*	    activate popup pop_errh bar 4
*!*	enddo
*!*	release popup pop_errh
*!*	gcansw = prompt()
*!*	*do case
*!*	*case bar() = 1    && Ignore
*!*	    *do app_log with m.line_txt
*!*	*    pop key
*!*	*    return
*!*	*case bar() = 2    && Retry
*!*	*    *do app_log with m.line_txt
*!*	*    pop key
*!*	*    retry
*!*	*case bar()=3      && Suspend
*!*	*    *do app_log with m.line_txt
*!*	*    do sta_susp
*!*	*otherwise        && Cancel
*!*	    *do app_log with m.line_txt
*!*	INSERT INTO (m.gchom_path+"err_log") FROM MEMVAR 
*!*	    on key
*!*	    *do del_pripath
*!*	    do shut_dn
*!*	*endcase


*!*****************************************************************************
*!      Procedure: ERR_HAND
*!*****************************************************************************
PROCEDURE err_hand
PARAMETERS err_num, mssg, line_txt, mlineno
PRIVATE err_num, mssg, line_txt, mlineno
PRIVATE sta_debug, can_susp, lastw, old_errh, old_row, old_col, prog_chain, iii, otevreno
* takhle se aktivuje :
* ON ERROR DO err_hand WITH ERROR(), MESSAGE(), MESSAGE(1), LINE()
PUSH KEY CLEAR

*!*	sta_debug = "DEB" $ m.food_debug
*!*	can_susp  = .NOT. "LIBRARY" $ UPPER(VERSION())

mssg = STR(m.err_num, 5) + ":" + m.mssg
line_txt = STR(m.mlineno, 5) + ":" + ALLTRIM(m.line_txt)
otevreno = DBF() + IIF(EMPTY(DBF()), "", " as " + ALIAS() + IIF(EMPTY(ORDER()), " not ordered", " tag " + ORDER()))
otevreno = SUBSTR(STRTR( m.otevreno, ".DBF", ""), 4)

DO CASE
*!*	CASE (m.err_num = 165) .AND. ("ST_SYSMENU" $ UPPER(m.line_txt))
*!*	  POP KEY                              && Nedefinovan systmov menu
*!*	  ON KEY LABEL shift+f12
*!*	  RETURN
*!*	CASE m.err_num = 125                    && Printer not ready
*!*	  do form (m.start_path+'yesnofrm') with "Tiskárna není připravena","chcete tisk zruit ?" to m.bbar
*!*	  IF m.bbar = 1
*!*	    POP KEY
*!*	    RETURN
*!*	  ELSE
*!*	    POP KEY
*!*	    RETRY
*!*	  ENDIF
*!*	CASE m.err_num = 9991707                    && CDX doesn't exist
*!*	  DO app_log WITH m.line_txt
*!*	  POP KEY
*!*	  DO st_konec WITH "CDX doesn't exist"
*!*	CASE m.err_num = 114   && Index neodpovida databazi
*!*	  USE
*!*	  DO app_log WITH m.line_txt
CASE m.err_num = 1001	&& Pepanek nekde zapomnel suspend
  *DO app_log WITH "Zapomenuty suspend v kodu"
  POP KEY 
  RETURN 
*!*	CASE m.err_num = 1957	&& Chyba pristupu pro soubezny tisk = Blbe nadefin.tiskarna (PRN_DEF x Windows)
*!*	  DO app_log WITH "Blbe nadefinovana tiskarna (PRN_DEF x Windows)"
*!*	  POP KEY 
*!*	  RETURN 
OTHERWISE
  prog_chain = PROGRAM(2)
  iii = 3
  DO WHILE (PROGRAM(iii) # PROGRAM()) .AND. (m.iii < 32)
    prog_chain = ALLT(IIF ("..." $ PROGRAM(iii), "", PROGRAM(iii) + " ") + m.prog_chain)
    iii = m.iii + 1
  ENDDO
  do form (m.gcini_path+'forms\err_hand') with ;
    "Chyba   :" + PADR(TRIM(m.mssg),70),;
    "Řádek   :" + PADR(TRIM(m.line_txt),70),;
    "Soubor  :" + m.otevreno,;
    "Program :" + PADR(TRIM(m.prog_chain),70),;
    "" to m.bbar
*!*	    "Poznámka:" + m.err_h_info,;
*!*	    PADR(m.pgm,8) + " " + PADR(m.verze,6) + m.pgm_id + " " + PADR(m.pgm_param,12) + " (" + m.machine + ") " +;
*!*	      " " + SUBSTR(ser_time(), 3, 12) + " " + LEFT(RIGHT(m.hom_path, 9), 8);
  
*!*	  DO CASE
*!*	  CASE m.bbar = 1	&& Ignore
*!*	    answ = 'Ignore'
*!*	    DO app_log WITH m.line_txt
*!*	    POP KEY
*!*	    RETURN
*!*	  CASE m.bbar= 2	&& Retry
*!*	    answ = 'Retry'
*!*	    DO app_log WITH m.line_txt
*!*	    POP KEY
*!*	    RETRY
*!*	  CASE m.bbar=3  	&& Suspend
*!*	    answ = 'Suspend'
*!*	    DO app_log WITH m.line_txt
*!*	    DO sta_susp
*!*	  OTHERWISE		&& Cancel
    answ = 'Cancel'
INSERT INTO (m.gchom_path+"err_log") FROM MEMVAR 
    on key
    *do del_pripath
    do shut_dn
*!*	      ENDCASE 
ENDCASE


*!*****************************************************************************
*!      Procedure: STA_SUSP
*!*****************************************************************************
    procedure sta_susp
    private old_sel, old_errh, old_row, old_col, lastw
    lastw = woutput()
    old_errh = on("ERROR")
    old_row = row()
    old_col = col()
    activate screen
    save screen
    on error
    push key clear
    set sysmenu to default
    suspend
    on error &old_errh
    activate screen
    restore screen
    if .not. empty(m.lastw)
        activate window (m.lastw)
    endif
    @ m.old_row, m.old_row say ""
    pop key

*!*****************************************************************************
*!      Function: shut_dn
*!*****************************************************************************
    procedure shut_dn
    *do n_sunlock
    IF VARTYPE(monitorzakaznici2) == 'O'
      monitorzakaznici2.Release
    ENDIF 
    IF VARTYPE(monitorzakaznici4) == 'O'
      monitorzakaznici4.Release
    ENDIF 
    CLOSE data  
    ON SHUTDOWN 
    *use (m.fn_food_dat)
    *repl all era_cen with "hhoollaa"
    *DO n_sunlock

    *release systolb

    *do clos_data
    _screen.width  = gio_scrwidth
    _screen.height = gio_scrheight
    _screen.Caption = gio_scrcapt
    _screen.LockScreen = .F.
    set library to
    on error
    set sysmenu nosave
    set sysmenu to default
    release all extended

    *if wexist ("Project Manager - Vladastrav")
    *    show wind ("Project Manager - Vladastrav")
    *endif
    CANCEL
    
*!*****************************************************************************
*!      Function: shut_dn2
*!*****************************************************************************
    procedure shut_dn2
    IF VARTYPE(monitorzakaznici) == 'O'
      monitorzakaznici.Release
    ENDIF 
    CLOSE data  
    set library to
    on error
    set sysmenu nosave
    set sysmenu to default
    release all extended
    QUIT 
    
************************************************************
* Procedure: GetPriPath
*************************************************************
Procedure GetPriPath
machine = Get_ComputerName()
if empt(m.machine)
  machine = PADL(GETENV("computername"), 12, "_")
endif

*semafor_id = m.machine + "_" + m.id2

DO CASE
CASE ! EMPT(GETENV("TMP"))
   gcpri_path = GETENV("TMP")
CASE ! EMPT(GETENV("TEMP"))
   gcpri_path = GETENV("TEMP")
OTHER
   gcpri_path = "\tmp"
ENDCASE

IF "documents and" $ LOWER(m.gcpri_path)
  IF EMPTY(JUSTDRIVE(m.gcpri_path))
    m.gcpri_path = "c:\tmp"
  ELSE
    m.gcpri_path = JUSTDRIVE(m.gcpri_path) + "\tmp"
  ENDIF 
ENDIF

gcpri_path = gcpri_path + IIF(RIGHT(m.gcpri_path,1)="\", "", "\") + m.machine + "\" + IIF(!EMPTY(m.gcIdMisto), m.gcIdMisto,"AS") + "\"


RETURN

*!*****************************************************************************
*!      Procedure: del_pripath
*!*****************************************************************************
    proc del_pripath
    lparam cesta
    private cccc, dddd, iiii, cesta
    if empt(m.cesta)
        retu .t.
    else
        ok = .T.
        err_h_old = on ("ERROR")
        on error store .F. to m.ok
        cesta = allt(cesta) + iif(right(allt(cesta) ,1)="\", "", "\")
        cccc = adir(dddd, m.cesta + "*.*")
        for iiii = 1 to cccc
            erase (m.cesta + dddd(iiii, 1))
        endfor
        on error &err_h_old
        cccc = adir (dddd, allt(m.cesta) + "*.*")
        return empt(m.cccc)
    endif

*!*****************************************************************************
*!      Procedure: MK_DIR
*!*****************************************************************************
*    proc mk_dir
*    parameters cesta
*    err_h_old = on ("ERROR")
*    on error a = 1
*    MKDIR ( m.cesta )
*    on error &err_h_old


*!*****************************************************************************
*!      Procedure: MK_DIR
*!*****************************************************************************
PROC mk_dir
PARAMETERS cesta
PRIVATE ii, car, handle
IF SUBST(m.cesta, 2, 1) # ":"
  cesta = SYS(5) + m.cesta
ENDIF
ii=2
DO WHILE AT("\",cesta,ii) # 0
	car=LEFT(cesta,AT("\",cesta,ii)-1)
*!*	  handle=FCREATE(car)
*!*	  IF handle > 0     && soubor lze vytvorit, takze takovy adresar jeste neexistuje
*!*	    = FCLOSE(handle)
*!*	    DELETE FILE &car  && smazani pomocneho souboru, vytvoreneho FCREA(car)
*!*	    MKDIR &car
*!*	  ENDIF
	TRY
		MKDIR &car
	CATCH
		IF !DIRECTORY(m.car)
	  		*WAIT "Chyba při vytvoření pomocného adresáře " + m.cesta WINDOW TIMEOUT 2
		ENDIF 
	ENDTRY 
	ii=ii+1
ENDDO

*!*	PROCEDURE mk_dir
*!*	PARAMETERS cesta, pQuit
*!*	PRIVATE ii, car, handle
*!*	IF PCOUNT() < 2
*!*	  m.pQuit = .T.
*!*	ENDIF 
*!*	*WAIT "Cesta parametr="+ALLTRIM(m.cesta) WINDOW TIMEOUT 5
*!*	DO CASE 
*!*	CASE LEFT(m.cesta, 2) = "\\"
*!*	  * Nedelej nic
*!*	CASE SUBST(m.cesta, 2, 1) # ":" AND LEFT(m.cesta, 2) # "\\"
*!*	  cesta = SYS(5) + m.cesta
*!*	ENDCASE
*!*	*WAIT "Cesta upravena="+ALLTRIM(m.cesta) WINDOW TIMEOUT 5
*!*	TRY 
*!*	  	*MKDIR &cesta
*!*	  	MKDIR (m.cesta)
*!*	CATCH 
*!*		IF !DIRECTORY(m.cesta)
*!*	  		WAIT "Chyba při vytvoření pomocného adresáře " + m.cesta WINDOW TIMEOUT 10
*!*	  		IF m.pQuit
*!*	  		  CLOSE DATABASES 
*!*	  		  CANCEL 
*!*	  		ENDIF 
*!*		ENDIF 
*!*	ENDTRY


*!*****************************************************************************
*!       Procedure : Get_ComputerName
*!*****************************************************************************
FUNCTION Get_ComputerName

DECLARE INTEGER GetComputerName ;
     IN WIN32API STRING@ cComputerName, INTEGER@ nSize

lcComputer=SPACE(80)
lnSize=80

=GetComputername(@lcComputer,@lnSize)
IF lnSize < 2
   RETURN ""
ELSE
   RETURN SUBSTR(lcComputer,1,lnSize)
ENDIF   

*!*****************************************************************************
*!      Procedure: F_ACC
*!*****************************************************************************
    procedure f_acc
    parameters fa_soubor
    private err_h_old, ok
    ok = .t.
    err_h_old = on ("ERROR")
    sele 0
    on error do fa_errhand with error(), message()
    fa_soubor = "USE " + m.fa_soubor
    err_h_info = m.fa_soubor
    &fa_soubor
    err_h_info = ""
    on error &err_h_old
    return m.ok

*!*****************************************************************************
*!       Function: F_ACC_EX()
*!*****************************************************************************
    function f_acc_ex
    parameters fa_soubor
    private ok, err_h_old
    if ! file(m.fa_soubor + ".dbf")
        *do app_log with "F_ACC_EX : nonexistent " + m.fa_soubor
        wait clear
    endif
    ok = .t.
    err_h_old = on ("ERROR")
    on error do fa_errhand with error(), message()
    err_h_info = m.fa_soubor
    use (m.fa_soubor) exclusive
    err_h_info = ""
    if m.ok
        use (m.fa_soubor) exclusive
    endif
    on error &err_h_old
    return ok

*!*****************************************************************************
*!      Procedure: FA_ERRHAND
*!*****************************************************************************
    procedure fa_errhand
    parameters errno, messg
    do case
    case (m.errno = 108) .or. (m.errno = 1705) .or. (m.errno = 1718)   && File used by another/ Acces denied/Read only kvuli NT
        ok = .f.
        wait left(m.fa_soubor,44) + ": " + m.messg window time 3
    case m.errno = 114   && Index neodpovida databazi
        ok = .f.
        use
        erase (m.fa_soubor + ".cdx")
        *do app_log with "FA_ERRHAND : index doesn't match database : " + m.fa_soubor
    otherwise
        &err_h_old
    endcase
*!*****************************************************************************
*!      Procedure: SET_lpt3
*!*****************************************************************************
PROCEDURE set_lpt3
PARAMETERS prn_no, on_off
PRIVATE old_sel, cmd, ret, prim_rec
ret = .T.
old_sel = SELECT()
=f_acc('(gchom_path + "PRN_DEF") NOUPDATE')
LOCATE FOR prn_no = m.prn_no
IF FOUND()
   IF ! EMPTY(prn_def.prn_no_alt)
      prim_rec = RECNO()
      SCATTER FIELD prn_no_alt MEMVAR
      GO TOP
      LOCATE FOR prn_no = m.prn_no_alt
      IF ! FOUND()
        GO (m.prim_rec)
      ENDIF
   ENDIF
***************VFP
   IF UPPER(on_off)="ON"
      cmd = prn_def.cmd32_on
      &cmd
      DO pdf_scatt
   ELSE
      cmd = prn_def.cmd_off
      &cmd
      SET PRINTER TO
   ENDIF
***************VFP
ELSE
   ret = .F.
ENDIF
USE
SELE (old_sel)
RETURN m.ret

PROCEDURE pdf_scatt
IF TYPE('_pdparms') # "U"
  _pdparms[ 1] = pd_parse(prn_def.prn_name)
  _pdparms[ 2] = pd_parse(prn_def.p_name)
  _pdparms[ 3] = ""
  _pdparms[ 4] = ""
  _pdparms[ 5] = pd_parse(prn_def.p_ff)
  _pdparms[ 6] = pd_parse(prn_def.p_crlf)
  _pdparms[ 7] = pd_parse(prn_def.p_reset)
  _pdparms[ 8] = pd_parse(prn_def.p_10cpi)
  _pdparms[ 9] = pd_parse(prn_def.p_12cpi)
  _pdparms[10] = pd_parse(prn_def.p_16cpi)
  _pdparms[11] = pd_parse(prn_def.p_boldon)
  _pdparms[12] = pd_parse(prn_def.p_boldoff)
  _pdparms[13] = pd_parse(prn_def.p_ulineon)
  _pdparms[14] = pd_parse(prn_def.p_ulineoff)
  _pdparms[15] = pd_parse(prn_def.p_italon)
  _pdparms[16] = pd_parse(prn_def.p_italoff)
  _pdparms[17] = pd_parse(prn_def.p_draft)
  _pdparms[18] = pd_parse(prn_def.p_nlq)
  _pdparms[19] = pd_parse(prn_def.p_fullcut)
  _pdparms[20] = pd_parse(prn_def.p_partcut)
  _pdparms[21] = pd_parse(prn_def.p_6lpi)
  _pdparms[22] = pd_parse(prn_def.p_8lpi)
  _pdparms[23] = pd_parse(prn_def.p_wideon)
  _pdparms[24] = pd_parse(prn_def.p_wideoff)

  _pdparms[27] = prn_def.p_ucetfeed
  _pdparms[28] = prn_def.p_header
  _pdparms[29] = prn_def.p_width
ENDIF

*!*****************************************************************************
*!      Procedure: VIEWER
*!*****************************************************************************
PROCEDURE viewer
* slouzi k vystupu souboru na obrazovku nebo na tiskarnu
* prvni parametr je vzdy uplny nazev souboru, druhy nepovinny oznacuje,
* zda soubor ma byt prohlizen na obrazovce nebo tisknut. Je-li vynechan, zobrazi se menu Obrazovka/Tiskarna
* Globalni promnn  view_edit uruje, zda sestava se smi editovat
*	ver 5.0 12.03.1993
******************************************************************************
PARAMETERS sestava,kam, qq	&& kam = "O" obrazovka, "T" tiskarna
PRIVATE mnu
m.rwait = 99999
IF ! FILE(sestava)
  WAIT "Sestava neni vytvorena" WINDOW TIME 3
  RETURN
ENDIF
PUSH KEY CLEAR
handle = FOPEN(m.sestava)
DO tisk2
POP KEY


*!*****************************************************************************
*!      Procedure: TISK2
*!*****************************************************************************
PROCEDURE tisk2
PRIVATE old_errh, line
IF (handle > 0)
  IF PRINTSTATUS()
    DEFINE WINDOW __tisk__ FROM 8,22 TO 11,62
    ACTIVATE WINDOW __tisk__
    @ 1,2 SAY "Print in progress... <End> to cancel"
    old_errh = ON("ERROR")
    ON ERROR
    printjob
    DO WHILE (! FEOF(handle)) .AND. (INKEY() # 6)
      if m.rwait > 0
        ??? CHR(13) + CHR(10) + FGETS(handle)
        m.rwait = m.rwait - 1
      else
        ??? CHR(13) + CHR(10) + FGETS(handle)
        m.rwait = m.qq
        do vymen_pap
      endif
    ENDDO
    endprintjob
    ON ERROR &old_errh
    RELEASE WINDOW __tisk__
  ENDIF
  = FCLOSE(handle)
ELSE
  WAIT "VIEWER: can'not open file '" + m.sestava + "'" TIMEOUT 3
ENDIF


*!*****************************************************************************
procedure vymen_pap
wait 'Vlozte novy papir do tiskarny a stisknete klavesu' WINDOW NOWAIT 


*!**************************************************************************************
*!
*!      Procedure: sc_lp_code   &&setlpt, neaktivuje tiskarnu, pouze precte ridici kody
*!**************************************************************************************
PROCEDURE sc_lp_code
PARAMETERS prn_no
PRIVATE old_sel, cmd, ret, prim_rec
ret = .T.
old_sel = SELECT()
=f_acc('(gchom_path + "PRN_DEF") NOUPDATE')
LOCATE FOR prn_no = m.prn_no
IF FOUND()
   IF ! EMPTY(prn_def.prn_no_alt)
      prim_rec = RECNO()
      SCATTER FIELD prn_no_alt MEMVAR
      GO TOP
      LOCATE FOR prn_no = m.prn_no_alt
      IF ! FOUND()
        GO (m.prim_rec)
      ENDIF
   ENDIF
   DO pdf_scatt
ELSE
   ret = .F.
ENDIF
USE
SELE (old_sel)
RETURN m.ret


*!*****************************************************************************
*!      Procedure: PD_PARSE
*!*****************************************************************************
PROC pd_parse
PARAM _in_str
PRIVATE _out_str, _iii, _pom_iii
_out_str = ""
_iii = 1
DO WHILE _iii <= LEN(ALLTR(m._in_str))
  IF SUBSTR(m._in_str, m._iii, 1) # "{"
    _out_str = m._out_str + SUBSTR(m._in_str, m._iii, 1)
  ELSE
    _iii = m._iii + 1
    _pom_iii = m._iii
    DO WHILE SUBSTR(m._in_str, m._iii, 1) # "}"
      _iii = m._iii + 1
    ENDDO
    _out_str = m._out_str + CHR(VAL(SUBSTR(m._in_str, m._pom_iii, m._iii-m._pom_iii)))
  ENDIF
  _iii = m._iii + 1
ENDDO
RETURN m._out_str

PROCEDURE jaz
PARAMETERS p_klic
RETURN ALLTRIM(p_klic)

function p_ucet_off
PRIVATE ret
  m.ret = REPLICATE(_pdparms[6],2)+_pdparms[19]      && 2xCrLf + 1xfullcut
RETURN ret

*!*****************************************************************************
*!       Function: SER_TIME()
*!*****************************************************************************
FUNCTION ser_time
PARAM pozice
IF PARAM()=0
  pozice = 1
ENDIF
*ser_time = DTOS(DATE()) + " " + LEFT(TIME(), 5) + "000"
ser_time = TTOC(DATETIME(), 1)
RETURN SUBST(m.ser_time, m.pozice)

*Odcesteni hlasek na display
FUNCTION td
PARAMETER retez
PRIVATE ret
IF .T. 		&&m.lcd_csoff
    m.ret = chrtran(m.retez, "ďňáéíóúýůěřčÁÉÍÓÚÝUĚŘČ-ßäëöüÄËÖÜ",;
    						 "dtnaeiouyuezsrcAEIOUYUEZSRC-saeouAEOU")
ELSE 
  m.ret = CPCONVERT(1250,852,m.retez)
ENDIF 
RETURN ret

*Odcesteni uctenek
FUNCTION t
PARAMETER retez
PRIVATE ret
*ret = SYS(15, cs_off, retez)            && TISK ÚČTU, UZÁVĚRKY
*m.ret = chrtran(m.retez, "ĺ Ą˘ŁěŘ§çýľÖŕéíŢˇŚćüŹÄ", "naeiouyuezsrcAEIOUYUEZSRC-")
IF .T.
    m.ret = chrtran(m.retez, "ďňáéíóúýůěřčÁÉÍÓÚÝUĚŘČ-ßäëöüÄËÖÜ",;
    						 "dtnaeiouyuezsrcAEIOUYUEZSRC-saeouAEOU")
ELSE 
  m.ret = CPCONVERT(1250,852,m.retez)
ENDIF 
RETURN ret

PROC pozavirej
PARAM pom
DO WHILE "," $ m.pom
  por1 = AT(",", m.pom, 1)
  soub_alias = LEFT(m.pom, m.por1-1)
  pom = ALLT(SUBST(m.pom, por1+1))
  IF USED(m.soub_alias)
    USE IN (m.soub_alias)
  ENDIF
ENDDO
IF USED(m.pom)
  USE IN (m.pom)
ENDIF

* Interf.Hores10

FUNCTION citajkartu
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, id_karty, hor_probud &&Identifikátor zámkové karty je typu integer, zapsaný v první pouitelné stopě nebo prvním pouitelném poli na kartě.
LOCAL m.ret, m.lcClasslibWas, m.vysledok
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/checkCard/" , .F.)
Http.Option(4) = 13056
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
IF VARTYPE(m.id_karty) # 'C'
	m.crdDotaz = '{"card_id":'+ALLTRIM(STR(m.id_karty,10,0))+'}'
ELSE
	m.crdDotaz = '{"serial_number":"'+ALLTRIM(m.id_karty)+'"}'
ENDIF 
TRY 
	http.SEND(m.crdDotaz)
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/checkCard/"+m.crdDotaz, " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
	m.lcClasslibWas = SET("Classlib")
	SET CLASSLIB TO "JSON.VCX" ADDITIVE 
	m.ret = .t.
	m.loJSON = CREATEOBJECT("JSON")
	m.vysledok=lojson.parse(http.responsetext)
	RELEASE lojson
	CREATE CURSOR hotkarta (result I, account_id I, room_code c(10), message c(100), room_id I)
	IF !ISNULL(vysledok)
		IF vysledok.result=0
			INSERT INTO hotkarta (result, account_id, room_code, room_id) VALUES(vysledok.result, vysledok.account_id, vysledok.room_code, vysledok.room_id)
		ELSE 
			INSERT INTO hotkarta (result, message) VALUES(vysledok.result, vysledok.message)
		ENDIF 		
	ELSE
		INSERT INTO hotkarta (result, message) VALUES(99, "Hores neodpovedal")
	ENDIF 
	SELECT hotkarta
	RELEASE karta
	RELEASE CLASSLIB JSON.VCX
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajhosti
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, id_izby, hor_probud &&accounts.id
LOCAL m.ret, m.lcClasslibWas, m.vysledok
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
SET CLASSLIB TO "JSON.VCX" ADDITIVE 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/currentGuests/" , .F.)
Http.Option(4) = 13056
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND('{"room_id":'+ALLTRIM(STR(m.id_izby,10,0))+'}')
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/currentGuests/"+'{"room_id":'+ALLTRIM(STR(m.id_izby,10,0))+'}', " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
	SET CLASSLIB TO "JSON.VCX" ADDITIVE 
	m.ret = .t.
	m.loJSON = CREATEOBJECT("JSON")
	EXTERNAL ARRAY host
	DIMENSION host(1,1)
	m.vysledok=lojson.parse(http.responsetext,"",@host)
	RELEASE lojson
	CREATE CURSOR hostia (id I, first c(100), last c(100))
	FOR m.i=1 TO ALEN(host)
		TRY 
			INSERT INTO hostia (id, first, last) VALUES(host[m.i].id, IIF(ISNULL(host[m.i].first_name) OR EMPTY(host[m.i].first_name),"",host[m.i].first_name), IIF(ISNULL(host[m.i].last_name) OR EMPTY(host[m.i].last_name),"",host[m.i].last_name))
		CATCH
		ENDTRY 
	ENDFOR 
	SELECT hostia
	RELEASE host
	RELEASE CLASSLIB JSON.VCX
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajhotelstrava
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, acc_id, hor_probud
LOCAL m.ret, m.lcClasslibWas, vysledok, i
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/complementaryCodes?current_account_id=" +ALLTRIM(STR(m.acc_id,12)) , .F.)
Http.Option(4) = 13056 
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND("")
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/complementaryCodes?current_account_id=" +ALLTRIM(STR(m.acc_id,12)), " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
*	m.lcClasslibWas = SET("Classlib")
	SET CLASSLIB TO "JSON.VCX" ADDITIVE 
	m.ret = .t.
	m.loJSON = CREATEOBJECT("JSON")
	m.vysledok=lojson.parse(http.responsetext)
	EXTERNAL ARRAY ahotelstrava
	DIMENSION ahotelstrava(10,10)
	m.vysledok=lojson.parse(http.responsetext,"",@ahotelstrava)
	RELEASE lojson
	CREATE CURSOR hotelstrava (account_id I, naz_poloz C(15))
	FOR m.i=1 TO ALEN(ahotelstrava)
		TRY 
			INSERT INTO hotelstrava (account_id, naz_poloz) VALUES (m.acc_id, ahotelstrava[m.i])
		CATCH 
		ENDTRY 
	ENDFOR 
	SELECT hotelstrava
	RELEASE ahotelstrava
	RELEASE CLASSLIB JSON.VCX
*	SET CLASSLIB TO (m.lcClasslibWas)
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajstravasum
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, hor_probud
LOCAL m.ret, m.lcClasslibWas, vysledok, i, m.responsetext
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/currentComplementaryCodesSummary/", .F.)
Http.Option(4) = 13056 
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND("")
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/currentComplementaryCodesSummary/", " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
	m.ret = .t.
	m.responsetext = http.responsetext
	CREATE CURSOR stravasum (naz_poloz C(10), pocet N(6,0))
	DO WHILE .T.
		m.pos = AT('"', m.responsetext)
		IF m.pos # 0
			m.naz_poloz = SUBSTR(m.responsetext, m.pos+1, AT('"', m.responsetext, 2)-m.pos-1)
			m.pos0 = AT(':', m.responsetext)
			m.pos1 = AT(',', m.responsetext)
			m.pos2 =  AT('}', m.responsetext)
			IF m.pos1 # 0 OR m.pos2 # 0
				m.pocet = VAL(ALLTRIM(SUBSTR(m.responsetext, m.pos0+1, IIF(m.pos1#0, m.pos1, m.pos2) - m.pos0-1)))
				TRY 
					INSERT INTO stravasum  FROM MEMVAR 
				CATCH 
				ENDTRY
			ELSE
				EXIT 	
			ENDIF
			IF m.pos1 # 0
				m.responsetext = SUBSTR(m.responsetext, m.pos1+1) 
			ELSE
				EXIT 
			ENDIF 
		ELSE
			EXIT 
		ENDIF  
	ENDDO 
	SELECT stravasum
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajPoctyHostu
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, hor_probud
LOCAL m.ret, m.lcClasslibWas, vysledok, i, m.responsetext
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/todayGuestCounts/", .F.)
Http.Option(4) = 13056 
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND("")
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/todayGuestCounts/", " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
*	m.lcClasslibWas = SET("Classlib")
	SET CLASSLIB TO "JSON.VCX" ADDITIVE 
	m.ret = .t.
	m.loJSON = CREATEOBJECT("JSON")
	m.vysledok=lojson.parse(http.responsetext)
	RELEASE lojson
	CREATE CURSOR poctyhostu (arrivals N(6,0), checked_id N(6,0))
	IF !ISNULL(m.vysledok)
		TRY 
			INSERT INTO poctyhostu (arrivals, checked_in) VALUES (vysledok.arrivals, vysledok.checked_in)
		CATCH 
		ENDTRY 
	ENDIF 
	SELECT poctyhostu
	RELEASE CLASSLIB JSON.VCX
*	SET CLASSLIB TO (m.lcClasslibWas)
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajarrivalsstravasum
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd, hor_probud
LOCAL m.ret, m.lcClasslibWas, vysledok, i, m.responsetext
IF m.hor_probud
  = citajhores10plonk(hor_adr, hor_port, hor_usr, hor_pwd)
ENDIF 
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/arrivalsComplementaryCodesSummary/", .F.)
Http.Option(4) = 13056 
http.settimeouts(0, 0, 0, 0)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND("")
	m.httpodpoved=http.statustext
	m.vysledok=http.status
	m.odpoved = ALLTRIM(http.responsetext)
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
	m.odpoved = ""
ENDTRY 
DO hores_http_log WITH "https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/arrivalsComplementaryCodesSummary/", " Status:"+ALLTRIM(STR(m.vysledok))+m.httpodpoved+IIF(EMPTY(m.odpoved), "", HCRLF + "         BODY>>> " + m.odpoved + " <<<BODY ")
IF m.vysledok=200
	m.ret = .t.
	m.responsetext = http.responsetext
	CREATE CURSOR arrivalsstravasum (naz_poloz C(10), pocet N(6,0))
	DO WHILE .T.
		m.pos = AT('"', m.responsetext)
		IF m.pos # 0
			m.naz_poloz = SUBSTR(m.responsetext, m.pos+1, AT('"', m.responsetext, 2)-m.pos-1)
			m.pos0 = AT(':', m.responsetext)
			m.pos1 = AT(',', m.responsetext)
			m.pos2 =  AT('}', m.responsetext)
			IF m.pos1 # 0 OR m.pos2 # 0
				m.pocet = VAL(ALLTRIM(SUBSTR(m.responsetext, m.pos0+1, IIF(m.pos1#0, m.pos1, m.pos2) - m.pos0-1)))
				TRY 
					INSERT INTO arrivalsstravasum  FROM MEMVAR 
				CATCH 
				ENDTRY
			ELSE
				EXIT 	
			ENDIF
			IF m.pos1 # 0
				m.responsetext = SUBSTR(m.responsetext, m.pos1+1) 
			ELSE
				EXIT 
			ENDIF 
		ELSE
			EXIT 
		ENDIF  
	ENDDO 
	SELECT arrivalsstravasum
ELSE
	m.ret=.f.
ENDIF 	
RELEASE m.http
RETURN m.ret

FUNCTION citajhores10plonk
* Slouzi k 
PARAMETERS hor_adr, hor_port, hor_usr, hor_pwd
LOCAL m.ret, m.lcClasslibWas, m.vysledok
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
http.OPEN("POST","https://"+m.hor_adr+":"+ALLTRIM(STR(m.hor_port,10,0))+"/cash_register/currencies/" , .F.)
Http.Option(4) = 13056
http.settimeouts(0, 2000, 2000, 2000)
http.setrequestheader("content-type", "application/json;charset=utf-8;")
*Http.SetCredentials(m.hor_usr,m.hor_pwd, 0)
http.setrequestheader("Authorization", "Basic "+STRCONV(m.hor_usr+":"+m.hor_pwd,13))
TRY 
	http.SEND("")
	m.httpodpoved=http.statustext
	m.vysledok=http.status
CATCH
	m.vysledok=-100
	m.httpodpoved="Server neodpovedá."
ENDTRY 
RELEASE m.http
RETURN .T.

***********************************************************

PROCEDURE hores_http_log
LPARAMETERS text_do_logu, poznamecka

IF VARTYPE(m.hores_http_logovat) # "U"
    IF !EMPTY(m.hores_http_logovat)
        jmeno_logu = IIF( VARTYPE(m.gchom_path) = "C", m.gchom_path, ".\") + "zh_http_foodserv" + SUBST(DTOS(DATE()), 3, 4) + ".txt"

        log_prefix = HCRLF + REPLICATE("    *", 22) + HCRLF + LEFT(TTOC(DATETIME(), 3), 16) + "  " + IIF(VARTYPE(poznamecka)="C", m.poznamecka, "")
        STRTOFILE( log_prefix + HCRLF + m.text_do_logu + HCRLF, m.jmeno_logu, 1 )
    ENDIF 
ENDIF 


FUNCTION sertimek
RETURN DATETIME()

*** L.L. (27.09.2017) Ciastocne pripojenie na SQLServer
*!*****************************************************************************
*!      Function: SQL_INI
*!*****************************************************************************
*** L.L. (05.11.2017) Mierne prerobena funkcia, aby sa dala pouzit aj na nastavenie
*** pripojenie pre ine servre nie len pre hlavny datovy
PROCEDURE sql_ini
LPARAMETERS iniHlavnyKluc, iniSectionSqlConnection, sServer
LOCAL m.sqldriver, sqlConnectString, lSqlSetup, lNastavene

m.iniHlavnyKluc = IIF(PARAMETERS()<1, "SQL", m.iniHlavnyKluc)
m.iniSectionSqlConnection = IIF(PARAMETERS()<2, "SQL Spojenie", m.iniSectionSqlConnection)
m.sServer = IIF(PARAMETERS()<3, "FOODMAN", m.sServer)

m.sqlConnectString = ""

m.lSqlSetup	= get_ini("Config", iniHlavnyKluc, ".F.")
IF m.lSqlSetup == "2"
	m.lSqlSetup = .T.
ELSE
	m.lSqlSetup = .F.
ENDIF

IF m.lSqlSetup
	LOCAL lNastavene
	DO FORM sqlspojenie TO lNastavene WITH iniHlavnyKluc, iniSectionSqlConnection, sServer
	IF !lNastavene AND ALLTRIM(UPPER(sServer))=="FOODMAN"
		= MESSAGEBOX("Parametre na pripojenie k SQL serveru neboli nastavené!"+CHR(13)+CHR(10)+"Program bude ukončený!",16,"FoodMan")				
	ENDIF
ELSE
	m.lNastavene = .T.
ENDIF

IF m.lNastavene
	localPathRoot	= get_ini(gcini_file, iniSectionSqlConnection, "localPathRoot")
	IF !EMPTY(localPathRoot)
		localPathRoot = UPPER(ADDBS(localPathRoot))
	ENDIF 
	sqlDSN   		= get_ini(iniSectionSqlConnection, "DSN")
	sqldriver       = get_ini(iniSectionSqlConnection, "ODBCDriver")
	sqladresa		= get_ini(iniSectionSqlConnection, "Server")
	sqlport			= get_ini(iniSectionSqlConnection, "Port")
	sqldatabaza		= get_ini(iniSectionSqlConnection, "Databaza")
	sqlmeno			= get_ini(iniSectionSqlConnection, "User")
	sqlheslo		= depwd(get_ini(iniSectionSqlConnection, "Heslo"))
	*
	IF !EMPTY(sqlDSN)
		m.sqlConnectString ="DSN="+ALLTRIM(m.sqlDSN)
	ELSE
		IF !EMPTY(m.sqladresa)		
			IF EMPTY(m.sqldriver)
				m.sqldriver= "PostgreSQL UNICODE"
			ENDIF
			IF EMPTY(m.sqldatabaza)
				m.sqldatabaza = "food600"
			ENDIF
			IF EMPTY(m.sqlport) 
				m.sqlport = "5432"
			ENDIF
			IF EMPTY(m.sqlmeno)
				m.sqlmeno= "postgres"
			ENDIF
			IF EMPTY(m.sqlheslo)
				m.sqlheslo = ""
			ENDIF
			m.sqlConnectString ="DRIVER={"+m.sqldriver+"};SERVER="+ALLTRIM(m.sqladresa)			
		ELSE
			IF ALLTRIM(UPPER(sServer))=="FOODMAN"
				= MESSAGEBOX("Nesprávne nastavené parametre na pripojenie k SQL serveru"+CHR(13)+CHR(10)+"Program bude ukončený!",16,"FoodMan")				
			ENDIF
			m.sqlConnectString = "" 
		ENDIF	
		*
		IF !EMPTY(m.sqlConnectString)
			m.sqlConnectString = m.sqlConnectString + IIF(!EMPTY(m.sqlport), ";PORT="+ALLTRIM(m.sqlport),"")
			m.sqlConnectString = m.sqlConnectString + IIF(!EMPTY(m.sqldatabaza), ";DATABASE="+ALLTRIM(m.sqldatabaza),"")
			m.sqlConnectString = m.sqlConnectString + IIF(!EMPTY(m.sqlmeno), ";UID="+ALLTRIM(m.sqlmeno),"")
			m.sqlConnectString = m.sqlConnectString + IIF(!EMPTY(m.sqlheslo), ";PWD="+ALLTRIM(m.sqlheslo),"")
		ENDIF
	ENDIF
ENDIF 
RETURN sqlConnectString

*** L.L. (27.09.2017) Ciastocne pripojenie na SQLServer
*!*****************************************************************************
*!      Function: PWD
*!*****************************************************************************
FUNCTION pwd
PARAMETERS untxt
delka = LEN(m.untxt)
txt = ""
FOR iii = 1 TO m.delka
	pismenko = ASC(SUBSTR(m.untxt, m.iii, 1))
	txt = m.txt + ;
		CHR(97 + BITAND(m.pismenko, 7)    + m.iii % 5) + ;
		CHR(97 + BITRSHIFT(m.pismenko, 3) + m.iii % 4)
ENDFOR
RETURN m.txt

*** L.L. (27.09.2017) Ciastocne pripojenie na SQLServer
*!*****************************************************************************
*!      Function: DEPWD
*!*****************************************************************************
FUNCTION depwd
PARAMETERS txt
delka = LEN(m.txt)
detxt = ""
FOR iii = 1 TO m.delka STEP 2
	cislo1 = ASC(SUBSTR(m.txt, m.iii  , 1)) - 97 - INT(m.iii/2 + .51) % 5
	cislo2 = ASC(SUBSTR(m.txt, m.iii+1, 1)) - 97 - INT(m.iii/2 + .51) % 4
	detxt = m.detxt + CHR(cislo2*8 + cislo1)
ENDFOR
RETURN ALLTRIM(m.detxt)
