home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / tema / SW602 / Winbase / EShop_demo / WWW_LOGIN.PGM < prev    next >
Text File  |  2000-03-16  |  3KB  |  116 lines
  1. {$$3220792584 .                              }//Program www-obj
  2. table obj_header, default_hodnoty, SYS_PAR;
  3. {$I I_wbinet}
  4.  
  5. var
  6.    wd_obch, wd_deal, wd_typ, wd_id:integer;
  7.  
  8. procedure chybacgi(pomstr:string[200]); 
  9. /*********************************************************************/
  10.  begin
  11.    log_write(pomstr);
  12.  /*  if rp then  SetSTWError(pomstr)
  13.    else*/ SetUserError(pomstr);
  14.    Halt;
  15.  end;
  16.  
  17.  
  18. function pridel_id():integer;
  19. /*********************************************************************/
  20. var
  21.  pomid:integer;
  22. begin
  23.  pomid:=sys_par[0].id_last_od+2;
  24.  if (odd(pomid)<>SYS_PAR[0].OPID_LICHE) then pomid:=pomid+1;
  25.  pridel_id:=pomid;
  26.  sys_par[0].id_last_od:=pomid;
  27. end;
  28.  
  29.  
  30.  
  31. procedure w_defuziv();
  32. /*********************************************************************/
  33.  
  34. begin
  35.   wd_obch:=default_hodnoty[0].obchodnik;
  36.   wd_deal:=default_hodnoty[0].deal_sk;
  37.   wd_typ:=default_hodnoty[0].typ_uziv;
  38.   wd_id:=pridel_id();
  39. end;
  40.  
  41.  
  42. procedure W_delobj();
  43. /*********************************************************************/
  44. var
  45.  limit, i, id_objdel :integer;
  46.  podminka, podminka0: string[120];
  47.  cursobj,curs:cursor;
  48.  
  49. begin //0
  50.    limit:=0;
  51.    podminka0:="(id_org=-1) AND (potvrzena<>TRUE) AND datum<today";
  52.   if not Open_sql_parts(cursobj, "*", "obj_header", podminka0, "") then 
  53.    begin //1
  54.      Rec_cnt(cursobj, limit);
  55.      if limit>0 then
  56.        begin   //2
  57.          for i:=0 to limit-1 do
  58.           begin  //3
  59.             id_objdel:=cursobj[i].id_dobj; 
  60.             podminka:="id_dobj="+int2str(id_objdel);
  61.               begin
  62.                 if not Open_sql_parts(curs, "*", "obj_polozky", podminka, "") then 
  63.                   begin
  64.                     Delete_all_records(curs);
  65.                     Close_cursor(curs);
  66.                   end;  
  67.               end;
  68.           end;  //3
  69.        end;  //2
  70.     Delete_all_records(cursobj);
  71.     Close_cursor(cursobj);
  72.     end;  //1
  73. end;   //0
  74.  
  75.  
  76. procedure w_cis_uziv(id_obj:integer;nazev,heslo:string[35]; zid:integer);
  77. /************************************************************************/
  78. var 
  79.  podminka: string[120];
  80.  curs:cursor;
  81.  pocet,i:integer;
  82.  u:untyped;
  83.  irec:trecnum;
  84.  
  85. begin //0
  86.   u:=id_obj;
  87.   irec := Look_up(Obj_header,"id_dobj",u);
  88.   if irec=-1 then 
  89.     chybacgi(" chyba  p°i b∞hu procedury  w_cis_uziv - nenalezena objednßvka")
  90.   else   
  91.    begin //1
  92.      if heslo="" then heslo:=int2str(zid);
  93.      podminka:="(id="+int2str(zid)+")";
  94. //     podminka:="((nazev1="+""""+nazev+""""+") AND ( intr_pswd="+""""+heslo+""""+"))";
  95.      if Open_sql_parts(curs, "id,ico", "obchodni_partneri", podminka, "") then chybacgi(" chyba  p°i b∞hu procedury  w_cis_uziv - nenalezen u₧ivatel")
  96.      else 
  97.        begin //2
  98.          Rec_cnt(curs,pocet);
  99.          if pocet>0 then  
  100.            begin  //3
  101.              obj_header[irec].id_org:=curs[0].id;
  102.              obj_header[irec].ico:=curs[0].ico;
  103.            end   //3 
  104.          else  chybacgi(" chyba  p°i b∞hu procedury  w_cis_uziv - nenalezen u₧ivatel"); 
  105.          close_cursor(curs);
  106.        end;  //2
  107.     end;  //1
  108.  end;  //0
  109.        
  110.  
  111.  
  112. begin              
  113. end.
  114.  
  115.  
  116.