?
Solved

Remove word in string (500 points)

Posted on 2006-11-28
9
Medium Priority
?
182 Views
Last Modified: 2010-04-05
If a known word appears twice in a string or link, I want it removed:

For example, if a link is:
http://www.domain.com/docs/docs/example.htm  (with the word "docs" mentioned twice)

I want it to become:
http://www.domain.com/docs/example.htm  (with the word "docs" mentioned just once and removing the extra / symbol).

Note that I know the word so no need to discover if ANY word appears twice (easy).  The word will always be "docs" or will have "docs" in it somewhere (docs, docs2, docs_one, etc).

I am using Delphi 6.  This is URGENT so I am awarding 500 points and my grateful thanks.
0
Comment
Question by:rincewind666
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +3
9 Comments
 
LVL 3

Expert Comment

by:D-Master
ID: 18031140
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses StrUtils;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  pos1,pos2: integer;
  s,word1: string;
begin
  word1 := 'docs/';
  s := edit1.text;
  pos1 := pos(word1,edit1.Text);
  pos2 := posex(word1,edit1.text,pos1+1);
  if pos2 > pos1 then
    delete(s,pos1,length(word1));
  label1.Caption := s;
end;

end.
0
 
LVL 9

Expert Comment

by:bernani
ID: 18031588

Hi,

Sth like this:

Function ReplaceSubStringInStringNoCase(OldSubString, NewSubString, InputString: String): String;

Var
  CharPos : Integer;
  LengthOldString     : Integer;
  UpperOldString     : String;
Begin
  Result := InputString;
  LengthOldString    := Length(OldSubString);
  UpperOldString    := UpperCase(OldSubString);
  While True Do
  Begin
    CharPos := Pos(UpperOldString,UpperCase(InputString));
    If Not (CharPos = 0) Then
    Begin
      Delete(InputString,CharPos,LengthOldString);
      Insert(NewSubString,InputString,CharPos);
    End
    Else
    Begin
      Break;
    End;
  End;
  Result := InputString;
End;

Call like this
ReplaceSubStringInStringNoCase('docs/docs/','docs/','http://www.domain.com/docs/docs/example.htm');

wich returns:

http://www.domain.com/docs/example.htm 



0
 
LVL 15

Expert Comment

by:mikelittlewood
ID: 18032481
Need a few more examples really.

Could you have
http://www.domain.com/docs/docs_one/example.htm 
http://www.domain.com/docs_one/docs/example.htm 
http://www.domain.com/docs_one/docs_one/example.htm 
http://www.domain.com/docs_next/docs_temp/example.htm 

etc etc

ie. if they are not the same, which do you remove.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 15

Expert Comment

by:mikelittlewood
ID: 18032498
> The word will always be "docs" or will have "docs" in it somewhere

Does this also mean you could have

http://www.domain.com/mydocs/thisdocs/example.htm 
0
 
LVL 28

Accepted Solution

by:
TName earned 2000 total points
ID: 18032613
Same questions as Mike...

That's why there are 2 versions. ;)
Version 1 will only remove all occurences of the *exact* same string except the first one
Version 2 will remove all occurences of strings that contain the mentioned string, also except the first one.


//To be called for example like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text:=RemoveDuplicate(Edit1.Text, 'docs','/');
end;


//Version 1:  (will only remove the second, third, etc... occurence of the exact string)

function RemoveDuplicate(text,str:String; del:Char):String;
var
i,c:Integer;
s:String;
begin
   result:='';
   i:=1; c:=0;
   while i<=Length(text) do begin
     s:='';
     while (text[i]<>del) do begin
       s:=s+text[i];
       i:=i+1;
     end;
     if (c=0) or (s<>str) then begin
       result:=result+s;
       if (s=str) then
          c:=c+1;
        if text[i]=del then
          result:=result+del;
     end;
     i:=i+1;
   end;
end;



//Version 2:   (if the string is "docs" it will also remove "somedocs", "mydocs", etc..)

function RemoveDuplicate(text,str:String; del:Char):String;
var
i,c:Integer;
s:String;
eos:Boolean;
begin
   result:='';
   i:=1; c:=0; eos:=False;
   while i<=Length(text) do begin
     s:='';
     while (text[i]<>del) and (not eos) do begin
       s:=s+text[i];
       i:=i+1;
       if i>Length(text) then
         eos:=True;
     end;
     if text[i]=del then
       s:=s+del;
     if (c=0) or (pos(str,s)=0) or eos  then begin
       result:=result+s;
       if (pos(str,s)>0) then
          c:=c+1;
     end;
     i:=i+1;
   end;
end;

0
 
LVL 9

Expert Comment

by:bernani
ID: 18033094

Hi,

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.clear;
Memo1.lines.add(ReplaceSubStringInStringNoCase('docs/docs/','docs/','http://www.domain.com/docs/docs/example.htm'));
Memo1.lines.add(ReplaceSubStringInStringNoCase('docs/docs_one/','docs/','http://www.domain.com/docs/docs_one/example.htm'));
Memo1.lines.add(ReplaceSubStringInStringNoCase('docs_one/docs/','docs/','http://www.domain.com/docs_one/docs/example.htm'));
Memo1.lines.add(ReplaceSubStringInStringNoCase('docs_one/docs_one/','docs/','http://www.domain.com/docs_one/docs_one/example.htm'));
Memo1.lines.add(ReplaceSubStringInStringNoCase('docs_next/docs_temp/','docs/','http://www.domain.com/docs_next/docs_temp/example.htm'));
end;

gives always the same result whatever you use.

0
 
LVL 1

Expert Comment

by:tammoz
ID: 18035828
hi
this function cuts S1 from S2 no matter how many times s1 is repeated in s2:

function StringCutter(S1, S2 :string) : string;
begin

  while Ansipos(S1, s2) > 0 do
  begin
    ShowMessage(S2 + #13 + S1 + #13 + IntToStr(Ansipos(S1, s2)));
    s2 := Copy(s2, 0,AnsiPos(s1, s2) - 1)
            + Copy(s2, AnsiPos(s1, s2) + Length(s1) + 1,Length(s2));
  end;
  Result := s2;
end;
0
 
LVL 1

Expert Comment

by:tammoz
ID: 18035868
if u want to keep one s1 just change this

function StringCutter(S1, S2 :string) : string;
var i : integer;
begin
    i := Ansipos(S1, s2);
  while Ansipos(S1, s2) > 0 do
  begin
    s2 := Copy(s2, 0,AnsiPos(s1, s2) - 1)
    + Copy(s2, AnsiPos(s1, s2) + Length(s1) + 1,Length(s2));
  end;

  S2 := Copy(s2, 0,i - 1) + S1 + Copy(s2, i -Length(s1) + 1,Length(s2));
  Result := s2;
end;
0
 

Author Comment

by:rincewind666
ID: 18062985
Many thanks for your help to all of you - greatly appreciated.
0

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question