home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
sp15demo.zip
/
libsrc.zip
/
LIBSRC
/
STRINGS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-25
|
14KB
|
686 lines
{**************************************************************************
* General Unit for Speed-Pascal/2 *
* *
* *
* Copyright (C) 1995..96 SpeedSoft *
* Partial Copyright (C) 1995 Uwe Chalas (Thanks a lot !) *
* *
* All REP MOVSB changed to 32 Bit *
* *
**************************************************************************}
UNIT Strings;
INTERFACE
USES Os2Def;
FUNCTION StrNew(Str: PChar): PChar;
PROCEDURE StrDispose(Str: PChar);
FUNCTION StrEnd(Str:PChar):PChar;
FUNCTION StrMove(Dest, Source: PChar; Count: ULONG): PChar;
FUNCTION StrCat(Dest,Source:PChar):PChar;
FUNCTION StrCopy(Dest,Source:PChar):PChar;
FUNCTION StrECopy(Dest,Source:PChar):PChar;
FUNCTION StrLCopy(Dest,Source:PChar;Len:LONGINT):PChar;
FUNCTION StrLen(pszStr:PChar):ULONG;
FUNCTION StrPos(MainStr,SubStr:PChar):Pchar;
FUNCTION StrPosN(MainStr,SubStr:PChar):LONGINT;
FUNCTION StrScan(Str:PChar; Chr : Char):PChar;
FUNCTION StrScanN(Str:PChar; Chr : Char):LONGINT;
FUNCTION StrRScan(Str:PChar; Chr : Char):PChar;
FUNCTION StrRScanN(Str:PChar; Chr : Char):LONGINT;
FUNCTION StrUpper(Str:PChar):PChar;
FUNCTION StrLower(Str:PChar):PChar;
FUNCTION StrPCopy(Dest: PChar;CONST Source: String): PChar;
FUNCTION StrPas(Str:PChar):String;
FUNCTION StrComp(Str1,Str2:PChar):Integer;
FUNCTION StriComp(Str1,Str2:PChar):Integer;
FUNCTION StrLComp(Str1, Str2: PChar; MaxLen: LongWord): Integer;
FUNCTION StrLIComp(Str1,Str2:PChar;MaxLen:LONGWORD):Integer;
IMPLEMENTATION
IMPORTS
FUNCTION WinUpper(ahab:HAB;idcp,idcc:LONGWORD;apsz:PSZ):LONGWORD;
APIENTRY; PMWIN index 893;
FUNCTION WinCompareStrings(ahab:HAB;idcp,idcc:LONGWORD;psz1,psz2:PSZ;
reserved:LONGWORD):LONGWORD;
APIENTRY; PMWIN index 708;
END;
CONST
WCS_ERROR =0;
WCS_EQ =1;
WCS_LT =2;
WCS_GT =3;
ASSEMBLER
!StrEnd PROC NEAR32
//get pointer to end of string into EAX
//changes EAX,EBX,ECX und EDI
MOV EBX,ESP
MOV EDI,[EBX+4]
XOR EAX,EAX
CMP EDI,0
JE !Out!StrEnd //String is NIL
MOV ECX,$0FFFFFFFF
CLD
REPNE
SCASB
DEC EDI
MOV EAX,EDI
!Out!StrEnd:
RETN32 4
!StrEnd ENDP
!StrLen PROC NEAR32
//get length of string
//changes EAX,EBX,ECX und EDI
MOV EBX,ESP
MOV EDI,[EBX+4]
XOR EAX,EAX
CMP EDI,0
JE !Out!StrLen //String is NIL
MOV ECX,$0FFFFFFFF
CLD
REPNE
SCASB
NOT ECX
DEC ECX
MOV EAX,ECX
!Out!StrLen:
RETN32 4
!StrLen ENDP
END; {Assembler}
{Allocate copy of Str}
FUNCTION StrNew(Str: PChar): PChar;
VAR
L: LONGWORD;
result:PChar;
BEGIN
result := NIL;
L := StrLen(Str);
IF L > 0 THEN
BEGIN
Inc(L);
GetMem(Result, L);
StrMove(Result,Str,L);
END;
StrNew:=Result;
END;
{Dispose Str}
PROCEDURE StrDispose(Str: PChar);
BEGIN
IF Str <> NIL THEN FreeMem(Str, StrLen(Str) + 1);
END;
{Get Pointer to End of String}
FUNCTION StrEnd(Str:PChar):PChar;
BEGIN
ASM
PUSHL $Str
CALLN32 !StrEnd
MOV $!funcresult,EAX
END;
END;
{Copy one string into another}
FUNCTION StrMove(Dest, Source: PChar; Count: ULONG): PChar;
VAR result:PChar;
LABEL l;
BEGIN
result:=NIL;
IF Source=NIL THEN goto l;
IF Dest=NIL THEN goto l;
IF Count=0 THEN goto l;
Move(Source^,Dest^,Count);
result:=Dest;
l:
StrMove := result;
END;
{Concat two strings}
FUNCTION StrCat(Dest,Source:PChar):PChar;
BEGIN
ASM
MOV ESI,$Source //Source to ESI
XOR EAX,EAX //EAX := 0
CMP ESI,0 //If Source = NIL..,
JE !OUTStrCat //... get out here !
PUSHL $Dest //Dest auf den Stack
CALLN32 !StrEnd //StrEnd-Proc aufrufen
CMP EAX,0 //StrEnd returns 0 ?
JE !OutStrCat //if yes get out
PUSH EDI //StrEnd (Dest)
XOR EAX,EAX
MOV EDI,$Source
MOV ECX,$0FFFFFFFF
CLD
REPNE
SCASB
NOT ECX
POP EDI //StrEnd (Dest)
MOV ESI,$Source
MOV EDX,ECX
SHR ECX,2
REP
MOVSD
MOV ECX,EDX
AND ECX,3
REP
MOVSB
MOV EAX,$Dest
!OutStrCat:
MOV $!funcresult,EAX
END;
END;
{Copy String into another}
FUNCTION StrCopy(Dest,Source:PChar):PChar;
BEGIN
ASM
MOV EDI,$Source
MOV ESI,$Dest
XOR EAX,EAX
CMP EDI,0
JE !OUTStrCopy
CMP ESI,0
JE !OUTStrCopy
MOV ECX,$0FFFFFFFF
CLD
REPNE
SCASB
NOT ECX
MOV ESI,$Source
MOV EDI,$Dest
MOV EDX,ECX
SHR ECX,2
REP
MOVSD
MOV ECX,EDX
AND ECX,3
REP
MOVSB
MOV EAX,$Dest
!OUTStrCopy:
MOV $!funcresult,EAX
END;
END;
FUNCTION StrECopy(Dest,Source:PChar):PChar;
BEGIN
result:=StrCopy(Dest,Source);
result:=StrEnd(result);
END;
FUNCTION StrLCopy(Dest,Source:PChar;Len:LONGINT):PChar;
BEGIN
ASM
MOV EDI,$Source
MOV ESI,$Dest
XOR EAX,EAX
CMP EDI,0
JE !OUTStrCopy_xx
CMP ESI,0
JE !OUTStrCopy_xx
MOV ECX,$0FFFFFFFF
CLD
REPNE
SCASB
NOT ECX
CMP ECX,$Len
JBE !strxxxx2
MOV ECX,$Len
!strxxxx2:
MOV ESI,$Source
MOV EDI,$Dest
MOV EDX,ECX
SHR ECX,2
REP
MOVSD
MOV ECX,EDX
AND ECX,3
REP
MOVSB
MOV EAX,$Dest
!OUTStrCopy_xx:
MOV $!funcresult,EAX
END;
END;
{Get length of string}
FUNCTION StrLen(pszStr:PChar):ULONG;
BEGIN
ASM
PUSHL $pszStr
CALLN32 !StrLen
MOV $!funcresult,EAX
END;
END;
{Get pos-pointer to substring from string}
FUNCTION StrPos(MainStr,SubStr:PChar):PChar;
BEGIN
ASM
PUSHL $SubStr //SubStr
CALLN32 !StrLen
CMP EAX,0
JE !ErrOutStrPos
MOV EDX,EAX //Länge von SubStr in EDX
PUSHL $MainStr
CALLN32 !StrLen
CMP EAX,0
JE !ErrOutStrPos
SUB EAX,EDX
JB !ErrOutStrPos
MOV EDI,$MainStr
!1:
MOV ESI,$SubStr
LODSB
REPNE
SCASB
JNE !ErrOutStrPos;
MOV EAX,ECX
PUSH EDI
MOV ECX,EDX //Länge SubStr nach ECX
DEC ECX
REPE
CMPSB
MOV ECX,EAX
POP EDI
JNE !1
MOV EAX,EDI
DEC EAX
JMP !out
!ErrOutStrPos:
XOR EAX,EAX
!Out:
MOV $!funcresult,EAX
END;
END;
{returns -1 if subStr is not inside of MainStr, otherwise position }
FUNCTION StrPosN(MainStr,SubStr:PChar):LONGINT;
BEGIN
ASM
PUSHL $SubStr
CALLN32 !StrLen
CMP EAX,0
JE !ErrOutPos
MOV EDX,EAX //Länge von SubStr in EDX
PUSHL $MainStr
CALLN32 !StrLen
CMP EAX,0
JE !ErrOutPos
SUB EAX,EDX
JB !ErrOutPos
MOV EDI,$MainStr
!1_1:
MOV ESI,$SubStr
LODSB
REPNE
SCASB
JNE !ErrOutPos
MOV EAX,ECX
PUSH EDI
MOV ECX,EDX //Länge SubStr nach ECX
DEC ECX
REPE
CMPSB
MOV ECX,EAX
POP EDI
JNE !1_1
SUB EDI,$MainStr
MOV EAX,EDI
DEC EAX
JMP !out_1
!ErrOutPos:
MOV EAX,$0FFFFFFFF
!Out_1:
MOV $!funcresult,EAX
END;
END;
{Scan for char inside of string and return pointer to it}
FUNCTION StrScan(Str:PChar; Chr : Char):PChar;
BEGIN
ASM
PUSHL $Str
CALLN32 !StrLen
CMP EAX,0
JE !OutStrScan
MOV AL,$Chr
MOV EDI,$Str
CLD
REPNE
SCASB
MOV EAX,0
CWD
JNE !OutStrScan
MOV EAX,EDI
DEC EAX
!OutStrScan:
MOV $!funcresult,EAX
END;
END;
{returns -1 IF Chr is not inside of Str, Otherwise position}
FUNCTION StrScanN(Str:PChar; Chr : Char):LONGINT;
BEGIN
ASM
PUSHL $Str
CALLN32 !StrLen
CMP EAX,0
JE !ErrStrScanN
MOV AL,$Chr
MOV EDI,$Str
CLD
REPNE
SCASB
CWD
JNE !ErrStrScanN
SUB EDI,$Str
MOV EAX,EDI
DEC EAX
JMP !OutStrScanN
!ErrStrScanN:
MOV EAX,$0FFFFFFFF
!OutStrScann:
MOV $!funcresult,EAX
END;
END;
{Get pointer to last appearance of character}
FUNCTION StrRScan(Str:PChar; Chr : Char):PChar;
BEGIN
ASM
PUSHL $Str
CALLN32 !StrLen
CMP EAX,0
JE !OutStrRScan
MOV AL,$Chr
DEC EDI //returned from !StrLen
MOV ECX,EAX
STD
REPNE
SCASB
MOV EAX,0
CWD
JNE !OutStrRScan
MOV EAX,EDI
INC EAX
!OutStrRScan:
CLD
MOV $!funcresult,EAX
END;
END;
{returns -1 if chr is not inside of Str, otherwise pos of last appearance}
FUNCTION StrRScanN(Str:PChar; Chr : Char):LONGINT;
BEGIN
ASM
PUSHL $Str
CALLN32 !StrLen
CMP EAX,0
JE !ErrStrRScanN
MOV AL,$Chr
DEC EDI
MOV ECX,EAX
STD
REPNE
SCASB
CWD
JNE !ErrStrRScanN
SUB EDI,$Str
MOV EAX,EDI
INC EAX
JMP !OutStrRScanN
!ErrStrRScanN:
MOV EAX,$0FFFFFFFF
!OutStrRScanN:
CLD
MOV $!funcresult,EAX
END;
END;
{Convert string to upper}
FUNCTION StrUpper(Str:PChar):PChar;
BEGIN
WinUpper(0,0,0,Str^);
StrUpper := Str;
END;
{Convert string to lower}
FUNCTION StrLower(Str:PChar):PChar;
BEGIN
ASM
CLD
MOV ESI,$Str
!SL1:
LODSB
OR AL,AL
JE !OutStrLower
CMP AL,'Ä'
JNE !SLUE
MOV AL,'ä'
JMP !SetChar
!SLUE:
CMP AL,'Ü'
JNE !SLOE
MOV AL,'ü'
JMP !SetChar
!SLOE:
CMP AL,'Ö'
JNE !SL2
MOV AL,'ö'
JMP !SetChar
!SL2:
CMP AL, 'A'
JB !SL1
CMP AL,'Z'
JA !SL1
ADD AL,$20
!SetChar:
MOV [ESI-1],AL
JMP !SL1
!OutStrLower:
MOV EAX,$Str
MOV $!funcresult,EAX
END;
END;
{Convert Pascal String to pointer}
FUNCTION StrPCopy(Dest: PChar;CONST Source: String): PChar;
BEGIN
ASM
MOV ESI,$Source
MOV EDI,$Dest
MOV CL,[ESI+0]
INC ESI
MOVZX ECX,CL
CLD
MOV EDX,ECX
SHR ECX,2
REP
MOVSD
MOV ECX,EDX
AND ECX,3
REP
MOVSB
!OutStrPCopy:
MOVB [EDI+0],0 //terminate with zero
MOV EAX,$Dest
MOV $!funcresult,EAX
END;
END;
{Convert PChar to Pascal String}
FUNCTION StrPas(Str:PChar):String;
BEGIN
ASM
PUSHL $Str //Get Str
CALLN32 !StrLen
POP EBX
CMP EAX,0
JE !ErrStrPas
MOV EDI,$!funcresult //DestString
MOV ESI,$Str //SourceStr
MOVZX ECX,AL
STOSB
MOV EDX,ECX
SHR ECX,2
REP
MOVSD
MOV ECX,EDX
AND ECX,3
REP
MOVSB
JMP !OutStrPas
!ErrStrPas:
MOV EDI,$!funcresult //get result string
MOVB [EDI+0],0 //terminate with zero
!OutStrPas:
END;
END;
{Compare strings without upper and lower case}
FUNCTION StrIComp(Str1,Str2:PChar):Integer;
VAR Res : LONGWORD;
BEGIN
Res := WinCompareStrings(0,0,0,Str1^,Str2^,0);
case Res of
WCS_EQ : StrIComp := 0;
WCS_LT : StrIComp := -1;
WCS_GT : StrIComp := 1;
WCS_ERROR : StrIComp := $FF;
end;
END;
FUNCTION StrLIComp(Str1,Str2:PChar;MaxLen:LONGWORD):Integer;
VAR Res : LONGWORD;
c1,c2:Char;
BEGIN
IF StrLen(Str1) > MaxLen then
BEGIN
c1 := PString(Str1)^[MaxLen];
PString(Str1)^[MaxLen] := #0;
END
ELSE c1 := #0;
IF StrLen(Str2) > MaxLen then
BEGIN
c2 := PString(Str2)^[MaxLen];
PString(Str2)^[MaxLen] := #0;
END
ELSE c2 := #0;
Res := WinCompareStrings(0,0,0,Str1^,Str2^,0);
CASE Res OF
WCS_EQ : StrLIComp := 0;
WCS_LT : StrLIComp := -1;
WCS_GT : StrLIComp := 1;
WCS_ERROR : StrLIComp := $FF;
END;
IF c1 <> #0 THEN PString(Str1)^[MaxLen] := c1;
IF c2 <> #0 THEN PString(Str2)^[MaxLen] := c2;
END;
{Compare strings}
FUNCTION StrComp(Str1,Str2:PChar):Integer;
BEGIN
ASM
CLD
MOV EDI,$Str2
MOV ECX,$0FFFFFFFF
XOR EAX,EAX
CWD
REPNE
SCASB
NOT ECX
MOV ESI,$Str1
MOV EDI,$Str2
XOR EAX,EAX
CMP ESI,0
JE !OutStrComp
CMP EDI,0
JE !OutStrComp
REPE
CMPSB
XOR AX,AX
XOR DX,DX
MOV AL,[ESI-1]
MOV DL,[EDI-1]
SUB AX,DX
!OutStrComp:
MOV $!funcresult,EAX
END;
END;
FUNCTION StrLComp(Str1, Str2: PChar; MaxLen: LongWord): Integer;
BEGIN
ASM
CLD
MOV EDI,$Str2
MOV EAX,$MaxLen
CMP EAX,0
JE !ErrStrLComp
MOV ECX,EAX
PUSH EBX
XCHG EAX,EBX
XOR EAX,EAX
CWD
REPNE
SCASB
SUB EBX,ECX
MOV ECX,EBX
POP EBX
MOV EDI,$Str2
MOV ESI,$Str1
REPE
CMPSB
XOR AX,AX
XOR DX,DX
MOV AL,[ESI-1]
MOV DL,[EDI-1]
SUB AX,DX
JMP !OutStrLComp
!ErrStrLComp:
MOV EAX,42
!OutStrLComp:
MOV $!funcresult,EAX
END;
END;
END.