Program FisBox Example by fhHQ7z

VIEWS: 17 PAGES: 5

									program FisBox;
uses Dos, CRT, Consts, Uzit;
{   --------------------------------–––––––––––––––------------------------------   }
{    Komunikacia s modulom FisBox, odosielanie a prijem dat z COM cez prerusenie    }
{   ------------------------------------------------------------–––––––––––––––--   }
{   Example PASCAL: 27.02.2010 - by Kompio – Gensor Stefan, Namestovo, SLOVAKIA     }
{   ------------------------------------------------------------–––––––––––––––--   }

const USART1_Tbuf_size = 512;
const USART1_Rbuf_size = 512;
{ /* Velkost buff musi byt nasobok 2 ( 64,128,256,512,... ) */    }
{ -------------------------------------------------------------- }
type pLarr = ^Larr;
       Larr = array[0..maxint] of char;
{ ------------------------ COM -------------------------- }
{ MemW[0:$400] .... - bazove adresy COM portov, alebo 000 }
{   ak porty nie su nainstalovane (najviac 4 COMx porty) }
{ ------------------------ LPTx ------------------------- }
{ MemW[0:$408] .... - bazove adresy LPT portov, alebo 000 }
{   ak porty nie su nainstalovane (najviac 4 LPTx porty) }
{ ------------------ Systemove hodiny PC ---------------- }
var SysClock: longint absolute $40:$6c;   { posunie sa o +1 kazdych 55 ms = 18.2x za sekundu}

function        DajInPocetZnakov:longint;    { vrati pocet bajtov v prijimacom buffri }
function        InitComL(ComX:byte):boolean; { Inicializuje COMx, 9600,n,8,1 }
procedure       DoneCom;                     { Uzavrie ComX }
procedure     ComPrerusenie;interrupt;      { obsluha IRQ prerusenia pre prijem a vysielanie dat }
       { cez COM s pouzitim dvoch buffrov: USART1_Rbuf_dat - Receive, USART1_Tbuf_dat - Transmit }
       { velkost buffrov USART1_R/Tbuf_size musi byt 2^N = napr. min. 128, 256, 512, 1024... }


{ ----------------- COM definicie ------------------ }
const ErrInFlag:boolean=false;   { Interrupt Error }
var   OdlozINTadr :pointer;
const ComAdr:word=$3f8;     comIRQ:byte=$0EF;
      intAdr:byte=$0C;      IrqLst:byte=$00;
const DataIn_Cnt_RX :longint = 0;
const DataOut_Cnt_TX :longint = 0;
procedure USART1_CLR_RXbuf;
begin
     USART1_Rbuf_in := 0;
     USART1_Rbuf_out := 0;
end;
procedure USART1_CLR_TXbuf;
begin
     USART1_Tbuf_in := 0;
     USART1_Tbuf_out := 0;
end;


function DajInPocetZnakov:longint;
begin
  DajInPocetZnakov:=USART1_Rbuf_in - USART1_Rbuf_out;
end;


function DajOutPocetZnakov:longint;
begin
  DajOutPocetZnakov:=USART1_Tbuf_in - USART1_Tbuf_out;
end;
{ ----------------- COM definicie ------------------ }
const ErrInFlag:boolean=false;   { Interrupt Error }
var   OdlozINTadr :pointer;
const ComAdr:word=$3f8;     comIRQ:byte=$0EF;
      intAdr:byte=$0C;      IrqLst:byte=$00;
{ ----------------- Original ----------------- }
{ ComAdr:array[0..1] of word=($3f8,$2f8);
  comIRQ:array[0..1] of byte=($0EF,$0F7);
  intAdr:array[0..1] of byte=($0C,$0B);
  IrqLst:array[0..1] of byte=($00,$00);
}

{ ----------- Prerusenie ---------- }
const DataIn_Cnt_RX :longint = 0;
const DataOut_Cnt_TX :longint = 0;

procedure ComPrerusenie;interrupt;
 var cStav2,cStav5,cStav6,cData:byte; ix,iy,iz:longint;
begin
    cStav2:=port[comAdr+02];       { identifikacia prerusenia }
    cStav5:=port[comAdr+05];       { register stavu linky LSR }
    cStav6:=port[comAdr+06];       { register stavu modemu }
   if (cStav2 and $06)=$04 then    { prijate data }
    begin
       { clear interrupt by read data }
       cData := port[comAdr];
      {
        --> service received data
      }
      {write(char(cData));}
    end;
    if ((cStav2 and $06)=$02) then      { bajt bol odoslany }
    begin
        { odosle dalsi bajt }
        {
            --> service transmit data
        }
    end;
   if (cStav5 and $1E)<>0 then       { ak chyba prenosu (0001 1110b) }
     begin
        { clear error by read data }
        cData:=port[comAdr];      { citaj RX register }
        ErrInFlag:=true;
     end;
   port[$20]:=$20; { Odosli nespecifikovany EOI do 8259 }
end;

{---------------------------------------------------
  USART1 -> - transmit a character
   (put it to Tbuffer) (len 1 bajt)
---------------------------------------------------}
procedure USART1_VlozChar(Xbyte:byte);
var bx:byte; iz, dx:longint;
begin
  { Add data to the transmit buffer. }
  iz:=USART1_Tbuf_size-1;
  dx:=USART1_Tbuf_in and iz;
  USART1_Tbuf_dat[dx] := Xbyte;
  USART1_Tbuf_in:=USART1_Tbuf_in+1;
end;

{---------------------------------------------------
  USART1 -> GetChar receive a character
   / or return ErrorCode(-1) if no data /
---------------------------------------------------}
function USART1_GetChar:integer;
var cData:byte; iz:longint;
begin
  if (DajInPocetZnakov = 0) then
  begin
    USART1_GetChar:=-1;
    exit;
  end;
  iz:=USART1_Rbuf_size-1;
  cData:=USART1_Rbuf_dat[USART1_Rbuf_out and iz];
  USART1_Rbuf_out:=USART1_Rbuf_out+1;
  { vrati data v rozsahu (0 - 255) }
  USART1_GetChar:=cData;
end;


{---------------------------------------------------
  USART1 -> GetBlok receive a blok dat
- return ErrorCode -1 if no data
- return OK_Code     0 if data (Bsize) recived
- pozor, pozadovany pocet musi byt mensi ako
  velkost prijimacieho buffra
---------------------------------------------------}
function USART1_GetBlok(xdata:pointer; Bsize:integer):integer;
var ix:integer; cData:byte;
begin
  if (DajInPocetZnakov < Bsize) then
  begin
    USART1_GetBlok:=-1;
    exit;
  end;
  for ix:= 0 to (Bsize-1) do
  begin
      cData:=USART1_GetChar;
      pLarr(xdata)^[ix]:= char(cData);
  end;
  USART1_GetBlok:=0;
end;
procedure TestSysClockTik(var LastClk:longint; var MaxWaitV:longint);
{ pri kazdej zmene SysClock odpocita z MaxWaitV 1 }
var lm:longint;
  begin
     lm:=SysClock;
     if (LastClk<>lm) then
     begin
        dec(MaxWaitV);
         { odpocita 55ms ak doslo ku lubovolnej zmene SysClock }
         { ak sa SysClock zmenilo aj o inu hodnotu odpocita sa len 1x55ms }
         { - kompenzuje casove dilatacie, napr. pri tepelnej kalibracii HDD }
         { alebo ak PC spracovava predusenie alebo DMA s vyssou prioritou }
        LastClk:=lm;
     end;
  end;



function OdosliDataCOM(xdata:pointer; Bsize:word):boolean;
{------- Odosle blok xdata^ cez prerusenie ---------}
var lx,lz:longint; cData:char; t1:boolean;
begin
    lz:=0;
    lx:=5*18;      { wait time in sec. }

   { bude cakat max 5 sekund na odoslanie predosleho bloku }
   while (USART1_continue = 1) and (lx<>0) do TestSysClockTik(lz, lx);
   { vlozi data do OUT buffra }
   for lz:=1 to Bsize do USART1_VlozChar(byte(pLarr(xdata)^[lz-1]));
   { nastartuje odosielanie pripraveneho bloku }
   USART1_continue :=1;
   port[ComAdr+01] :=$03;   { povoli prijem aj vysielanie }
   port[comAdr+02] :=$02;   { vyvola prerusenie od TX }
    { writeln(' Odoslane (B):'+Fstr(Bsize,5)); }
    { vrati true ak nevyprsal cas na odoslanie predosleho bloku }
    OdosliDataCOM:=(lx<>0);
end;


function CakajPrijemCOM(xdata:pointer; Bsize:word):boolean;
{ Caka na prijem Bsize (bajtov), ak pridu, ulozi ich do --> xdata }
{ ak nepridu, vynuluje buffer, vrati uspesnost prijatia bloku dat }
var lx,lz:longint;
begin
    ResponseStatus := TRUE; { predpoklada sa OK }
   lz:=0;
   lx:=Max_Wait_CMDx;      { wait time in milisec. }
   { bude cakat max X sekund na prijatie celeho bloku }
   while (DajInPocetZnakov < Bsize) and (lx<>0) do TestSysClockTik(lz, lx);
   if (DajInPocetZnakov >= Bsize) then
    begin
        USART1_GetBlok(xdata, Bsize);
        { writeln(' Prijate (B):'+Fstr(Bsize,5)); }
    end
   else
    begin
        Nuluj(xdata^, Bsize);
        { writeln(' Data in TimeOut '); }
        ResponseStatus := FALSE;   { neprisla ziadna odozva }
        messageBox(DajEcho(74),mfError+mfokbutton);
        USART1_CLR_RXbuf;
    end;

   { na konci si nastavi automaticky standartny cakaci cas }
   SetMaxWait(Max_Wait_CMD_default);

    CakajPrijemCOM:=(lx<>0);
end;



procedure Prijmi_Data_Blok(xdata:pointer; Bsize:word);
{ Prijme data z COM a vytlaci prijaty blok na obrazovke }
begin
   CakajPrijemCOM( xdata, Bsize);
   { Vytlac_Znaky(   xdata, Bsize);}
end;



procedure Odosli_Data_Blok(xdata:pointer; Bsize:word);
{ Odosle blok dat na COMx a zobrazi text na obrazovke }
begin
   OdosliDataCOM( xdata, Bsize);
   {Vytlac_Znaky( xdata, Bsize);}
end;
procedure Uctuj_Doklad(TypDokladu:char);
{---------------------------------------------------
 Do predtym otvoreneho dokladu s cislom
   PCID = '---X' nauctuje:
----------------------------------------------------
  - kratke (jednoriadkove - 40z) uctovne polozky,
  - dlhe (dvojriadkove - 80z) uctovne polozky,
  - dlhe (dvojriadkove - 80z) informativne polozky,
----------------------------------------------------
 uctovane hodnoty a texty poloziek priebezne
 zobrazuje na zakaznickom displeji, doklad nakoniec
 uzavrie a vytlaci
---------------------------------------------------}
var i,j,k :longint; s0,s1 :string; DPH:byte;
begin
for i:=1 to 12 do { pocet uctovnych poloziek }
begin
  { generuje nahodne oddelenie DPH (@,A-G) pre polozky }
  DPH:=(i mod 8)+64;
  { ---- pripravi povel pre uctovny riadok ---- }
  {      - parne riadky budu kratke (40 znakov) }
  {      - neparne riadky budu dlhe (80 znakov) }
  { ------------------------------------------- }
  if ((i mod 2) = 1) then { neparne riadky dokladu }
  begin
      { kratky uctovny riadok (6+40 bajtov)    }
      s0:='PR---X';
      s0:=s0+'Polozka:'+Fstr(i,3)+' Maslo Rama KratkaP    1.93 '+char(DPH);
  end
  else                     { parne riadky dokladu }
  begin
      { ---- dlhy uctovny riadok (6+80 bajtov) ---- }
      s0:='PU---X';
      s0:=s0+'Dlha UP:'+Fstr(i,3)+' Cukor krystal        -1.21 '+char(DPH);
      s0:=s0+'Doplnujuci text polozky, napr. vyr.cislo';
  end;
  { ---- odosle pripravenu polozku ---- }
  Odosli_Data_Blok( @s0[1], length(s0));
  { ---- caka na potvrdenie OK/ERR (6 bajtov) ---- }
  Prijmi_Data_Blok( @s1[1], 6);
  { ---- ak bolo OK, caka na doterajsi medzisucet ---- }
  { ---- za nauctovane polozky v 16 znakoch textu ---- }
  if (s1[1] = '+') then Prijmi_Data_Blok( @s1[1], 16);

  { ---- za kazdu tretiu uctovnu polozku vlozi ---- }
  {   tkz. informativny riadok: '>INFO TEXT >'      }
  if ((i mod 3) = 2) then
  begin
      { pripravi text dlhej informativnej polozky }
      { s nulovou hodnotou a symbolom '<' na konci }
      s0:='PU---X';
      s0:=s0+'------------- #1 Cislo polozky: 12345 < ';
      s0:=s0+'Toto je info text riadok:125698-12-88 #1';
        { ---- odosle pripravenu informativnu polozku ---- }
        Odosli_Data_Blok( @s0[1], length(s0));
        { ---- caka na potvrdenie OK/ERR (6 bajtov) ---- }
        Prijmi_Data_Blok( @s1[1], 6);
      { ---- prijme sa medzisucet po INFO polozke ---- }
      if (s1[1] = '+') then Prijmi_Data_Blok( @s1[1], 16);
  end;
end;

{ ---- Uzatvorenie a vytlacenie dokladu ---- }
 { ako typ dokladu pouzije prijaty parameter }
s0:='cT---X';
s0[2]:=TypDokladu; { vpise TypDokladu na poziciu 2 }
Odosli_Data_Blok( @s0[1], length(s0));

{ ---- prijme sa potvrdenie OK/ERR pre uzatvorenie dokladu ---- }
Prijmi_Data_Blok( @s1[1], 6);

{ 1. ---- prijme sa pridelene finalne cislo FPID dokladu ---- }
{      podla tohoto cisla doklad kedykolvek najdete v zurnali }
Prijmi_Data_Blok( @s1[1], 16);
{ 2. ---- Suma za doklad TOTAL (Rounded) ---- }
Prijmi_Data_Blok( @s1[1], 16);
{ 3. ---- Vydavok v Lokalnej mene ---- }
Prijmi_Data_Blok( @s1[1], 16);
{ 4. ---- Pocet poloziek (uctovnych riadkov) dokladu ---- }
Prijmi_Data_Blok( @s1[1], 16);
{ 5. ---- Suma za doklad v Cudzej mene (Rounded) ---- }
Prijmi_Data_Blok( @s1[1], 16);
{ 6. ---- Vydavok v Cudzej mene ---- }
Prijmi_Data_Blok( @s1[1], 16);
{ POZN. modul FisBox bude po odoslani posledneho bajtu (6.) casti
        interne spracovavat vacsie mnozstvo dat a sucasne sa bude
        cely doklad tlacit na tlaciarni, preto na povely ktore
        odoslete moze prist odozva az po cca 3 sekundach }
end;




{ ************** HLAVNE TELO PROGRAMU *************** }
var i:integer;
    s0,s1 :string;
begin
clrscr;          { CLS }
writeln('    Testovaci program pre komunikaciu s modulom FisBox.');
writeln('    Program vytvori a vytlaci jeden doklad s 12 polozkami');
writeln('               na fiskalnej tlaciarni pripojenej na COM1.');
writeln('    Created:   Kompio, Namestovo, Slovakia. 27.02.2010');
writeln('    ... wait max 5 sec.');
writeln;
InitComL(0);     { Inicializuje Com 1 }

{ ---- Otvorenie noveho dokladu ---- }
s0:='FO---X';
Odosli_Data_Blok( @s0[1], length(s0));
Prijmi_Data_Blok( @s1[1], 6);
{ ---- ak otvorenie prebehlo OK, doklad je uspesne ---- }
{ ---- otvoreny, prijme sa OpenId dokladu v 4 bajtoch ---- }
if (s1[1] = '+') then
  begin
     CakajPrijemCOM( @s1[1], 4);
     Vytlac_Znaky(   @s1[1], 4);
     { --- uctovanie poloziek dokladu --- }
     Uctuj_Doklad('T');
  end
 else
  begin
     writeln('Chyba pri otvarani dokladu: ',byte(s1[2]));
  end;
 writeln;
 writeln('Odoslane celkom :',DataOut_Cnt_TX:20);
 writeln('Prijate celkom :',DataIn_Cnt_RX:20);
 writeln('Press any key..');

 repeat until keypressed;
 ClearInputbuffer;

  DoneCom;
end.

								
To top