dxstring.pas

Well known and usefull component for delphi 7

   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
   end{asm}
{$ENDIF}
   end;

function isNumericString(const S:string):Boolean;
var
   Loop,MaxLoop:Integer;

begin
   Result:=True;
   MaxLoop:=Length(S);
   Loop:=0;
   while (Loop<MaxLoop) do begin
      Case S[Loop+1] of
         '0'..'9','.','-':Inc(Loop);
         Else Begin
            Result:=False;
            Exit;
         End;
      End;
   end;
{   Result:=True;
   MaxLoop:=Length(S);
   Loop:=0;
   while (Result) and (Loop<MaxLoop) do begin
      Result:=S[Loop+1] in ['0'..'9','.','-'];
      Inc(Loop);
   end;}
end;

function Min(const I1,I2:Integer):Integer;
begin
{$IFNDEF ASM8086}
   if I1<I2 then
      Result:=I1
   else
      Result:=I2;
{$ELSE}
   Result:=I1;
   asm
   mov ECX, I2    // Store I2 in ECX
   mov EDX, I1    // Store I1 in EDX
   cmp EDX, ECX   // compare I2 to I1
   jl @TheEnd     // if I2<I1 then Exit {result already set}
@ItIsLess:
   mov Result,ECX // result=I2/Exit
@TheEnd:
   end;{asm}
{$ENDIF}
end;

function Max(const I1,I2:Integer):Integer;

begin
{$IFNDEF ASM8086}
   if I1>I2 then
      Result:=I1
   else
      Result:=I2;
{$ELSE}
   Result:=I1;
   asm
   mov ECX, I2    // Store I2 in ECX
   mov EDX, I1    // Store I1 in EDX
   cmp EDX, ECX   // compare I2 to I1
   jg @TheEnd     // if I2>I1 then Exit {result already set}
@ItIsLess:
   mov Result,ECX // result=I2/Exit
@TheEnd:
   end;{asm}
{$ENDIF}
end;

function StringToInteger(const S:string):Integer;
var
   E:Integer;

begin
   Val(S,Result,E);
end;

function IntegerToString(const I:Integer):String;
begin
   Str(I,Result);
end;

procedure SwapMove(Source:Word;var Dest);
begin
   Source:=(HI(Source))+(LO(Source)*256);
   FastMove(Source,Dest,2);
end;

function IntToCommaStr(const Number:Integer):string;
var
   StrPos:Integer;

begin
   Result:=IntegerToString(Number);
   StrPos:=Length(Result)-2;
   while StrPos>1 do begin
      Insert(',',Result,StrPos);
      StrPos:=StrPos-3;
   end;
end;

function BinaryToString(const Number:Byte):string;
var
   Temp2:Byte;
   i:Word;

begin
   Result:='00000000';
   Temp2:=$80;
   for i:=1 to 8 do begin
      if (Number and Temp2)<>0 then Result[i]:='1';
      Temp2:=Temp2 shr 1;
   end;
end;

function StringToBinary(S:string):Byte;
var
   i:Word;
   Temp1:Byte;
   Temp2:Byte;

begin
   S:=Trim(S);
   while Length(S)<8 do
      S:='0'+S;
   Temp1:=0;
   Temp2:=$80;
   for i:=1 to 8 do begin
      if S[i]='1' then Inc(Temp1,Temp2);
      Temp2:=Temp2 shr 1;
   end;
   Result:=Temp1;
end;

///////////////////////////////////////////////////////////////////////////////
// String Routines
///////////////////////////////////////////////////////////////////////////////

function QuickPos(const aFindString,aSourceString:string):integer;
var
   SourceLen,aSourceLen,aFindLen,StartPos:integer;

begin
{$IFNDEF ASM8086}
   Result:=Pos(aFindString,aSourceString);
{$ELSE}
   Result:=0;
   aSourceLen:=Length(aSourceString);
   if aSourceLen=0 then Exit;
   aFindLen:=Length(aFindString);
   if (aFindLen=0)or(aFindlen>AsourceLen) then Exit;{GSW FIX!}
   StartPos:=1;
   SourceLen:=aSourceLen-aFindLen;
   SourceLen:=(SourceLen-StartPos)+2;

   asm
   push ESI
   push EDI
   push EBX
   mov EDI, aSourceString
   add EDI, StartPos
   dec EDI
   mov ESI, aFindString
   mov ECX, SourceLen
   mov Al, [ESI]
@ScaSB:
   mov Ah, [EDI]
   cmp Ah,Al
   jne @NextChar
@CompareStrings:
   mov EBX, aFindLen
   dec EBX
   jz @FullMatch
@CompareNext:
   mov Al, [ESI+EBX]
   mov Ah, [EDI+EBX]
   cmp Al, Ah
   jz @Matches
   mov Al, [ESI]
   jmp @NextChar
@Matches:
   dec EBX
   jnz @CompareNext
@FullMatch:
   mov EAX, EDI
   sub EAX, aSourceString
   inc EAX
   mov Result, EAX
   jmp @TheEnd
@NextChar:
   inc EDI
   dec ECX
   jnz @ScaSB
   mov Result,0
@TheEnd:
   pop EBX
   pop EDI
   pop ESI
   end;{asm}
{$ENDIF}
end;

function CharPos(const C:Char;const aSource:string):Integer;
var
   L:Integer;
begin
   L:=Length(aSource);
   Result:=0;
   if L=0 then exit;

   asm
  PUSH EDI                 //Preserve this register
  mov  EDI, aSource        //Point EDI at aSource
  mov  ECX, L              //Make a note of how many chars to search through
  mov  AL,  C              //and which char we want
@Loop:
  mov  AH, [EDI]
  inc  EDI
  xor  AH, AL
  jz   @Found
  dec  ECX
  jnz  @Loop
  jmp  @NotFound
@Found:
  sub  EDI, aSource        //EDI has been incremented, so EDI-OrigAdress = Char pos !
  mov  Result,   EDI
  jmp @TheEnd
@NotFound:
  mov  Result, 0 // fix (ozz)
@TheEnd:
  POP  EDI
   end;
end;

function Fetch(var S:string;const Sub:string;const IgnoreCase:Boolean):string;
var
   P:Integer;

begin
   if IgnoreCase then
      P:=QuickPos(Uppercase(Sub),Uppercase(S))
   else
      P:=QuickPos(Sub,S);
   if (P=0) then begin
      Result:=S;
      S:='';
   end
   else begin
      Result:=Copy(S,1,P-1);
      Delete(S,1,P+(Length(Sub)-1));
   end;
end;

function FetchByChar(var S:string;const Sub:Char;const IgnoreCase:Boolean):string;
var
   P:Integer;

begin
   if IgnoreCase then
      P:=CharPos(Upcase(Sub),Uppercase(S))
   else
      P:=CharPos(Sub,S);
   if (P=0) then begin
      Result:=S;
      S:='';
   end
   else begin
      Result:=Copy(S,1,P-1);
      Delete(S,1,P);
   end;
end;

function Uppercase(const S:string):string;
{$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=S;
   MaxLoop:=Length(Result);
   for Loop:=MaxLoop downto 1 do
      if Result[Loop]in ['a'..'z'] then Dec(Result[Loop],32);
end;
{$ELSE}
var
   LenOfString:Integer;
   FirstSource,FirstDest:Pointer;

   begin
      LenOfString:=Length(S);
      if LenOfString=0 then begin
         Result:='';
         Exit;
      end;
      SetLength(Result,LenOfString);
      FirstSource:=Pointer(s);
      FirstDest:=Pointer(Result);
      asm
   PUSH ESI            //Firstly and most importantly
   PUSH EDI            //Delphi uses EBX, ESI, EDI extensively, so we need to
                       //push them onto the stack, and then pop them off after
   mov ESI, FirstSource//Move the address of Result into ESI
   mov EDI, FirstDest  //ESI and EDI are 2 generic "data moving" registers
                       //ESI = Source, EDI = Destination
                       //MovSB (MoveString Byte, there is also, MovSW word and MovSD double)
                       //MovXX copy from EDI to ESI, and then INC *both* ESI and EDI
                       //  and also DEC ECX (generic string length counter)
                       //But I will not use these as I need to Uppercase the results
   mov ECX, LenOfString//ECX will contain a count of how many chars left to do
@NextChar:
   mov AL, [ESI]       //Move ESI^ into AL
                       //  AL = Char, AX = Word, EAX = DWord, all different parts
                       //  of the same register
   cmp AL, $61
   jl  @NoUpper        // < 'a' don't convert
   cmp AL, $7A
   jg  @NoUpper        // > 'z' don't convert
   and AL, $DF         // Convert to uppercase
@NoUpper:
   mov [EDI], AL       // Put AL back into EDI^  (That's what [] means)
   Inc ESI             //Point to next character
   Inc EDI
   Dec ECX             //Decrement the count, if it reaches 0, the ZERO flag will be set
   jnz @NextChar       //"J"ump if "n"ot "z"ero to the next character
   POP EDI
   POP ESI
      end;{asm}
   end;
{$ENDIF}

function Lowercase(const S:string):string;
{$IFNDEF ASM8086}
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:=S;
   MaxLoop:=Length(Result);
   for Loop:=MaxLoop downto 1 do
      if Result[Loop]in ['A'..'Z'] then Inc(Result[Loop],32);
end;
{$ELSE}
var
   LenOfString:Integer;
   FirstSource,FirstDest:Pointer;

   begin
      LenOfString:=Length(S);
      if LenOfString=0 then begin
         Result:='';
         Exit;
      end;
      SetLength(Result,LenOfString);
      FirstSource:=Pointer(S);
      FirstDest:=Pointer(Result);
      asm
   PUSH ESI            //Firstly and most importantly
   PUSH EDI            //Delphi uses EBX, ESI, EDI extensively, so we need to
                       //push them onto the stack, and then pop them off after
   mov ESI, FirstSource//Move the address of Result into ESI
   mov EDI, FirstDest  //ESI and EDI are 2 generic "data moving" registers
                       //ESI = Source, EDI = Destination
                       //MovSB (MoveString Byte, there is also, MovSW word and MovSD double)
                       //MovXX copy from EDI to ESI, and then INC *both* ESI and EDI
                       //  and also DEC ECX (generic string length counter)
                       //But I will not use these as I need to Uppercase the results
   mov ECX, LenOfString//ECX will contain a count of how many chars left to do
@NextChar:
   mov AL, [ESI]       //Move ESI^ into AL
                       //  AL = Char, AX = Word, EAX = DWord, all different parts
                       //  of the same register
   cmp AL, 'A'
   jl  @NoUpper        // < 'a' don't convert
   cmp AL, 'Z'
   jg  @NoUpper        // > 'z' don't convert
   xor AL, $20         // Convert to lowercase
@NoUpper:
   mov [EDI], AL       // Put AL back into EDI^  (That's what [] means)
   Inc ESI             //Point to next character
   Inc EDI
   Dec ECX             //Decrement the count, if it reaches 0, the ZERO flag will be set
   jnz @NextChar       //"J"ump if "n"ot "z"ero to the next character
   POP EDI
   POP ESI
      end;{asm}
   end;
{$ENDIF}

function ProperCase(const S:string):string;
var
   Len:Integer;
   MaxLen:Integer;

begin
   Len:=Length(S);
   MaxLen:=Len;
   SetLength(Result,Len);
   Result:=Lowercase(S);
   while Len>0 do begin
      if not(Result[Len]in ['a'..'z'])and(Len<MaxLen) then
         Result[Len+1]:=Upcase(Result[Len+1]);
      Dec(Len);
   end;
   if (MaxLen>0)and(Result[1]in ['a'..'z']) then
      Result[1]:=Upcase(Result[1]);
end;

function Trim(const S:string):string;
var
   I,L:Integer;
begin
   L:=Length(S);
   I:=1;
   while (I<=L)and(S[I]<=' ') do Inc(I);
   if I>L then Result:=''
   else begin
      while S[L]<=' ' do Dec(L);
      Result:=Copy(S,I,L-I+1);
   end;
end;

function NoCRLF(const S:string):string;
begin
   Result:=StringReplace(S,#13#10,'', [rfReplaceAll]);
end;

function NoAngleBrackets(const S:string):string;
var
   LenOfStr:Integer;

begin
   Result:=S;
   LenOfStr:=Length(Result);
   if LenOfStr>1 then
      if (Result[1]='<')and(Result[LenOfStr]='>') then
         Result:=Copy(Result,2,LenOfStr-2);
end;

// Known Commands should be a 0 based array!
// For testing Winshoes products against ours, this command is useless to our
// engine. We use a dynamic parser which provides a much more flexible
// development solution for you.

function InStrArray(const SearchStr:string;const KnownCommands:array of string):Integer;