多线程问题，为什么我这个用多线程与没用效果一样呢？无法做其它操作。请看代码(100分)

  • 主题发起人 主题发起人 xieyj
  • 开始时间 开始时间
X

xieyj

Unregistered / Unconfirmed
GUEST, unregistred user!
因为小弟是初学多线程。有些问题弄不清楚，请大哥们多指点。
我的多线程单元如下：
unit MyDownload;
interface
uses
Classes, SysUtils, Windows, syncobjs, Forms, TFlatEditUnit, TFlatProgressBarUnit, urlmon;
type
TDownThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(Url:TFlatEdit;From:TFlatEdit;Too:TFlatEdit;Where:TFlatEdit;process:TFlatProgressBar);
destructor Destroy;override;
end;

implementation
var myfile:string;i:integer;
//替换函数(html 替换成 txt)
procedure stringreplaceall(var text: string;
const ss, ds: string);
var
p: integer;
begin
while pos(ss, text) > 0do
begin
p := pos(ss, text);
delete(text, p, length(ss));
insert(ds, text, p);
end;
end;
//HTML转换成TXT文本
Function htmtotxtClick(S:string):string;
var
sels,sele: longint;
begin
S:=Lowercase(S);
sels := pos('<head>', s);
sele := pos('</head>', s);
delete(s, sels, sele-sels+7);
{删除<head>中的数据}
sels := pos('<script>', s);
sele := pos('</script>', s);
delete(s, sels, sele-sels+1);
{删除<Script>中的数据}
while pos('<', s) <> 0do
begin
sels := pos('<', s);
sele := pos('>', s);
if sele = 0 then
break;{没有 '>'}
if sels > sele then
break;{像这样: '>...<'}
delete(s, sels, sele-sels+1);{删除 '<...>'}
end;
stringreplaceall(s, '&amp;nbsp;', ' ');
stringreplaceall(s, '&amp;quot;', '"');
stringreplaceall(s, '&amp;lt;', '<');
stringreplaceall(s, '&amp;gt;', '>');
Result := s;
end;
//取得网页的标题
Function GetTitle(S:string):String;
var ms,me:longint;
begin
S:=Lowercase(S);
while pos('<title>',s)<>0do
begin
ms:=pos('<title>',s);
delete(s,1,ms+6);
me:=pos('</title>',s);
delete(s,me,length(s));
Result:=s;
end;
end;
//只得到前面的ID号，把HTM或HTML或ASP或JSP的扩展名去掉
Function clearhtm(S:string):String;
var ms:longint;
begin
S:=Lowercase(S);
while pos('.htm',s)<>0do
begin
ms:=pos('.htm',s);
delete(s,ms,length(s));
end;
while pos('.html',s)<>0do
begin
ms:=pos('.html',s);
delete(s,ms,length(s));
end;
while pos('.asp',s)<>0do
begin
ms:=pos('.asp',s);
delete(s,ms,length(s));
end;
while pos('.jsp',s)<>0do
begin
ms:=pos('.jsp',s);
delete(s,ms,length(s));
end;
Result:=s;
end;
{下载文件判断函数}
functiondo
wnloadFile(Source, Dest: string;
Over: Boolean): Boolean;
begin
{首先判断目录是否存在}
If Not DirectoryExists(ExtractFilePath(Pchar(Dest))) then
begin
MkDir(ExtractFilePath(Pchar(Dest)));
end;
{判断文件存在时的提示}
If (FileExists(PChar(Dest))) And (Over=True) then
begin
if Application.MessageBox(PChar('文件"'+Dest+'"已经存在，是否要重命名！'),'重命名：',mb_yesno+mb_iconinformation)<>idyes then
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end
else
for i:=0 to 1000do
begin
myfile:=PChar(Copy(Dest,0,Length(Dest)-4)+'('+inttostr(i)+').htm');
if Not FileExists(myfile) then
begin
myfile:=PChar(Copy(Dest,0,Length(Dest)-4)+'('+inttostr(i)+').htm');
Break;
end;
end;
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(myfile), 0, nil) = 0;
except
Result:=False;
end;
End
else
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;
end;
procedure TDownThread.Execute;
begin
while not Terminateddo
begin
end;
end;
constructor TDownThread.Create(Url:TFlatEdit;From:TFlatEdit;Too:TFlatEdit;Where:TFlatEdit;process:TFlatProgressBar);
var ii:integer;str1,str2:string;
begin
Inherited Create(True);
if (trim(Url.Text)='') and (trim(From.Text)='') and (trim(Too.Text)='') and (trim(Where.Text)='') then
begin
application.MessageBox('请输入URL地址或保存文件的路径！','提示：',mb_ok+mb_iconinformation);
Exit;
end
else
begin
process.Max:=(strtoint(clearhtm(Too.text))-strtoint(clearhtm(From.Text)))*2;
for ii:=strtoint(clearhtm(From.Text)) to strtoint(clearhtm(Too.text))do
begin
Str1:=Url.Text+inttostr(ii)+'.htm';
Str2:=Where.Text+'/'+inttostr(ii)+'.htm';
do
wnloadFile(Str1,Str2,true);
process.StepBy(1);
end;
end;
end;

destructor TDownThread.Destroy;
begin
inherited Destroy;
end;
end.
调用过程如下：
public
{ Public declarations }
do
wn:TDownThread;
end;
button1.click事件如下：
do
wn:=TDownThread.Create(FlatEdit1,FlatEdit2,FlatEdit3,FlatEdit4,FlatProgressBar1);
do
wn.Resume;
请高手们如果方便直接MAIL给我。xieyj@esquel.com
 
procedure Execute
你怎么什么代码也没写，
线程主要是执行这个函数
 
HI，我想执行DOWNLOADFILE这个部分的，请问该如何写。多谢了！因为我是多线程的菜鸟。
 
应该是
constructor TDownThread.Create(Url:TFlatEdit;From:TFlatEdit;Too:TFlatEdit;Where:TFlatEdit;process:TFlatProgressBar);
这个部分的，请问该如何写。多谢了！因为我是多线程的菜鸟。
 
我又更改了一下程序:主窗体程序如下：为什么好象用多线程与没用效果一样。请帮忙看一下哪错了，大侠们：
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, TFlatProgressBarUnit, TFlatEditUnit,
TFlatSpeedButtonUnit,mydownload;
type
Tfrmdown = class(TForm)
FlatProgressBar1: TFlatProgressBar;
do
wnload: TFlatSpeedButton;
FlatEdit1: TFlatEdit;
FlatEdit2: TFlatEdit;
FlatEdit3: TFlatEdit;
Label1: TLabel;
Label2: TLabel;
FlatEdit4: TFlatEdit;
FlatSpeedButton1: TFlatSpeedButton;
Memo1: TMemo;
proceduredo
wnloadClick(Sender: TObject);
procedure FlatSpeedButton1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
do
wn:TDownThread;
end;

var
frmdown: Tfrmdown;
implementation
{$R *.dfm}
procedure Tfrmdown.downloadClick(Sender: TObject);
var Mystream:TFilestream;Slist:TStrings;Mytitle:TextFile;
begin
do
wn:=TDownThread.Create;
do
wn.Resume;
{ for ii:=strtoint(flatedit2.Text) to strtoint(FlatEdit3.text)do
begin
if fileexists(Str2) then
begin
AssignFile(Mytitle,Str2);
Reset(Mytitle);
CloseFile(Mytitle);
memo1.Lines.LoadFromFile(Str2);
slist:=TStringList.Create;
Mystream:=TFileStream.Create(Str2,fmOpenRead);
Try
slist.LoadFromStream(Mystream);
slist.Strings[1]:=htmtotxtClick(memo1.Text);
If FileExists(PChar(FlatEdit4.Text+'/'+GetTitle(memo1.Text)+'.htm')) then
begin
if Application.MessageBox(PChar('文件"'+GetTitle(memo1.Text)+'.htm'+'"已经存在，是否要重命名！'),'重命名：',mb_yesno+mb_iconinformation)<>idyes then
exit
else
begin
for i:=0 to 1000do
begin
myfile:=PChar(GetTitle(memo1.Text)+'('+inttostr(i)+').htm');
if Not FileExists(myfile) then
begin
myfile:=PChar(GetTitle(memo1.Text)+'('+inttostr(i)+').htm');
Break;
end;
end;
end;
end
else
myfile:=GetTitle(memo1.Text)+'.htm';
slist.SaveToFile(FlatEdit4.Text+'/'+myfile);
MyStream.Free;
DeleteFile(Pchar(Str2));
Except
MyStream.Free;
end;
end;
end;
}
end;

procedure Tfrmdown.FlatSpeedButton1Click(Sender: TObject);
Var Mydir:string;
begin
SelectDirectory('请选择你要保存文件的目录：','',Mydir);
FlatEdit4.Text:=Mydir;
end;

procedure Tfrmdown.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
do
wn.Free;
end;

end.
多线程如下：
unit MyDownload;
interface
uses
Classes, SysUtils, Windows, syncobjs, Forms, TFlatEditUnit, TFlatProgressBarUnit, urlmon;
type
TDownThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
proceduredo
Down;
public
constructor Create;
destructor Destroy;override;
end;

implementation
Uses Main;
var myfile:string;i:integer;
//替换函数(html 替换成 txt)
procedure stringreplaceall(var text: string;
const ss, ds: string);
var
p: integer;
begin
while pos(ss, text) > 0do
begin
p := pos(ss, text);
delete(text, p, length(ss));
insert(ds, text, p);
end;
end;
//HTML转换成TXT文本
Function htmtotxtClick(S:string):string;
var
sels,sele: longint;
begin
S:=Lowercase(S);
sels := pos('<head>', s);
sele := pos('</head>', s);
delete(s, sels, sele-sels+7);
{删除<head>中的数据}
sels := pos('<script>', s);
sele := pos('</script>', s);
delete(s, sels, sele-sels+1);
{删除<Script>中的数据}
while pos('<', s) <> 0do
begin
sels := pos('<', s);
sele := pos('>', s);
if sele = 0 then
break;{没有 '>'}
if sels > sele then
break;{像这样: '>...<'}
delete(s, sels, sele-sels+1);{删除 '<...>'}
end;
stringreplaceall(s, '&amp;nbsp;', ' ');
stringreplaceall(s, '&amp;quot;', '"');
stringreplaceall(s, '&amp;lt;', '<');
stringreplaceall(s, '&amp;gt;', '>');
Result := s;
end;
//取得网页的标题
Function GetTitle(S:string):String;
var ms,me:longint;
begin
S:=Lowercase(S);
while pos('<title>',s)<>0do
begin
ms:=pos('<title>',s);
delete(s,1,ms+6);
me:=pos('</title>',s);
delete(s,me,length(s));
Result:=s;
end;
end;
//只得到前面的ID号，把HTM或HTML或ASP或JSP的扩展名去掉
Function clearhtm(S:string):String;
var ms:longint;
begin
S:=Lowercase(S);
while pos('.htm',s)<>0do
begin
ms:=pos('.htm',s);
delete(s,ms,length(s));
end;
while pos('.html',s)<>0do
begin
ms:=pos('.html',s);
delete(s,ms,length(s));
end;
while pos('.asp',s)<>0do
begin
ms:=pos('.asp',s);
delete(s,ms,length(s));
end;
while pos('.jsp',s)<>0do
begin
ms:=pos('.jsp',s);
delete(s,ms,length(s));
end;
while pos('.shtml',s)<>0do
begin
ms:=pos('.shtml',s);
delete(s,ms,length(s));
end;
while pos('.dhtml',s)<>0do
begin
ms:=pos('.dhtml',s);
delete(s,ms,length(s));
end;
Result:=s;
end;
{下载文件判断函数}
functiondo
wnloadFile(Source, Dest: string;
Over: Boolean): Boolean;
begin
{首先判断目录是否存在}
If Not DirectoryExists(ExtractFilePath(Pchar(Dest))) then
begin
MkDir(ExtractFilePath(Pchar(Dest)));
end;
{判断文件存在时的提示}
If (FileExists(PChar(Dest))) And (Over=True) then
begin
if Application.MessageBox(PChar('文件"'+Dest+'"已经存在，是否要重命名！'),'重命名：',mb_yesno+mb_iconinformation)<>idyes then
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end
else
for i:=0 to 1000do
begin
myfile:=PChar(Copy(Dest,0,Length(Dest)-4)+'('+inttostr(i)+').htm');
if Not FileExists(myfile) then
begin
myfile:=PChar(Copy(Dest,0,Length(Dest)-4)+'('+inttostr(i)+').htm');
Break;
end;
end;
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(myfile), 0, nil) = 0;
except
Result:=False;
end;
End
else
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;
end;
procedure TDownThread.Execute;
begin
inherited;
Synchronize(DoDown);
end;
procedure TDownThread.DoDown;
var ii:integer;str1,str2:string;
begin
if (trim(frmdown.FlatEdit1.Text)='') and (trim(frmdown.FlatEdit2.Text)='') and (trim(frmdown.FlatEdit3.Text)='') and (trim(frmdown.FlatEdit4.Text)='') then
begin
application.MessageBox('请输入URL地址或保存文件的路径！','提示：',mb_ok+mb_iconinformation);
Exit;
end
else
begin
frmdown.FlatProgressBar1.Max:=(strtoint(clearhtm(frmdown.FlatEdit3.text))-strtoint(clearhtm(frmdown.FlatEdit2.Text)))*2;
for ii:=strtoint(clearhtm(frmdown.FlatEdit2.Text)) to strtoint(clearhtm(frmdown.FlatEdit3.text))do
begin
Str1:=frmdown.FlatEdit1.Text+inttostr(ii)+'.htm';
Str2:=frmdown.FlatEdit4.Text+'/'+inttostr(ii)+'.htm';
do
wnloadFile(Str1,Str2,true);
frmdown.FlatProgressBar1.StepBy(1);
end;
end;

end;
constructor TDownThread.Create;
begin
Inherited Create(False);
end;

destructor TDownThread.Destroy;
begin
inherited Destroy;
end;
end.
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

I
一个函数集
回复
0
查看
687
import
I
I
Quick Report FAQ [ 1 ]
回复
0
查看
1K
import
I
X
应部分网友要求，公开 myfunctions 单元，里面有很多有用的函数(0)
回复
10
查看
4K
yczjs
Y
F
关于多线程对串口的操作，常量comnum=1就可以，大于1就出错(200)
回复
7
查看
1K
feng7504
F
江
Delphi获得弹出U盘的代码及获取U盘序列号的方法(100)
回复
8
查看
2K
江上游者
江
后退
顶部