Solved

Remove word in string (500 points)

Posted on 2006-11-28
9
177 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
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 
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

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
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…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…

776 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