home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / WWW_CENIK.PGM < prev    next >
Text File  |  2000-03-16  |  3KB  |  101 lines
  1. {$$3220792584 .                              }//Program www-obj
  2.  
  3. table 
  4.  sys_par, obj_header, S_deal_sk, Obchodni_partneri;
  5.  
  6. {$I I_wbinet}
  7.  
  8. var
  9.    W_jmeno,w_heslo:string[20];
  10.    dcena:string[10];
  11.  
  12. procedure chybacgi(pomstr:string[200]); 
  13. /*********************************************************************/
  14.  begin
  15.    log_write(pomstr);
  16.  /*  if rp then  SetSTWError(pomstr)
  17.    else*/ SetUserError(pomstr);
  18.    Halt;
  19.  end;
  20.  
  21.  
  22. procedure dealcena(jmeno,heslo:string[80]); 
  23. /*********************************************************************/
  24. var
  25.  podminka:string[200];
  26.  curs:cursor;
  27.  pocet, dsk:integer;
  28.  jrec:trecnum;
  29.  u:untyped;
  30.  
  31.  begin //0
  32.    podminka:="((intr_user="+""""+jmeno+""""+")  AND  (intr_pswd="+""""+heslo+""""+"))";
  33.    if not Open_sql_parts(curs, "id, deal_sk", "obchodni_partneri", podminka, "") then 
  34.      begin //1
  35.        Rec_cnt(curs,pocet);
  36.        if pocet>0 then
  37.          begin //2
  38.            dsk:=curs[0].deal_sk;
  39.            if ((dsk>0) AND (dsk<10)) then dcena:="cena"+int2str(dsk) else  dcena:="min_cena";
  40.            u:=dsk;
  41.            jrec := Look_up(S_deal_sk,"deal_id",u);
  42.            if jrec=-1 then   chybacgi(" chyba  p°i b∞hu procedury dealcena - nenalezena dealerskß skupina"); 
  43.          end //2
  44.        else dcena:="min_cena";
  45.        close_cursor(curs);
  46.      end  //1
  47.    else dcena:="min_cena";
  48.  if jmeno="" then w_jmeno:="NOVY" else w_jmeno:=jmeno;
  49.  if heslo="" then w_heslo:="NOVY" else w_heslo:=heslo;
  50.  end; //0
  51.  
  52.  procedure W_smaz_obj(id_obj:integer);
  53. /*********************************************************************/
  54. var
  55.  cislo_tab : tobjnum;
  56.  irec:trecnum;
  57.  u:untyped;
  58.  zakaznik,limit,pocet:integer;
  59.  podminka: string[120];
  60.  curs:cursor;
  61.  
  62. begin
  63.    limit:=0;
  64.    podminka:="id_dobj="+int2str(id_obj);
  65.    u := id_obj;
  66.    irec := Look_up(obj_header,"id_dobj",u);
  67.    if irec=-1 then   chybacgi(" chyba  p°i b∞hu procedury W_smaz_obj - nenalezena objednßvka"); 
  68.    if irec<>-1 then 
  69.      begin
  70.        zakaznik:=obj_header[irec].id_org;
  71.        if not Open_sql_parts(curs, "*", "obj_polozky", podminka, "") then 
  72.          begin
  73.            Delete_all_records(curs);
  74.            Close_cursor(curs);
  75. //           if not Find_object("obj_polozky", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  76.          end;  
  77.        Delete(obj_header,irec);
  78. //       if not Find_object("obj_header", CATEG_TABLE, cislo_tab) then Free_deleted(cislo_tab);
  79.        if zakaznik<>-1 then
  80.         begin
  81.             podminka:="id_org="+int2str(zakaznik);
  82.             if not Open_sql_parts(curs, "*", "obj_header", podminka, "") then 
  83.               begin
  84.                  Rec_cnt(curs,pocet);
  85.                  Close_cursor(curs);
  86.                    if pocet<1 then
  87.                      begin
  88.                         u := zakaznik;
  89.                         irec := Look_up(obchodni_partneri,"id",u);
  90.                         Delete(obchodni_partneri,irec);
  91.                      end;
  92.               end;
  93.          end;
  94.      end;
  95. end;
  96.  
  97. begin              
  98. end.
  99.  
  100.  
  101.