{ UTILITY.INC: Utility Routines }

{==========================================================================}
{ (c) Copyright Waterline Software Developent V.O.F. 1990-1994             }
{                                                                          }
{    Waterline Software Development V.O.F.                                 }
{    Wouter Sluislaan 12                                                   }
{    1461 AC  Zuidoostbeemster                                             }
{    The Netherlands                                                       }
{                                                                          }
{ It not allowed to use this user interface in any program not owned by    }
{ the Waterline Software Development V.O.F.                                }
{ Special conditions apply to programs distributed by the Waterline        }
{ Software Development V.O.F. If the source code of any of these programs  }
{ is distributed as well, it is NOT allowed to use the user interface in   }
{ your own programs. Violators may be prosecuted!                          }
{                                                                          }
{ Please contact the Waterline Software Development V.O.F. at the above    }
{ address for your licence to use the "Ramon" user interface. You will get }
{ the most recent copy of the "Ramon" user interface and the "Ramon" user  }
{ interface expert for free. This program helps you design your user       }
{ interfaces at an instance.                                               }
{                                                                          }
{ This copyright notice should remain in this file and all files that are  }
{ part of the user interface "Ramon".                                      }
{==========================================================================}

{ History:

 RWI 231094: DeleteFrontAndBackSpaces toegevoegd ter vervanging van
             DeleteFrontSpaces (DeleteBackSpaces ()) wat regelmatig
             gebruikt werd.
             DeleteFrontSpaces (3.7x), DeleteBackSpaces (3.7x) en
             DeleteFrontAndBackSpaces (5.2x) omgezet in een flink snellere
             versie, gebruik makend van wat assembly. Het verschil tussen
             DeleteFrontAndBackSpaces en de oude versie met aanroep van
             twee routines is zelfs een factor 5.8x sneller!
}

{--------------------------------------------------------------------------}
{ RepChar                                                                  }
{                                                                          }
{ Geeft een string terug met als inhoud het opgegeven Teken, net zo vaak   }
{ als opgegeven was in Aantal.                                             }
{                                                                          }
FUNCTION RepChar (Aantal : BYTE; Teken : CHAR) : STRING;

VAR Temp : STRING;

BEGIN
     FillChar (Temp[1],Aantal,Teken);
     Temp[0]:=Chr (Aantal);

     RepChar:=Temp;
END;


{--------------------------------------------------------------------------}
{ Spaces                                                                   }
{                                                                          }
{ Deze routine geeft een string met het opgegeven aantal spaties terug.    }
{                                                                          }
FUNCTION Spaces (Aantal : BYTE) : STRING;
BEGIN
     Spaces:=RepChar (Aantal,' ');
END;


{--------------------------------------------------------------------------}
{ AddUpWithSpaces                                                          }
{                                                                          }
{ Vul de opgegeven tekst aan met spaties tot de lengte Len.                }
{                                                                          }
FUNCTION AddUpWithSpaces (Len : BYTE; Tekst : STRING) : STRING;
BEGIN
     IF (Length (Tekst) > Len) THEN
        AddUpWithSpaces:=Copy (Tekst,1,Len)
     ELSE
         AddUpWithSpaces:=Tekst+RepChar (Len-Length (Tekst),' ');
END;


{--------------------------------------------------------------------------}
{ AddUpWithSpaceNoCut                                                      }
{                                                                          }
{ Vult een string aan met spaties tot de opgegeven lengte, maar kapt 'm    }
{ niet af omdat ie langer is dan dat aantal tekens, zoals AddUpWithSpaces  }
{ doet.                                                                    }
{                                                                          }
FUNCTION AddUpWithSpacesNoCut (Len : BYTE; Tekst : STRING) : STRING;
BEGIN
     IF (Length (Tekst) < Len) THEN
        AddUpWithSpacesNoCut:=Tekst+RepChar (Len-Length (Tekst),' ')
     ELSE
         AddUpWithSpacesNoCut:= Tekst;
END;


{--------------------------------------------------------------------------}
{ DeleteBackSpaces                                                         }
{                                                                          }
{ Deze routine haalt alle spaties aan het einde van de opgegeven tekst weg }
{ totdat de string leeg is of er een niet-spatie teken aan het eind staat. }
{                                                                          }
FUNCTION DeleteBackSpaces (Tekst : STRING) : STRING;

VAR P : BYTE;

BEGIN
     IF (Tekst <> '') THEN
     BEGIN
          {$IFDEF PLATFORM_OS2_WIN32}
          P:=Length (Tekst);
          WHILE (P > 0) AND (Tekst[P] = ' ') DO
                Dec (P);
          {$ELSE}
          ASM
             LEA SI,Tekst   { SS:SI wijst nu naar de opslag ruimte van Tekst }

             MOV CL,SS:[SI] { lengte byte ophalen }
             XOR CH,CH      { lengte zit nu in CX voor de loop }

             MOV AH,CL      { aantal tekens te behouden in AH }

             ADD SI,CX      { ga naar het einde van de string }

             STD            { set the direction flag to go in reverse direction }
      @Loop: SEGSS LODSB    { haal een teken vd string op }
             CMP AL,' '     { is het een spatie? }
             JNZ @Einde     { nee, einde van alle spaties bereikt }
             DEC AH         { 1 teken minder behouden straks }
             LOOP @Loop     { volgende teken bekijken }

     @Einde: MOV P,AH       { aantal tekens te behouden opslaan in P }
          END;
          {$ENDIF}

          DeleteBackSpaces:=Copy (Tekst,1,P);
          Exit;
     END;

     DeleteBackSpaces:=Tekst;
END;


{--------------------------------------------------------------------------}
{ DeleteBackNulls                                                          }
{                                                                          }
{ Deze routine haalt alle NULLs aan het einde van de opgegeven tekst weg   }
{ totdat de string leeg is of er een niet-NULL teken aan het eind staat.   }
{                                                                          }
FUNCTION DeleteBackNulls (Tekst : STRING) : STRING;

VAR P : BYTE;

BEGIN
     IF (Tekst <> '') THEN
     BEGIN
          {$IFDEF PLATFORM_OS2_WIN32}
          P:=Length (Tekst);
          WHILE (P > 0) AND (Tekst[P] = #0) DO
                Dec (P);
          {$ELSE}
          ASM
             LEA SI,Tekst   { SS:SI wijst nu naar de opslag ruimte van Tekst }

             MOV CL,SS:[SI] { lengte byte ophalen }
             XOR CH,CH      { lengte zit nu in CX voor de loop }

             MOV AH,CL      { aantal tekens te behouden in AH }

             ADD SI,CX      { ga naar het einde van de string }

             STD            { set the direction flag to go in reverse direction }
      @Loop: SEGSS LODSB    { haal een teken vd string op }
             CMP AL,0       { is het een NULL? }
             JNZ @Einde     { nee, einde van alle spaties bereikt }
             DEC AH         { 1 teken minder behouden straks }
             LOOP @Loop     { volgende teken bekijken }

     @Einde: MOV P,AH       { aantal tekens te behouden opslaan in P }
          END;
          {$ENDIF}

          DeleteBackNulls:=Copy (Tekst,1,P);
          Exit;
     END;

     DeleteBackNulls:=Tekst;
END;


{--------------------------------------------------------------------------}
{ DeleteFrontSpaces                                                        }
{                                                                          }
{ Deze routine haalt de spaties aan het begin van een string weg en geeft  }
{ de rest terug.                                                           }
{                                                                          }
FUNCTION DeleteFrontSpaces (Tekst : STRING) : STRING;

VAR P : BYTE;

BEGIN
     IF (Tekst <> '') THEN
     BEGIN
          {$IFDEF PLATFORM_OS2_WIN32}
          P:=0;
          WHILE (P < Length (Tekst)) AND (Tekst[P+1] = ' ') DO
                Inc (P);
          {$ELSE}
          ASM
             LEA SI,Tekst

             CLD
             SEGSS LODSB    { lengte byte ophalen }
             MOV CL,AL      { lengte naar CX voor LOOP }
             XOR CH,CH

             XOR AH,AH      { aantal spaties geteld: 0 }
       @More:
             SEGSS LODSB    { teken ophalen }
             CMP AL,' '     { is het een spatie? }
             JNZ @Einde     { nee, klaar met tellen }
             INC AH         { 1 spatie meer geteld }
             LOOP @More     { verder zoeken tot einde string }

     @Einde: MOV P,AH       { aantal gevonden spaties opslaan in P }
          END;
          {$ENDIF}

          IF (P <> 0) THEN
          BEGIN
               DeleteFrontSpaces:=Copy (Tekst,P+1,255);
               Exit;
          END;
     END;

     DeleteFrontSpaces:=Tekst;
END;


{---------------------------------------------------------------------------}
{ DeleteFrontAndBackSpaces                                                  }
{                                                                           }
{ Deze routine haalt de spaties aan het begin en het einde weg.             }
{                                                                           }
FUNCTION DeleteFrontAndBackSpaces (Tekst : STRING) : STRING;

VAR PF,PB : BYTE;

BEGIN
     IF (Tekst <> '') THEN
     BEGIN
          { tel hoeveel teken er overblijven als de achterkant gestript }
          { wordt.                                                      }

          {$IFDEF PLATFORM_OS2_OR_WIN32}
          PB:=Length (Tekst);
          WHILE (PB > 0) AND (Tekst[PB] = ' ') DO
                Dec (PB);
          {$ELSE}
          ASM
             LEA SI,Tekst   { SS:SI wijst nu naar de opslag ruimte van Tekst }

             MOV CL,SS:[SI] { lengte byte ophalen }
             XOR CH,CH      { lengte zit nu in CX voor de loop }

             MOV AH,CL      { aantal tekens te behouden in AH }

             ADD SI,CX      { ga naar het einde van de string }

             STD            { set the direction flag to go in reverse direction }
      @Loop: SEGSS LODSB    { haal een teken vd string op }
             CMP AL,' '     { is het een spatie? }
             JNZ @Einde     { nee, einde van alle spaties bereikt }
             DEC AH         { 1 teken minder behouden straks }
             LOOP @Loop     { volgende teken bekijken }

     @Einde: MOV PB,AH      { aantal tekens te behouden opslaan in PB }
          END;
          {$ENDIF}

          IF (PB = 0) THEN
          BEGIN
               { er blijft niets over, dat is dus rap klaar }
               DeleteFrontAndBackSpaces:='';
               Exit;
          END;

          { tel hoeveel spaties er aan de voorkant af gaan }
          {$IFDEF PLATFORM_OS2_OR_WIN32}
          PF:=0;
          WHILE (PF < PB) AND (Tekst[PF+1] = ' ') DO
                Inc (PF);
          {$ELSE}
          ASM
             LEA SI,Tekst

             CLD
             SEGSS LODSB    { lengte byte ophalen }
             MOV CL,AL      { lengte naar CX voor LOOP }
             XOR CH,CH

             XOR AH,AH      { aantal spaties geteld: 0 }
       @More:
             SEGSS LODSB    { teken ophalen }
             CMP AL,' '     { is het een spatie? }
             JNZ @Einde     { nee, klaar met tellen }
             INC AH         { 1 spatie meer geteld }
             LOOP @More     { verder zoeken tot einde string }

     @Einde: MOV PF,AH       { aantal gevonden spaties opslaan in PF }
          END;
          {$ENDIF}

          DeleteFrontAndBackSpaces:=Copy (Tekst,PF+1,PB-PF);
          Exit;
     END;

     DeleteFrontAndBackSpaces:=Tekst;
END;


{--------------------------------------------------------------------------}
{ AddUpWithPre0s                                                           }
{                                                                          }
{ Deze routine vult de opgegeven string aan tot de gewenste lengte door    }
{ voorloop nullen voor de tekst te zetten.                                 }
{                                                                          }
FUNCTION AddUpWithPre0s (Len : BYTE; Tekst : STRING) : STRING;
BEGIN
     IF (Length (Tekst) < Len) THEN
        Tekst:=RepChar (Len-Length (Tekst),'0')+Tekst;

     AddUpWithPre0s:=Tekst;
END;


{--------------------------------------------------------------------------}
{ AddUpWithPreSpaces                                                       }
{                                                                          }
{ Deze routine vult de opgegeven string aan tot de gewenste lengte door    }
{ voorloop spaties voor de tekst te zetten.                                }
{                                                                          }
FUNCTION AddUpWithPreSpaces (Len : BYTE; Tekst : STRING) : STRING;
BEGIN
     IF (Length (Tekst) < Len) THEN
        Tekst:=RepChar (Len-Length (Tekst),' ')+Tekst;

     AddUpWithPreSpaces:=Tekst;
END;

{$IFDEF PLATFORM_DOS_NOT_DPMI}
{--------------------------------------------------------------------------}
{ SetEnvStr                                                                }
{                                                                          }
{ Met deze routine kan een environment variabele van de meest recente      }
{ ingeladen COMMAND.COM gewijzigd worden. De wijziging wordt niet in de    }
{ eigen environment variabelen doorgevoerd en kan dus net met EnvCount,    }
{ GetEnv etc. worden opgehaald.                                            }
{ Als de variabele al bestaat dan wordt deze eerst verwijderd. Als er      }
{ (daarna) geen genoeg ruimte is om een nieuwe variabele aan te maken, dan }
{ wordt deze niet aangemaakt. Anders wordt de nieuwe variabele als laatste }
{ aan de lijst toegevoegd.                                                 }
{                                                                          }
PROCEDURE SetEnvStr (StrName : STRING; NewValue : STRING);

TYPE EnvBuffer = ARRAY[1..32768] OF CHAR;
     EnvPtr    = ^EnvBuffer;

VAR CurrEnv     : EnvPtr;
    CurrMaxSize : WORD;


{--------------------------------------------------------------------------}
{ FindEnvironment                                                          }
{                                                                          }
{ Deze routine gaat in het geheugen op zoek naar het MCB waar de           }
{ environment variabelen in opgeslagen zijn. Als eerste worden alle        }
{ segmenten achterwaarts afgelopen tot het segment van COMMAND.COM         }
{ gevonden wordt. Vanaf daar wordt vooruit gezocht naar het memory block   }
{ waarin de environment variabelen staan. Dit gaat redelijk tricky, maar   }
{ het werkt wel.                                                           }
{                                                                          }
PROCEDURE FindEnvironment;

VAR CommandSeg,
    TempSeg,
    BlockSeg   : WORD;

BEGIN
     TempSeg:=PrefixSeg;
     REPEAT
           CommandSeg:=TempSeg;
           TempSeg:=MemW[TempSeg:$16];
     UNTIL (CommandSeg = TempSeg);

     BlockSeg:=CommandSeg;
     REPEAT
          Inc (BlockSeg);
     UNTIL (Mem[BlockSeg:0] = $4D) AND (MemW[BlockSeg:1] = CommandSeg);

     CurrEnv:=Ptr (Succ (BlockSeg),0);
     CurrMaxSize:=16*MemW[BlockSeg:3];
END;


{ SetEnvStr }

VAR NewEnv   : EnvPtr;
    CurrItem,
    NewItem  : STRING;
    CurrOfs,
    NewOfs,
    Lp       : WORD;

BEGIN
     FindEnvironment;

     GetMem (NewEnv,CurrMaxSize);

     CurrOfs:=1;
     NewOfs:=1;

     StrName:=UpCaseString (StrName);
     NewItem:=StrName+'='+NewValue;

{ oude items kopieren }
     WHILE (CurrEnv^[CurrOfs] <> #0) DO
     BEGIN
          CurrItem:='';

          WHILE (CurrEnv^[CurrOfs] <> #0) DO
          BEGIN
               CurrItem:=CurrItem+CurrEnv^[CurrOfs];
               Inc (CurrOfs);
          END;

          Inc (CurrOfs);                                  { sla de 0 over }

          IF (Copy (CurrItem,1,Pos ('=',CurrItem)-1) <> StrName) THEN
          BEGIN
               FOR Lp:=1 TO Length (CurrItem) DO
               BEGIN
                    NewEnv^[NewOfs]:=CurrItem[Lp];
                    Inc (NewOfs);
               END;

               NewEnv^[NewOfs]:=#0;
               Inc (NewOfs);
          END;
     END;

   { WriteLn ('Free before creation: ',CurrMaxSize-NewOfs);
     WriteLn ('Length of NewItem+1: ',Length (NewItem)+1); }

{ nieuwe item toevoegen, mits er ruimte genoeg voor is }
     IF ((CurrMaxSize - NewOfs) > Length (NewItem)) THEN
     BEGIN
          FOR Lp:=1 TO Length (NewItem) DO
          BEGIN
               NewEnv^[NewOfs]:=NewItem[Lp];
               Inc (NewOfs);
          END;

          NewEnv^[NewOfs]:=#0;
          Inc (NewOfs);
     END;

   { WriteLn ('Free after creation: ',CurrMaxSize-NewOfs); }

{ rest wissen }
     WHILE (NewOfs <= CurrMaxSize) DO
     BEGIN
          NewEnv^[NewOfs]:=#0;
          Inc (NewOfs);
     END;

{ nieuwe environment over oude heen kopieren}
    Move (NewEnv^,CurrEnv^,CurrMaxSize);

    FreeMem (NewEnv,CurrMaxSize);
END;

{$ENDIF}

{ deze tabel kost 1Kb in het globale datasegment. Dat moet dan maar    }
{ totdat er een routine is die de tabel tijdens run-time kan genereren }
CONST CRC32Tab : ARRAY[0..255] OF LONGINT = (
{ tabel overgenomen uit crc_32.c van de snip1292.arj archive }
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f,
$e963a535, $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,
$09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064, $6ab020f2,
$f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
$fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172,
$3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,
$dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423,
$cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
$2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,
$98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d,
$91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,
$6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
$8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7,
$a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,
$44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa,
$be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,
$b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,
$ead54739, $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84,
$0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
$196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,
$f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e,
$38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55,
$316e8eef, $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
$cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28,
$2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f,
$72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,
$92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
$68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69,
$616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,
$a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,
$40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693,
$54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,
$b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
);


{--------------------------------------------------------------------------}
{ UpdateCRC32                                                              }
{                                                                          }
{ Deze routine loopt het opgegeven InBuf door voor InLen tekens en past de }
{ opgegeven InitCRC aan de hand van het CRC32 polynoom aan.                }
{                                                                          }
FUNCTION UpdateCRC32 (InitCRC : LONGINT; VAR InBuf; InLen : WORD) : LONGINT;
{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
ASSEMBLER;
{$USES ESI,EDI,ECX,EBX}
ASM
   { adres van het buffer ophalen naar DS:SI }
   MOV ESI,InBuf

   { haal de initiele CRC waarde op in DX:AX }
   MOV AX,Word (InitCRC)
   MOV DX,Word (InitCRC+2)

   { haal de lengte van het buffer op }
   XOR ECX,ECX
   MOV CX,InLen
   OR CX,CX       { length = 0? }
   JZ @Einde      { ja, dan niets te doen hier }

   CLD

@DoBufLp:
   MOV EBX,0
   MOV BL,AL   { BL = AL = LSB van CRC32 }
   LODSB       { haal een teken uit de string op van DS:SI naar AL }
   XOR BL,AL   { XOR het teken met het LSB van de CRC32 }

   { schuif het hele CRC 8 bits door naar beneden }
   MOV AL,AH
   MOV AH,DL
   MOV DL,DH
   XOR DH,DH

   SHL BX,1       { *4, want iedere entry in de tabel is een LONGINT }
   SHL BX,1       { BX was 0..255 }

   ADD EBX,OFFSET CRC32Tab
   XOR AX,ES:[EBX+0]
   XOR DX,ES:[EBX+2]

   LOOP @DoBufLp { meer tekens uit het buffer verwerken }

   PUSH DX
   PUSH AX
   POP EAX       { return value in EAX }

@Einde:
END;
{$ELSE}                  { This is FPC }
VAR
     Ptr : Pointer;
     Count : WORD;
     CRC: LONGINT;

BEGIN
     Ptr := @InBuf;
     CRC := InitCRC;

     FOR Count := 1 TO InLen DO
     BEGIN
          Crc := CRC32Tab [BYTE (CRC XOR LONGINT (BYTE (Ptr^)))]
                    XOR ((CRC SHR 8) AND $00FFFFFF);
     END;

     UpdateCRC32 := CRC;
END;
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     Ptr : Pointer;
     Count : WORD;
     CRC: LONGINT;

BEGIN
     Ptr := @InBuf;
     CRC := InitCRC;

     FOR Count := 1 TO InLen DO
     BEGIN
          Crc := CRC32Tab [BYTE (CRC XOR LONGINT (BYTE (Ptr^)))]
                    XOR ((CRC SHR 8) AND $00FFFFFF);
     END;

     UpdateCRC32 := CRC;
END;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
ASSEMBLER;
ASM
   PUSH DS

   { adres van het buffer ophalen naar DS:SI }
   LDS SI,InBuf

   { haal de initiele CRC waarde op in DX:AX }
   MOV AX,Word (InitCRC)
   MOV DX,Word (InitCRC+2)

   { tabel staat nu op DS:CRC32Tab, kan ook ergens anders heen  }
   { een pointer naar de tabel moet dan simpel hier neergezet   }
   { worden. Bij een dynamische tabel moet een routine gemaakt  }
   { worden die de tabel genereerd. Een pointer naar de tabel   }
   { wordt dan in een globale variabele opgeslagen. Met de      }
   { instructie LES DI,[Pointer] kan deze dan opgehaald worden. }
   POP ES
   PUSH ES
   MOV DI,OFFSET CRC32Tab

   { haal de lengte van het buffer op }
   MOV CX,InLen
   OR CX,CX       { length = 0? }
   JZ @Einde      { ja, dan niets te doen hier }

   CLD

@DoBufLp:
   XOR BH,BH
   MOV BL,AL   { BL = AL = LSB van CRC32 }
   LODSB       { haal een teken uit de string op van DS:SI naar AL }
   XOR BL,AL   { XOR het teken met het LSB van de CRC32 }

   { schuif het hele CRC 8 bits door naar beneden }
   MOV AL,AH
   MOV AH,DL
   MOV DL,DH
   XOR DH,DH

   SHL BX,1       { *4, want iedere entry in de tabel is een LONGINT }
   SHL BX,1       { BX was 0..255 }

   XOR AX,ES:[DI+BX]
   XOR DX,ES:[DI+BX+2]

   LOOP @DoBufLp { meer tekens uit het buffer verwerken }

@Einde:
   POP DS
   { resultaat in DX:AX is het de teruggegeven LONGINT }
END;
{$ENDIF}


{--------------------------------------------------------------------------}
{ LoCase                                                                   }
{                                                                          }
{ Deze routine zet het opgegeven teken om in een kleine letter als het een }
{ hoofdletter was.                                                         }
{                                                                          }
FUNCTION LoCase (C : CHAR) : CHAR;
BEGIN
     IF (C IN ['A'..'Z']) THEN
        C:=Char (Byte (C)+32);
     LoCase:=C;
END;


{--------------------------------------------------------------------------}
{ SwapWords                                                                }
{                                                                          }
{ Deze routine draait de inhoud van de twee words om.                      }
{                                                                          }
PROCEDURE SwapWords (VAR W1,W2 : WORD);

VAR W3 : WORD;

BEGIN
     W3:=W1;
     W1:=W2;
     W2:=W3;
END;


{--------------------------------------------------------------------------}
{ UpCaseString                                                             }
{                                                                          }
{ Deze routine zet de opgegeven Tekst om in hoofdletters.                  }
{ manual.                                                                  }
{                                                                          }
FUNCTION UpCaseString (Tekst : STRING) : STRING;
{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
{$USES ESI,EDI,ECX,EAX}
ASSEMBLER;
ASM
    CLD            { van voor naar achter door de string }

    MOV ESI,Tekst   { Load effective address (offset) van Tekst in SI }
    MOV EDI,@Result { daar moet het resultaat heen }

    LODSB           { ESI Lengte byte ophalen }
    STOSB           { Sla de lengte byte op }

    { AL bevat nu de lengte byte }
    XOR ECX,ECX
    XOR AH,AH
    XCHG AX,CX     { lengte naar CX, past ook vlaggen aan }
    JCXZ @3        { geen tekst, lengte is 0 }

  @1:
    LODSB          { haal een teken op }
    CMP AL,'a'     { is het een kleine letter? }
    JB @2          { nee }
    CMP AL,'z'
    JA @2          { nee }
    SUB AL,32      { ja, maak er een hoofdletter van }
  @2:
    STOSB          { sla het (eventueel aangepaste) teken op }
    LOOP @1        { volgende teken verwerken }
  @3:
END;
{$ELSE}
VAR
     N: INTEGER;

BEGIN
     FOR N := 1 TO Length (Tekst) DO
          Tekst [N] := UpCase (Tekst [N]);

     UpCaseString := Tekst;
END;
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     N: INTEGER;

BEGIN
     FOR N := 1 TO Length (Tekst) DO
          Tekst [N] := UpCase (Tekst [N]);

     UpCaseString := Tekst;
END;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
BEGIN
     ASM
        CLD            { van voor naar achter door de string }

        LEA SI,Tekst   { Load effective address (offset) van Tekst in SI }
        LES DI,@Result { daar moet het resultaat heen }

        SEGSS LODSB    { SS:SI Lengte byte ophalen }
        STOSB          { Sla de lengte byte op }

        XOR AH,AH
        XCHG AX,CX     { lengte naar CX, past ook vlaggen aan }
        JCXZ @3        { geen tekst, lengte is 0 }

      @1:
        SEGSS LODSB    { haal een teken op }
        CMP AL,'a'     { is het een kleine letter? }
        JB @2          { nee }
        CMP AL,'z'
        JA @2          { nee }
        SUB AL,32      { ja, maak er een hoofdletter van }
      @2:
        STOSB          { sla het (eventueel aangepaste) teken op }
        LOOP @1        { volgende teken verwerken }
      @3:
     END;
END;
{$ENDIF}


{--------------------------------------------------------------------------}
{ LoCaseString                                                             }
{                                                                          }
{ Deze routine zet de opgegeven Tekst om in kleine letters.                }
{                                                                          }
FUNCTION LoCaseString (Tekst : STRING) : STRING;
{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
{$USES ESI,EDI,ECX,EAX}
ASSEMBLER;
ASM
    CLD            { van voor naar achter door de string }

    MOV ESI,Tekst   { Load effective address (offset) van Tekst in SI }
    MOV EDI,@Result { daar moet het resultaat heen }

    LODSB           { ESI Lengte byte ophalen }
    STOSB           { Sla de lengte byte op }

    { AL bevat nu de lengte byte }
    XOR ECX,ECX
    XOR AH,AH
    XCHG AX,CX     { lengte naar CX, past ook vlaggen aan }

    JCXZ @3        { geen tekst, lengte is 0 }

  @1:
    SEGSS LODSB    { haal een teken op }
    CMP AL,'A'     { is het een kleine letter? }
    JB @2          { nee }
    CMP AL,'Z'
    JA @2          { nee }
    ADD AL,32      { ja, maak er een kleine letter van }
  @2:
    STOSB          { sla het (eventueel aangepaste) teken op }
    LOOP @1        { volgende teken verwerken }
  @3:
END;
{$ELSE}
VAR
     N: INTEGER;

BEGIN
     FOR N := 1 TO Length (Tekst) DO
          Tekst [N] := LoCase (Tekst [N]);

     LoCaseString := Tekst;
END;
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     N: INTEGER;

BEGIN
     FOR N := 1 TO Length (Tekst) DO
          Tekst [N] := LoCase (Tekst [N]);

     LoCaseString := Tekst;
END;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
BEGIN
     ASM
        CLD            { van voor naar achter door de string }

        LEA SI,Tekst   { Load effective address (offset) van Tekst in SI }
        LES DI,@Result { daar moet het resultaat heen }

        SEGSS LODSB    { SS:SI Lengte byte ophalen }
        STOSB          { Sla de lengte byte op }

        XOR AH,AH
        XCHG AX,CX     { lengte naar CX, past ook vlaggen aan }
        JCXZ @3        { geen tekst, lengte is 0 }

      @1:
        SEGSS LODSB    { haal een teken op }
        CMP AL,'A'     { is het een kleine letter? }
        JB @2          { nee }
        CMP AL,'Z'
        JA @2          { nee }
        ADD AL,32      { ja, maak er een kleine letter van }
      @2:
        STOSB          { sla het (eventueel aangepaste) teken op }
        LOOP @1        { volgende teken verwerken }
      @3:
     END;
END;
{$ENDIF}


{--------------------------------------------------------------------------}
{ GetTimer                                                                 }
{                                                                          }
{ Deze routine leest de computer timer uit. Deze wordt 18.2 keer per sec.  }
{ verhoogd met 1.                                                          }
{                                                                          }
FUNCTION GetTimer : LONGINT;
{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
VAR H,M,S,SH : LONGINT;

BEGIN
     GetTime (H,M,S,SH);
     GetTimer:=Trunc ((H*3600+M*60+S)*18.2);
{$ELSE}
VAR H,M,S,SH : WORD;

BEGIN
     GetTime (H,M,S,SH);
     GetTimer:=Trunc ((LONGINT(H*3600+M*60+S))*18.2);
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}

VAR H,M,S,SH : WORD;

BEGIN
     GetTime (H,M,S,SH);
     GetTimer:=Trunc ((LONGINT(H*3600+M*60+S))*18.2);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
BEGIN
     GetTimer:=MemL[Seg0040:$6C];
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ CleanTabs                                                                }
{                                                                          }
{ Vervangt Tabs door een opgegeven aantal spaties.                         }
{                                                                          }
FUNCTION CleanTabs (Tekst : STRING; WithNrSpaces : BYTE) : STRING;

VAR P : BYTE;

BEGIN
     P:=Pos (#9,Tekst);
     WHILE (P > 0) DO
     BEGIN
          Tekst:=Copy (Tekst,1,P-1)+Spaces (WithNrSpaces)+Copy (Tekst,P+1,255);
          P:=Pos (#9,Tekst);
     END;

     CleanTabs:=Tekst;
END;


{--------------------------------------------------------------------------}
{ CaselessMatch                                                            }
{                                                                          }
{ This routine returns TRUE if the two strings are a case insensitive      }
{ match.                                                                   }
{                                                                          }
FUNCTION CaselessMatch (VAR Str1 : STRING; Str2 : STRING) : BOOLEAN;

VAR Lp : BYTE;

BEGIN
     CaselessMatch:=FALSE; { assume mismatch }

     IF (Length (Str1) <> Length (Str2)) THEN
        Exit;

     {## optimize with assembly? }
     FOR Lp:=1 TO Length (Str1) DO
         IF (UpCase (Str1[Lp]) <> UpCase (Str2[Lp])) THEN
            Exit;

     CaselessMatch:=TRUE;
END;


FUNCTION CaselessMatch_CC (Str1,Str2 : STRING) : BOOLEAN;
BEGIN
     CaselessMatch_CC:=CaselessMatch (Str1,Str2);
END;


{--------------------------------------------------------------------------}
{ CaselessStartMatch                                                       }
{                                                                          }
{ This routine returns TRUE when the first few characters of the first     }
{ argument caseless match all the characters of the second argument.       }
{                                                                          }
FUNCTION CaselessStartMatch (VAR Str1 : STRING; Str2 : STRING) : BOOLEAN;

VAR Lp : BYTE;

BEGIN
     CaselessStartMatch:=FALSE; { assume mis-match }

     IF (Length (Str1) < Length (Str2)) THEN
        Exit;

     {## optimize with assembly? }
     FOR Lp:=1 TO Length (Str2) DO
         IF (UpCase (Str1[Lp]) <> UpCase (Str2[Lp])) THEN
            Exit;

     CaselessStartMatch:=TRUE;
END;


{--------------------------------------------------------------------------}
{ DelayOneSecond                                                           }
{                                                                          }
{ Wait of an UNPRECISE time one of second. If this routine is called a     }
{ couple of time, the first call might be under one second but the others  }
{ should keep correct time. The implementation uses the Real-time clock.   }
{                                                                          }
PROCEDURE DelayOneSecond;

VAR X,Sec1,Sec2 : WordLong;

BEGIN
     GetTime (X,X,Sec1,X);
     REPEAT
           GetTime (X,X,Sec2,X);
     UNTIL (Sec1 <> Sec2);
END;


{--------------------------------------------------------------------------}
{ NewDelay                                                                 }
{                                                                          }
{ This routine is now used instead of the normal Delay() function since    }
{ it was modified to avoid a DIV overflow error while measuring the        }
{ duration of one loop. The value got too big on 233MHz or faster          }
{ machines. This routine works under DOS (modified), DPMI (modified) and   }
{ OS/2.                                                                    }
{                                                                          }
PROCEDURE NewDelay (MS : WORD); { must be 6553 or lower! }
BEGIN
     {$IFDEF PLATFORM_OS2_WIN32}
     Delay (MS);
     {$ELSE}
     { I have modified the library function! - see function header comments }
     Delay (MS*10);
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ _MemAvail                                                                }
{                                                                          }
{ This routine works like MemAvail and returns the sum of free memory      }
{ scattered over the heap, but it returns a postive number in case the     }
{ value turns negative because of a signed overflow.                       }
{                                                                          }
FUNCTION _MemAvail : LONGINT;

VAR L : LONGINT;

BEGIN
     L:=MemAvail;

     IF (L < 0) THEN
        L:=MAXLONGINT;

     _MemAvail:=L;
END;


{--------------------------------------------------------------------------}
{ _MaxAvail                                                                }
{                                                                          }
{ This routine works like MaxAvail and returns the size of the largest     }
{ block that can be allocated on the heap, but it returns a postive number }
{ in case the value turns negative because of a signed overflow.           }
{                                                                          }
FUNCTION _MaxAvail : LONGINT;

VAR L : LONGINT;

BEGIN
     L:=MaxAvail;

     IF (L < 0) THEN
        L:=MAXLONGINT;

     _MaxAvail:=L;
END;


{ end of file utility.inc }

