Функция генерации штрихкода на PL/SQL : Программирование

 CREATE PROCEDURE S$_GENBARCODE (
    pflg char(1))
returns (
    barcode varchar(13))
as
declare variable i integer;
declare variable lbar varchar(13);
declare variable li integer;
declare variable lsum integer;
begin
  /* Procedure Text */

  if (PFLG='S') then begin

   i=GEN_ID(G_BARSCALE,1);
   i=i+1;
   lbar=cast(i as varchar(13));

  end else begin
   i=gen_id(G_BAR,1);
   i=i+1;
   lbar=cast(i as varchar(13));



   select RES from s$_addchar (:lbar,'0',10)
   into :lbar;

   lbar='24'||lbar;

   li=strlen(lbar); i=1; lsum=0;
    while (li<>0) do begin
     if (mod(li,2)=0) then
      lsum=lsum+(cast(subst(lbar,i,i) as integer)*1);
     else
      lsum=lsum+(cast(subst(lbar,i,i) as integer)*3);
     li=li-1;i=i+1;
    end
    if (mod(lsum,10)=0) then
      lbar=lbar||'0';
    else begin
      i=10-mod(lsum,10);
      lbar=lbar||cast(i as varchar(1));
    end
  end

  barcode=:lbar;

  suspend;
end^

SET TERM ; ^

CREATE PROCEDURE S$BARTOTXT (
    pbar varchar(14))
returns (
    bartxt varchar(25))
as
declare variable ls varchar(1);
declare variable li integer;
declare variable lupcode varchar(7);
begin
  /* Procedure Text */
  li=1;bartxt='';
  while (li<=strlen(:pbar)) do begin
   ls=subst(:pbar,li,li);
   if ((ls='0') and (li=1)) then begin
       lupcode='AAAAAA';
       bartxt='0';
   end
   if ((ls='1') and (li=1)) then lupcode='AABABB';
   if ((ls='2') and (li=1)) then begin
       lupcode='AABBAB';
        bartxt='%';
   end
   if ((ls='3') and (li=1)) then lupcode='AABBBA';
   if ((ls='4') and (li=1)) then lupcode='ABAABB';
   if ((ls='5') and (li=1)) then lupcode='ABBAAB';
   if ((ls='6') and (li=1)) then lupcode='ABBBAA';
   if ((ls='7') and (li=1)) then lupcode='ABABAB';
   if ((ls='8') and (li=1)) then lupcode='ABABBA';
   if ((ls='9') and (li=1)) then lupcode='ABBABA';


   if (li=2) then begin
     bartxt=:bartxt||'!';
   end
   if (li=8) then begin
     bartxt=:bartxt||'-';
   end

   if ((li>1) and (li<=7)) then begin
    if ((ls='0') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'0';
    if ((ls='0') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'A';

    if ((ls='1') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'1';
    if ((ls='1') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'B';

    if ((ls='2') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'2';
    if ((ls='2') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'C';

    if ((ls='3') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'3';
    if ((ls='3') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'D';

    if ((ls='4') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'4';
    if ((ls='4') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'E';

    if ((ls='5') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'5';
    if ((ls='5') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'F';

    if ((ls='6') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'6';
    if ((ls='6') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'G';

    if ((ls='7') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'7';
    if ((ls='7') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'H';

    if ((ls='8') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'8';
    if ((ls='8') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'I';

    if ((ls='9') and (subst(lupcode,li-1,li-1)='A')) then
      bartxt=:bartxt||'9';
    if ((ls='9') and (subst(lupcode,li-1,li-1)='B')) then
      bartxt=:bartxt||'J';
   end

   if ((li>7) and (ls='0')) then begin
    bartxt=:bartxt||'a';
   end
   if ((li>7) and (ls='1')) then begin
    bartxt=:bartxt||'b';
   end
   if ((li>7) and (ls='2')) then begin
    bartxt=:bartxt||'c';
   end
   if ((li>7) and (ls='3')) then begin
    bartxt=:bartxt||'d';
   end
   if ((li>7) and (ls='4')) then begin
    bartxt=:bartxt||'e';
   end
   if ((li>7) and (ls='5')) then begin
    bartxt=:bartxt||'f';
   end
   if ((li>7) and (ls='6')) then begin
    bartxt=:bartxt||'g';
   end
   if ((li>7) and (ls='7')) then begin
    bartxt=:bartxt||'h';
   end
   if ((li>7) and (ls='8')) then begin
    bartxt=:bartxt||'i';
   end
   if ((li>7) and (ls='9')) then begin
    bartxt=:bartxt||'j';
   end
   if(li=13) then
    bartxt=:bartxt||'!';

   li=li+1;
  end
  suspend;
end^

SET TERM ; ^