Delphi7,多线程操作,菜鸟求教,
delphi吧
全部回复
仅看楼主
level 2
涐媞犭者 楼主
这个程序主要是从网站上下东西,多线程,不是多线程下载,而是每个线程只下一个文件,同时下多个,中间还有一些是对网页信息进行解析的代码,可是,总是出错,各种错误,请大家帮我看看,
程序在这------->百度网盘
2014年04月26日 06点04分 1
level 2
涐媞犭者 楼主
请各位大神帮个忙看看吧,,,
2014年04月26日 14点04分 2
level 12
哈哈,楼上的签名搞笑
2014年04月28日 03点04分 4
level 2
涐媞犭者 楼主
谢谢两位挽尊,,不会是大神们都不愿意去下载吧,我还是把源码复制上来吧
2014年04月30日 04点04分 5
level 2
涐媞犭者 楼主
nit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
const
S1='<img alt="';
S2='<a hidefocus="true" title="';
S3='" href="';
S4='topic';
S5='var mhpicpath="';
S6='<div id="startvar" class="hideval2">';
S7='<div id="totalPage" class="hideval2">';
type
TmhThread = class(TThread)
mhURL,mhName:String;
PartName,PartURL:array[1..1000] of String;
mhTot,PartTot:longint;
protected
procedure Execute; override;
procedure HtmlDownload(aURL,Name:String);
procedure ReadFromIndex;
procedure WorkonPart;
procedure PicDownload(URL:String;Start,Total:longint);
private
public
end;
TDownloadThread = class(TThread)
URL,Path:String;
Port:word;
private
aFile:TMemoryStream;
Linker:TIdHTTP;
protected
procedure Execute; override;
constructor CreateDownload(tURL,tPath:String;tPort:Word);
end;
TForm1 = class(TForm)
Edit1: TEdit;
Image1: TImage;
IdHTTP1: TIdHTTP;
Timer1: TTimer;
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CanvasInitialize;
procedure DrawProgressBar;
procedure Timer1Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ThreadTot,Mark,Max:longint;
CSforMark,CSforThreadTot,CSforMax: TRTLCriticalSection;
implementation
{$R *.dfm}
constructor TDownloadThread.CreateDownload(tURL,tPath:String;tPort:Word);
begin
inherited Create(true);
FreeOnTerminate:=true;
URL:=tURL;
Path:=tPath;
Port:=tPort;
EnterCriticalSection(CSforThreadTot); try
ThreadTot:=ThreadTot+1;
finally LeaveCriticalSection(CSforThreadTot); end;
Resume;
end;
procedure TDownloadThread.Execute;
var
tmp:String;
SomethingWrong:boolean;
begin
Linker:=TIdHTTP.Create(nil);
tmp:=copy(URL,8,255);
Linker.Host:=copy(tmp,1,pos('/',tmp)-1);
Linker.Port:=Port;
Linker.ReadTimeout:=3777;
aFile:=TMemoryStream.Create;
SomethingWrong:=false;
try
Linker.Connect(3777);
Linker.Get(URL,aFile);
except
SomethingWrong:=true;
CreateDownload(URL,Path,Port);
end;
EnterCriticalSection(CSforThreadTot); try
ThreadTot:=ThreadTot-1;
finally LeaveCriticalSection(CSforThreadTot); end;
Linker.Disconnect;
if not SomethingWrong
then aFile.SaveToFile(Path);
FreeandNIL(Linker);
FreeandNIL(aFile);
end;
procedure TmhThread.Execute;
begin
HtmlDownload(mhURL+'/','Index.html');
ReadfromIndex;
WorkonPart;
end;
2014年04月30日 04点04分 8
level 2
涐媞犭者 楼主
procedure TmhThread.WorkonPart;
var
i,Start,Total:longint;
hFindFile: THandle;
FindFileData: WIN32_FIND_DATA;
Str,mhpicpath:string;
begin
for i:=PartTot downto 1 do
begin
if (DirectoryExists(PartName[i]+'\')) and
(not FileExists(PartName[i]+'\'+PartURL[i])) and
(FileExists(PartName[i]+'\000.jpg'))
then begin
hFindFile := FindFirstFile(pchar(IncludeTrailingPathDelimiter(PartName[i])+'*.*'),
FindFileData);
if hFindFile <> 0 then begin
repeat
Str:=FindFileData.cFileName;
if (Str='.') or (Str='..') then continue;
EnterCriticalSection(CSforMark); try
Mark:=Mark+1;
finally LeaveCriticalSection(CSforMark); end;
until FindNextFile(hFindFile, FindFileData) = false;
windows.FindClose(hFindFile);
continue;
end;
end;
CreateDir(PartName[i]);
Chdir(PartName[i]);
if not FileExists('000.jpg')
then HtmlDownload(mhURL+'/'+PartURL[i],PartURL[i]);
AssignFile(Input,PartURL[i]);
Reset(Input);
Start:=0; Total:=0;
while not eof(Input) do
begin
readln(Input,Str);
if pos(S5,Str)<>0
then begin
delete(Str,1,pos(S5,Str)+length(S5)-1);
mhpicpath:=copy(Str,1,pos('"',Str)-1);
end;
if pos(S6,Str)<>0
then begin
delete(Str,1,pos(S6,Str)+length(S6)-1);
start:=strtoint(copy(Str,1,pos('<',Str)-1));
end;
if pos(S7,Str)<>0
then begin
delete(Str,1,pos(S7,Str)+length(S7)-1);
total:=strtoint(copy(Str,1,pos('<',Str)-1));
end;
end;
PicDownload(mhpicpath,Start,total);
CloseFile(Input);
DeleteFile(PartURL[i]);
chdir('..');
end;
end;
procedure TForm1.CanvasInitialize;
begin
Edit1.Visible:=False;
Image1.Visible:=true;
Image1.Canvas.Lock;
Image1.Canvas.Pen.Width:=0;
Image1.Canvas.Pen.Color:=Form1.Color;
Image1.Canvas.Brush.Color:=Form1.Color;
Image1.Canvas.Rectangle(-1,-1,Image1.Width+1,Image1.Height+1);
Image1.Canvas.Pen.Color:=$00ffffff;
Image1.Canvas.Roundrect(0,0,Image1.Width,Image1.Height,Image1.Height,Image1.Height div 2);
Image1.Canvas.Unlock;
end;
procedure TForm1.DrawProgressBar;
var
tmpMark,tmpMax:Longint;
begin
EnterCriticalSection(CSforMark);
EnterCriticalSection(CSforMax); try
tmpMark:=Mark;
tmpMax:=Max;
finally LeaveCriticalSection(CSforMark);
LeaveCriticalSection(CSforMax); end;
Image1.Canvas.Lock;
Image1.Canvas.Brush.Color:=$00ffffff;
Image1.Canvas.Roundrect(0,0,Image1.Width,Image1.Height,Image1.Height,Image1.Height div 2);
Image1.Canvas.Brush.Color:=$00ffD500;
Image1.Canvas.Roundrect(0,0,round(tmpMark*Image1.Width/tmpMax),Image1.Height,Image1.Height,Image1.Height div 2);
Image1.Canvas.Unlock;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=13
then begin
with TmhThread.Create(TRUE) do
begin
FreeonTerminate:=true;
mhURL:=Edit1.Text;
Resume;
end;
CanvasInitialize;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
DrawProgressBar;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Halt;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CSforMark);
InitializeCriticalSection(CSforThreadTot);
InitializeCriticalSection(CSforMax);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CSforMark);
DeleteCriticalSection(CSforThreadTot);
DeleteCriticalSection(CSforMax);
end;
end.
2014年04月30日 04点04分 10
1