(*
*******************************************************************************
*         Copyright (C) SofCon 2002 All Rights Reserved                       *
*******************************************************************************
*
*    project:     vizualizace
*
*    title:       Archive1.pas
*
*******************************************************************************
*
*    description: priklad prace s dvemi archivy
*                 archivy - kruhovy bufer bez modifikace a s modifikaci
*                           s podporou zobrazeni tabulky
*		  ve verzi pro PC neni uvolnovana pamet archivu
*			a pamet jednotlivych objektu deskriptoru
*
*    version:     1.05
*    language:    Borland Pascal
*
*    author:      Hvozdovic
*    history:     date      sign   remark
*                 8.02      hv     zacatek vyvoje
*                11.02      hv     prvni release
*                12.02      hv     zruseni odkazu na ChnPrt, ChnSofs
*                 1.03      hv     pridan priznak af_InitArchive do priznaku
*                                  archivu
*				   pridano osetreni novych chyb archivu
*                 3.03      bi     nova hodnota retezce controlleridstr - jmena stored archivu
*                12.03      hv     doplneni poznamky o reinicializi archivu
*****************************************************************************
*)
{$I sets.inc}

unit Archive1;
interface
uses
   Objects             { objekty }
  ,ChnVirt             { virtualni kanal }
  ,ChnSofT             { definice typu pro protokol SofCon }
  ,Xtking_1            { definice typu a konstant pro praci s vizualizaci }
  ,AppDesc             { jednotka definujici kompletni rozlozeni pameti
                         v aplikaci LOADER, pouziva xDesc
                         Dale v teto jednotce muzou byt aplikacne zavisle
                         struktury a konstanty }
  ,ATypes              { definice typu a konstant pro praci s archivy }
  ,AVirt               { virtualni predek vsech archivu pro cteni a zapis }
  ,ChAVirt             { objekt archivu podporujiciho prenos dat
                         po komunikacnim kanalu }
  ,ChADscr             { objekt archivu podporujiciho prenos dat
                         vcetne jeho popisu pomoci deskriptoru }
  ,ChATypes            { definice typu a konstant pro praci s archivy
                         podporujicich prenos dat po komunikacnim kanalu }
  ,AMCycle             { objekt archivu podporujiciho modifikaci polozek -
                         kruhovy buffer s podporou modifikace,
                         bez podpory prenosu dat po komunikacnim kanale }
  ,NumToStr            { prace s retezeci }
  ,WTArch;             { objekt s podporou prace s archivy }


type
  { vyctovy typ popisujici banky archivu }
  tArchiveEnum =
  (
    arch_Archive1,
    arch_Archive2
  );

  { objekt pracujici s archivy  }
  PArchive1 = ^TArchive1;
  TArchive1 = object(TWinTickArchive)
    { pole popisovacu archivu s podporou prenosu archivu }
    m_pArchiveArray : array [tArchiveEnum] of PChArchiveVirt;

    constructor Init;
    destructor Done; virtual;

    function  fnConvertArchiveNo(bBankNo:Byte):Byte; virtual;
    function  fnGetArchiveCnt:Byte; virtual;

    procedure fnAbort;virtual;
    function  fnClose:Boolean; virtual;
    procedure fnGetListOpen(var ArchListInfo:TArchListInfo); virtual;
    procedure fnGetListItem(var ArchListItem:TArchDataHeader); virtual;
    procedure fnGetState(var ArchiveRecState:TRecArchiveState); virtual;
    procedure fnOpenArchive(BegRecTime, EndRecTime:LongInt; var Prvni, Posledni, Length: LongInt); virtual;
    function  fnReadArchive(pData:Pointer; EndTime:LongInt; var Len:Word):Boolean; virtual;
    function  fnClearArchive:Boolean; virtual;
  end;


{ procedura pro zobrazeni stavu - zobrazi se stiskem klavesy "1" }
procedure ShowState;

{ funkce zapisujici do bank archivu }
procedure WriteToArchive;


implementation
uses
   Strings             { retezce zakoncene nulou }
  ,Kernel;             { jadro os ReTOS }


{ funkce modifikujici ctene polozky pRecord do podoby,
  ktere se prenasi po komunikacnim kanalu pExRecord }
procedure TextModif(pRecord:Pointer; pExRecord:Pointer); far;
begin
  with pArchive2Record(pExRecord)^ do
  begin
    dwPackDate:=pArchive1Record(pRecord)^.dwPackDate;
    bActive:=pArchive1Record(pRecord)^.bActive;
    case pArchive1Record(pRecord)^.wCode of
      0..63:    str:='0..63';
      64..94:   str:='64..94';
      95..190:  str:='95..190';
      191..255: str:='191..255';
    else
      str:='256..65535';
    end;
  end;
end;


constructor TArchive1.Init;
var
  pArchive:PArchiveVirt;
  pDscrObj1, pDscrObj2:pDscr;
  ArchiveDesc:TArchiveDesc;
  DscrChArchive:TChArchiveDesc;
  ptr:tArchiveEnum;
begin
  inherited Init;

  { vytvoreni popisovacu archivu #1 }
  new(pDscrObj1, Init(
     'Time|Code|Active',     { popisky/zahlavi polozek zaznamu }
     '',                     { format % strings polozek zaznamu like CSV }
     sizeof(tArchive1Record)   { velikost zaznamu }
     ));
  { datum a cas ulozeni zaznamu }
  if not pDscrObj1^.AddType(DscrMsk_DosDaTi, 0) then RunError(255);
  { kod }
  if not pDscrObj1^.AddType(DscrMsk_Word, 0) then RunError(255);
  { priznaky }
  if not pDscrObj1^.AddType(DscrMsk_Byte, 0) then RunError(255);

  { kontrola celkove delky zaznamu - predeslo kontroly lze vynechat }
  if pDscrObj1^.GetDscrMaskLen <> sizeof(tArchive1Record) then RunError(255);

  with ArchiveDesc do {#1}
  begin
   {$ifdef CONVERT_BANKNO}             { oznaceni banku archivu }
    FillChar(gpArchive1AStruct^, sizeof(tArchiveStruct), 0);
    wArchiveNo:=5;
   {$else}
    wArchiveNo:=Word(arch_Archive1);
   {$endif}
    laBaseAddr:=laArchive1;            { abs. adresa zacatku archivu }
    wRecordSize:=sizeof(tArchive1Record);{ velikost polozky }
    dwMaxRecordCnt:=cArchive1MaxRecord;      { max. pocet polozek }
{$ifNdef ARCHIVE_INIT}
    SetAFlags:=[af_InitArchive];
{$else}
    { pouze v pripade zamerneho poskozeni archivu }
    SetAFlags:=[af_InitArchive, af_NotCheckAStruct];
{$endif}
    pAStruct:=gpArchive1AStruct;       { ukazatel na statickou strukturu
                                         popisujici parametry archivu }
  end;
  { alokace objektu pristupujici do staticke pameti a kontrola chyb }
  pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pArchive^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pArchive^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pArchive^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;
  with DscrChArchive do
  begin
    SecDiff:=cMinSecDiff;              { urcuje cas nejmladsi polozky
                         prenase po komunikaci, tj. <GetPackTime-cSecDiff,
                         osetreni synchronizace mezi procesem zapisujicim
                         do archivu a procesem, ktery z archivu cte }
    pDscrObj:=pDscrObj1;               { ukazatel na popisovace }
    strName:='Archive1';               { jmeno archivu zobrazene ve vizualizaci }
  end;
  { vytvoreni objektu prenasejici data archivu vcetne popisovacu
    po komunikacnim kanale a kontrola chyb }
  m_pArchiveArray[arch_Archive1]:=New(pDscrChArchive, Init(pArchive, DscrChArchive));
  if m_pArchiveArray[arch_Archive1]^.GetLastError<>ae_NoError then
  begin
    writeln('LastError: ', Byte(m_pArchiveArray[arch_Archive1]^.GetLastError));
    RunError(255);
  end;


  { vytvoreni popisovacu archivu #2 }
  new(pDscrObj2, Init(
     'Time|String|Active',   { popisky/zahlavi polozek zaznamu }
     '',                     { format % strings polozek zaznamu like CSV }
     sizeof(tArchive2Record)   { velikost zaznamu }
     ));
  { datum a cas ulozeni zaznamu }
  if not pDscrObj2^.AddType(DscrMsk_DosDaTi, 0) then RunError(255);
  { kod }
  if not pDscrObj2^.AddType(DscrMsk_String, cMaxArchive2Str+1) then RunError(255);
  { priznaky }
  if not pDscrObj2^.AddType(DscrMsk_Byte, 0) then RunError(255);

  { kontrola celkove delky zaznamu - predeslo kontroly lze vynechat }
  if pDscrObj2^.GetDscrMaskLen <> sizeof(tArchive2Record) then RunError(255);

  with ArchiveDesc do {#2}
  begin
   {$ifdef CONVERT_BANKNO}
    FillChar(gpArchive2AStruct^, sizeof(tArchiveStruct), 0);
    wArchiveNo:=8;
   {$else}
    wArchiveNo:=Word(arch_Archive2);
   {$endif}
    laBaseAddr:=laArchive2;
    wRecordSize:=sizeof(tArchive1Record);
    dwMaxRecordCnt:=cArchive2MaxRecord;
{$ifNdef ARCHIVE_INIT}
    SetAFlags:=[af_InitArchive];
{$else}
    { pouze v pripade zamerneho poskozeni archivu }
    SetAFlags:=[af_InitArchive, af_NotCheckAStruct];
{$endif}
    pAStruct:=gpArchive2AStruct;
    { modification }
    wExRecordSize:=sizeof(tArchive2Record);
    fnModification:=TextModif;
  end;
  pArchive:=New(pModCycleArchive, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pArchive^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pArchive^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pArchive^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;
  with DscrChArchive do
  begin
    SecDiff:=cMinSecDiff;
    pDscrObj:=pDscrObj2;
    strName:='Archive2';
  end;
  m_pArchiveArray[arch_Archive2]:=New(pDscrChArchive, Init(pArchive, DscrChArchive));
  if m_pArchiveArray[arch_Archive2]^.GetLastError<>ae_NoError then
  begin
    writeln('LastError: ', Byte(m_pArchiveArray[arch_Archive1]^.GetLastError));
    RunError(255);
  end;
end;

destructor TArchive1.Done;
begin
  inherited Done;
end;


function  TArchive1.fnConvertArchiveNo(bBankNo:Byte):Byte;
begin
 {$ifdef CONVERT_BANKNO}
  case bBankNo of
   5:  fnConvertArchiveNo:=Byte(arch_Archive1);
   8:  fnConvertArchiveNo:=Byte(arch_Archive2);
  else
    fnConvertArchiveNo:=High(bBankNo);
  end;
 {$else}
  fnConvertArchiveNo:=inherited fnConvertArchiveNo(bBankNo);
 {$endif}
end;

function  TArchive1.fnGetArchiveCnt:Byte;
begin
  fnGetArchiveCnt:=Byte(high(tArchiveEnum))+1;
end;

procedure TArchive1.fnAbort;
begin
end;

function  TArchive1.fnClose:Boolean;
begin
  fnClose:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.CloseArchive;
end;

procedure TArchive1.fnGetListOpen(var ArchListInfo:TArchListInfo);
begin
  with ArchListInfo do
  begin
    {Serial Number ridiciho systemu - jedinecne cislo HW }
    ControllerSN   := $01;
    {Identifikacni string ridiciho systemu }
    ControllerIDStr:= 'A1: '+strAppName+'_Arch1';
    {celkovy pocet banku archivu - max. 255}
    ArchListCount  := fnGetArchiveCnt;
  end;
end;

procedure TArchive1.fnGetListItem(var ArchListItem:TArchDataHeader);
begin
  pDscrChArchive(m_pArchiveArray[tArchiveEnum(m_bArchive)])^.GetHeader(ArchListItem);
  ArchListItem.NextHeaderFl:=tArchiveEnum(m_bArchive)<>High(tArchiveEnum);
end;

procedure TArchive1.fnGetState(var ArchiveRecState:TRecArchiveState);
begin
  pDscrChArchive(m_pArchiveArray[tArchiveEnum(m_bArchive)])^.GetState(ArchiveRecState);
end;

procedure TArchive1.fnOpenArchive(BegRecTime, EndRecTime:LongInt;
                                  var Prvni, Posledni, Length: LongInt);
begin
  m_pArchiveArray[tArchiveEnum(m_bArchive)]^.OpenArchive(BegRecTime, EndRecTime, Prvni, Posledni, Length);
end;

function  TArchive1.fnReadArchive(pData:Pointer; EndTime:LongInt; var Len:Word):Boolean;
begin
  fnReadArchive:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.Read(pData, EndTime, Len);
end;

function  TArchive1.fnClearArchive:Boolean;
begin
  fnClearArchive:=m_pArchiveArray[tArchiveEnum(m_bArchive)]^.InitArchive;
end;

{ procedura pro zobrazeni stavu - zobrazi se stiskem klavesy "1" }
procedure ShowState;
begin
end;

{ funkce zapisujici do bank archivu }
procedure WriteToArchive;
var
  pArchive1:pArchiveVirt;
  pArchive2:pArchiveVirt;
  item:tArchive1Record;
  uwCode:Word;
  ArchiveDesc:tArchiveDesc;

begin
  with ArchiveDesc do
  begin
   {$ifdef CONVERT_BANKNO}
    wArchiveNo:=5;
   {$else}
    wArchiveNo:=Word(arch_Archive1);
   {$endif}
    laBaseAddr:=laArchive1;
    wRecordSize:=sizeof(tArchive1Record);
    dwMaxRecordCnt:=cArchive1MaxRecord;
    SetAFlags:=[af_InitArchive];
    pAStruct:=gpArchive1AStruct;
  end;
  pArchive1:=New(pArchiveVirt, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pArchive1^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pArchive1^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pArchive1^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;
  with ArchiveDesc do
  begin
   {$ifdef CONVERT_BANKNO}
    wArchiveNo:=8;
   {$else}
    wArchiveNo:=Word(arch_Archive2);
   {$endif}
    laBaseAddr:=laArchive2;
    wRecordSize:=sizeof(tArchive1Record);
    dwMaxRecordCnt:=cArchive2MaxRecord;
    SetAFlags:=[af_InitArchive];
    pAStruct:=gpArchive2AStruct;
  end;
  pArchive2:=New(pArchiveVirt, Init(nil, ArchiveDesc));
  {nedoslo pri inicializaci archivu k chybe}
  case pArchive2^.GetLastError of
    ae_NoError: ;{vse Ok}
    ae_AStructCrc: ;{popisovac archivu je poskozen->mela by nasledovat
                         inicializace archivu}
    ae_BaseAddr,   {datova cast archivu byla posunuta - hrozi poskozeni archivu }
    ae_IncompParams: {nekompatibilni parametry - hrozi poskozeni archivu }
      begin
(*
        v realne aplikaci by melo byt toto osetreni
        { zavreni znovu otevreni  bez kontrol }
        Dispose(pArchive, Done);
        ArchiveDesc.SetAFlags:=[af_NotCheckAStruct];
        pArchive:=New(pArchiveVirt, Init(nil, ArchiveDesc));
        if pArchive^.GetLastError<>ae_NoError then RunError(255);
*)
        { v pripade chyby -> ARCHIVE_INIT }
        writeln('LastError: ', Byte(pArchive2^.GetLastError));
        RunError(255);
      end;
  else
    {ae_InvalidParams}
    { v pripade chyby -> ARCHIVE_INIT }
    writeln('LastError: ', Byte(pArchive2^.GetLastError));
    RunError(255); { neplatne parametry konstruktoru }
  end;


  uwCode:=0;
  repeat
    with item do
    begin
      dwPackDate:=GetPackTime;
      wCode:=uwCode;
      bActive:=Byte(uwCode);
    end;

    if (uwCode mod 7) = 0 then
    begin
     {$ifdef Deb_Crt}
      Writeln('Zapis do archive1: ', item.dwPackDate, ',', item.wCode, ',', item.bActive);
     {$endif}
      if not pArchive1^.CheckWrite(@item) then RunError(255);
    end;
    if (uwCode mod 13) = 0 then
    begin
     {$ifdef Deb_Crt}
      Writeln('Zapis do archive2: ', item.dwPackDate, ',', item.wCode, ',', item.bActive);
     {$endif}
      if not pArchive2^.CheckWrite(@item) then RunError(255);
    end;

    Inc(uwCode);

    Wait(5);
  until FALSE;

  Terminate;

end;

end.
