UNIT STRPARSE;

{
        This is a Pascal Version of the 'C' Functions StrTok, Which is a
 String Parsing Routine. I wrote this routine because I'm basicly a 'C'
 programmer but had to write an application in Pascal. I'm uploading this
 routine to other because I think they'll find it useful.

  The Following is an excerpt from the Borland C++ 3.0 Library Reference
  discribing the syntax and use of this statment. The same apply's to this
  version. :


StrTok  [ this part (Name)  is modified for pasal use ]
_____________________________________________________________________________

       Function  Searches one string for tokens, which are separated by
       --------  Delimeter defined in a second string.

         Syntax  uses STRPARSE;    [ this part is modified for pasal use ]
         ------  Function StrTok(Phrase:Pchar;Delimeter:PChar):Pchar;

   Prototype in  STRPARSE.PAS [ this part is modified for pasal use ]
   ------------
        Remarks  StrTok considers the string Phrase to consist of a sequence
        -------  of zero or more text tokens,separated by spans of one or more
                 characters from the separator string Delimeter.

                 The first call to StrTok returns a Pointer (PChar type for
                  Pascal) to the first character of the first token in Phrase
                 and writes a null (nil for Pascal) character into Phrase
                 immediately following the returned token. Subsequent calls
                 with null (nil for Pacsal) for the first argument will
                 work through the string Phrase in this way, unitl no tokens
                 remain.

                 The separator string,Delimeter, can be different from call
                 to call.

   Return Value  StrTok returns a pointer (PChar) to the token found in Phrase
   ------------  A null (Nil fo Pascal) is returned when there are no more
                 tokens.

        Example
        -------

               Function GetPrinterDC:HDC;
                var
                 szPrinter : array [0..80] of Char;
                 szDevice,
                 szDriver,
                 szOutput  : PChar;

                begin

                 GetProfileString('windows','device',',,,',szPrinter,80);

                 szDevice := StrTok(szPrinter,',');
                 szDriver := StrTok(Nil      ,',');
                 szOutput := StrTok(Nil      ,',');


                 if ((szDevice<>Nil) and (szDriver<>Nil) and (szOutput<>Nil)) Then
                     GetPrinterDC := CreateDC (szDriver,szDevice,szOutput,nil)
                 else
                     GetPrinterDC := 0;

                end;


   That is the offical Borland Explanation of how te funtion works. I Hope
   that in my efforts I have faithfully reproduced it's functionality. I
   hope that some of you will find this function useful, and I now declare
   this function to be Public domain, use as you whish.

        I Would however apprieciate feed back on it,(you know bugs ECT.)
   at 76356,3601.

                 This function was written by:

                               John Cooper
                         Tower Software & Systems

                       and is donated to Public Domain.

  NOTE : This Function Physically alters your original string, so if you
  ----   Want or need to use your string somewhere else in your program
         send StrTok only a COPY of your original string.

                                                         Thanks.

}

interface

uses Strings;

Function StrTok(Phrase:Pchar;Delimeter:PChar):Pchar;

implementation

var
    TokenPointer,
    WorkPointer : PChar;

 { String Manipulation Routines }


Function StrTok(Phrase:Pchar;Delimeter:PChar):Pchar;
 var
  NullPointer : Pchar;
 begin

  if (Phrase<>Nil) then
   begin
    WorkPointer := Phrase;
   end
  else
   begin
    WorkPointer := TokenPointer;
   end;

  NullPointer := StrPos(WorkPointer,Delimeter);


  if (NullPointer<> Nil) then
   NullPointer^ := Chr(0);

  TokenPointer  := NullPointer + 1;


  StrTok := WorkPointer

 end;

end.