Solved

Remove word in string (500 points)

Posted on 2006-11-28
9
180 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
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 500 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Comparing dates in Delphi. Greater than/ Less than 3 301
delphi parse string to params 3 158
Reconfigure Delphi Install? 2 66
Delphi Firemonkey send email on Android 1 47
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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

730 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