dos_compilers/Borland Turbo Pascal v7/SOURCE/STRINGS.PAS
2024-07-02 08:21:37 -07:00

563 lines
10 KiB
Plaintext

{*******************************************************}
{ }
{ Turbo Pascal Runtime Library }
{ String Handling Unit }
{ }
{ Copyright (C) 1990,92 Borland International }
{ }
{*******************************************************}
unit Strings;
{$S-}
interface
{ StrLen returns the number of characters in Str, not counting }
{ the null terminator. }
function StrLen(Str: PChar): Word;
{ StrEnd returns a pointer to the null character that }
{ terminates Str. }
function StrEnd(Str: PChar): PChar;
{ StrMove copies exactly Count characters from Source to Dest }
{ and returns Dest. Source and Dest may overlap. }
function StrMove(Dest, Source: PChar; Count: Word): PChar;
{ StrCopy copies Source to Dest and returns Dest. }
function StrCopy(Dest, Source: PChar): PChar;
{ StrECopy copies Source to Dest and returns StrEnd(Dest). }
function StrECopy(Dest, Source: PChar): PChar;
{ StrLCopy copies at most MaxLen characters from Source to Dest }
{ and returns Dest. }
function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar;
{ StrPCopy copies the Pascal style string Source into Dest and }
{ returns Dest. }
function StrPCopy(Dest: PChar; Source: String): PChar;
{ StrCat appends a copy of Source to the end of Dest and }
{ returns Dest. }
function StrCat(Dest, Source: PChar): PChar;
{ StrLCat appends at most MaxLen - StrLen(Dest) characters from }
{ Source to the end of Dest, and returns Dest. }
function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar;
{ StrComp compares Str1 to Str2. The return value is less than }
{ 0 if Str1 < Str2, 0 if Str1 = Str2, or greater than 0 if }
{ Str1 > Str2. }
function StrComp(Str1, Str2: PChar): Integer;
{ StrIComp compares Str1 to Str2, without case sensitivity. The }
{ return value is the same as StrComp. }
function StrIComp(Str1, Str2: PChar): Integer;
{ StrLComp compares Str1 to Str2, for a maximum length of }
{ MaxLen characters. The return value is the same as StrComp. }
function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer;
{ StrLIComp compares Str1 to Str2, for a maximum length of }
{ MaxLen characters, without case sensitivity. The return value }
{ is the same as StrComp. }
function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer;
{ StrScan returns a pointer to the first occurrence of Chr in }
{ Str. If Chr does not occur in Str, StrScan returns NIL. The }
{ null terminator is considered to be part of the string. }
function StrScan(Str: PChar; Chr: Char): PChar;
{ StrRScan returns a pointer to the last occurrence of Chr in }
{ Str. If Chr does not occur in Str, StrRScan returns NIL. The }
{ null terminator is considered to be part of the string. }
function StrRScan(Str: PChar; Chr: Char): PChar;
{ StrPos returns a pointer to the first occurrence of Str2 in }
{ Str1. If Str2 does not occur in Str1, StrPos returns NIL. }
function StrPos(Str1, Str2: PChar): PChar;
{ StrUpper converts Str to upper case and returns Str. }
function StrUpper(Str: PChar): PChar;
{ StrLower converts Str to lower case and returns Str. }
function StrLower(Str: PChar): PChar;
{ StrPas converts Str to a Pascal style string. }
function StrPas(Str: PChar): String;
{ StrNew allocates a copy of Str on the heap. If Str is NIL or }
{ points to an empty string, StrNew returns NIL and doesn't }
{ allocate any heap space. Otherwise, StrNew makes a duplicate }
{ of Str, obtaining space with a call to the GetMem standard }
{ procedure, and returns a pointer to the duplicated string. }
{ The allocated space is StrLen(Str) + 1 bytes long. }
function StrNew(Str: PChar): PChar;
{ StrDispose disposes a string that was previously allocated }
{ with StrNew. If Str is NIL, StrDispose does nothing. }
procedure StrDispose(Str: PChar);
implementation
{$W-}
function StrLen(Str: PChar): Word; assembler;
asm
CLD
LES DI,Str
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
MOV AX,0FFFEH
SUB AX,CX
end;
function StrEnd(Str: PChar): PChar; assembler;
asm
CLD
LES DI,Str
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
MOV AX,DI
MOV DX,ES
DEC AX
end;
function StrMove(Dest, Source: PChar; Count: Word): PChar; assembler;
asm
PUSH DS
CLD
LDS SI,Source
LES DI,Dest
MOV AX,DI
MOV DX,ES
MOV CX,Count
CMP SI,DI
JAE @@1
STD
ADD SI,CX
ADD DI,CX
DEC SI
DEC DI
@@1: REP MOVSB
CLD
POP DS
end;
function StrCopy(Dest, Source: PChar): PChar; assembler;
asm
PUSH DS
CLD
LES DI,Source
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
NOT CX
LDS SI,Source
LES DI,Dest
MOV AX,DI
MOV DX,ES
REP MOVSB
POP DS
end;
function StrECopy(Dest, Source: PChar): PChar; assembler;
asm
PUSH DS
CLD
LES DI,Source
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
NOT CX
LDS SI,Source
LES DI,Dest
REP MOVSB
MOV AX,DI
MOV DX,ES
DEC AX
POP DS
end;
function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar; assembler;
asm
PUSH DS
CLD
LES DI,Source
MOV CX,MaxLen
MOV BX,CX
XOR AL,AL
REPNE SCASB
SUB BX,CX
MOV CX,BX
LDS SI,Source
LES DI,Dest
MOV BX,DI
MOV DX,ES
REP MOVSB
STOSB
XCHG AX,BX
POP DS
end;
function StrPCopy(Dest: PChar; Source: String): PChar; assembler;
asm
PUSH DS
CLD
LDS SI,Source
LES DI,Dest
MOV BX,DI
MOV DX,ES
LODSB
XOR AH,AH
XCHG AX,CX
REP MOVSB
XOR AL,AL
STOSB
XCHG AX,BX
POP DS
end;
function StrCat(Dest, Source: PChar): PChar; assembler;
asm
PUSH Dest.Word[2]
PUSH Dest.Word[0]
PUSH CS
CALL NEAR PTR StrEnd
PUSH DX
PUSH AX
PUSH Source.Word[2]
PUSH Source.Word[0]
PUSH CS
CALL NEAR PTR StrCopy
MOV AX,Dest.Word[0]
MOV DX,Dest.Word[2]
end;
function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar; assembler;
asm
PUSH Dest.Word[2]
PUSH Dest.Word[0]
PUSH CS
CALL NEAR PTR StrEnd
MOV CX,Dest.Word[0]
ADD CX,MaxLen
SUB CX,AX
JBE @@1
PUSH DX
PUSH AX
PUSH Source.Word[2]
PUSH Source.Word[0]
PUSH CX
PUSH CS
CALL NEAR PTR StrLCopy
@@1: MOV AX,Dest.Word[0]
MOV DX,Dest.Word[2]
end;
function StrComp(Str1, Str2: PChar): Integer; assembler;
asm
PUSH DS
CLD
LES DI,Str2
MOV SI,DI
MOV CX,0FFFFH
XOR AX,AX
CWD
REPNE SCASB
NOT CX
MOV DI,SI
LDS SI,Str1
REPE CMPSB
MOV AL,DS:[SI-1]
MOV DL,ES:[DI-1]
SUB AX,DX
POP DS
end;
function StrIComp(Str1, Str2: PChar): Integer; assembler;
asm
PUSH DS
CLD
LES DI,Str2
MOV SI,DI
MOV CX,0FFFFH
XOR AX,AX
CWD
REPNE SCASB
NOT CX
MOV DI,SI
LDS SI,Str1
@@1: REPE CMPSB
JE @@4
MOV AL,DS:[SI-1]
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: MOV DL,ES:[DI-1]
CMP DL,'a'
JB @@3
CMP DL,'z'
JA @@3
SUB DL,20H
@@3: SUB AX,DX
JE @@1
@@4: POP DS
end;
function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler;
asm
PUSH DS
CLD
LES DI,Str2
MOV SI,DI
MOV AX,MaxLen
MOV CX,AX
JCXZ @@1
XCHG AX,BX
XOR AX,AX
CWD
REPNE SCASB
SUB BX,CX
MOV CX,BX
MOV DI,SI
LDS SI,Str1
REPE CMPSB
MOV AL,DS:[SI-1]
MOV DL,ES:[DI-1]
SUB AX,DX
@@1: POP DS
end;
function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler;
asm
PUSH DS
CLD
LES DI,Str2
MOV SI,DI
MOV AX,MaxLen
MOV CX,AX
JCXZ @@4
XCHG AX,BX
XOR AX,AX
CWD
REPNE SCASB
SUB BX,CX
MOV CX,BX
MOV DI,SI
LDS SI,Str1
@@1: REPE CMPSB
JE @@4
MOV AL,DS:[SI-1]
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: MOV DL,ES:[DI-1]
CMP DL,'a'
JB @@3
CMP DL,'z'
JA @@3
SUB DL,20H
@@3: SUB AX,DX
JE @@1
@@4: POP DS
end;
function StrScan(Str: PChar; Chr: Char): PChar; assembler;
asm
CLD
LES DI,Str
MOV SI,DI
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
NOT CX
MOV DI,SI
MOV AL,Chr
REPNE SCASB
MOV AX,0
CWD
JNE @@1
MOV AX,DI
MOV DX,ES
DEC AX
@@1:
end;
function StrRScan(Str: PChar; Chr: Char): PChar; assembler;
asm
CLD
LES DI,Str
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
NOT CX
STD
DEC DI
MOV AL,Chr
REPNE SCASB
MOV AX,0
CWD
JNE @@1
MOV AX,DI
MOV DX,ES
INC AX
@@1: CLD
end;
function StrPos(Str1, Str2: PChar): PChar; assembler;
asm
PUSH DS
CLD
XOR AL,AL
LES DI,Str2
MOV CX,0FFFFH
REPNE SCASB
NOT CX
DEC CX
JE @@2
MOV DX,CX
MOV BX,ES
MOV DS,BX
LES DI,Str1
MOV BX,DI
MOV CX,0FFFFH
REPNE SCASB
NOT CX
SUB CX,DX
JBE @@2
MOV DI,BX
@@1: MOV SI,Str2.Word[0]
LODSB
REPNE SCASB
JNE @@2
MOV AX,CX
MOV BX,DI
MOV CX,DX
DEC CX
REPE CMPSB
MOV CX,AX
MOV DI,BX
JNE @@1
MOV AX,DI
MOV DX,ES
DEC AX
JMP @@3
@@2: XOR AX,AX
MOV DX,AX
@@3: POP DS
end;
function StrUpper(Str: PChar): PChar; assembler;
asm
PUSH DS
CLD
LDS SI,Str
MOV BX,SI
MOV DX,DS
@@1: LODSB
OR AL,AL
JE @@2
CMP AL,'a'
JB @@1
CMP AL,'z'
JA @@1
SUB AL,20H
MOV [SI-1],AL
JMP @@1
@@2: XCHG AX,BX
POP DS
end;
function StrLower(Str: PChar): PChar; assembler;
asm
PUSH DS
CLD
LDS SI,Str
MOV BX,SI
MOV DX,DS
@@1: LODSB
OR AL,AL
JE @@2
CMP AL,'A'
JB @@1
CMP AL,'Z'
JA @@1
ADD AL,20H
MOV [SI-1],AL
JMP @@1
@@2: XCHG AX,BX
POP DS
end;
function StrPas(Str: PChar): String; assembler;
asm
PUSH DS
CLD
LES DI,Str
MOV CX,0FFFFH
XOR AL,AL
REPNE SCASB
NOT CX
DEC CX
LDS SI,Str
LES DI,@Result
MOV AL,CL
STOSB
REP MOVSB
POP DS
end;
{$W+}
function StrNew(Str: PChar): PChar;
var
L: Word;
P: PChar;
begin
StrNew := nil;
if (Str <> nil) and (Str^ <> #0) then
begin
L := StrLen(Str) + 1;
GetMem(P, L);
if P <> nil then StrNew := StrMove(P, Str, L);
end;
end;
procedure StrDispose(Str: PChar);
begin
if Str <> nil then FreeMem(Str, StrLen(Str) + 1);
end;
end.