DELPHI清除TXT文件内重复字符串

Question

比如一个TXT文本内容是
111 222 333
555 333 666
222 777 111
怎样实现清除重复之后变成
111 222 333
555 666 777
先要把每行的内容按空格分割成字符串,然后清除重复
然后再排列回来
还有就是我下次再把内容输入到这个文本里的时候
如果跟文本内的字符串有重复就提示字符串已经存在
因为之前有很多有重复内容的文本需要我整理 很麻烦
大家帮帮忙 我只有20分了

Answer 1

这样的程序用PERL、PHP等语言来写就易如反掌了，用PASCAL也不是太复杂，我下面给出用PASCAL写这样程序的数据结构和算法，你试试看可能能写出来。

类型要定义一个字符串链表
type
PStrList=^TStrList;
TStrList=record
s:string;
next:PStrList;
end;
全局变量要定义了字符串列表
var
StrList:PStrlist;
需要编写的函数有一个，判断指定字符串是否在列表中
function StrExists(str:string):boolean;
begin
用指针循环全局字符串链表StrList是是否存在字符串str，存在返回true，循环到结尾都没有发现则返回false
end;
需要编写一个过程，把指定字符串插入到链表里面
procedure StrAppend(str:string);
begin
把字符串插入到链表的最前面
end;
主程序的逻辑非常简单
var str,str1:string;
begin
初始化StrList:=nil;
打开文件
while not eof() do
begin
readln(str);
while(str长度大于0) do begin
str1:=str的第一个单词；
str:=str的剩余部分;
if not StrExists(str1) then
begin
write(str1);
StrAppend(Str1);
end;
end;
end;
关闭文件
end.

没想到这么简单，今天心情还好，完整程序如下：

{$apptype console}
program test;
//类型要定义一个字符串链表
type
PStrList=^TStrList;
TStrList=record
s:string;
next:PStrList;
end;
//全局变量要定义了字符串列表
var
StrList:PStrlist;
//判断指定字符串是否在列表中
function StrExists(str:string):boolean;
var p:PStrList;
begin
StrExists:=false;
p:=StrList;
while p<>nil do
begin
if p^.s=str then begin StrExists:=true; exit; end;
p:=p^.next;
end;
end;
//把指定字符串插入到链表里面
procedure StrAppend(str:string);
var p:PStrList;
begin
new(p);
p^.s:=str;
p^.next:=StrList;
StrList:=p;
end;
//主程序
var
i:integer;
str,str1:string;
begin
StrList:=nil;
while not eof do
begin
readln(str);
while (length(str)>0)and(str[1]=' ') do delete(str,1,1);//删除str前面的空格
while length(str)>0 do begin
i:=pos(' ',str);
if i>0 then begin str1:=copy(str,1,i-1); delete(str,1,i); end
else begin str1:=str; str:=''; end;
if not StrExists(str1) then
begin
write(str1,' ');
StrAppend(Str1);
end;
while (length(str)>0)and(str[1]=' ') do delete(str,1,1);//删除str前面的空格
end;
end;
end.

以上程序上机验证通过，没有问题，能干正确执行。但是是从键盘读入数据，如果你需要从文件读写，可以在运行的时候进行输入输出，或者修改程序增加文件变量、打开文件、从文件中读取、关闭文件。

Answer 2

//建立新的单元
//单元代码如下
unit Unit2;

interface

uses
Classes;

type

TMyText = class(TObject)
private
SL: TStringList;
procedure SetText(Value: string);
function GetText: string;
public
constructor Create;
destructor Destroy; override;
function Add(text: string): Boolean; //加入字符，成功返回真
property Text: String read GetText write SetText;
end;

implementation

procedure StringToList(SL: TStringList; S: string);

procedure _SortString(S1: string);
var
I: integer;
temp: string;
begin
repeat
I := pos(#$20, S1);
if I = 0 then i := length(S1) + 1;
temp := copy(S1, 1, I - 1);
S1 := copy(S1, I + 1, length(S1));
if (temp <> '') and (SL.IndexOf(temp) = -1) then
SL.Add(temp);
until (I = 0) or (S1 = '');
end;

var
I: Integer;
temp: string;
begin
repeat
I := pos(sLineBreak, S);
if I <> 0 then
temp := copy(S, 1, I - 1)
else
temp := S;
_SortString(temp);
S := copy(S, I + length(sLineBreak), length(S));
until I = 0;
SL.Sort;
end;

procedure TMyText.SetText(Value: string);
begin
SL.Clear;
StringToList(SL, Value);
end;

function TMyText.GetText: string;
var
I: Integer;
begin
SL.Sort;
for I := 0 to SL.Count - 1 do
begin
result := result + SL[i] + #$20;
if (I <> 0) and ((I + 1) mod 3 = 0) then
result := result + sLineBreak;
end;
end;

function TMyText.Add(text: string): Boolean;
begin
result := false;
if SL.IndexOf(text) = -1 then
begin
SL.Add(text);
result := True;
end;
end;

constructor TMyText.Create;
begin
inherited Create;
SL := TStringList.Create;
end;

destructor TMyText.Destroy;
begin
SL.Free;
inherited;
end;
end.

//------------------------------------------
在要引用TMyText的单元上的uses 中加 Unit2

如：
uses
unit2;

var
MyText: TMyText;
begin
MyText := TMyText.Create;
try
MyText.Text := Memo1.Text;
if not MyText.Add('111') then
MessageBox(Handle, '已存在，请重新输入！', '', 0);
Memo2.Text := MyText.Text; //得到过滤后的TEXT
finally
MyText.Free;
end;