[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]

    {$S-,R-,V-,I-,B-,F+}

    {$IFNDEF Ver40}
      {$I OPLUS.INC}
    {$ENDIF}

    {*********************************************************}
    {*                  TPWRDSTR.PAS 1.0                     *}
    {*          Copyright (c) Ken Henderson 1990.            *}
    {*                                                       *}
    {*                                                       *}
    {*                 All rights reserved.                  *}
    {*********************************************************}

    unit TPWrdStr;
      {-Routines to support strings which use a word in the place of Turbo Pascal's
        byte for holding the length of a string -- theoretically allowing strings
        as large as 64k.}

    interface

    uses
      TpString;

    const
      MaxWrdStr = 1024;          {Maximum length of WrdStr - increase up to 65519}
      NotFound = 0;              {Returned by the Pos functions if substring not found}

    type
      WrdStr = array[-1..MaxWrdStr] of Char;
      WrdStrPtr = ^WrdStr;

    function WrdStr2Str(var A : WrdStr) : string;
      {-Convert WrdStr to Turbo string, truncating if longer than 255 chars}

    procedure Str2WrdStr(S : string; var A : WrdStr);
      {-Convert a Turbo string into an WrdStr}

    function LenWrdStr(A : WrdStr) : Word;
      {-Return the length of an WrdStr string}

    procedure CopyWrdStr(var A : WrdStr; Start, Len : Word; var O : WrdStr);
      {-Return a substring of a. Note start=1 for first char in a}

    procedure DeleteWrdStr(var A : WrdStr; Start, Len : Word);
      {-Delete len characters of a, starting at position start}

    procedure ConcatWrdStr(var A, B, C : WrdStr);
      {-Concatenate two WrdStr strings, returning a third}

    procedure ConcatStr(var A : WrdStr; S : string; var C : WrdStr);
      {-Concatenate a string to an WrdStr, returning a new WrdStr}

    procedure InsertWrdStr(var Obj, A : WrdStr; Start : Word);
      {-Insert WrdStr obj at position start of a}

    procedure InsertStr(Obj : string; var A : WrdStr; Start : Word);
      {-Insert string obj at position start of a}

    function PosStr(Obj : string; var A : WrdStr) : Word;
      {-Return the position of the string obj in a, returning NotFound if not found}

    function PosWrdStr(var Obja, A : WrdStr) : Word;
      {-Return the position of obja in a, returning NotFound if not found}

    function WrdStrToHeap(var A : WrdStr) : WrdStrPtr;
      {-Put WrdStr on heap, returning a pointer, nil if insufficient memory}

    procedure WrdStrFromHeap(P : WrdStrPtr; var A : WrdStr);
      {-Return an WrdStr from the heap, empty if pointer is nil}

    procedure DisposeWrdStr(P : WrdStrPtr);
      {-Dispose of heap space pointed to by P}

    function ReadLnWrdStr(var F : Text; var A : WrdStr) : Boolean;
      {-Read an WrdStr from text file, returning true if successful}

    function WriteWrdStr(var F : Text; var A : WrdStr) : Boolean;
      {-Write an WrdStr to text file, returning true if successful}

    procedure WrdStrUpcase(var A, B : WrdStr);
      {-Uppercase the WrdStr in a, returning b}

    procedure WrdStrLocase(var A, B : WrdStr);
      {-Lowercase the WrdStr in a, returning b}

    procedure WrdStrCharStr(Ch : Char; Len : Word; var A : WrdStr);
      {-Return an WrdStr of length len filled with ch}

    procedure WrdStrPadCh(var A : WrdStr; Ch : Char; Len : Word; var B : WrdStr);
      {-Right-pad the WrdStr in a to length len with ch, returning b}

    procedure WrdStrPad(var A : WrdStr; Len : Word; var B : WrdStr);
      {-Right-pad the WrdStr in a to length len with blanks, returning b}

    procedure WrdStrLeftPadCh(var A : WrdStr; Ch : Char; Len : Word; var B : WrdStr);
      {-Left-pad the WrdStr in a to length len with ch, returning b}

    procedure WrdStrLeftPad(var A : WrdStr; Len : Word; var B : WrdStr);
      {-Left-pad the WrdStr in a to length len with blanks, returning b}

    procedure WrdStrTrimLead(var A, B : WrdStr);
      {-Return an WrdStr with leading white space removed}

    procedure WrdStrTrimTrail(var A, B : WrdStr);
      {-Return an WrdStr with trailing white space removed}

    procedure WrdStrTrim(var A, B : WrdStr);
      {-Return an WrdStr with leading and trailing white space removed}

    procedure WrdStrCenterCh(var A : WrdStr; Ch : Char; Width : Word; var B : WrdStr);
      {-Return an WrdStr centered in an WrdStr of Ch with specified width}

    procedure WrdStrCenter(var A : WrdStr; Width : Word; var B : WrdStr);
      {-Return an WrdStr centered in an WrdStr of blanks with specified width}

    function CompWrdStr(var a1, a2 : WrdStr) : Boolean;
      {-Return equivalence of a1 and a2}

      {==========================================================================}

    implementation
    const
     Blank : char = #32;

      function WrdStr2Str(var A : WrdStr) : string;
        {-Convert WrdStr to Turbo string, truncating if longer than 255 chars}
      var
        S : string;
        Len : Word absolute A;
        Slen : byte Absolute S;
      begin
        if Len > 255 then SLen := 255
        else Slen := Len;
        Move(A[1], S[1], SLen);
        WrdStr2Str := S;
      end;

      procedure Str2WrdStr(S : string; var A : WrdStr);
        {-Convert a Turbo string into an WrdStr}
      var
        slen : byte absolute S;
        alen : word absolute A;
      begin
        Move(S[1], A[1], slen);
        alen := slen;
      end;

      function LenWrdStr(A : WrdStr) : Word;
        {-Return the length of an WrdStr string}
      var
        alen : Word absolute A;
      begin
        LenWrdStr := alen;
      end;

      procedure CopyWrdStr(var A : WrdStr; Start, Len : Word; var O : WrdStr);
        {-Return a substring of a. Note start=1 for first char in a}
      var
        alen : Word absolute A;
        olen : Word absolute O;
      begin
        if Start > alen then
          Olen := 0
        else begin
          {Don't copy more than exists}
          if Start+Len > alen then
            Len := Succ(alen-Start);
          Move(A[Start], O[1], Len);
          Olen := Len;
        end;
      end;

      procedure DeleteWrdStr(var A : WrdStr; Start, Len : Word);
        {-Delete len characters of a, starting at position start}
      var
        alen : Word Absolute A;
        mid : Word;
      begin
        if Start <= alen then begin
          {Don't do anything if start position exceeds length of string}
          mid := Start+Len;
          if mid <= alen then begin
            {Move right remainder of string left}
            Move(A[mid], A[Start], len);
            Dec(alen,len);
          end else
            {Entire end of string deleted}
            alen := Pred(Start);
        end;
      end;

      procedure ConcatWrdStr(var A, B, C : WrdStr);
        {-Concatenate two WrdStr strings, returning a third}
      var
        alen : Word absolute A;
        blen : Word absolute B;
        clen : Word absolute C;
        temp : Word;
      begin

        {Put a into the result}
        Move(A[1], C[1], alen);

        {Store as much of b as fits into result}
        Temp := blen;
        if alen+blen > MaxWrdStr then
          Temp := MaxWrdStr-alen;
        Move(B[1], C[Succ(alen)], Temp);

        {Terminate the result}
        clen := alen+blen;
      end;

      procedure ConcatStr(var A : WrdStr; S : string; var C : WrdStr);
        {-Concatenate a string to an WrdStr, returning a new WrdStr}
      var
        alen : Word absolute A;
        clen : Word absolute C;
        slen : Byte absolute S;
      begin

        {Put a into the result}
        Move(A[1], C[1], alen);

        {Store as much of s as fits into result}
        if alen+slen > MaxWrdStr then
          slen := MaxWrdStr-alen;
        Move(S[1], C[succ(alen)], slen);

        {Terminate the result}
        clen := alen+slen;
      end;

      procedure InsertWrdStr(var Obj, A : WrdStr; Start : Word);
        {-Insert WrdStr obj at position start of a}
      var
        alen : Word absolute A;
        olen : Word absolute Obj;
        mid, temp : Word;
      begin

        if Start > alen then
          {Concatenate if start exceeds alen}
          Start := Succ(alen)

        else begin
          {Move right side characters right to make space for insert}
          mid := Start+olen;
          if mid <= MaxWrdStr then
            {Room for at least some of the right side characters}
            if alen+olen <= MaxWrdStr then
              {Room for all of the right side}
              Move(A[Start], A[mid], Succ(alen-Start))
            else
              {Room for part of the right side}
              Move(A[Start], A[mid], Succ(MaxWrdStr-mid));
        end;

        {Insert the obj string}
        temp := Olen;
        if Start+olen > MaxWrdStr then
          temp := Succ(MaxWrdStr-Start);
        Move(Obj[1], A[Start], temp);

        {Terminate the string}
        if alen+olen <= MaxWrdStr then
          Inc(alen,olen)
        else
          alen := MaxWrdStr;
      end;

      procedure InsertStr(Obj : string; var A : WrdStr; Start : Word);
        {-Insert string obj at position start of a}
      var
        alen : Word absolute A;
        olen : byte absolute Obj;
        mid,temp : Word;
      begin

        if Start > alen then
          {Concatenate if start exceeds alen}
          Start := succ(alen)

        else begin
          {Move right side characters right to make space for insert}
          mid := Start+olen;
          if mid <= MaxWrdStr then
            {Room for at least some of the right side characters}
            if alen+olen <= MaxWrdStr then
              {Room for all of the right side}
              Move(A[Start], A[mid], Succ(alen-Start))
            else
              {Room for part of the right side}
              Move(A[Start], A[mid], Succ(MaxWrdStr-mid));
        end;

        {Insert the obj string}
        temp := olen;
        if Start+olen > MaxWrdStr then
          temp := Succ(MaxWrdStr-Start);
        Move(Obj[1], A[Start], temp);

        {Terminate the string}
        if alen+olen <= MaxWrdStr then
          Inc(alen,olen)
        else
          alen := MaxWrdStr;
      end;

      {$L TPWrdStr}
      function Search(var Buffer; BufLength : Word; var Match; MatLength : Word) : Word;
        external;
      procedure WrdStrUpcase(var A, B : WrdStr);
        {-Upper case WrdStr A, returning it in B}
      var
        alen : Word absolute A;
        x : Word;
      begin
        For x:=1 to alen do A[x]:=UpCase(A[x]);
        Move(A,B,alen+2);
      end;
      procedure WrdStrLocase(var A, B : WrdStr);
        {-Lower case WrdStr A, returning it in B}
      var
        alen : Word absolute A;
        x : Word;
      begin
        For x:=1 to alen do A[x]:=LoCase(A[x]);
        Move(A,B,alen+2);
      end;

      function CompWrdStr(var a1, a2 : WrdStr) : Boolean;
        {-Compare WrdStr's a1 and a2 and return equivalence}
      var
       alen1 : Word absolute A1;
       alen2 : Word absolute A2;
       x : Word;
      begin
        CompWrdStr := false;
        If (alen1=alen2) then  {possibly equal, let's check it out}
        begin
          for x:=1 to alen1 do if (A1[x]<>A2[x]) then exit;
          CompWrdStr := true;  {If we made it to here, they must be equal}
        end;
      end;

      function PosStr(Obj : string; var A : WrdStr) : Word;
        {-Return the position of the string obj in a, returning NotFound if not found}
      var
        alen : Word absolute A;
        olen : Byte absolute Obj;
        PosFound : Word;
      begin
        PosFound := Search(A[1], alen, Obj[1], olen);
        If (PosFound = $FFFF) then {Search didn't find it}
           PosFound := 0;
        PosStr := Succ(PosFound);
      end;

      function PosWrdStr(var Obja, A : WrdStr) : Word;
        {-Return the position of obja in a, returning NotFound if not found}
      var
        alen : Word absolute A;
        olen : Word absolute Obja;
        PosFound : Word;
      begin
        PosFound := Search(A[1], alen, Obja[1], olen);
        If (PosFound = $FFFF) then {Search didn't find it}
           PosFound := 0;
        PosWrdStr := Succ(PosFound);
      end;

      function WrdStrToHeap(var A : WrdStr) : WrdStrPtr;
        {-Put WrdStr on heap, returning a pointer, nil if insufficient memory}
      var
        alen : Word;
        P : WrdStrPtr;
      begin
        alen := LenWrdStr(A)+2;
        if MaxAvail >= alen then begin
          GetMem(P, alen);
          Move(A, P^, alen);
          WrdStrToHeap := P;
        end else
          WrdStrToHeap := nil;
      end;

      procedure WrdStrFromHeap(P : WrdStrPtr; var A : WrdStr);
        {-Return an WrdStr from the heap, empty if pointer is nil}
      var
        alen : Word absolute a;
        plen : Word absolute p;
      begin
        if P = nil then
          Alen := 0
        else
          Move(P^, A, Plen+2);
      end;

      procedure DisposeWrdStr(P : WrdStrPtr);
        {-Dispose of heap space pointed to by P}
      begin
        if P <> nil then
          FreeMem(P, LenWrdStr(P^)+2);
      end;

      procedure WrdStrCharStr(Ch : Char; Len : Word; var A : WrdStr);
        {-Return an WrdStr of length len filled with ch}
      var
        alen : Word absolute A;
      begin
        if Len = 0 then
          Alen := 0
        else begin
          if Len > MaxWrdStr then
            Len := MaxWrdStr;
          FillChar(A[1], Len, Ch);
          Alen := Len;
        end;
      end;

      procedure WrdStrPadCh(var A : WrdStr; Ch : Char; Len : Word; var B : WrdStr);
        {-Right-pad the WrdStr to length len with ch, returning b}
      var
        alen : Word Absolute A;
        blen : Word Absolute B;
      begin
        if alen >= Len then
          {Return the input string}
          Move(A, B, alen+2)
        else begin
          if Len > MaxWrdStr then
            Len := MaxWrdStr;
          Move(A[1], B[1], alen);
          FillChar(B[succ(alen)], Len-alen, Ch);
          Blen := len;
        end;
      end;

      procedure WrdStrPad(var A : WrdStr; Len : Word; var B : WrdStr);
        {-Right-pad the WrdStr to length len with blanks, returning b}
      begin
        WrdStrPadCh(A, Blank, Len, B);
      end;

      procedure WrdStrLeftPadCh(var A : WrdStr; Ch : Char; Len : Word; var B : WrdStr);
        {-Left-pad the WrdStr in a to length len with ch, returning b}
      var
        alen : Word absolute A;
        blen : Word absolute B;
      begin
        if alen >= Len then
          {Return the input string}
          Move(A, B, alen+2)
        else begin
          FillChar(B[1], Len-alen, Ch);
          Move(A[1], B[Succ(Len-alen)], alen);
          BLen := Len;
        end;
      end;

      procedure WrdStrLeftPad(var A : WrdStr; Len : Word; var B : WrdStr);
        {-Left-pad the WrdStr in a to length len with blanks, returning b}
      begin
        WrdStrLeftPadCh(A, Blank, Len, B);
      end;

      procedure WrdStrTrimLead(var A, B : WrdStr);
        {-Return an WrdStr with leading white space removed}
      var
        alen : Word absolute A;
        apos : Word;
      begin
        apos := 1;
        while (apos < alen) and (A[apos] <= Blank) do
          Inc(apos);
        Move(A[apos], B[1], Succ(alen-apos));
      end;

      procedure WrdStrTrimTrail(var A, B : WrdStr);
        {-Return an WrdStr with trailing white space removed}
      var
        alen : Word absolute A;
        blen : Word absolute B;
      begin
        while (alen > 1) and (A[Pred(alen)] <= Blank) do
          Dec(alen);
        Move(A, B, alen+2);
      end;

      procedure WrdStrTrim(var A, B : WrdStr);
        {-Return an WrdStr with leading and trailing white space removed}
      var
        blen : Word Absolute B;
      begin
        WrdStrTrimLead(A, B);
        while (blen > 1) and (B[Pred(blen)] <= Blank) do
          Dec(blen);
      end;

      procedure WrdStrCenterCh(var A : WrdStr; Ch : Char; Width : Word; var B : WrdStr);
        {-Return an WrdStr centered in an WrdStr of Ch with specified width}
      var
        alen : Word absolute A;
        blen : Word absolute B;
      begin
        if alen >= Width then
          {Return input}
          Move(A, B, alen+2)
        else begin
          FillChar(B[1], Width, Ch);
          Move(A[1], B[Succ((Width-alen) shr 1)], alen);
          Blen := Width;
        end;
      end;

      procedure WrdStrCenter(var A : WrdStr; Width : Word; var B : WrdStr);
        {-Return an WrdStr centered in an WrdStr of blanks with specified width}
      begin
        WrdStrCenterCh(A, Blank, Width, B);
      end;

    type
      {text buffer}
      TextBuffer = array[0..65520] of Byte;

      {structure of a Turbo File Interface Block}
      FIB = record
              Handle : Word;
              Mode : Word;
              BufSize : Word;
              Private : Word;
              BufPos : Word;
              BufEnd : Word;
              BufPtr : ^TextBuffer;
              OpenProc : Pointer;
              InOutProc : Pointer;
              FlushProc : Pointer;
              CloseProc : Pointer;
              UserData : array[1..16] of Byte;
              Name : array[0..79] of Char;
              Buffer : array[0..127] of Char;
            end;

    const
      FMClosed = $D7B0;
      FMInput = $D7B1;
      FMOutput = $D7B2;
      FMInOut = $D7B3;
      CR : Char = ^M;

      function ReadLnWrdStr(var F : Text; var A : WrdStr) : Boolean;
        {-Read an WrdStr from text file, returning true if successful}
      var
        CrPos : Word;
        alen : Word absolute A;
        blen : Word;

        function RefillBuf(var F : Text) : Boolean;
          {-Refill buffer}
        var
          Ch : Char;
        begin
          with FIB(F) do begin
            BufEnd := 0;
            BufPos := 0;
            Read(F, Ch);
            if IoResult <> 0 then begin
              {Couldn't read from file}
              RefillBuf := False;
              Exit;
            end;
            {Reset the buffer again}
            BufPos := 0;
            RefillBuf := True;
          end;
        end;

      begin
        with FIB(F) do begin

          {Initialize the WrdStr length and function result}
          alen := 0;
          ReadLnWrdStr := False;

          {Make sure file open for input}
          if Mode <> FMInput then
            Exit;

          {Make sure something is in buffer}
          if BufPos >= BufEnd then
            if not(RefillBuf(F)) then
              Exit;

          {Use the Turbo text file buffer to build the WrdStr}
          repeat

            {Search for the next carriage return in the file buffer}
            CrPos := Search(BufPtr^[BufPos], Succ(BufEnd-BufPos), CR, 1);

            if CrPos = $FFFF then begin
              {CR not found, save the portion of the buffer seen so far}
              blen := BufEnd-BufPos;
              if alen+blen > MaxWrdStr then
                blen := MaxWrdStr-alen;

              Move(BufPtr^[BufPos], A[alen], blen);
              Inc(alen, blen);

              {See if at end of file}
              if eof(F) then begin
                {Force exit with this line}
                CrPos := 0;
                {Remove trailing ^Z}
                while (alen > 1) and (A[Pred(alen)] = ^Z) do
                  Dec(alen);
              end else if not(RefillBuf(F)) then
                Exit;

            end else begin
              {Save up to the CR}
              blen := CrPos;
              if alen+blen > MaxWrdStr then
                blen := MaxWrdStr-alen;
              Move(BufPtr^[BufPos], A[alen], blen);
              Inc(alen, blen);

              {Inform Turbo we used the characters}
              Inc(BufPos, Succ(CrPos));

              {Skip over following ^J}
              if BufPos < BufEnd then begin
                {Next character is within current buffer}
                if BufPtr^[BufPos] = Ord(^J) then
                  Inc(BufPos);
              end else begin
                {Next character is not within current buffer}
                {Refill the buffer}
                if not(RefillBuf(F)) then
                  Exit;
                if BufPos < BufEnd then
                  if BufPtr^[BufPos] = Ord(^J) then
                    Inc(BufPos);
              end;

            end;

          until (CrPos <> $FFFF) or (alen > MaxWrdStr);

          {Return success and terminate the WrdStr}
          ReadLnWrdStr := True;

        end;
      end;

      function WriteWrdStr(var F : Text; var A : WrdStr) : Boolean;
        {-Write an WrdStr to text file, returning true if successful}
      var
        S : string;
        alen : Word absolute A;
        apos : Word;
        slen : Byte absolute S;
      begin
        apos := 1;
        WriteWrdStr := False;

        {Write the WrdStr as a series of strings}
        while apos < alen do begin
          slen := alen-apos;
          if slen > 255 then
            slen := 255;
          Move(A[apos], S[1], slen);
          Write(F, S);
          if IoResult <> 0 then
            Exit;
          Inc(apos, slen);
        end;

        WriteWrdStr := True;
      end;

    end.

    { -----------------    XX3402 Code for TPWRDSTR.OBJ ------------------}
    { Cut HERE and save save to a files (TPWRDSTR.XX).  From DOS execute:
    {               XX3402 D TPWRDSTR.XX to create TPWRDSTR.OBJ           }

    *XX3402-000257-280390--72--85-53814----TPWRDSTR.OBJ--1-OF--1
    U+s+13FEJp72IpFG9Y3HHQq66++++3FpQa7j623nQqJhMalZQW+UJaJmQqZjPW+l9X+lW6UI
    +21dk9Bw3+lII3RGF3BIIWt-IoqHW-E+ECaU83gG13FEEoxBHIxC9Y3HHLu6+k-+uImK+U++
    O7M4++F1HoF3FNU5+0V0++6-+TCA4E+8JJ-1EJB3I377HE+8H2x1EJB3I377HE-TY+o+++24
    IoJ-IYB6++++dcU2+20W+N4UFU+-++-JWykSzAFy1cjTWosAWpM4VR7o7AJq08l88wdq4z8i
    RFS3obEAIJRKWwfndZtTKLLgHsj58wDf+nD+G-y9tJr80U+VWU6++5E+
    ***** END OF BLOCK 1 *****

    { -----------------------   CUT HERE  -----------------------------------  }

    {  -------------     ASSEMBLER CODE FOR TPWRDSTR.ASM  -------------------  }
    {  USE TASM TO COMPILE }
    ;******************************************************
    ;                  TPWRDSTR.ASM 1.0
    ;             WrdStr string manipulation
    ;        Copyright (c) TurboPower Software 1987.
    ; Portions copyright (c) Sunny Hill Software 1985, 1986
    ;     and used under license to TurboPower Software
    ;                All rights reserved.
    ;******************************************************

            INCLUDE TPCOMMON.ASM

    ;****************************************************** Code

    CODE    SEGMENT BYTE PUBLIC

            ASSUME  CS:CODE

            PUBLIC  Search

            EXTRN   UpCasePrim : FAR
            EXTRN   LoCasePrim : FAR

    Upcase  MACRO                           ;UpCase character in AL
            PUSH   BX
            CALL   UpCasePrim
            POP    BX
            ENDM

    Locase  MACRO                           ;LoCase character in AL
            PUSH   BX
            CALL   LoCasePrim
            POP    BX
            ENDM

    ;****************************************************** Search

    ;  function Search(var Buffer; BufLength : Word;
    ;                  var Match;  MatLength : Word) : Word; external;
    ;Search through Buffer for Match.
    ;BufLength is length of range to search.
    ;MatLength is length of string to match
    ;Returns number of bytes searched to find St, FFFF if not found

    ;equates for parameters:
    MatLength       EQU     WORD PTR [BP+6]
    Match           EQU     DWORD PTR [BP+8]
    BufLength       EQU     WORD PTR  [BP+0Ch]
    Buffer          EQU     DWORD PTR [BP+0Eh]

    Search  PROC FAR

            StackFrameBP
            PUSH    DS                      ;Save DS
            CLD                             ;Go forward

            LES     DI,Buffer               ;ES:DI => Buffer
            MOV     BX,DI                   ;BX = Ofs(Buffer)

            MOV     CX,BufLength            ;CX = Length of range to scan
            MOV     DX,MatLength            ;DX = Length of match string

            TEST    DX,DX                   ;Length(Match) = 0?
            JZ      Error                   ;If so, we're done

            LDS     SI,Match                ;DS:SI => Match buffer
            LODSB                           ;AL = Match[1]; DS:SI => Match[2]
            DEC     DX                      ;DX = MatLength-1
            SUB     CX,DX                   ;CX = BufLength-(MatLength-1)
            JBE     Error                   ;Error if BufLength is less

    ;Search for first character in St
    Next:   REPNE   SCASB                   ;Search forward for Match[1]
            JNE     Error                   ;Done if not found
            TEST    DX,DX                   ;If Length = 1 (DX = 0) ...
            JZ      Found                   ; the "string" was found

            ;Search for remainder of St

            PUSH    CX                      ;Save CX
            PUSH    DI                      ;Save DI
            PUSH    SI                      ;Save SI

            MOV     CX,DX                   ;CX = Length(St) - 1
            REPE    CMPSB                   ;Does rest of string match?

            POP     SI                      ;Restore SI
            POP     DI                      ;Restore DI
            POP     CX                      ;Restore CX

            JNE     Next                    ;Try again if no match

    ;Calculate number of bytes searched and return in St
    Found:  DEC     DI                      ;DX = Offset where found
            MOV     AX,DI                   ;AX = Offset where found
            SUB     AX,BX                   ;Subtract starting offset
            JMP     Short Done              ;Done

    ;Match was not found
    Error:  XOR     AX,AX                   ;Return
            DEC     AX                      ;Return FFFF

    Done:   POP     DS                      ;Restore DS
            ExitCode 10

    Search  ENDP

    CODE    ENDS

            END
    { END OF TPWRDSTR.ASM }
    {-------------------------------   CUT HERE ------------------------- }

[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]