Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 184
  • Last Modified:

Remove word in string (500 points)

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
rincewind666
Asked:
rincewind666
  • 2
  • 2
  • 2
  • +3
1 Solution
 
D-MasterCommented:
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
 
bernaniCommented:

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
 
mikelittlewoodCommented:
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
Industry Leaders: 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!

 
mikelittlewoodCommented:
> 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
 
TNameCommented:
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
 
bernaniCommented:

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
 
tammozCommented:
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
 
tammozCommented:
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
 
rincewind666Author Commented:
Many thanks for your help to all of you - greatly appreciated.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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.

  • 2
  • 2
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now