⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 strings.htm

📁 对于学习很有帮助
💻 HTM
📖 第 1 页 / 共 2 页
字号:
<!-- This document was created with HomeSite v2.5 -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">

<HTML>
<HEAD>
	<TITLE>UDDF - Strings</TITLE>
	<META NAME="Description" CONTENT="String routines section of the Delphi Developers FAQ">
	<META NAME="Keywords" CONTENT="delphi,strings ">
</HEAD>

<BODY  bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" color="#00FF00">



<CENTER><FONT SIZE="7" FACE="Arial Black" COLOR="RED">Strings</FONT></CENTER>


<P><H1><A NAME="strings0">Equivalent of Trim$(),Mid$(), etc?</P></A></H1>
<H2> Solution 1</H2>
<P><I>From: bobs@dragons.nest.nl (Bob Swart)</I></P>

<HR><PRE> unit TrimStr;
 {$B-}
 {
      File: TrimStr
    Author: Bob Swart [100434,2072]
   Purpose: routines for removing leading/trailing spaces from strings,
            and to take parts of left/right of string (a la Basic).
   Version: 2.0

   LTrim()    - Remove all spaces from the left side of a string
   RTrim()    - Remove all spaces from the right side of a string
   Trim()     - Remove all extraneous spaces from a string
   RightStr() - Take a certain portion of the right side of a string
   LeftStr()  - Take a certain portion of the left side of a string
   MidStr()   - Take the middle portion of a string

 }
 interface
 Const
   Space = #$20;

   function LTrim(Const Str: String): String;
   function RTrim(Str: String): String;
   function Trim(Str: String):  String;
   function RightStr(Const Str: String; Size: Word): String;
   function LeftStr(Const Str: String; Size: Word): String;
   function MidStr(Const Str: String; Size: Word): String;

 implementation

   function LTrim(Const Str: String): String;
   var len: Byte absolute Str;
       i: Integer;
   begin
     i := 1;
     while (i &lt;= len) and (Str[i] = Space) do Inc(i);
     LTrim := Copy(Str,i,len)
   end {LTrim};

   function RTrim(Str: String): String;
   var len: Byte absolute Str;
   begin
     while (Str[len] = Space) do Dec(len);
     RTrim := Str
   end {RTrim};

   function Trim(Str: String): String;
   begin
     Trim := LTrim(RTrim(Str))
   end {Trim};

   function RightStr(Const Str: String; Size: Word): String;
   var len: Byte absolute Str;
   begin
     if Size &gt; len then Size := len;
     RightStr := Copy(Str,len-Size+1,Size)
   end {RightStr};

   function LeftStr(Const Str: String; Size: Word): String;
   begin
     LeftStr := Copy(Str,1,Size)
   end {LeftStr};

   function MidStr(Const Str: String; Size: Word): String;
   var len: Byte absolute Str;
   begin
     if Size &gt; len then Size := len;
     MidStr := Copy(Str,((len - Size) div 2)+1,Size)
   end {MidStr};
 end.
</PRE><HR>

<H2> Solution 2 </H2>
<P><I>From: jbui@scd.hp.com (Joseph Bui)</I></P>

For Mid$, use Copy(S: string; start, length: byte): string; <br>
You can make copy perform Right$ and Left$ as well by doing:<br>
Copy(S, 1, Length) for left$ and <br>
Copy(S, Start, 255) for right$<br>
Note: Start and Length are the byte positions of your starting
point, get these with Pos().<p>

Here are some functions I wrote that come in handy for me.
Way down at the bottom is a trim() function that you can
modify into TrimRight$ and TrimLeft$. Also, they all take
pascal style strings, but you can modify them to easily
null terminated.<p>

<HR><PRE>
const
   BlackSpace = [#33..#126];

{
   squish() returns a string with all whitespace not inside single
quotes deleted.
}
function squish(const Search: string): string;
var
   Index: byte;
   InString: boolean;
begin
   InString:=False;
   Result:='';
   for Index:=1 to Length(Search) do
   begin
      if InString or (Search[Index] in BlackSpace) then
         AppendStr(Result, Search[Index]);
      InString:=((Search[Index] = '''') and (Search[Index - 1] &lt;&gt; '\'))
            xor InString;
   end;
end;

{
   before() returns everything before the first occurance of
Find in Search. If Find does not occur in Search, Search is
returned.
}
function before(const Search, Find: string): string;
var
   index: byte;
begin
   index:=Pos(Find, Search);
   if index = 0 then
      Result:=Search
   else
      Result:=Copy(Search, 1, index - 1);
end;

{
   after() returns everything after the first occurance of
Find in Search. If Find does not occur in Search, a null
string is returned.
}
function after(const Search, Find: string): string;
var
   index: byte;
begin
   index:=Pos(Find, Search);
   if index = 0 then
      Result:=''
   else
      Result:=Copy(Search, index + Length(Find), 255);
end;

{
   RPos() returns the index of the first character of the last
occurance of Find in Search. Returns 0 if Find does not occur
in Search. Like Pos() but searches in reverse.
}
function RPos(const Find, Search: string): byte;
var
   FindPtr, SearchPtr, TempPtr: PChar;
begin
   FindPtr:=StrAlloc(Length(Find)+1);
   SearchPtr:=StrAlloc(Length(Search)+1);
   StrPCopy(FindPtr,Find);
   StrPCopy(SearchPtr,Search);
   Result:=0;
   repeat
      TempPtr:=StrRScan(SearchPtr, FindPtr^);
      if TempPtr &lt;&gt; nil then
         if (StrLComp(TempPtr, FindPtr, Length(Find)) = 0) then
         begin
            Result:=TempPtr - SearchPtr + 1;
            TempPtr:=nil;
         end
         else
            TempPtr:=#0;
   until TempPtr = nil;
end;

{
   inside() returns the string between the most inside nested
Front ... Back pair.
}
function inside(const Search, Front, Back: string): string;
var
   Index, Len: byte;
begin
   Index:=RPos(Front, before(Search, Back));
   Len:=Pos(Back, Search);
   if (Index &gt; 0) and (Len &gt; 0) then
      Result:=Copy(Search, Index + 1, Len - (Index + 1))
   else
      Result:='';
end;

{
   leftside() returns what is to the left of inside() or Search.
}
function leftside(const Search, Front, Back: string): string;
begin
   Result:=before(Search, Front + inside(Search, Front, Back) + Back);
end;

{
   rightside() returns what is to the right of inside() or Null.
}
function rightside(const Search, Front, Back: string): string;
begin
   Result:=after(Search, Front + inside(Search, Front, Back) + Back);
end;

{
   trim() returns a string with all right and left whitespace removed.
}
function trim(const Search: string): string;
var
   Index: byte;
begin
   Index:=1;
   while (Index &lt;= Length(Search)) and not (Search[Index] in BlackSpace) do
      Index:=Index + 1;
   Result:=Copy(Search, Index, 255);
   Index:=Length(Result);
   while (Index &gt; 0) and not (Result[Index] in BlackSpace) do
      Index:=Index - 1;
   Result:=Copy(Result, 1, Index);
end;
</PRE><HR>

<P><H1><A NAME="strings1">String Pattern matching</P></A></H1>
<P><I>From: stidolph@magnet.com (David Stidolph)</I></P>

There are many times when you need to compare two strings, but want to use
wild cards in the match - all last names that begin with 'St', etc.  The
following is a piece of code I got from Sean Stanley in Tallahassee Florida
in C.  I translated it into Delphi an am uploading it here for all to use.
I have not tested it extensivly, but the original function has been tested
quite thoughly.<p>

I would love feedback on this routine - or peoples changes to it.  I want to
forward them to Sean to get him to release more tidbits like this.<P>

<HR><PRE>{
  This function takes two strings and compares them.  The first string
  can be anything, but should not contain pattern characters (* or ?).
  The pattern string can have as many of these pattern characters as you want.
  For example: MatchStrings('David Stidolph','*St*') would return True.

  Orignal code by Sean Stanley in C
  Rewritten in Delphi by David Stidolph
}
function MatchStrings(source, pattern: String): Boolean;
var
  pSource: Array [0..255] of Char;
  pPattern: Array [0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;

    function IsPatternWild(pattern: PChar): Boolean;
    var
      t: Integer;
    begin
      Result := StrScan(pattern,'*') &lt;&gt; nil;
      if not Result then Result := StrScan(pattern,'?') &lt;&gt; nil;
    end;

  begin
    if 0 = StrComp(pattern,'*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ &lt;&gt; Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else begin
      case pattern^ of
      '*': if MatchPattern(element,@pattern[1]) then
             Result := True
           else
             Result := MatchPattern(@element[1],pattern);
      '?': Result := MatchPattern(@element[1],@pattern[1]);
      else
        if element^ = pattern^ then
          Result := MatchPattern(@element[1],@pattern[1])
        else
          Result := False;
      end;
    end;
  end;

begin
  StrPCopy(pSource,source);
  StrPCopy(pPattern,pattern);
  Result := MatchPattern(pSource,pPattern);
end;
</PRE><HR>

<P><H1><A NAME="strings2">GetToken</P></A></H1>
<P><I>Thomas Scheffczyk &lt;SCHEFFCZYK@islay.verwaltung.uni-mainz.de&gt;</I></P>

I don't know if this will help you, but the following (simple) functions 
helped me handling substrings. Perhaps you can use them to seperate 
the text for each field (for i := 1 to NumToken do ...) and store it 
seperatly in the database-fields. <P>


<HR><PRE>
function GetToken(aString, SepChar: String; TokenNum: Byte):String;
{
parameters: aString : the complete string
            SepChar : a single character used as separator 
                      between the substrings
            TokenNum: the number of the substring you want
result    : the substring or an empty string if the are less then
            'TokenNum' substrings
}
var
   Token     : String;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -