home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / ZALOHA.PGM < prev    next >
Text File  |  2000-03-16  |  54KB  |  1,414 lines
  1. {$$3220792584 .                              }INCLUDE
  2. //--------------------------------------------------------
  3. // 602KATALOG   (Zaloha dat) 13.1.1998
  4. //--------------------------------------------------------
  5.  
  6. Table cenik_upd, OP_upd, Jednotka, Rabat_header;
  7. cursor  Testsoubor, TestsouborC;
  8.  
  9. /*type
  10.   filestr=record
  11.     neco : array[1..44] of char;
  12.     longname : string[260];
  13.     alias : string[14];
  14.   end;
  15. */
  16.  
  17.  
  18. var
  19.  fileOK, zal_all:Boolean;
  20.  filename: STRING[200];
  21.  zaldatum:string[80];
  22.  
  23.  
  24. /*function FindFirstFile(var name : string; var soubor : filestr) : integer;
  25. external "KERNEL32";
  26. */
  27.  
  28. function FileExists(var fname : string) : boolean;
  29. /*********************************************************************/
  30. var
  31.   strsoub : _WIN32_FIND_DATA;
  32. begin
  33.   FileExists := false;
  34.   if (fname <> "") and (FindFirstFile(fname,strsoub) > -1) then FileExists := true
  35. end;
  36.  
  37.  
  38. function FileDate(var fname : string) : boolean;
  39. /*********************************************************************/
  40. var
  41.  lpFindFileData:_WIN32_FIND_DATA ;
  42.  hFindFile,lpLocalFileTime,lpFileTime,i:integer;
  43.  lpSystemTime:_SYSTEMTIME;
  44.  ok: Boolean;
  45.  
  46. begin
  47.     ok:=false;
  48.     hFindFile:= FindFirstFile(fname, lpFindFileData);
  49.     if hFindFile<>-1 then ok:=true;
  50.     if ok then
  51.       begin
  52.         FileTimeToLocalFileTime(lpFindFileData.ft1LastWriteTime,lpLocalFileTime);
  53.         FileTimeToSystemTime(lpLocalFileTime, lpSystemTime);
  54.         zaldatum:= int2str(lpSystemTime.wDay)+"."+int2str(lpSystemTime.wMonth)+"."+int2str(lpSystemTime.wYear);
  55.  //       info_box( lpFindFileData.cFileName , sdatum);
  56.       end;
  57.     
  58.     while ok do
  59.       begin
  60.         ok:= FindNextFile(hFindFile, lpFindFileData);
  61.          if ok then
  62.           begin
  63.             FileTimeToLocalFileTime(lpFindFileData.ft1LastWriteTime,lpLocalFileTime);
  64.             FileTimeToSystemTime(lpLocalFileTime, lpSystemTime);
  65.             zaldatum:= int2str(lpSystemTime.wDay)+"."+int2str(lpSystemTime.wMonth)+"."+int2str(lpSystemTime.wYear);
  66. //            info_box( lpFindFileData.cFileName , sdatum);
  67.           end;
  68.       end;
  69. end;
  70.  
  71.  
  72. function  test_exist_file(soubor:string[200]):Boolean;
  73. /*********************************************************************/
  74. var
  75.  i,j,pocet,pomid:integer;
  76.  jmenosouboru, pomsoubor, pomstr:string[255];
  77.  s:string[255];
  78.  
  79. begin
  80.  
  81.    jmenosouboru:=soubor;
  82.    fileOK:=FileExists(jmenosouboru);
  83. /*   test_exist_file:=fileOK;
  84.    pomstr:="POZOR cφlov² soubor"+soubor+" existuje!!!";
  85.    s:="to znamenß, ₧e cφlov² soubor obsahuje data z p°edchozφho exportu. "#10#13"To m∙₧e znamenat, ₧e nebyla p°enesena do IS. "#10#13"P°episem m∙₧ete o p°edchozφ export p°ijφt!!!"#10#13"Chcete soubor OPRAVDU P╪EPSAT?";
  86.    if (fileOK) then   fileOK:=YesNo_Box(pomstr,s);
  87.  */
  88.    if (fileOK) then  Open_view("*prepisOK",NO_REDIR,MODAL_VIEW,0,0,nil);
  89.    test_exist_file:=NOT (fileOK);
  90. end;
  91.  
  92.  
  93. function Prevod(jm_tab: string[100]):string[10];
  94. /*********************************************************************/
  95. //p°evod dlouh²ch nßzv∙ tabulek na nßzvy krßtkΘ DOS - a₧ bude Φas najφt obecn² algoritmus
  96.  
  97. var 
  98. i : integer;
  99. s,s2 : string[50];
  100.  
  101. begin
  102.   s2 := Strcopy(jm_tab,1,6);
  103.   s := jm_tab;
  104.   if s ~ "obchodnici" then  s2 := "obchod2";
  105.   if s ~ "Cenik_upd" then  s2 := "cen_upd";
  106.   Prevod:=s2;
  107. // Info_box(s,s2);
  108. end; 
  109.  
  110.  
  111. procedure Chyba(m : short);
  112. /*********************************************************************/
  113. //
  114. begin
  115.   case m of
  116.       2    :  Info_box("Upozorn∞nφ","Data se nepoda°ilo importovat");
  117.       3    :  Info_box("Upozorn∞nφ","Chyba v arj");
  118.       4    :  Info_box("Upozorn∞nφ","Nebyl vybrßn ₧ßdn² soubor!");
  119.       5    :  Info_box("Upozorn∞nφ","Nebyl vybrßn ₧ßdn² adresß°!");
  120.       8    :  Info_box("Upozorn∞nφ","Data se nepoda°ilo smazat!");
  121.      else  :  Info_box("Upozorn∞nφ","Nenalezeno odpovφdajφcφ chybovΘ hlßÜenφ");
  122.   end;      
  123.  // i_chyba 0:= true;
  124. end;  
  125.  
  126.  
  127.  
  128. function Extension(i:integer):string[4];
  129. /*********************************************************************/
  130. begin
  131.   case i of
  132.    0:extension:=".tdt";
  133.    1:extension:=".txt";
  134.    2:extension:=".csv";
  135.    3,4:extension:=".dbf";
  136.   end;
  137. end;
  138.  
  139. function FindObj(var objname : string) : short;
  140. /*********************************************************************/
  141. // vrßtφ Φφslo objektu nebo -1 p°i chyb∞
  142. var
  143.   position : short;
  144. begin
  145.   if not Find_object(objname, CATEG_PGMSRC, position) then
  146.     FindObj := position
  147.   else 
  148.     FindObj := -1;
  149. end;
  150.  
  151.  
  152. procedure Exportuj(co : integer; var adr : string);
  153. /*********************************************************************/
  154. // vytvo°φ podle zadßnφ v pohledech Export a Export_select prom∞nn² kurzor 
  155. // a jeho obsah vyexportuje ve zvolenΘm formßtu a k≤dovßnφ
  156. // pou₧ije se triku zm∞ny prom∞nnΘho kurzoru na kurzor pevn² (zßpisem do tabulky objekt∙), aby Ülo exportovat-Honza
  157.  
  158. var
  159.   pomdotnum : short;
  160.   soubor  : string[200];
  161.   ext : string[4];
  162.   s1, podminka, defdotazu : string[500];
  163.   curs:cursor;
  164.   i, pocet, maxid:integer;
  165.   pr : string[10];
  166.   prenosobj : short;
  167.   oksoubor:Boolean;
  168.  
  169. begin
  170.   if pevny_export then 
  171.   begin //1
  172.     case e_table of
  173.       1 : begin
  174.             pr := "ExCenik";
  175.             prenosobj := FindObj(pr);
  176.           end; 
  177.       3 : begin
  178.             pr := "ExObjh";
  179.             prenosobj := FindObj(pr);
  180.           end; 
  181.       4 : begin
  182.             pr := "ExPartner";
  183.             prenosobj := FindObj(pr);
  184.           end; 
  185.     end;   //case
  186.     if prenosobj = -1 then
  187.     begin     //2
  188.       s1 := "Implicitnφ p°enos >"+pr+"< nenalezen, import je ukonΦen.";
  189.       Info_box("Chyba",s1);
  190.       Halt;
  191.     end;       //2
  192.  end;//1
  193.  
  194.   maxid:=0;
  195.     ext := Extension(I_format); //p°φpona dle vybranΘho formßtu exp. dat 
  196.  
  197.   if co = 1 then 
  198.    // tabulka Cenik - pouze cenik /Dasa
  199.   //********************************************************************************************************
  200.     begin   //1
  201.     if Find_object("Pdexcenik", categ_cursor,pomdotnum) then Signalize
  202.      else
  203.       begin //2
  204.        defdotazu := "SELECT * FROM cenik";
  205.        OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  206.        OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  207.  
  208.        if pevny_export then 
  209.          begin  //3
  210.           // soubor:=SYS_PAR[0].ISIMPCNK;  
  211.            if not Move_data(prenosobj,"Pdexcenik",-1,"",-1,-1,-1,I_kod,false) then Signalize
  212.             else Info_box("Upozorn∞nφ","Export tabulky  cenik prob∞hl ·sp∞Ün∞.");
  213.          end    //3
  214.        else
  215.          begin  //3
  216.           soubor:=adr+'\cenik'+ext;   //nßzev souboru se sklßdß z vybranΘho adresß°e jmΘna tabulky a p°φpony odvozenΘ ze I_formßt
  217.           if not Move_data(-1,"Pdexcenik",-1,soubor,6,i_format,0,i_kod,false) then Signalize
  218.            else Info_box("Upozorn∞nφ","Export tabulky  cenik prob∞hl ·sp∞Ün∞.");
  219.          end;   //3
  220.      end;  //2        
  221.    end;  //1                  // tabulka Cenik - Dasa
  222.  
  223.   if co = 4 then 
  224.     begin  //1
  225.   // tabulka Obchodnφ partne°i
  226.   //********************************************************************************************************
  227.       case e_vyber of
  228.         1 : 
  229.           begin
  230.            podminka := " FROM Obchodni_partneri, S_Deal_sk WHERE (S_Deal_sk.deal_id= Obchodni_partneri.DEAL_SK) AND (intr_user<>"+""""")";
  231.            defdotazu := "SELECT Obchodni_partneri.*,S_Deal_sk.kod "+ podminka;
  232.           end;
  233.         2 :
  234.           begin
  235.            podminka := " FROM Obchodni_partneri, S_Deal_sk  WHERE (S_Deal_sk.deal_id= Obchodni_partneri.DEAL_SK) AND (dat_zal>="+Date2str(dat_od,1)+") AND (dat_zal<="+Date2str(dat_do,1)+") AND (intr_user<>"+""""")";
  236.            defdotazu := "SELECT Obchodni_partneri.*,S_Deal_sk.kod  "+ podminka;
  237.           end;
  238.         3 :
  239.           begin 
  240.            podminka := " FROM Obchodni_partneri, S_Deal_sk   WHERE (S_Deal_sk.deal_id= Obchodni_partneri.DEAL_SK) AND (intr_user<>"+""""") AND (NOT (Obchodni_partneri.expok))";
  241.            defdotazu := "SELECT Obchodni_partneri.*,S_Deal_sk.kod  "+ podminka;
  242.           end; 
  243.       end;
  244.     if Find_object("Pdexpartner", categ_cursor,pomdotnum) then Signalize
  245.      else
  246.       begin //2
  247.       OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  248.       OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  249.       defdotazu := "SELECT id, dat_exp "+ podminka;
  250.       if Open_sql_cursor(curs,defdotazu) then Signalize
  251.       else Rec_cnt(curs,pocet);
  252. //      close_cursor(curs);
  253.       if pocet>0 then  
  254.         begin //3
  255.           if pevny_export then 
  256.            begin
  257.             soubor:=SYS_PAR[0].ISEXOP;   
  258.             oksoubor:=test_exist_file(soubor);
  259.             if oksoubor then
  260.              begin
  261.                i_kod:=SYS_PAR[0].KODOVANI_CS;   
  262.                if not Move_data(prenosobj,"Pdexpartner",-1,soubor,-1,-1,-1,i_kod,false) then Signalize
  263.                 else Info_box("Upozorn∞nφ","Export Obchodnφch partner∙ prob∞hl ·sp∞Ün∞.");
  264.              end;
  265.            end
  266.           else
  267.            begin
  268.             soubor:=adr+'\OBCH_PAR'+ext;   //nßzev souboru se sklßdß z vybranΘho adresß°e jmΘna tabulky a p°φpony odvozenΘ ze I_formßt
  269.             if not Move_data(-1,"Pdexpartner",-1,soubor,6,i_format,0,i_kod,false) then Signalize
  270.              else Info_box("Upozorn∞nφ","Export Obchodnφch partner∙ prob∞hl ·sp∞Ün∞.");
  271.            end;
  272.  
  273.         for i:=0 to pocet-1 do
  274.         begin
  275.          curs[i].DAT_EXP:=datetime2timestamp(today,now);
  276.          end;
  277.         close_cursor(curs);
  278.  
  279.         end   //3
  280.       else 
  281.         begin
  282.          close_cursor(curs);
  283.          Info_box("Upozorn∞nφ","V databßzi nejsou ₧ßdnφ novφ obchodnφ partne°i od poslednφho exportu ");
  284.         end; 
  285.     end;    //2
  286.   end;  //1                 
  287.  
  288.   if co = 3 then 
  289.     begin //1
  290.     //tabulky Obj_header a Obj_polozky  
  291.     //********************************************************************************************************
  292.     case e_vyber of      // za prvΘ export vybran²ch hlaviΦek objednßvky
  293.         1 :
  294.           begin
  295.            podminka := " FROM Obj_header, Obchodni_partneri WHERE Obj_header.id_org=Obchodni_partneri.id AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true)";        
  296.            defdotazu := "SELECT Obj_header.*,Obchodni_partneri.smlouva  "+ podminka;
  297.           end;
  298.         2 :
  299.           begin
  300.            podminka := "  FROM Obj_header, Obchodni_partneri WHERE Obj_header.id_org=Obchodni_partneri.id AND (datum>="+Date2str(dat_od,1)+") AND (Obj_header.datum<="+Date2str(dat_do,1)+") AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true)";
  301.            defdotazu := "SELECT Obj_header.*,Obchodni_partneri.smlouva  "+ podminka;
  302.           end;
  303.         
  304.         3 :
  305.           begin
  306.            podminka  := "  FROM Obj_header, Obchodni_partneri WHERE Obj_header.id_org=Obchodni_partneri.id AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true) AND (Obj_header.exok<>true)";
  307.            defdotazu := "SELECT Obj_header.*,Obchodni_partneri.smlouva "+ podminka;
  308.           end;
  309.       end;
  310.     if Find_object("Pdexobjh", categ_cursor,pomdotnum) then Signalize
  311.      else
  312.      begin //2
  313.  
  314.       OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  315.       OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  316.  
  317.       defdotazu := "SELECT id_dobj, exok, dat_exp "+ podminka;
  318.       if Open_sql_cursor(curs,defdotazu) then Signalize
  319.       else Rec_cnt(curs,pocet);
  320.       if pocet>0 then  
  321.         begin //3
  322.          if pevny_export then 
  323.            begin
  324.             soubor:=SYS_PAR[0].ISEXOBH;   
  325.             oksoubor:=test_exist_file(soubor);
  326.             if oksoubor then
  327.              begin
  328.                i_kod:=SYS_PAR[0].KODOVANI_CS;   
  329.                if not Move_data(prenosobj,"Pdexobjh",-1,soubor,-1,-1,-1,i_kod,false) then Signalize
  330.                 else Info_box("Upozorn∞nφ","Export hlaviΦky objednßvky prob∞hl ·sp∞Ün∞.");
  331.              end;
  332.            end
  333.           else
  334.            begin
  335.             soubor:=adr+'\OBJ_HEAD'+ext;   //nßzev souboru se sklßdß z vybranΘho adresß°e jmΘna tabulky a p°φpony odvozenΘ ze I_formßt
  336.             if not Move_data(-1,"Pdexobjh",-1,soubor,6,i_format,0,i_kod,false) then Signalize
  337.              else Info_box("Upozorn∞nφ","Export hlaviΦky objednßvky prob∞hl ·sp∞Ün∞.");
  338.            end;
  339.  
  340.         end //3
  341.       else 
  342.         begin   //3
  343.          for i:=0 to pocet-1 do
  344.          curs[i].DAT_EXP:=datetime2timestamp(today,now);
  345.          close_cursor(curs);
  346.          Info_box("Upozorn∞nφ","V databßzi nejsou ₧ßdnΘ novΘ objednßvky od poslednφho exportu ");
  347.         end;     //3
  348.      end; //2
  349.      if oksoubor then
  350.        begin  //2a
  351.              case e_vyber of      //za druhΘ export odpovφdajφcφch polo₧ek k vybran²m hlaviΦkßm 
  352.               1 : defdotazu := "SELECT cenik.kod_zbozi, Obj_polozky.*, Obj_header.cis_eob  FROM Obj_header,Obj_polozky, cenik WHERE (Obj_polozky.id_cnk=cenik.id_cenik) AND (Obj_header.id_dobj=Obj_polozky.id_dobj) AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true) ";
  353.               2 : defdotazu := "SELECT cenik.kod_zbozi, Obj_polozky.*, Obj_header.cis_eob  FROM Obj_header,Obj_polozky, cenik WHERE (Obj_polozky.id_cnk=cenik.id_cenik) AND (Obj_header.id_dobj=Obj_polozky.id_dobj) AND (datum>="+Date2str(dat_od,1)+") AND (datum<="+Date2str(dat_do,1)+") AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true) ";
  354.               3 : defdotazu := "SELECT cenik.kod_zbozi, Obj_polozky.*, Obj_header.cis_eob  FROM Obj_header,Obj_polozky, cenik WHERE (Obj_polozky.id_cnk=cenik.id_cenik) AND (Obj_header.id_dobj=Obj_polozky.id_dobj) AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true) AND (Obj_header.exok<>true)";
  355.              end;
  356.         
  357.              if Find_object("Pdexobjp", categ_cursor,pomdotnum) then Signalize
  358.               else
  359.                begin //2b
  360.                 OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  361.                 OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  362.                 if pocet>0 then  
  363.                   begin //3
  364.                    if pevny_export then 
  365.                      begin //4
  366.                        pr := "ExObjp";
  367.                        prenosobj := FindObj(pr);
  368.                        soubor:=SYS_PAR[0].ISEXOBP;   
  369.                        oksoubor:=test_exist_file(soubor);
  370.                        if oksoubor then
  371.                         begin //5
  372.                            i_kod:=SYS_PAR[0].KODOVANI_CS;   
  373.                            if not Move_data(prenosobj,"Pdexobjp",-1,SOUBOR,-1,-1,-1,i_kod,false) then Signalize
  374.                             else Info_box("Upozorn∞nφ","Export polo₧ek objednßvek prob∞hl ·sp∞Ün∞.");
  375.                         end;   //5
  376.                      end   //4
  377.                    else
  378.                      begin  //4
  379.                        soubor:=adr+'\OBJ_POLO'+ext;   //nßzev souboru se sklßdß z vybranΘho adresß°e jmΘna tabulky a p°φpony odvozenΘ ze I_formßt
  380.                        if not Move_data(-1,"Pdexobjp",-1,soubor,6,i_format,0,i_kod,false) then Signalize
  381.                         else Info_box("Upozorn∞nφ","Export polo₧ek objednßvek prob∞hl ·sp∞Ün∞.");
  382.                      end;    //4
  383.                   end; //3
  384.                end; //2b
  385.        end; //2a
  386.   end //1
  387. end;
  388.  
  389.  
  390. procedure Export;
  391. /*********************************************************************/
  392. //p°enos dat z tabulek do soubor∙ v adresß°i adrexp
  393.  
  394. var 
  395.   s1 : string[200];
  396.   adrexp : string[200];
  397.   
  398. begin //1 
  399.  Close_all_views;
  400.  pevny_export:=true; 
  401. if pevny_export<>true then
  402.  begin  //2
  403.   adrexp :="c:"; /*sys_par[0].adr_exporty;*/
  404.   if not Select_directory(0,adrexp) then  Chyba(5)  //vybrat adresß° kam exportovat
  405.   else begin //3
  406.     s1 := "╚ekejte prosφm, exportuji data";
  407.     Set_status_text(s1);
  408.     Exportuj(E_table,adrexp);     // provede export vybranΘ tabulky
  409.     Close_all_views;
  410.     Set_status_text("");
  411.   end;   //3
  412.  end   //2
  413.   else begin  //3
  414.     s1 := "╚ekejte prosφm, exportuji data";
  415.     Set_status_text(s1);
  416.     E_vyber:=1;
  417.     Exportuj(E_table,adrexp);     // provede export vybranΘ tabulky
  418.     Close_all_views;
  419.     Set_status_text("");
  420.   end;       //3
  421.  
  422. end;  //1
  423.  
  424.  
  425. procedure Import0;
  426. /*********************************************************************/
  427. //p°enos dat do tabulek podle pevn∞ nastavenΘho p°enosu nebo ze souboru v adresß°i adr 
  428. //ve zvolenΘm formßtu a k≤dovßnφ
  429.  
  430. var 
  431.  s1,s2:string[200];
  432.  tabulka :string[100];
  433.  soubor  : string[100];
  434.  ext:string[4];
  435.  prenosobj : short;
  436.  pr : string[10];
  437.  ano,ano1: Boolean;
  438.  jmeno_tab, stattxt   : string[100];
  439.  cislo_tab : short;
  440.  
  441.  
  442. begin        
  443.   if pevny_import then 
  444.   begin //1
  445.     case e_table of
  446.       1 : begin
  447.             pr := "PreCenik";
  448.             prenosobj := FindObj(pr);
  449.           end; 
  450.       4 : begin
  451.             pr := "PrePartner";
  452.             prenosobj := FindObj(pr);
  453.           end; 
  454.     end;   //case
  455.     if prenosobj = -1 then
  456.     begin     //2
  457.       s1 := "Implicitnφ p°enos >"+pr+"< nenalezen, import je ukonΦen.";
  458.       Info_box("Chyba",s1);
  459.       Halt;
  460.     end;       //2
  461.      if  e_table=1 then 
  462.       begin    //3
  463.       Ano:=YesNo_Box("UPOZORN╠N═","Data z tabulky Cenφk_imp budou smazßna"#10" a nahrazena daty ze souboru"#10"PokraΦovat?" );
  464.       if ano then 
  465.         begin    //4
  466.           Ano1:=YesNo_Box("UPOZORN╠N═","Chcete p∙vodnφ data zßlohovat?"#10"Vyberte jin² adresß° ne₧ ze kterΘho importujete,"#10"aby jste si nep°emazali soubor p°ipraven² pro import" );
  467.           if ano1 then  
  468.             begin   //5
  469.               Export;
  470.               s2:="Export dat z tabulky "+tabulka+" byl proveden";
  471.               Info_Box("UPOZORN╠N═",s2 );
  472.             end;       //5
  473.         //sma₧ou se a uvolnφ zßznamy v tabulkßch
  474.          stattxt := "╚ekejte prosφm, ma₧u data v tabulce- cenik";
  475.          Set_status_text(stattxt);
  476.          if not Find_object("cenik", CATEG_TABLE, cislo_tab) then 
  477.            begin  //10
  478.              Delete_all_records(cislo_tab);
  479.             // Free_deleted(cislo_tab); 
  480.            end;  //10
  481.         end;         //4
  482.       end;        //3
  483.     if ano then
  484.      begin //11
  485.       Set_status_text("");
  486.       s2:="╚ekejte prosφm, importuji data do tabulky ";
  487.       Set_status_text(s2);
  488.       if not Move_data(prenosobj,"",-1,"",-1,-1,I_kod,-1,false) then Signalize;
  489.          if  e_table=1 then 
  490. /*          begin    //6
  491.             vlozcenik();
  492.             smazcen();     
  493.           end;     //6
  494.   */
  495.      end;     //11
  496.   end     //1
  497.    else begin  //7
  498.     ext := Extension(I_format);
  499.     case e_table of 
  500.      1 : tabulka:="cenik";
  501.      4 : tabulka:="obchodni_partneri";
  502.     end;      //case
  503.  
  504.      if  e_table=1 then 
  505.       begin    //3
  506.       Ano:=YesNo_Box("UPOZORN╠N═","Data z tabulky Cenφk_imp budou smazßna"#10" a nahrazena daty ze souboru"#10"PokraΦovat?" );
  507.       if ano then 
  508.         begin    //4
  509.           Ano1:=YesNo_Box("UPOZORN╠N═","Chcete p∙vodnφ data zßlohovat?"#10"Vyberte jin² adresß° ne₧ ze kterΘho importujete,"#10"aby jste si nep°emazali soubor p°ipraven² pro import" );
  510.           if ano1 then  
  511.             begin   //5
  512.               Export;
  513.               s2:="Export dat z tabulky "+tabulka+" byl proveden";
  514.               Info_Box("UPOZORN╠N═",s2 );
  515.             end;       //5
  516.           //sma₧ou se a uvolnφ zßznamy v tabulkßch
  517.            stattxt := "╚ekejte prosφm, ma₧u data v tabulce- cenik";
  518.            Set_status_text(stattxt);
  519.            if not Find_object("cenik", CATEG_TABLE, cislo_tab) then 
  520.              begin  //10
  521.                Delete_all_records(cislo_tab);
  522.               // Free_deleted(cislo_tab); 
  523.              end;  //10
  524.         end;      //4
  525.       end;       //3
  526.  
  527.  
  528.     if ano then
  529.      begin //11
  530.        Set_status_text("");
  531.        soubor :="C:"  /*sys_par[0].adr_importy*/+ext;
  532.        if not Select_file(0,soubor) then  Chyba(4)  //vybrat soubor
  533.        else begin   //8
  534.          s2:="╚ekejte prosφm, importuji data do tabulky "+tabulka;
  535.          Set_status_text(s2);
  536.          Move_data(-1,soubor,-1,TABULKA,I_format,11,I_kod,0,false); 
  537.          Set_status_text("");
  538.          if  e_table=1 then 
  539.          /*
  540.           begin     //9
  541.            vlozcenik();
  542.            smazcen();  
  543.           end;//9
  544.           */
  545.        end;   //8
  546.      end;  //11       
  547.    end;     //7
  548.   s2:="Import dat do tabulky "+tabulka+" byl proveden";
  549.   if ano then Info_Box("UPOZORN╠N═",s2 );
  550.   Set_status_text("");
  551.  
  552. end;         
  553.  
  554. function Exportuj_zal(var adr, tabulka: string):Boolean;
  555. /*********************************************************************/
  556. //zßloha - p°enos dat z tabulky  tabulka do adresß°e adr v internφm formßtu WinBase
  557.  
  558. var
  559.  cc:cursor;
  560.  query:string[80];
  561.  s1,s2:string[200];
  562.  cislo_tab:tobjnum;
  563.  
  564. begin
  565.     s2:=prevod(tabulka);
  566.     s1:=adr+"\"+s2+".tdt";
  567.     s2:="╚ekejte prosφm, zßlohuji data z tabulky "+tabulka+" do zvolenΘho adresß°e";
  568.     Set_status_text(s2);
  569. //uvolnφ zßznamy v tabulkßch
  570.     if not Find_object(tabulka, CATEG_TABLE, cislo_tab) then  Free_deleted(cislo_tab); 
  571.     query:="select * from "+tabulka;
  572.     Open_sql_cursor(cc, query);
  573.     if not Move_data(-1,"",cc,s1,10,0,0,0,true) then Signalize; 
  574.     close_cursor(cc);
  575. end; 
  576.  
  577.  
  578. procedure  Zadej_poradi();
  579. /*********************************************************************/
  580. var
  581.   jmeno_tab : string[100];
  582.   i,pocet_tab:integer;
  583.   ct:cursor;
  584.  
  585. begin   //0
  586.   if  Open_sql_cursor(Ct,"select * from ZAL_TAB ")  then Signalize 
  587.   else
  588.    begin //2
  589.      Rec_cnt(Ct,pocet_tab);
  590.      for i:=0 to pocet_tab-1 do
  591.        begin   //3
  592.          jmeno_tab:=Ct[i].jmeno;
  593.          Ct[i].poradi:=1;
  594.          if jmeno_tab.="S_" then Ct[i].poradi:=11;
  595.          if jmeno_tab.="EP_" then Ct[i].poradi:=11;
  596.          if jmeno_tab.=."_POL" then Ct[i].poradi:=33;
  597.          if jmeno_tab.=."_HEAD" then Ct[i].poradi:=22;
  598.          if jmeno_tab.="SPOJ" then Ct[i].poradi:=9999;
  599.          if jmeno_tab.="OBCHODNICI" then Ct[i].poradi:=19;
  600.          if jmeno_tab.="DEFAULT" then Ct[i].poradi:=60;
  601.          if jmeno_tab.="OBCHODNI_" then Ct[i].poradi:=20;
  602.          if jmeno_tab="RABAT" then Ct[i].poradi:=27;        
  603.          if jmeno_tab.="SYS_PAR" then Ct[i].poradi:=61; 
  604.          if jmeno_tab="CENIK" then Ct[i].poradi:=30;
  605. //         if jmeno_tab.="" then Ct[i].poradi:=;
  606.          if jmeno_tab.="VYB" then Ct[i].poradi:=0;
  607.          if jmeno_tab.=."_UPD" then Ct[i].poradi:=0;
  608.          if jmeno_tab.="ZAL_TAB" then Ct[i].poradi:=0;
  609.          if jmeno_tab.="UZIV" then Ct[i].poradi:=0;
  610.          if jmeno_tab="CHYBY" then Ct[i].poradi:=0;
  611.       end;  //3
  612.      close_cursor(Ct);
  613.    end;  //2
  614.  
  615.  
  616. end;      //0
  617.  
  618. procedure preZaloha();
  619. /*********************************************************************/
  620. var
  621. i,pocet_tab:integer;
  622. prennum:tobjnum;
  623.  
  624. begin
  625.    Rec_cnt(ZAL_TAB,pocet_tab);
  626.    if pocet_tab=0 then
  627.    begin
  628.     if Find_object("ZT",CATEG_PGMSRC,prennum) then Signalize
  629.     else 
  630.      if not Move_data(prennum,"",-1,"",-1,-1,-1,-1,true) then Signalize;
  631.    end;
  632.      Zadej_poradi();
  633. end;
  634.  
  635.  
  636. procedure Zaloha();
  637. /*********************************************************************/
  638. //provede zßlohu dat vÜech tabulek do vybranΘho adresß°e
  639.  
  640. var
  641. adr       : string[100];
  642. soubor    : string[100];
  643. zs        : string[100];
  644. jmeno_tab : string[100];
  645. i,pocet_tab:integer;
  646. ok        : Boolean;
  647. kratke_jm : string[10];
  648. ct:cursor;
  649. prennum:tobjnum;
  650.  
  651. begin    //0
  652.   preZaloha();
  653. //  if dvyb then dvyber;
  654.  adr := sys_par[0].adr_zaloha;
  655.  
  656.  if strlength(adr)<2 then 
  657.   begin     //1
  658.    adr := 'C:\';
  659.    if not Select_directory(0,adr) then Chyba(5)
  660.   end        //1
  661.  else Make_directory(adr);
  662.  
  663.  
  664.    begin    //1
  665.    //otev°enφ kursoru obsahujφcφ seznam tabulek aplikace 
  666.     pocet_tab:=0;
  667.     if Open_sql_cursor(Ct,"select * from zal_TAB WHERE poradi>0 ORDER BY poradi" ) then Signalize
  668.      else Rec_cnt(ct,pocet_tab);
  669.   //export tabulek do soubor∙ .tdt
  670.      if pocet_tab>0 then begin    //2
  671.       for i:=0 to pocet_tab-1 do begin   //3
  672.        zs := "╚ekejte prosφm, zßlohuji data v tabulce - " +jmeno_tab;
  673.        Set_status_text(zs);
  674.         jmeno_tab:=ct[i].jmeno;
  675.         Exportuj_zal(adr,jmeno_tab);
  676.       end;    //3
  677.        zs:="Zßloha prob∞hla ·sp∞Ün∞. Data jsou v  adresß°i "+adr;
  678.        sys_par[0].adr_zaloha:=adr;
  679.        Info_box("Upozorn∞nφ",zs);
  680.     end;  //2
  681.     Close_cursor(ct);
  682.     Set_status_text(zs);
  683.     Set_status_nums(0,0);
  684.    end;  //1
  685. end; //0
  686.  
  687.     
  688. procedure Obnoveni();
  689. /*********************************************************************/
  690. //provede obnovenφ dat vÜech tabulek ze zßlohy
  691.  
  692. var
  693.   soubor    : string[100];
  694.   adr       : string[100];
  695.   zs        : string[100];
  696.   stattxt   : string[100];
  697.   cislo_tab : short;
  698.   pakk_out  : string[10];
  699.   pakk_ext  : string[4];
  700.   jmeno_tab : string[100];
  701.   kratke_jm: string[10];
  702.   i,pocet_tab:integer;
  703.   ct        :cursor;
  704.   f:file;
  705.  
  706. begin            //0
  707.   adr := sys_par[0].adr_zaloha;
  708. //  adr := 'C:\';
  709.   i_chyba := false;
  710.   if adr="" then begin adr:="c:"; Select_Directory(0,adr); end;
  711.   soubor:=adr+"\Cenik.tdt";
  712.    if NOT (FileExists(soubor)) then  Select_Directory(0,adr);
  713.    soubor:=adr+"\Cenik.tdt";
  714.   i_chyba:= NOT (FileExists(soubor));
  715.   if not i_chyba then
  716.    begin   //3
  717.     FileDate(soubor);
  718.     zs:="Obnovenφ dat ze zßlohy po°φzenΘ "+zaldatum;
  719.     if Yesno_box(zs,"Obnovenφm dat dojde ke smazßnφ aktußlnφch. PokraΦovat?") then
  720.      begin    //4
  721.       //otev°enφ kursoru obsahujφcφ seznam tabulek aplikace 
  722.        if Open_sql_cursor(Ct,"select * from zal_TAB WHERE poradi>0 ORDER BY poradi" ) then Signalize
  723.         else
  724.          begin   //5
  725.            Rec_cnt(ct,pocet_tab);
  726.            if pocet_tab>0 then
  727.              begin  //6
  728.               for i:=pocet_tab-1 downto 0 do
  729.                begin   //7
  730.                  jmeno_tab := ct[i].jmeno;
  731.                  kratke_jm := Prevod(jmeno_tab);
  732.                  soubor := adr+"\"+kratke_jm+".tdt";
  733.                  stattxt := "╚ekejte prosφm, Obnovuji data v tabulce - " +jmeno_tab;
  734.                  Set_status_text(stattxt);
  735.                  if FileExists(soubor) then
  736.                   begin
  737.                     stattxt := "╚ekejte prosφm, ma₧u data v tabulce- " +jmeno_tab;
  738.                     Set_status_text(stattxt);
  739.                     if not Find_object(jmeno_tab, CATEG_TABLE, cislo_tab) then 
  740.                      begin  //8
  741.    //sma₧ou se a uvolnφ zßznamy v tabulkßch
  742.                       if Delete_all_records(cislo_tab) then begin Signalize; i_chyba := true; end;
  743.                       Free_deleted(cislo_tab); 
  744.                      end   //8
  745.                  else
  746.                   begin  //8
  747.                    stattxt:= "tabulka: " +jmeno_tab + " nenalezena";
  748.                    Info_box("upozorn∞nφ",stattxt);
  749.                   end;   //8
  750.                 end
  751.                 else 
  752.                  begin
  753.                   i_chyba := true; 
  754.                   stattxt := "Nenalezen soubor - " +soubor;
  755.                   Info_box("UkonΦenφ obnovy dat!",stattxt);
  756.                   i:=0;
  757.                  end;
  758.                end;     //7
  759. //obnovφ se zßznamy v tabulkßch
  760.              if NOT i_chyba then
  761.               begin
  762.               for i:=0 to pocet_tab-1 do
  763.                begin   //7
  764.                  jmeno_tab := ct[i].jmeno;
  765.                  kratke_jm := Prevod(jmeno_tab);
  766.                  soubor := adr+"\"+kratke_jm+".tdt";
  767.                  stattxt := "╚ekejte prosφm, Obnovuji data v tabulce - " +jmeno_tab;
  768.                  Set_status_text(stattxt);
  769.                  if FileExists(soubor) then
  770.                   begin
  771.                     if NOT Move_data(-1,soubor,-1,jmeno_tab,0,11,0,0,false) then i_chyba := true;
  772.                   end
  773.                  else i_chyba := true; 
  774.                end;     //7
  775.                end;
  776.              end;  //6
  777.            if i_chyba then Info_box("Upozorn∞nφ","P°i pokusu o obnovu dat doÜlo k chyb∞. Zkontrolujte data a zkuste importovat data samostatn∞.")
  778.            else 
  779.             begin    //9
  780.               if YesNo_box("Obnova dat byla dokonΦena", "Chcete zßlo₧nφ soubory smazat?") then
  781.                begin  //8
  782. //sma₧e soubory zßlo₧nφho adresß°e
  783.               for i:=0 to pocet_tab-1 do
  784.                begin   //7
  785.                  jmeno_tab := ct[i].jmeno;
  786.                  kratke_jm := Prevod(jmeno_tab);
  787.                  soubor := adr+"\"+kratke_jm+".tdt";
  788.                  stattxt := "╚ekejte prosφm, ma₧u soubor - " +soubor;
  789.                  Set_status_text(stattxt);
  790.                  //adr:=adr+"\*.tdt";
  791.                  if Delete_file(soubor) then Signalize;
  792.                end;   //7
  793.              end;    //8
  794.             end;    //9
  795.            Close_cursor(ct);
  796.          end;   //5
  797.      end;           //4
  798.    end   //3
  799.    else 
  800.     begin
  801.      stattxt := "Ve zvolenΘm adresß°i nejsou zßlohovanΘ soubory" +adr;
  802.      Set_status_text(stattxt);  
  803.      Info_box("Upozorn∞nφ",stattxt);
  804.     end;
  805.   Set_status_text("");
  806.   Set_status_nums(0,0);
  807. end;          //0
  808.  
  809. function  exist_file(soubor:string[200];op:Boolean):Boolean;
  810. /*********************************************************************/
  811. var
  812.  i,j,pocet,pomid:integer;
  813.  pomsoubor:string[255];
  814.  pomdef:string[2000];
  815.  delka:short;
  816.  
  817. begin
  818.  if soubor="" then
  819.   begin
  820.      if op then
  821.      begin
  822.        if open_cursor(Testsoubor) then Signalize
  823.        else Rec_cnt(Testsoubor,pocet);
  824.        if pocet>0 then
  825.          begin
  826.       /*   strinsert (Testsoubor[0].defin,pomdef,1);
  827.          delka:= strlength(Testsoubor[0].defin#);*/
  828.            pomsoubor:= Testsoubor[0].defin[0,255];
  829.          end;
  830.        close_cursor(Testsoubor);
  831.      end
  832.       else
  833.      begin
  834.        if open_cursor(TestsouborC) then Signalize
  835.        else Rec_cnt(TestsouborC,pocet);
  836.        if pocet>0 then
  837.          begin
  838.       /*   strinsert (TestsouborC[0].defin,pomdef,1);
  839.          delka:= strlength(TestsouborC[0].defin#);*/
  840.            pomsoubor:= TestsouborC[0].defin[0,255];
  841.          end;
  842.        close_cursor(TestsouborC);
  843.      end;
  844.     end;
  845. /*
  846.    i:=1;j:=1;
  847.    while pomsoubor[i]<>"""" do i:=i+1;
  848.    i:=i+1;
  849.    while pomsoubor[i]<>"""" do
  850.    begin
  851.     soubor[j]:=pomsoubor[i];
  852.     i:=i+1;
  853.     j:=j+1;
  854.    end; 
  855. */
  856.    fileOK:=FileExists(soubor);
  857.    filename:=soubor;
  858.    if (fileOK) then 
  859.    fileOK:=YesNo_Box(soubor,"Soubor existuje,chcete opravdu provΘst import?")
  860.    else Info_box(soubor,'Soubor neexistuje! Import nelze provΘst.');;
  861.    exist_file:=fileOK;
  862.  
  863. end;
  864.  
  865.  
  866. procedure upd_cenik(kod:Boolean);
  867. /*********************************************************************/
  868. var
  869.  s, podminka, pomstr:string[255];
  870.  idpre, idtab:tobjnum;
  871.  pomreal,kdph:real;
  872.  adr,soubor:string[200];
  873.  kod_cs, idcenik, delka, i, pocet, pocetdph:integer;
  874.  csk,c,curs, cdph:cursor;
  875.  s1 : string[200];
  876.  u:untyped;
  877.  irec, crec, srec, skrec, oprec, jedrec, rabrec: trecnum;
  878.  allOK,ano:Boolean;
  879.  newid, lid,idph, pominteger:integer;
  880.  kodsk, kodjed, kodrab: STRING[30];
  881.  pomstrhtw: string[10000];
  882.  dstr:short;
  883.  
  884. begin
  885.    filename:=SYS_PAR[0].ISIMPCNK;
  886.    kod_cs:=SYS_PAR[0].KODOVANI_CS;
  887.    fileOK:=exist_file(filename,false); 
  888.    if fileOK then
  889.    begin  //0
  890.   allOk:=false;
  891.   ano:=false;
  892.   s:="UPDATE cenik SET upd=FALSE";
  893.   Sql_execute(s);
  894. //  delka:=strlength(sys_par[0].adr_importy)-5;
  895. /*  delka:=strlength(sys_par[0].adr_importy);
  896.   adr:=strcopy(sys_par[0].adr_importy,1,delka);
  897.   if adr="" then if not Select_directory(0,adr) then Signalize;  //vybrat adresar
  898. // else
  899. */  
  900.     begin //1
  901.       s1 := "╚ekejte prosφm, importuji data";
  902.       Set_status_text(s1);
  903.       if not Find_object("Cenik_upd", CATEG_TABLE, idtab) then 
  904.         begin
  905.           Delete_all_records(Cenik_upd);
  906.           Free_deleted(idtab);
  907.         end;
  908.       if not Find_object("preCenik", CATEG_PGMSRC, idpre) then
  909.       if not Move_data(idpre,filename,-1,"Cenik_upd",-1,11,kod_cs,0,false) then Signalize
  910.       else
  911.          begin //2
  912.            if Open_sql_cursor(c, "SELECT * FROM Cenik_upd") then Signalize
  913.             else
  914.              begin  //3
  915.                Rec_cnt(c,pocet);
  916.                for i:=0 to pocet-1 do
  917.                 begin  //4
  918.                 set_status_nums(i,pocet-1);
  919. //zjiÜt∞nφ id_cenik podle  kod-kod_zbozi
  920.                  if kod then
  921.                   begin
  922.                     u:=c[i].kod_zbozi;
  923.                     irec := Look_up(CENIK,"kod_zbozi",u);
  924.                   end
  925.                  else
  926.                   begin
  927.                     u:=c[i].id_cenik;
  928.                     irec := Look_up(CENIK,"id_cenik",u);
  929.                   end;
  930.                   if irec=-1 then 
  931.                    begin
  932.                     irec:=  Insert(CENIK);
  933. //                    if kod  then
  934.                      cenik[irec].kod_zbozi:=c[i].kod_zbozi;
  935.                    //  else
  936.                    //    begin
  937.                          newid:=c[i].id_cenik;
  938.                          if newid<>NONEINTEGER then
  939.                            begin
  940.                              if newid>sys_par[0].id_last_c then sys_par[0].id_last_c:= newid ;
  941.                              cenik[irec].id_cenik:= newid;
  942.                            end
  943.                          else
  944.                            begin
  945.                              cenik[irec].id_cenik:= sys_par[0].id_last_c+1 ;
  946.                              sys_par[0].id_last_c:= sys_par[0].id_last_c+1 ;
  947.                            end;
  948.                      //  end;
  949.                    end;
  950. //cenik
  951.                   idcenik:=cenik[irec].id_cenik;      
  952.                   cenik[irec].nazev_zbozi:=c[i].nazev_zbozi;      
  953.                   if NOT(kod) then  cenik[irec].kod_zbozi:=c[i].kod_zbozi;
  954.                    kdph:=1.0;
  955.                   if sys_par[0].impdph then
  956.                     begin
  957.                       idph:=c[i].idph;
  958.  
  959.                       if idph<>NONEINTEGER then      
  960.                         begin
  961.                           podminka:="SELECT * FROM S_DPH WHERE S_DPH.uc_rok="+int2str(year(today))+" AND S_DPH.id_dph="+int2str(idph);
  962.                           if Open_sql_cursor(cdph,podminka) then Signalize
  963.                           else Rec_cnt(cdph, pocetdph);
  964.                           if  pocetdph>0 then kdph:=cdph[0].procento;
  965.                           kdph:=100/(kdph+100);
  966.                          close_cursor(cdph);
  967.                         end 
  968.                     end;
  969.                   pomreal:=c[i].min_cena;
  970.                   cenik[irec].min_cena:=pomreal*kdph;      
  971.                   cenik[irec].upd:=true;      
  972.                   pomreal:=c[i].cena1;
  973.                   cenik[irec].cena1:=pomreal*kdph;      
  974.                   pomreal:=c[i].cena2;
  975.                   cenik[irec].cena2:=pomreal*kdph;      
  976.                   pomreal:=c[i].cena3;
  977.                   cenik[irec].cena3:=pomreal*kdph;      
  978.                   pomreal:=c[i].cena4;
  979.                   cenik[irec].cena4:=pomreal*kdph;      
  980. /*                  pomreal:=c[i].cena5;
  981.                   cenik[irec].cena5:=pomreal*kdph;      
  982.                   pomreal:=c[i].cena6;
  983.                   cenik[irec].cena6:=pomreal*kdph;      
  984.                   pomreal:=c[i].cena7;
  985.                   cenik[irec].cena7:=pomreal*kdph;      
  986.                   pomreal:=c[i].cena8;
  987.                   cenik[irec].cena8:=pomreal*kdph;      
  988.                   pomreal:=c[i].cena9;
  989.  */
  990.                   cenik[irec].cena9:=pomreal*kdph;      
  991.                   pomreal:=c[i].hmotnost;
  992.                   if pomreal<>NONEREAL then cenik[irec].hmotnost:=pomreal;      
  993.                   pominteger:=c[i].sklad;
  994.                   if pominteger<> NONEINTEGER then 
  995.                    begin
  996.                     if pominteger>0 then cenik[irec].skladem:=true else cenik[irec].skladem:=false;      
  997.                    end;
  998.                   pomstr:=c[i].anotace;
  999.                   if pomstr<>"" then cenik[irec].anotace:=pomstr;
  1000.                   pomstr:=c[i].vyrobce;
  1001. //                  pominteger:=NONEINTEGER;
  1002.                   if pomstr<>"" then 
  1003.                    begin
  1004.                      u:=pomstr;
  1005.                      crec := Look_up(vyrobci,"kod",u);
  1006.                      if crec>-1 then 
  1007.                        begin
  1008.                          pominteger:=vyrobci[crec].id;
  1009.                          cenik[irec].vyrobce:=pominteger;
  1010.                        end;
  1011.                    end;
  1012.                   idph:=c[i].idph;
  1013.                   kodsk:=c[i].kod_sk;
  1014.                   kodjed:=c[i].kod_jedn;
  1015.                   kodrab:=c[i].kod_rabat;
  1016.  
  1017.                    pomstrhtw:=c[i].htwtxt;
  1018.                    if strlength(pomstrhtw)>0 then cenik[irec].htwtxt:=pomstrhtw;
  1019.                    pomstrhtw:=c[i].htwobr;
  1020.                    if strlength(pomstrhtw)>0 then cenik[irec].htwobr:=pomstrhtw;
  1021. //                   dstr:=c[i].pozn#;
  1022. //                   pomstrhtw:=c[i].pozn[0,dstr];
  1023.                    pomstrhtw:=c[i].pozn;
  1024.                    dstr:=strlength(pomstrhtw);
  1025.                    if dstr>0 then cenik[irec].pozn[0,dstr]:=pomstrhtw;
  1026.               
  1027.                     if idph<>NONEINTEGER then      
  1028.                      begin
  1029.                       podminka:="SELECT * FROM S_DPH WHERE S_DPH.uc_rok="+int2str(year(today))+" AND S_DPH.id_dph="+int2str(idph);
  1030.                       if Open_sql_cursor(cdph,podminka) then Signalize
  1031.                       else Rec_cnt(cdph, pocetdph);
  1032.                       if  pocetdph>0 then
  1033.                        cenik[irec].dph:=cdph[0].id_dph
  1034.                       else   
  1035.                        cenik[irec].dph:=default_hodnoty[0].dph;      
  1036.                        close_cursor(cdph);
  1037.                      end 
  1038.                     else   
  1039.                       cenik[irec].dph:=default_hodnoty[0].dph;      
  1040.                     if kodsk<>"" then
  1041.                      begin
  1042.                        u:=kodsk;
  1043.                        skrec := Look_up(S_ZBOZI_SK,"kod_skupiny",u);
  1044.                        if skrec<>-1 then cenik[irec].skupina_zbozi:=S_ZBOZI_SK[skrec].id_skupiny;
  1045.                      end;     
  1046.                     if kodjed<>"" then
  1047.                      begin
  1048.                        u:=kodjed;
  1049.                        jedrec := Look_up(Jednotka,"kod",u);
  1050.                        if jedrec<>-1 then cenik[irec].jednotka:=Jednotka[jedrec].nazev
  1051.                        else
  1052.                         begin
  1053.                          u:=default_hodnoty[0].jednotka;
  1054.                          jedrec := Look_up(Jednotka,"idj",u);
  1055.                          if jedrec<>-1 then cenik[irec].jednotka:=Jednotka[jedrec].nazev
  1056.                         end;
  1057.                      end     
  1058.                        else
  1059.                         begin
  1060.                          u:=default_hodnoty[0].jednotka;
  1061.                          jedrec := Look_up(Jednotka,"idj",u);
  1062.                          if jedrec<>-1 then cenik[irec].jednotka:=Jednotka[jedrec].nazev
  1063.                         end;
  1064.                     if kodrab<>"" then
  1065.                      begin
  1066.                        u:=kodrab;
  1067.                        rabrec := Look_up(Rabat_header,"kod",u);
  1068.                        if rabrec<>-1 then cenik[irec].rabat:=Rabat_header[rabrec].metoda
  1069. /*                       else
  1070.                         begin
  1071.                          u:=default_hodnoty[0].rabatova_metoda;
  1072.                          rabrec := Look_up(Rabat_header,"metoda",u);
  1073.                          if rabrec<>-1 then cenik[crec].rabat:=Rabat_header[rabrec].metoda
  1074.                         end*/;
  1075.                      end;     
  1076.                   allOK:=true;
  1077.                 end;  //4
  1078.              end;  //3
  1079.                close_cursor(c);
  1080.         end;  //2
  1081.            if Open_sql_cursor(c, "SELECT * FROM cenik WHERE cenik.upd=false") then Signalize
  1082.             else
  1083.              begin  //3
  1084.                Rec_cnt(c,pocet);
  1085.                if pocet>0 then
  1086.                 begin
  1087.                   s:="Bude zruÜeno a uvoln∞no a₧ "+int2str(pocet)+" zßznam∙ v cenφku";;
  1088.                   ano:=YesNo_box("Upozorn∞nφ",s);
  1089.                 end;  
  1090.                if ano then
  1091.                 begin
  1092.                  s1 := "╚ekejte prosφm, provßdφm mazßnφ star²ch polo₧ek cenφku";
  1093.                  Set_status_text(s1);
  1094.                for i:=0 to pocet-1 do
  1095.                 begin  //4
  1096.                  set_status_nums(i,pocet-1);
  1097.                   idcenik:=c[i].id_cenik;      
  1098.                   u:=idcenik;
  1099.                   oprec := Look_up(Obj_polozky,"id_cnk",u);
  1100.                   if oprec=-1 then
  1101.                   begin
  1102.                    crec := Look_up(CENIK,"id_cenik",u);
  1103.                    if crec<>-1 then delete(CENIK,crec);
  1104.                    delete(C,i);
  1105.                   end;
  1106.                 end;    //4
  1107.                end;
  1108.            end;  //3
  1109.          close_cursor(c);
  1110. //         if not Find_object("cenik", CATEG_TABLE, idtab) then  Free_deleted(idtab);
  1111. //         if not Find_object("Cenik", CATEG_TABLE, idtab) then  Free_deleted(idtab);
  1112.     end;   //1
  1113.     if Open_sql_parts(curs, "MAX(id_cenik) AS M", "cenik", "", "") then Signalize;
  1114.     set_status_nums(-1,-1);
  1115.     Set_status_text("");
  1116.     lid:=CURS[0].M;
  1117.     close_cursor(curs);
  1118.     sys_par[0].id_last_c:=lid+1;
  1119.     if allOK then Info_box("Upozorn∞nφ","Import prob∞hl ·sp∞Ün∞.");
  1120.   end;      //0
  1121. end;
  1122.  
  1123.  
  1124.  
  1125.  
  1126.  
  1127. function pridel_id():integer;
  1128. /*********************************************************************/
  1129. var
  1130.  pomid:integer;
  1131. begin
  1132.  pomid:=sys_par[0].id_last_od+2;
  1133.  if (odd(pomid)<>SYS_PAR[0].OPID_LICHE) then pomid:=pomid+1;
  1134.  pridel_id:=pomid;
  1135. end;
  1136.  
  1137.  
  1138. procedure upd_OP(ICO:Boolean);
  1139. /*********************************************************************/
  1140. var
  1141.  s:string[255];
  1142.  idpre, idtab:tobjnum;
  1143.  adr,soubor:string[200];
  1144.  kod_cs, delka, i, pocet:integer;
  1145.  csk,c,curs:cursor;
  1146.  s1 : string[200];
  1147.  u:untyped;
  1148.  irec, crec, srec, skrec, oprec, jedrec: trecnum;
  1149.  allOK,ano:Boolean;
  1150.  id, idunique, lid, typ :integer;
  1151.  koddsk:STRING[8];
  1152.  filename: STRING[200];
  1153.  
  1154. begin
  1155.   filename:=SYS_PAR[0].ISIMPOP;
  1156.   kod_cs:=SYS_PAR[0].KODOVANI_CS;
  1157.   if kod_cs=NONEINTEGER then kod_cs:=0;
  1158.   exist_file(filename,true); 
  1159.   fileOK:=TRUE;
  1160.   if fileOK then
  1161.    begin //0
  1162.   allok:=false;
  1163.   ano:=false;
  1164.   s:="UPDATE OBCHODNI_PARTNERI SET upd=FALSE";
  1165.   Sql_execute(s);
  1166. //  delka:=strlength(sys_par[0].adr_importy)-5;
  1167. /*  delka:=strlength(sys_par[0].adr_importy);
  1168.   adr:=strcopy(sys_par[0].adr_importy,1,delka);
  1169.   if adr="" then if not Select_directory(0,adr) then Signalize;  //vybrat adresar
  1170. // else
  1171.  */   begin //1
  1172.       s1 := "╚ekejte prosφm, importuji data";
  1173.       Set_status_text(s1);
  1174.       if not Find_object("OP_upd", CATEG_TABLE, idtab) then 
  1175.         begin
  1176.           Delete_all_records(OP_upd);
  1177.           Free_deleted(idtab);
  1178.         end;
  1179.       if not Find_object("prePartner", CATEG_PGMSRC, idpre) then
  1180.       if not Move_data(idpre,filename,-1,"OP_upd",-1,11,kod_cs,0,false) then Signalize
  1181.       else
  1182.          begin //2
  1183.            if Open_sql_cursor(c, "SELECT * FROM OP_upd") then Signalize
  1184.             else
  1185.              begin  //3
  1186.                Rec_cnt(c,pocet);
  1187.                for i:=0 to pocet-1 do
  1188.                 begin  //4
  1189.                 set_status_nums(i,pocet-1);
  1190. //zjiÜt∞nφ id podle ICO
  1191.                  if ICO then
  1192.                   begin
  1193.                     u:=c[i].smlouva;
  1194.                     irec := Look_up(OBCHODNI_PARTNERI,"smlouva",u);
  1195.                   end
  1196.                  else
  1197.                   begin
  1198.                     u:=c[i].id;
  1199.                     irec := Look_up(OBCHODNI_PARTNERI,"id",u);
  1200.                   end;
  1201.                   if irec=-1 then 
  1202.                    begin
  1203.                     irec:=  Insert(OBCHODNI_PARTNERI);
  1204.                       if ICO then
  1205.                        begin
  1206.                          idunique:=pridel_id();
  1207.                          sys_par[0].id_last_od:= idunique ;
  1208.                        end
  1209.                       else
  1210.                        begin
  1211.                          idunique:=c[i].id;
  1212.                          if sys_par[0].id_last_od<idunique then sys_par[0].id_last_od:= idunique;
  1213.                        end;
  1214.                     OBCHODNI_PARTNERI[irec].id:= idunique ;
  1215.                     if ICO then OBCHODNI_PARTNERI[irec].smlouva:=c[i].smlouva;
  1216.                    end;
  1217.                    OBCHODNI_PARTNERI[irec].SMLOUVA:=c[i].SMLOUVA;
  1218.                    OBCHODNI_PARTNERI[irec].NAZEV1:=c[i].NAZEV1  ;
  1219.                    typ:=c[i].TYP  ;
  1220.                    if typ<> NONEINTEGER then OBCHODNI_PARTNERI[irec].TYP:=TYP else OBCHODNI_PARTNERI[irec].TYP:=default_hodnoty[0].TYP_UZIV;
  1221.                    OBCHODNI_PARTNERI[irec].KONT_OSOBA:=c[i].KONT_OSOBA  ;
  1222.                    OBCHODNI_PARTNERI[irec].ULICE:=c[i].ULICE  ;
  1223.                    OBCHODNI_PARTNERI[irec].PSC:=c[i].PSC  ;
  1224.                    OBCHODNI_PARTNERI[irec].MESTO:=c[i].MESTO  ;
  1225.                    OBCHODNI_PARTNERI[irec].ZEME :=c[i].ZEME   ;
  1226.                    OBCHODNI_PARTNERI[irec].TELEF:=c[i].TELEF  ;
  1227.                    OBCHODNI_PARTNERI[irec].FAX :=c[i].FAX   ;
  1228.                    OBCHODNI_PARTNERI[irec].ICO:=c[i].ICO  ;
  1229.                    OBCHODNI_PARTNERI[irec].DIC:=c[i].DIC  ;
  1230.                    OBCHODNI_PARTNERI[irec].CISLO_UCTU:=c[i].CISLO_UCTU  ;
  1231.                    OBCHODNI_PARTNERI[irec].PENEZNI_USTAV:=c[i].PENEZNI_USTAV  ;
  1232.                    OBCHODNI_PARTNERI[irec].MAIL_ADRES:=c[i].MAIL_ADRES  ;
  1233.                    OBCHODNI_PARTNERI[irec].POZNAMKA:=c[i].POZNAMKA  ;
  1234.                    OBCHODNI_PARTNERI[irec].upd:=true;      
  1235.                    koddsk:=c[i].DEAL_SK;
  1236.                    if koddsk<>"" then
  1237.                      begin
  1238.                        u:=koddsk;
  1239.                        skrec := Look_up(S_DEAL_SK,"kod",u);
  1240.                        if skrec<>-1 then OBCHODNI_PARTNERI[irec].deal_sk:=S_DEAL_SK[skrec].deal_id
  1241.                         else  OBCHODNI_PARTNERI[irec].deal_sk:=default_hodnoty[0].deal_sk;
  1242.                      end     
  1243.                     else if OBCHODNI_PARTNERI[irec].deal_sk=NONEINTEGER then OBCHODNI_PARTNERI[irec].deal_sk:=default_hodnoty[0].deal_sk;
  1244.                  allok:=true;
  1245.                 end;  //4
  1246.              end;  //3
  1247.                close_cursor(c);
  1248.         end;  //2
  1249.            if Open_sql_cursor(c, "SELECT * FROM OBCHODNI_PARTNERI WHERE OBCHODNI_PARTNERI.upd=false") then Signalize
  1250.             else
  1251.              begin  //3
  1252.                Rec_cnt(c,pocet);
  1253.                if pocet>0 then
  1254.                 begin
  1255.                   s:="Bude zruÜeno a uvoln∞no a₧ "+int2str(pocet)+" zßznam∙ v tabulce OBCHODNI_PARTNERI";;
  1256.                   ano:=YesNo_box("Upozorn∞nφ",s);
  1257.                 end;  
  1258.                if ano then
  1259.                 begin
  1260.                  s1 := "╚ekejte prosφm, provßdφm mazßnφ star²ch zßznam∙";
  1261.                  Set_status_text(s1);
  1262.                for i:=0 to pocet-1 do
  1263.                 begin  //4
  1264.                   set_status_nums(i,pocet-1);
  1265.                   id:=c[i].id;      
  1266.                   u:=id;
  1267.                   oprec := Look_up(Obj_header,"id_org",u);
  1268.                   if oprec=-1 then  delete(C,i);
  1269.                 end;    //4
  1270.                end;
  1271.            end;  //3
  1272.         close_cursor(c);
  1273. //        if not Find_object("OBCHODNI_PARTNERI", CATEG_TABLE, idtab) then  Free_deleted(idtab);
  1274.     end;   //1
  1275.     if Open_sql_parts(curs, "MAX(id) AS M", "OBCHODNI_PARTNERI", "", "") then Signalize;
  1276.     Set_status_text("");
  1277.     set_status_nums(-1,-1);
  1278.     lid:=CURS[0].M;
  1279.     sys_par[0].id_last_od:=pridel_id();;
  1280.     close_cursor(curs);
  1281.     if allOK then Info_box("Upozorn∞nφ","Import prob∞hl ·sp∞Ün∞.");
  1282.    end;  //0
  1283. end;
  1284.  
  1285. procedure Import;
  1286. /*********************************************************************/
  1287. var
  1288. impckod,impopkod:Boolean;
  1289. begin
  1290.   impckod:=SYS_PAR[0].impkodC;
  1291.   impopkod:=SYS_PAR[0].impkodOP;
  1292.      case  e_table of
  1293.      1:  upd_cenik(impckod);
  1294.      4:  upd_OP(impopkod)
  1295.      end;
  1296. end;
  1297.  
  1298. procedure Aktualrec;
  1299. /*********************************************************************/
  1300. var
  1301.   pomdotnum : short;
  1302.   soubor  : string[200];
  1303.   ext : string[4];
  1304.   s1, podminka, defdotazu : string[500];
  1305.   curs:cursor;
  1306.   i, pocet, maxid:integer;
  1307.   pr : string[10];
  1308.   prenosobj : short;
  1309.   oksoubor:Boolean;
  1310.   
  1311. begin
  1312.   // tabulka Obchodnφ partne°i
  1313.   //********************************************************************************************************
  1314.   pr := "ExPartner";
  1315.   prenosobj := FindObj(pr);
  1316.   maxid:=0;
  1317.    defdotazu := "SELECT Obchodni_partneri.*,S_Deal_sk.kod  FROM Obchodni_partneri, S_Deal_sk   WHERE (S_Deal_sk.deal_id= Obchodni_partneri.DEAL_SK) AND (intr_user<>"+""""") AND (DAT_ACT>=DAT_EXP) ";
  1318.    if Find_object("Pdexpartner", categ_cursor,pomdotnum) then Signalize
  1319.      else
  1320.       begin //2
  1321.       OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  1322.       OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  1323.       defdotazu := "SELECT id, DAT_EXP  FROM Obchodni_partneri WHERE (DAT_ACT>=DAT_EXP) ";
  1324.       if Open_sql_cursor(curs,defdotazu) then Signalize
  1325.       else
  1326.        begin
  1327.         Rec_cnt(curs,pocet);
  1328.         if pocet>0 then  
  1329.          begin //3
  1330.           soubor:=SYS_PAR[0].ISEXOP;   
  1331.           oksoubor:=test_exist_file(soubor);
  1332.            if oksoubor then
  1333.              begin
  1334.                 i_kod:=SYS_PAR[0].KODOVANI_CS;   
  1335.                 if not Move_data(prenosobj,"Pdexpartner",-1,soubor,-1,-1,-1,i_kod,false) then Signalize
  1336.                  else begin 
  1337.                   Info_box("Upozorn∞nφ","Export Obchodnφch partner∙ prob∞hl ·sp∞Ün∞.");
  1338.                   for i:=0 to pocet-1 do
  1339.                   curs[i].DAT_EXP:=datetime2timestamp(today,now);
  1340.                   end;
  1341.               end;
  1342.         end   //3
  1343.       else Info_box("Upozorn∞nφ","V databßzi nejsou ₧ßdnφ aktualizovanφ obchodnφ partne°i od poslednφho exportu ");
  1344.       close_cursor(curs);
  1345.       end
  1346.     end;    //2
  1347.  
  1348.     //tabulky Obj_header a Obj_polozky  
  1349.    //********************************************************************************************************
  1350.     s1 := "╚ekejte prosφm, exportuji objednßvky";
  1351.     Set_status_text(s1);
  1352.     pr := "ExObjh";
  1353.     prenosobj := FindObj(pr);
  1354.     defdotazu := "SELECT Obj_header.*,Obchodni_partneri.smlouva FROM Obj_header, Obchodni_partneri WHERE Obj_header.id_org=Obchodni_partneri.id AND Obj_header.DAT_ACT>=Obj_header.DAT_EXP AND Obj_header.zpracovana<>NONEDATE AND Obj_header.potvrzena=true";
  1355.     if Find_object("Pdexobjh", categ_cursor,pomdotnum) then Signalize
  1356.      else
  1357.      begin //2
  1358.       OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  1359.       OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  1360.       defdotazu := "SELECT id_dobj, DAT_EXP FROM Obj_header WHERE (DAT_ACT>=DAT_EXP) AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true)";
  1361.       if Open_sql_cursor(curs,defdotazu) then Signalize
  1362.       else 
  1363.        begin   //curs
  1364.          Rec_cnt(curs,pocet);
  1365.          if pocet>0 then  
  1366.            begin //3
  1367.              soubor:=SYS_PAR[0].ISEXOBH;   
  1368.              oksoubor:=test_exist_file(soubor);
  1369.               if oksoubor then
  1370.                 begin
  1371.                   i_kod:=SYS_PAR[0].KODOVANI_CS;   
  1372.                   if not Move_data(prenosobj,"Pdexobjh",-1,soubor,-1,-1,-1,i_kod,false) then Signalize
  1373.                    else begin 
  1374.                    Info_box("Upozorn∞nφ","Export hlaviΦky objednßvky prob∞hl ·sp∞Ün∞.");
  1375.                    end;
  1376.                 end;
  1377.            end //3
  1378.          else  Info_box("Upozorn∞nφ","V databßzi nejsou ₧ßdnΘ novΘ ani aktualizovanΘ objednßvky od poslednφho exportu ");
  1379.       
  1380.     if oksoubor then
  1381.      begin
  1382.        //za druhΘ export odpovφdajφcφch polo₧ek k vybran²m hlaviΦkßm 
  1383.          defdotazu := "SELECT cenik.kod_zbozi, Obj_polozky.*, Obj_header.cis_eob  FROM Obj_header,Obj_polozky , cenik WHERE (Obj_polozky.id_cnk=cenik.id_cenik) AND (Obj_header.id_dobj=Obj_polozky.id_dobj) AND (Obj_header.DAT_ACT>=Obj_header.DAT_EXP) AND (Obj_header.zpracovana<>NONEDATE) AND (Obj_header.potvrzena=true) ";
  1384.          if Find_object("Pdexobjp", categ_cursor,pomdotnum) then Signalize
  1385.           else
  1386.            begin //2
  1387.             OBJTAB[pomdotnum].defin[0,Strlength(defdotazu)] := defdotazu;    // p°epsßnφ pom.dotazu definicφ prom.dotazu, aby prob∞hl export dat funkcφ Move_data
  1388.             OBJTAB[pomdotnum].defin# := Strlength(defdotazu);
  1389.                if pocet>0 then  
  1390.                  begin //3
  1391.                   pr := "ExObjp";
  1392.                   prenosobj := FindObj(pr);
  1393.                   soubor:=SYS_PAR[0].ISEXOBP;   
  1394.                   oksoubor:=test_exist_file(soubor);
  1395.                    if oksoubor then
  1396.                      begin
  1397.                       i_kod:=SYS_PAR[0].KODOVANI_CS;   
  1398.                       if not Move_data(prenosobj,"Pdexobjp",-1,SOUBOR,-1,-1,-1,i_kod,false) then Signalize
  1399.                       else Info_box("Upozorn∞nφ","Export polo₧ek objednßvek prob∞hl ·sp∞Ün∞.");
  1400.                        for i:=0 to pocet-1 do 
  1401.                        curs[i].DAT_EXP:=datetime2timestamp(today,now);
  1402.                      end;
  1403.                  end; //3
  1404.            end; //2
  1405.        end;
  1406.         close_cursor(curs);
  1407.        end; //curs
  1408.         end; //2
  1409.     s1 := "Export dokonΦen";
  1410.     Set_status_text(s1);
  1411. end;
  1412.  
  1413.  
  1414.