home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / ESHOP4.0.PGM < prev    next >
Text File  |  2000-03-16  |  8KB  |  256 lines
  1. {$$3220792583                                }table 
  2.  uziv, sys_par, vyrobci, EP_EXPANDIA, Ep_setkb, objtab, cenik, s_zbozi_sk, obj_header, usertab,Obchodni_partneri, Kod_structura,S_deal_sk, obj_polozky, default_hodnoty, obchodnici, info_provozovatel, zal_tab, S_TAB_ROUND,S_platba;
  3. cursor 
  4.   seznam_tab, ceka, storno_ceka, Max_level, Vyb_dcenik;
  5.   
  6. var id_pohled    : window_id; 
  7.     id_nobj1     : window_id;
  8.     irec         : trecnum;
  9.     konec, testOK : Boolean;
  10.     msg          :integer;
  11.     ID_pohledu   :window_id;
  12.     nrec         :trecnum;
  13.     handle       :window_id;
  14.     jmeno        :string[31];                              // moje jmΘno
  15.     user_num   : tobjnum;                             // moje Φφslo v tab. USERTAB
  16.     user2_num  : tobjnum;                             // Φφslo u₧ivatele v tab. USERTAB, kterΘmu je dokument postoupen
  17.     group_num  : tobjnum;                             // Φφslo skupiny everybody v tab. USERTAB
  18.     table_num  : ttablenum/*objnum*/;                 // Φφslo tab. v tab. TABTAB
  19.     sloupce    : short;                                //poΦet sloupc∙ HTML strßnky 
  20.     pdoprava, pjednotka   : string[32];
  21.     stitekx,stiteky:integer;
  22.     zaksum:real;
  23.  //   role_num   : tobjnum;                             // Φφslo role v tab. OBJTAB
  24.    id_uz      : binary[12];                          // moje ID
  25.     cesta_zal        : String[200];
  26.     cesta_hlp        : String[200];
  27.     soubor_hlp       : String[200];
  28.     cesta_exp        : String[200];
  29.     cesta_imp        : String[200];
  30.     cesta_icnk       : String[200];
  31.     cesta_iop        : String[200];
  32.     cesta_eobh       : String[200];
  33.     cesta_eobp       : String[200];
  34.     cesta_eop        : String[200];
  35.     cesta_br         : String[200];
  36.  
  37.     i_chyba      : Boolean;  // true-Objevila se chyba import se neprovede, false-vse OK
  38.     e_vyber      : integer;  //druh v²b∞ru
  39.     i_zdroj      : integer;
  40.     e_table      : integer;  //1-cenφk, 3-objednßvka, 4-obchodnφ partne°i
  41.     i_kod        : integer;  //k≤dovßnφ ΦeÜtiny 
  42.     i_format     : integer;  //formßt dat (tdt,txt,csv,dbf)
  43.  //   G_PLAT_CNK   : integer;  //platnost cenφku;
  44.     G_stav       : integer;  //DPH
  45.     G_uc_rok     : integer;  //DPH 
  46.     G_dph        : integer;  //DPH
  47.     G_procento   : real;     //DPH 
  48.     dat_od       : date;
  49.     dat_do       : date;
  50.     pevny_import : boolean;
  51.     pevny_export : boolean;
  52.     pocet_urovni:integer;   
  53.     zarazeno:boolean;
  54.     activni:integer; //0=dbadmin, 1=administrator 2=obchodnik 3=internet_user 100=ostatni
  55.     lze_mazat:Boolean; //lze mazat polo₧ky Φφselnφk∙ 
  56.     jpv:Boolean;
  57.     jesys,jebanka:integer;
  58.     vsichni, dsk, tuz:integer;
  59.     findcomp: string[30];
  60.     neulozeno    : Boolean; 
  61.   
  62. //prom∞nnΘ pro v²b∞r zobrazen²ch objednßvek
  63.   cp,cn,cru,cnu, storno: Boolean;        //cp-potvrzenΘ, cn-nepotvrzenΘ, cru- registrovan² u₧ivatel (login vypln∞nΘ),  cnu- nov² u₧ivatel (login nevypln∞nΘ), storno-stornovane obj.
  64.   crec, pomtr:integer;                  //crec=0-vÜechny, 1-nezpracovanΘ,2-Φasov∞ omezenΘ, 3-nezpracovanΘ a stornovanΘ
  65.   pn,cu:short;                      //cu=1-cru, cu=2-cnu , pn 1/0=potvr. /nepotvr.
  66.   edsk:integer;                    //pom.prom.
  67.   pliccis:string[25];
  68. //  datod,datdo:date;              //datum od - do 
  69.     nob:integer;
  70.  
  71. //prom∞nnΘ pro statistiku
  72.     statnum      : integer;   //1=firma,2=polo₧ky cenφku 
  73.     statnumdat   : integer;   //1=vÜechny,2=Φasov∞ omezenΘ 
  74.     sdat_od      : date;
  75.     sdat_do      : date;
  76.  
  77.  
  78.   maxL:integer; //max. poΦet vno°enφ skupin  
  79.   pocet_curs:integer; 
  80.   deal_cena: array[0..9] of money;
  81.   
  82.   maxcen, maxobj, maxcenr, maxobjr :integer;
  83.   trial:boolean;
  84.  
  85.   si, sizebuf:integer;
  86.   serverinfo:string[30];
  87.  
  88. //includovanΘ programy 
  89.  
  90. //API funkce   
  91. {$I Winapi32}
  92. //programy t²kajφcφ se exportu, importu a zßlohy
  93. {$I zaloha}  
  94. //programy t²kajφcφ se vklßdßnφ nov²ch zßznam∙
  95. {$I procedury}  
  96. //programy t²kajφcφ se kontroly tabulek
  97. {$I testy}  
  98. //programy t²kajφcφ se kontroly tabulek
  99. {$I testyinp}  
  100. //programy t²kajφcφ se vklßdßnφ dat
  101. {$I objednavky}  
  102. //programy t²kajφcφ se definovßnφ skupin  
  103. {$I skupiny}  
  104. //Replikace   
  105. {$I Replikace}
  106.  
  107.  
  108. procedure Init;
  109. /*********************************************************************/
  110. var
  111.   infostr:string[255];
  112.   nobj,sobj:integer;
  113.   c:cursor;
  114.   
  115. begin
  116.  // zal_all:=true;
  117.   cu := 1;
  118.   e_vyber := 1;
  119.   e_table := 1;
  120.   dat_do := Today;
  121.   dat_od := dat_do-7;
  122.   cp:=TRUE;
  123.   cn:=FALSE;
  124.   cru:=TRUE;
  125.   cnu:=FALSE;
  126.   crec:=0;
  127.   storno:=FALSE;
  128.   pevny_import := true;
  129.   jmeno := Who_am_I;
  130.   nobj:=0;
  131.   sobj:=0;
  132.  
  133.   Rec_cnt(SYS_PAR, jesys);
  134.   Rec_cnt(EP_EXPANDIA, jebanka);
  135.   if ((jesys<1) OR (jebanka<1)) then Zaloz_tab();
  136.  
  137.  IF ACTIVNI<=2 THEN
  138.   BEGIN 
  139.   //zjisti max. poΦet vno°enφ skupin 
  140.    if Open_cursor( Max_level) then Signalize
  141.    else  Rec_cnt( Max_level,pocet_curs);
  142.    if pocet_curs >0 then maxL:= Max_level[0].max1;
  143.    close_cursor( Max_level);
  144.  
  145.   if Open_SQL_cursor(c,"select * from kod_structura") then Signalize
  146.   else  Rec_cnt(c,pocet_urovni);
  147.   close_cursor(c);
  148.   if sys_par[0].PLATNOST_CEN_DO<today then info_box("upozorn∞nφ", "VyprÜela platnost cenφku"); 
  149.  
  150.   smaz_stare();
  151.  // act_menu();
  152.  
  153.   if not Am_I_db_admin then
  154.    begin
  155.      if Open_cursor(ceka)then Signalize
  156.       else  Rec_cnt(ceka,nobj);
  157.      if Open_cursor(storno_ceka)then Signalize
  158.       else  Rec_cnt(storno_ceka,sobj);
  159.      infostr:='Na VaÜe vy°φzenφ Φekß'#10#10' '+int2str(nobj)+'  nov²ch objednßvek'#10' '+int2str(sobj)+'  stornovan²ch objednßvek';
  160.      Info_box("P╪EJI P╠KN▌ DEN",infostr);
  161.    end;
  162.  
  163.   if not Find_object(jmeno,CATEG_USER, user_num) then  id_uz := USERTAB[user_num].usr_uuid
  164.    else Signalize;
  165.  
  166. //  soubor_hlp:=sys_par[0].adr_help+ "\602eshop.hlp";
  167.   soubor_hlp:="602eshop.hlp";
  168.   Help_file(soubor_hlp);
  169.  
  170.   close_cursor(ceka);
  171.   close_cursor(storno_ceka);
  172.   uziv0();
  173. END;  
  174. end;
  175.  
  176. procedure Exit;
  177. /*********************************************************************/
  178. begin
  179.     Close_cursor(Skupiny);
  180.     Close_all_views; 
  181.     Halt;
  182. end;
  183.  
  184.  
  185. procedure Nuziv();
  186. /*********************************************************************/
  187. //p°ihlßsφ novΘho u₧ivatele
  188.  begin
  189.   Close_all_views;
  190.   if Alogin(0) then
  191.     act_menu();
  192.     IF ACTIVNI<=2 THEN   Init
  193.     ELSE 
  194.     begin
  195.       Info_box("UPOZORN╠N═","Nemßte prßvo pracovat s touto aplikacφ, po₧ßdejte sprßvce o obsazenφ do role obchodnφka.");
  196.       activni:=999;
  197.     halt;
  198.     end;
  199.  end;    
  200.  
  201.  
  202.  
  203. //Hlavnφ program
  204. /*********************************************************************/
  205. begin
  206.   /*i := WinBase602_version;
  207.   s := "Verze "+Int2str(i div 65536)+"."+Int2str(i mod 65536);
  208.   Info_box("WinBase",s);
  209.   */
  210.   sizebuf:=4;
  211.   Get_server_info(0, si, sizebuf);
  212.    case si of
  213.       0: serverinfo:="Windows";
  214.       1: serverinfo:="NOVELL NetWare";
  215.       2: serverinfo:="LINUX";
  216.       3: serverinfo:="FreeBSD";
  217.    end;
  218. //  Info_box("WinBase pracuje v prost°edφ:",serverinfo);   
  219.  
  220.   trial:=False;
  221.   maxcen:=20;
  222.   maxobj:=20;
  223.  
  224.   Rec_cnt(CENIK, maxcenr);
  225.   Rec_cnt(OBJ_HEADER, maxobjr);
  226.    if (((maxcenr>maxcen) OR (maxobjr>maxobj)) AND trial) then
  227.      begin
  228.         Delete_all_records(Obj_header);
  229.          Delete_all_records(Obj_polozky);
  230.          Uvolni_zrusene();
  231.          Info_box("TRIAL VERZE", "PoΦet objednßvek nebo polo₧ek cenφku je v∞tÜφ ne₧ povolen² poΦet pro Trial verzi!");
  232.      end
  233.    else 
  234.      begin
  235.        act_menu();
  236.        Init;
  237.        testlic();
  238.        Main_menu("*Menu");
  239.        Rec_cnt(Cenik,jesys);
  240.        if (jesys<1) then Show_help(11000);
  241.        konec := false;    
  242.        while NOT konec AND Get_ext_message(msg,handle,NIL) do 
  243.          begin  
  244.            case msg of
  245.              1050  :   konec := true;
  246.                       
  247. /*             1050  :  if   Yesno_box('D∞kuji za spoluprßci', 'Opravdu si p°ejete ukonΦit aplikaci?') 
  248.                       then konec := true
  249.                       else Main_menu("*Menu"); 
  250.  */          end 
  251.          end; 
  252.      end;
  253.   Exit;
  254. end.
  255.  
  256.