How to extract a string from the middle of a sentence (Views: 28)
Problem/Question/Abstract: I need to extract a string from the middle of a sentence. For example: An email will come in with the following subject: Order from the Web : a.dyble@ntlworld.com. My method is to start at the @ sign and work outwards using copy. Answer: Solve 1: This may not be the most efficient, but function MyWord(const Token: Char; const S: string): string; var B, M, E: Integer; K: string; begin Result := ''; M := Pos(Token, S); if M > 0 then begin K := ' ' + S + ' '; {wrap in spaces cause I'm lazy} B := M + 1; repeat Dec(B); until K[B] in [' ', #9, #10]; E := M; repeat Inc(E); until K[E] in [' ', #9, #13]; Result := Copy(S, B, E - B - 1); end; end; Example of using: procedure TForm1.Button1Click(Sender: TObject); begin Caption := MyWord('@', Memo1.Text); end; Solve 2: {Parse item} procedure ParseItem(var Source, Item: string; Delimiter: Char); var CurrentPosition: Integer; begin CurrentPosition := Pos(Delimiter, Source); if CurrentPosition = 0 then begin {No delimeter - item is the remaining string} Item := Source; Source := ''; end else begin {There is a delimeter} Item := Copy(Source, 1, CurrentPosition - 1); Delete(Source, 1, CurrentPosition); end; end; function GetEmailAddress(ASource: string): string; var AWord: string; begin Result := ''; while ASource <> '' do begin ParseItem(ASource, AWord, ' '); if Pos('@', AWord) <> 0 then begin Result := AWord; Break; end; end; end; procedure TForm1.Button30Click(Sender: TObject); begin ShowMessage(GetEmailAddress('Order from theWeb : a.dyble@ntlworld.com')); end; Solve 3: Can we assume that you always have the colon / blank sequence? If so then this may be easier: P := Pos(':', Subject) + 2; {Position following the colon / blank} {Grab everything after} EMailAddress := Copy(Subject, P, Length(Subject) - P - 1); Solve 4: If you can't count on the ' :' as Kurt suggests, perhaps the following will do: function ExtractEMailAddress(const s: string): string; const goodEMailChars = ['A'..'Z', 'a'..'z', '@', '.', '_', '-']; var i, j, lth: integer; begin i := pos('@', s); if i > 0 then begin j := i + 1; while (i > 0) and (s[i] in goodEMailChars) do dec(i); inc(i); lth := Length(s); while (j <= lth) and (s[j] in goodEMailChars) do inc(j); result := Copy(s, i, j - i); end else result := ''; end; Solve 5: You can use Pos to locate the substrings and Copy to copy the text to a new string. Something like: function FindSubString(const S, Prefix, Suffix: string): string; var P: Integer; begin Result := EmptyStr; P := Pos(Prefix, S); if P > 0 then begin Result := Copy(S, P + Length(Prefix), Length(S)); P := Pos(Suffix, Result); if P > 0 then SetLength(Result, P - 1) else Result := EmptyStr; end; end; The code isn't very efficient, but it should get you started. |