ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PNL003.ZIP/TOKEN.PAS

Pascal/Delphi Source File | 1990-05-30 | 13.8 KB | 173 lines

{************************************************************************
**
** Token.pas  Advanced string handling procedures.
**
** Written by G.Hoogterp
** All Copyrights reserved
** Version 1.0
**
** Use this unit as you like, you may modify it for personal use.
** you may NOT distribute a modified version though!
**
*************}
Unit Token;
Interface


{***********************************************************************
**
** Findtoken splits a tokenlist into a head and a tail.
**
**********}

Function FindToken(Var TokenList : String;Delimiters : String):String;

{***********************************************************************
**
** SimplifyDelimiter simplifies the delimiters in a tokenlist.
**
**********}

Procedure SimplifyDelimiters(Var TokenList : String;Delimiters : String);

{***********************************************************************
**
** SkipLeadingSpaces deletes the leading spaces of a tokenlist
**
**********}

Procedure SkipLeadingSpaces(Var TokenList : String);

{***********************************************************************
**
** DeletetrailingSpaces deletes the trailing spaces of a tokenlist
**
**********}

Procedure DeleteTrailingSpaces(Var TokenList : String);

{***********************************************************************
**
** UpStr converts a tokenlist to all uppercase
** DownStr converts a tokenlist to all lowercase
**
**********}

Procedure UpStr(Var TokenList : String);
Procedure DownStr(Var TokenList : String);

{***********************************************************************
**
** Delete noise deletes all charactes you don't want to find in a tokenlist.
**
**********}

Procedure DeleteNoise(Var TokenList : String;Noise : String);

{***********************************************************************
**
** Replace token can be used to change multiletter delimiters into
** single letter delimiters. (Or an other multiletter delimiter)
**
**********}

Procedure ReplaceToken(Var TokenList : String;Tok1,Tok2 : String);


Implementation

Function FindToken(Var TokenList : String;Delimiters : String):String;
Var HStr : String;
    Tel  : Byte;
Begin
HStr:='';
Tel:=1;
While (Tel<=Length(TokenList)) And
      (Pos(UpCase(TokenList[Tel]),Delimiters)=0) Do
 HStr:=HStr+TokenList[Tel];
 Inc(Tel);
 End;
FindToken:=HStr;
Delete(TokenList,1,Tel);
End;

Procedure SimplifyDelimiters(Var TokenList : String;Delimiters : String);
Var DelTel  : Byte;
Begin
DelTel:=1;
Repeat
If (Pos(TokenList[DelTel],Delimiters)>0) And
   (Pos(TokenList[DelTel+1],Delimiters)>0)
   Then Delete(TokenList,DelTel,1)
   Else Inc(DelTel);
Until DelTel>=(Length(TokenList)-1);
End;

Procedure SkipLeadingSpaces(Var TokenList : String);
Var Tel : Byte;
Begin
Tel:=1;
While (Tel<=Length(TokenList)) And (TokenList[Tel]=' ') Do
 Inc(Tel);
Delete(TokenList,1,Tel-1);
End;

Procedure DeleteTrailingSpaces(Var TokenList : String);
Var Tel : Byte;
Begin
Tel:=Length(TokenList);
While (Tel>0) And (TokenList[Tel]=' ') Do
 Dec(Tel);
TokenList[0]:=Chr(Tel);
End;

Procedure DeleteNoise(Var TokenList : String;Noise : String);
Var NoiseTel : Byte;
    PosNoise : Byte;
Begin
For NoiseTel:=1 To Length(Noise) Do
 Begin
 Repeat
  PosNoise:=Pos(Noise[NoiseTel],TokenList);
  If PosNoise>0
     Then Delete(TokenList,PosNoise,1);
 Until PosNoise=0;
 End;
End;

Procedure ReplaceToken(Var TokenList : String;Tok1,Tok2 : String);
Var Tok1Pos : Byte;
    HStr    : String;
Begin
HStr:=TokenList;
UpStr(HStr);
UpStr(Tok1);
Repeat
 Tok1Pos:=Pos(Tok1,HStr);
 If Tok1Pos>0
    Then Begin
         Delete(TokenList,Tok1Pos,Length(Tok1));
         Insert(Tok2,TokenList,Tok1Pos);
         HStr:=TokenList;
         UpStr(HStr);
         End;
Until Tok1Pos=0;
End;

Procedure UpStr(Var TokenList : String);
Var Tel : Byte;
Begin
For Tel:=1 to Length(TokenList) Do
 TokenList[Tel]:=UpCase(TokenList[Tel]);
End;

Procedure DownStr(Var TokenList : String);
Var Tel : Byte;
Begin
For Tel:=1 to Length(TokenList) Do
 If TokenList[Tel] in ['a'..'z']
    Then TokenList[Tel]:=Chr(Byte(TokenList[Tel])+32);
End;

End.