{$O+,F+}
Unit StrMode;

INTERFACE
  USES xStrings, StrConst;

procedure ReplaceByte(var str; size:word; rb,br:Byte);
procedure ReplaceBytes(var str; size:word; rbs:string; br:Byte);
procedure ReplaceChar(str:string; ReplacingChar,CharToReplace:Char);
procedure ReplaceChars(var str:string; rbs:string; chr:Char);

procedure Reverse(var str; size:word);
function  ReverseStr(str:string):string;

procedure FillStr(beg:pointer; size:word; pattern:Byte);
procedure FillStrByPattern(Str:pointer; StrSize:word;
			   Pattern:pointer; PatternSize:word);

function Shorten(var s; len:word):word;
procedure ShortenStr(var s:string);

function RemoveSpace(var s; len:word):Word;
procedure RemoveSpaceStr(var s:string);

function RemoveAllSpace(var s; len:word):word;
procedure RemoveAllSpaceStr(var s:string);

function TruncateRight(const s:string; const chars:string):string;
function TruncateLeft(const s:string; const chars:string):string;
function LTrim(const s:string):string;
function RTrim(const s:string):string;


IMPLEMENTATION

{-----------------------------------------------------------------------------}
procedure ReplaceAny; near;
assembler;
{$IfDef Seg16}
{  AL:=byte to replace;
   ES:DI -> bytes to be replaced; BL:= number of bytes;
   DX:SI -> string; CX:= length;}
asm
  jcxz @End; or bl,bl; jz @End
  push ds; push bp
  mov ds,dx; mov dx,cx; mov bp,di; xor bh,bh; mov ah,al
  @Loop:
    lodsb
    mov cx,bx; mov di,bp
    repne scasb; jne @Cont
      mov [si-1],ah
    @Cont:
    dec dx
  jnz @loop
  pop bp; pop ds
  @End:
end;
{$Else IfDef Seg16}
{  AL:=byte to replace;
   EDI -> bytes to be replaced; BL:= number of bytes;
   ESI -> string; ECX:= length;}
asm
  jecxz @End; or bl,bl; jz @End
  push ebp
  mov edx,ecx; mov ebp,edi; xor bh,bh; mov ah,al
  @Loop:
    lodsb
    xor ecx,ecx; mov cx,bx; mov edi,ebp
    repne scasb; jne @Cont
      mov [esi-1],ah
    @Cont:
    dec edx
  jnz @loop
  pop ebp
  @End:
end;
{$EndIf Def Seg16}

procedure ReplaceByte(var str; size:word; rb,br:Byte);
assembler;
{$IfDef Seg16}
  asm
    les si,str; mov cx,size; mov dx,es
    push ss; pop es; lea di,rb; mov bl,1
    mov al,br
    cld
    call ReplaceAny
  end;
{$Else IfDef Seg16}
  var lRB:byte;
  asm
    push esi; push edi; push ebx
    mov lRB,rb
    mov esi,str; xor ecx,ecx; mov cx,size
    lea edi,lRB; mov bl,1
    mov al,br
    call ReplaceAny
    pop ebx; pop edi; pop esi
  end;
{$EndIf Def Seg16}

procedure ReplaceBytes(var str; size:word; rbs:string; br:Byte);
assembler;
{$IfDef Seg16}
  asm
    cld
    les di,str; mov cx,size; mov dx,es
    les si,rbs; SEGES lodsb; mov bl,al; xchg di,si
    mov al,br
    call ReplaceAny
  end;
{$Else IfDef Seg16}
  asm
    push esi; push edi; push ebx
    mov edi,str; xor ecx,ecx; mov cx,size
    mov esi,rbs; lodsb; mov bl,al; xchg edi,esi
    mov al,br
    call ReplaceAny
    pop ebx; pop edi; pop esi
  end;
{$EndIf Def Seg16}

procedure ReplaceChars(var str:string; rbs:string; chr:Char);
assembler;
{$IfDef Seg16}
  asm
    cld
    les si,str; SEGES lodsb; xor ah,ah; xchg ax,cx; mov dx,es; mov di,si
    les si,rbs; SEGES lodsb; mov bl,al; xchg di,si
    mov al,chr
    call ReplaceAny
  end;
{$Else IfDef Seg16}
  asm
    push esi; push edi; push ebx
    mov esi,str; lodsb; xor ecx,ecx; xchg al,cl; mov edi,esi
    mov esi,rbs; lodsb; mov bl,al; xchg edi,esi
    mov al,chr
    call ReplaceAny
    pop ebx; pop edi; pop esi
  end;
{$EndIf Def Seg16}

procedure ReplaceChar(str:string; ReplacingChar,CharToReplace:Char);
assembler;
{$IfDef Seg16}
  asm
    cld
    les si,str; SEGES lodsb; xor ah,ah; xchg ax,cx; mov dx,es
    push ss; pop es; lea di,ReplacingChar; mov bl,1
    mov al,CharToReplace
    call ReplaceAny
  end;
{$Else IfDef Seg16}
  var lReplacingChar:char;
  asm
    push esi; push edi; push ebx
    mov lReplacingChar,ReplacingChar
    mov esi,str; lodsb; xor ecx,ecx; xchg al,cl
    lea edi,lReplacingChar; mov bl,1
    mov al,CharToReplace
    call ReplaceAny
    pop ebx; pop edi; pop esi
  end;
{$EndIf Def Seg16}

{-----------------------------------------------------------------------------}
procedure Reverse(var str; size:word);
assembler;
{$IfDef Seg16}
  asm
    les di,str; mov si,di; mov cx,size; add di,cx
    shr cx,1; jcxz @End
    mov bx,-1; cld
    @loop:
       dec di
       mov al,es:[di]; SEGES movsb; mov es:[si][bx],al
       dec di
    loop @loop
    @End:
  end;
{$Else IfDef Seg16}
  asm
    push esi; push edi; push ebx
    mov edi,str; mov esi,edi; xor ecx,ecx; mov cx,size; add edi,ecx
    shr cx,1; jcxz @End
    mov ebx,-1; cld
    @loop:
       dec edi
       mov al,[edi]; movsb; mov [esi][ebx],al
       dec edi
    loop @loop
    @End:
    pop ebx; pop edi; pop esi
  end;
{$EndIf Def Seg16}

function ReverseStr(str:string):string;
assembler;
{$IfDef Seg16}
  asm
    les di,str
    push es; push di;
    push word ptr @Result+2; push word ptr @Result
    {$IFOPT P+}
      push word(str)[4]
    {$ENDIF}
    call MoveStr
    les si,@Result
    cld
    SEGES lodsb
    xor ah,ah;
    push es; push si
    push ax
    push cs
    call near ptr Reverse
  end;
{$Else IfDef Seg16}
  asm
    mov eax,str
    mov ecx,@Result
    push ecx
    call MoveStr
    pop ecx
    xor eax,eax
    lodsb
    xchg eax,ecx
    call Reverse
  end;
{$EndIf Def Seg16}

{-----------------------------------------------------------------------------}
procedure FillStr(beg:pointer; size:word; pattern:Byte);
assembler;
{$IfDef Seg16}
    asm
      les di,beg; mov cx,size; mov al,pattern
      cld; shr cx,1
      jnc @FillWords
        stosb
      @FillWords:
        mov ah,al
        rep stosw
    end;
{$Else IfDef Seg16}
    asm
    push esi; push edi; push ebx
      mov edi,beg
      mov al,pattern; mov ah,al;
      shl eax,16
      mov al,pattern; mov ah,al;
      xor ecx,ecx; mov cx,size;
      shr cx,1
      jnc @FillWords
        stosb
      @FillWords:
      shr cx,1
      jnc @FillDWords
        stosw
      @FillDWords:
        rep stosd
    pop ebx; pop edi; pop esi
    end;
{$EndIf Def Seg16}

procedure FillStrByPattern(Str:pointer; StrSize:word;
			   Pattern:pointer; PatternSize:word);
assembler;
{$IfDef Seg16}
    asm
      push ds
      les di,Str; mov ax,StrSize;
      lds bx,Pattern; mov dx,PatternSize;
      cld
      @Loop:
	sub ax,dx; jc @EndLoop
	call @SubMove
      jmp @Loop
	@SubMove:
	  mov si,bx;
	  mov cx,dx; shr cx,1
	  jnc @FillWords
	    movsb
	  @FillWords:
	    rep movsw
	retn
      @EndLoop:
      add ax,dx
      mov cx,ax; call @SubMove
      pop ds
    end;
{$Else IfDef Seg16}
    asm
    push esi; push edi; push ebx
      mov edi,Str; xor eax,eax; mov ax,StrSize;
      mov ebx,Pattern; xor edx,edx; mov dx,PatternSize;
      xor ecx,ecx
      @Loop:
	sub ax,dx; jc @EndLoop
	call @SubMove
      jmp @Loop
	@SubMove:
          mov esi,ebx;
          mov cx,dx;
          shr cx,1
	  jnc @FillWords
	    movsb
	  @FillWords:
          shr cx,1
          jnc @FillDWords
            movsw
          @FillDWords:
            rep movsd
	retn
      @EndLoop:
      add ax,dx
      mov cx,ax; call @SubMove
    pop ebx; pop edi; pop esi
    end;
{$EndIf Def Seg16}

{---------------------------------------------------------------------------}
{ проверка символа AL на принадлежность [' ',TAB,CR,LF] }

procedure IsWhitespace; near;
assembler;
{ Subroutine to report whether a given character is whitespace.

  Input:
        AL:=character to check

  Output:
        Z flag = 0 (NZ) if character is not whitespace
               = 1 (Z) if character is whitespace

  Registers destroyed: none
}
{$IfDef Seg16}
  asm
        cmp     al,' '                      { is it a space? }
        jz      @EndIsCharacterWhitespace   { if so, it's whitespace }
        cmp     al,Tab                      { is it a tab? }
        jz      @EndIsCharacterWhitespace   { if so, it's whitespace }
        cmp     al,CR                       { is it a carriage return? }
        jz      @EndIsCharacterWhitespace   { if so, it's whitespace }
        cmp     al,LF                       { is it a linefeed? If so, }
                                            {   it's whitespace, so return Z; }
                                            {   if not, it's not whitespace, }
                                            {    so return NZ as set by cmp }
        @EndIsCharacterWhitespace:
  end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}

function Shorten(var s; len:word):word;
assembler;
{$IfDef Seg16}
    asm
      mov cx,len
      jcxz @End
        les si,s
        add si,cx
        dec si
        inc cx
        std
        @loop:
          SEGES lodsb
          call IsWhitespace
        loope @loop
      @End:
        mov ax,cx
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}

procedure ShortenStr(var s:string); assembler;
{$IfDef Seg16}
    asm
      les si,s
      cld
      SEGES lodsb
      xor ah,ah
      push es; push si; push ax
      push cs
      call near ptr Shorten
      les di,s
      stosb
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}

{--------------------------------------------------------------------------}
function RemoveSpace(var s; len:word):word;
assembler;
{$IfDef Seg16}
    asm
      mov cx,len; mov ax,cx
      jcxz @End
        cld
        les si,s; mov bx,si; mov di,si
        @loop:
          SEGES lodsb
          call IsWhitespace
          jz @NotMove
            stosb
            dec cx; je @Exit
            SEGES lodsb; stosb
          @NotMove:
        loop @loop
          cmp bx,di; jae @Exit
          call IsWhitespace
          jnz @Exit
            dec di
        @Exit:
          mov ax,di; sub ax,bx
      @End:
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}

procedure RemoveSpaceStr(var s:string); assembler;
{$IfDef Seg16}
    asm
      les si,s
      cld
      SEGES lodsb
      xor ah,ah
      push es; push si; push ax
      push cs
      call near ptr RemoveSpace
      les di,s
      stosb
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}
{--------------------------------------------------------------------------}
function RemoveAllSpace(var s; len:word):word;
assembler;
{$IfDef Seg16}
    asm
      mov cx,len
      jcxz @End
        cld
        les si,s
        mov bx,cx
        mov di,si
        @loop:
          SEGES lodsb
          call IsWhitespace
          je @NotMove
            stosb
          @NotMove:
        loop @loop
        sub si,di; mov cx,bx
        sub cx,si
      @End:
      mov ax,cx
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}
{--------------------------------------------------------------------------}
procedure RemoveAllSpaceStr(var s:string); assembler;
{$IfDef Seg16}
    asm
      les si,s
      cld
      SEGES lodsb
      xor ah,ah
      push es; push si; push ax
      push cs
      call near ptr RemoveAllSpace
      les di,s
      stosb
    end;
{$Else IfDef Seg16}
    asm
    end;
{$EndIf Def Seg16}

function TruncateRight;
  var i:byte;
begin
  i:=Length(s);
  TruncateRight:='';
  while (i>=1) do begin
    if Pos(s[i],chars)>0 then begin
      Dec(i);
    end else begin
      TruncateRight:=Copy(s,1,i);
      EXIT;
    end;
  end;
end;

function TruncateLeft;
  var i,l:byte;
begin
  l:=Length(s);
  i:=1;
  TruncateLeft:='';
  while (i<=l) do begin
    if Pos(s[i],chars)>0 then begin
      Inc(i);
    end else begin
      TruncateLeft:=Copy(s,i,$FF);
      EXIT;
    end;
  end;
end;

function LTrim;
begin
  LTrim:=TruncateLeft(s,cSpaceChars);
end;

function RTrim;
begin
  RTrim:=TruncateRight(s,cSpaceChars);
end;

{--------------------------------------------------------------------------}
END.