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
Solved

Remove word in string (500 points)

Posted on 2006-11-28
9
179 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
  • 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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

809 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