DELPHI清除TXT文件内重复字符串
比如一个TXT文本内容是111222333555333666222777111怎样实现清除重复之后变成111222333555666777先要把每行的内容按空格分割成字符...
比如一个TXT文本内容是
111 222 333
555 333 666
222 777 111
怎样实现清除重复之后变成
111 222 333
555 666 777
先要把每行的内容按空格分割成字符串,然后清除重复
然后再排列回来
还有就是我下次再把内容输入到这个文本里的时候
如果跟文本内的字符串有重复就提示字符串已经存在
因为之前有很多有重复内容的文本需要我整理 很麻烦
大家帮帮忙 我只有20分了 展开
111 222 333
555 333 666
222 777 111
怎样实现清除重复之后变成
111 222 333
555 666 777
先要把每行的内容按空格分割成字符串,然后清除重复
然后再排列回来
还有就是我下次再把内容输入到这个文本里的时候
如果跟文本内的字符串有重复就提示字符串已经存在
因为之前有很多有重复内容的文本需要我整理 很麻烦
大家帮帮忙 我只有20分了 展开
2个回答
展开全部
这样的程序用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.
以上程序上机验证通过,没有问题,能干正确执行。但是是从键盘读入数据,如果你需要从文件读写,可以在运行的时候进行输入输出,或者修改程序增加文件变量、打开文件、从文件中读取、关闭文件。
类型要定义一个字符串链表
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.
以上程序上机验证通过,没有问题,能干正确执行。但是是从键盘读入数据,如果你需要从文件读写,可以在运行的时候进行输入输出,或者修改程序增加文件变量、打开文件、从文件中读取、关闭文件。
展开全部
//建立新的单元
//单元代码如下
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;
//单元代码如下
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;
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询