{Automaticky test knihovny CFlash. Test otestuje spravny zapis a cteni do
 souboru pro linearni pristup. Provadi nekolik zapisu na ruzna mista o ruznych
 velikostech. Takto projde cely soubor az do konce. Nakonec obnovi puvodni
 soubor, tj. po skonceni testu je vhodne CF kartu vyjmout a v Total Commanderu
 porovnat s puvodnim obsahem souboru pro linearni pristup.}

uses
  HwSyst,
  NumToStr,
  CFlash,
 {$ifdef Kit188}
  Crt2Mem, {obsluhy Video a Keyboard BIOSu pro komunikaci na KitXxx}
  ChnVirt, {knihovna virtualniho komunikacniho kanalu}
  Chn188,  {knihovna vlastniho komunikacniho kanalu pro systemovy COM Kit188}
  ChnCrt,  {komunikacni protokol pro prenos Video a Keyboard}
  CrtComSl,{komunikacni automat pro prenos Video a Keyboard}
 {$endif}
  Crt;
const
  cBuffLen = 65528;
type
  pAByte = ^tAByte;
  tAByte = array[1..cBuffLen]of byte;
const
  CFObj     : tCFlash = ();   {objekt pro pristup k jednomu souboru CF}
  AddrForRW : longint = 0;    {linearni adresa pro cteni/zapis z/do CF}
  Len       : word    = 0;    {delka ctenych/zapisovanych dat}
  WrBuff    : pAByte  = nil;  {buffer pro zapisovana data}
  RdBuff    : pAByte  = nil;  {buffer pro ctena data}
  SaveBuff  : pAByte  = nil;  {buffer pro ulozeni puvodnich dat}
  PartTot   : longint = 0;    {celkovy pocet 64KB casti linearne pristupneho souboru}
  PartIx    : longint = 0;    {index aktualne testovane 64KB casti linearne pristupneho souboru}

  Res       : word    = 0;    {pro navratovy kod chyby CF operaci}

var
 {pomocne}
  SaveExit  : pointer;

label
  L_End;

function Test(X{pocet bytu v jedne skupine}:word):boolean;
var
  I,J,K,L  : word;
begin
  Test:=True;
  write('Zapis po ',X,'byte ... ');
  case X of
    1    ..    9:L:=30;
    10   ..   99:L:=20;
    100  ..  999:L:=10;
    1000 .. 9999:L:=7;
    10000..cBuffLen:L:=3;
  end;
  for I:=1 to L do {cyklus pres pocet zapisu}
  begin
   {nahodne zvolime misto zapisu}
    J:=Random(Len-X+1);
   {nahodne vyplnime zapisovana data}
    for K:=1 to X do
      WrBuff^[J+K]:=Random(256);
   {provedeme zapis}
    {write('Wr size',X,' pos',J);}
    Res:=CFObj.CFWrite(@WrBuff^[J+1],AddrForRW+J,X);
    if J+X>Len then
    begin {toto by spravne nemelo nikdy nastat}
      writeln('Chyba J=',J,' delka: ',X,' mimo rozsah ',Len);
      Test:=False;
      Exit;
    end;
    if Res<>resCF_Ok then
    begin
      writeln('Chyba ',Res,' pri zapisu na CF adr:',AddrForRW+J,' delka: ',X);
      Test:=False;
      Exit;
    end;
    Res:=CFObj.CFRead(AddrForRW+J,@RdBuff^[J+1],X);
    J:=MemCmp(@WrBuff^[J+1],@RdBuff^[J+1],X);
    if J<>0 then
    begin
      writeln('Chyba pri porovnavani zapsanych dat na ',J);
      writeln('WrBuff[',J,'] ',BufferStrHex2(@WrBuff^[J],5,#0,','));
      writeln('RdBuff[',J,'] ',BufferStrHex2(@RdBuff^[J],5,#0,','));
    end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}
  end;
 {zpetne precteme celou oblast}
  Res:=CFObj.CFRead(AddrForRW,RdBuff,Len);
  if Res<>resCF_Ok then
  begin
    writeln('Chyba ',Res,' pri cteni z CF adr:',AddrForRW,' delka: ',Len);
    Test:=False;
    Exit;
  end;
 {porovname je-li vse stejne}
  J:=MemCmp(WrBuff,RdBuff,Len);
  if J<>0 then
  begin
    writeln('Chyba pri porovnavani zapsanych dat na ',J,' adr:',AddrForRW+J-1);
    writeln('WrBuff[',J,'] ',BufferStrHex2(@WrBuff^[J],5,#0,','));
    writeln('RdBuff[',J,'] ',BufferStrHex2(@RdBuff^[J],5,#0,','));
    writeln('SvBuff[',J,'] ',BufferStrHex2(@SaveBuff^[J],5,#0,','));
    Test:=False;
    Exit;
  end;
  writeln('Ok');
end;

procedure MyAppExit; far;
begin
  ExitProc:=SaveExit;
  if ExitCode<>0 then
  begin
    writeln('RunError ',ExitCode,' on addr ',PtrToStr(ErrorAddr));
  end;
 {$ifdef Kit188}
  repeat
    CrtComMake;
  until false;
 {$endif}
end;

Begin
  ClrScr;

 {$ifdef Kit188}
  if InitCrtCom('NAM=CRT MAS=SLAVE LSB=400 '+
                'NAM=188 BD=115200 PAR=E STO=1 LRB=500') <> res_Ok then RunError(10);
 {$endif}

  SaveExit:=ExitProc;
  ExitProc:=@MyAppExit;

  writeln('Compact Flash size: ',CFSize,'B = (',CFSize shr 20,'MB)');
  Res:=CFObj.CFInit('linear.dat');
  if Res<>resCF_Ok then
  begin
    writeln('File Init Error: ',Res);
    Halt;
  end;
  writeln('Lin.space max.size: ',CFObj.CFGetFileSize,'B = (',CFObj.CFGetFileSize shr 20,'MB)');
  writeln;

  Randomize;
  New(WrBuff);
  New(RdBuff);
  New(SaveBuff);

  {spocteme kolik 64KB casti ma soubor pro linearni pristup}
  PartTot:=CFObj.CFGetFileSize div cBuffLen;
  if (CFObj.CFGetFileSize mod cBuffLen)<>0 then Inc(PartTot);

  repeat
    if CFObj.CFGetFileSize<cBuffLen+AddrForRW then
      Len:=CFObj.CFGetFileSize-AddrForRW
    else
      Len:=cBuffLen;

    Inc(PartIx);
    writeln('Prubeh testu ',PartIx,' z ',PartTot);

   {=================================}
   {ulozime puvodni data             }
   {=================================}
    Res:=CFObj.CFRead(AddrForRW,SaveBuff,Len);
    if Res<>resCF_Ok then
    begin
      writeln('Chyba ',Res,' pri cteni z CF adr:',AddrForRW,' delka: ',Len);
      goto L_end;
    end;
    WrBuff^:=SaveBuff^;

   {=================================}
   {nahodny zapis po 1byte           }
   {=================================}
    FillChar(RdBuff^,SizeOf(RdBuff^),0);
    if Len>=1 then
      if not Test(1) then
      begin
        Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
        goto L_End;
      end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}

   {=================================}
   {nahodny zapis po 10byte          }
   {=================================}
    FillChar(RdBuff^,SizeOf(RdBuff^),0);
    if Len>=10 then
      if not Test(10) then
      begin
        Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
        goto L_End;
      end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}

   {=================================}
   {nahodny zapis po 100byte         }
   {=================================}
    FillChar(RdBuff^,SizeOf(RdBuff^),0);
    if Len>=100 then
      if not Test(100) then
      begin
        Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
        goto L_End;
      end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}

   {=================================}
   {nahodny zapis po 1000byte        }
   {=================================}
    FillChar(RdBuff^,SizeOf(RdBuff^),0);
    if Len>=1000 then
      if not Test(1000) then
      begin
        Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
        goto L_End;
      end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}

   {=================================}
   {nahodny zapis po 10000byte       }
   {=================================}
    FillChar(RdBuff^,SizeOf(RdBuff^),0);
    if Len>=10000 then
      if not Test(10000) then
      begin
        Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
        goto L_End;
      end;
   {$ifdef Kit188}
    CrtComMake;
   {$endif}

   {=================================}
   {zapiseme zpet puvodni obsah      }
   {=================================}
    Res:=CFObj.CFWrite(SaveBuff,AddrForRW,Len);
    if Res<>resCF_Ok then
    begin
      writeln('Chyba ',Res,' pri zapisu na CF adr:',AddrForRW,' delka: ',Len);
      goto L_End;
    end;

    Inc(AddrForRW,cBuffLen);
   {$ifdef Kit188}
    CrtComMake;
   {$endif}
  until (AddrForRW>=CFObj.CFGetFileSize)or(keypressed);

  writeln;
  writeln('Test knihovny CFlash probehl bez chyby');

 L_End:
  Dispose(SaveBuff);
  Dispose(RdBuff);
  Dispose(WrBuff);
End.
