Delphi完成的斷點續傳例子，在網絡應用中，斷點續傳是相當實用的，比如自動升級、或下載程序中，都可以用到。在Delphi7中，可以使用TIdHTTP和TIdFTP組件實現基於HTTP協議的斷點續傳和FTP協議的斷點續傳，都是使用的Indy系列組件，使用方法大同小異，下面來看運行效果圖：
Delphi實現斷點續傳，完整代碼如下：
001
unit Unit1;
002
interface
003
uses
004
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
005
Dialogs, StdCtrls, ComCtrls, IdFTP, IDBaseComponent, IdComponent,
006
IdTCPConnection, IdTCPClIEnt, IdHTTP, IdHTTPHeaderInfo, ExtCtrls;
007
type
008
TForm1 = class(TForm)
009
ListBox1: TListBox;
010
Panel1: TPanel;
011
Label1: TLabel;
012
Label2: TLabel;
013
Button1: TButton;
014
ProgressBar1: TProgressBar;
015
Button2: TButton;
016
IdHTTP1: TIdHTTP;
017
IdFTP1: TIdFTP;
018
Button3: TButton;
019
ComboBox1: TComboBox;
020
procedure Button2Click(Sender: TObject);
021
procedure Button1Click(Sender: TObject);
022
procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
023
const AWorkCount: Integer);
024
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
025
const AWorkCountMax: Integer);
026
procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
027
procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
028
const AStatusText: string);
029
procedure Button3Click(Sender: TObject);
030
private
031
AbortTransfer: Boolean; //是否中斷
032
BytesToTransfer: LongWord; //下載總大小
033
procedure FTPDownLoad(aURL, aFile: string; bResume: Boolean);
034
procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);
035
procedure MyDownLoad(aURL, aFile: string; bResume: Boolean);
036
function GetProt(aURL: string): Byte;
037
function GetURLFileName(aURL: string): string;
038
procedure GetFTPParams(aURL: string; var sName, sPass, sHost, sPort,
039
sDir: string);
040
{ Private declarations }
041
public
042
{ Public declarations }
043
end;
044
var
045
Form1: TForm1;
046
var
047
AverageSpeed: Double = 0;
048
implementation
049
{$R *.dfm}
050
procedure TForm1.Button2Click(Sender: TObject);
051
begin
052
AbortTransfer := True;
053
end;
054
function TForm1.GetProt(aURL: string): Byte;
055
begin //檢測下載的地址是http還是FTP
056
Result := 0;
057
if Pos('http', LowerCase(aURL)) = 1 then
058
Result := 1; //http協議
059
if Pos('FTP', LowerCase(aURL)) = 1 then
060
Result := 2; //FTP協議
061
end;
062
function TForm1.GetURLFileName(aURL: string): string;
063
var
064
i: integer;
065
s: string;
066
begin //返回下載地址的文件名
067
s := aURL;
068
i := Pos('/', s);
069
while i <> 0 do //去掉"/"前面的內容剩下的就是文件名了
070
begin
071
Delete(s, 1, i);
072
i := Pos('/', s);
073
end;
074
Result := s;
075
end;
076
procedure TForm1.GetFTPParams(aURL: string; var sName, sPass, sHost, sPort, sDir: string);
077
var
078
i, j: integer;
079
s, tmp: string;
080
begin //分析FTP地址的登陸用戶名，密碼和目錄
081
s := aURL;
082
if Pos('FTP://', LowerCase(s)) <> 0 then //去掉FTP頭
083
Delete(s, 1, 6);
084
i := Pos('@', s);
085
if i <> 0 then //地址含用戶名，也可能含密碼
086
begin
087
tmp := Copy(s, 1, i - 1);
088
s := copy(s, i+1, Length(s));
089
j := Pos(':', tmp);
090
if j <> 0 then //包含密碼
091
begin
092
sName := Copy(tmp, 1, j - 1); //得到用戶名
093
sPass := Copy(tmp, j + 1, i - j - 1); //得到密碼
094
end else
095
begin
096
sName := tmp;
097
sPass := Inputbox('輸入框','請輸入登陸FTP密碼','');
098
end;
099
end else //匿名用戶
100
begin
101
sName := 'anonymous';
102
sPass := 'test@FTP.com';
103
end;
104
i := Pos(':', s);
105
j := Pos('/', s);
106
sHost := Copy(s, 1, j - 1); //主機
107
if i <> 0 then //含端口
108
sPort := Copy(s, i + 1, j - i - 1) else
109
sPort := '21'; //默認21端口
110
tmp := Copy(s, j + 1, Length(s));
111
while j <> 0 do
112
begin
113
Delete(s, 1, j);
114
j := Pos('/', s);
115
end; //目錄
116
sDir := '/' + Copy(tmp, 1, Length(tmp) - Length(s) - 1);
117
end;
118
procedure TForm1.FTPDownLoad(aURL, aFile: string; bResume: Boolean);
119
var
120
tStream: TFileStream;
121
sName, sPass, sHost, sPort, sDir: string;
122
begin //FTP方式下載
123
if FileExists(aFile) then //建立文件流
124
tStream := TFileStream.Create(aFile, fmOpenWrite) else
125
tStream := TFileStream.Create(aFile, fmCreate);
126
GetFTPParams(aURL, sName, sPass, sHost, sPort, sDir);
127
with IdFTP1 do
128
try
129
if Connected then Disconnect; //重新連接
130
Username := sName;
131
PassWord := sPass;
132
Host := sHost;
133
Port := StrToInt(sPort);
134
Connect;
135
except
136
exit;
137
end;
138
IdFTP1.ChangeDir(sDir); //改變目錄
139
BytesToTransfer := IdFTP1.Size(aFile);
140
try
141
if bResume then //續傳
142
begin
143
tStream.Position := tStream.Size;
144
IdFTP1.Get(aFile, tStream, True);
145
end else
146
begin
147
IdFTP1.Get(aFile, tStream, False);
148
end;
149
finally
150
tStream.Free;
151
end;
152
end;
153
procedure TForm1.HttpDownLoad(aURL, aFile: string; bResume: Boolean);
154
var
155
tStream: TFileStream;
156
begin //Http方式下載
157
if FileExists(aFile) then //如果文件已經存在
158
tStream := TFileStream.Create(aFile, fmOpenWrite) else
159
tStream := TFileStream.Create(aFile, fmCreate);
160
if bResume then //續傳方式
161
begin
162
IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;
163
tStream.Position := tStream.Size - 1; //移動到最後繼續下載
164
IdHTTP1.Head(aURL);
165
IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;
166
end else //覆蓋或新建方式
167
begin
168
IdHTTP1.Request.ContentRangeStart := 0;
169
end;
170
try
171
IdHTTP1.Get(aURL, tStream); //開始下載
172
finally
173
tStream.Free;
174
end;
175
end;
176
procedure TForm1.MyDownLoad(aURL, aFile: string; bResume: Boolean);
177
begin
178
case GetProt(aURL) of
179
0: ShowMessage('不可識別的地址！');
180
1: HttpDownLoad(aURL, aFile, bResume);
181
2: FTPDownLoad(aURL, aFile, bResume);
182
end;
183
end;
184
procedure TForm1.Button1Click(Sender: TObject);
185
var
186
aURL, aFile: string;
187
begin
188
aURL := ComboBox1.Text; //下載地址，例如"http://www.baidu.com/update/test.exe"
189
aFile := GetURLFileName(aURL); //得到文件名，例如"test.exe"
190
if FileExists(aFile) then
191
begin
192
case MessageDlg('文件已經存在，是否續傳？', mtConfirmation, mbYesNoCancel, 0) of
193
mrYes: MyDownLoad(aURL, aFile, True); //續傳
194
mrNo: MyDownLoad(aURL, aFile, False); //覆蓋
195
mrCancel: Exit; //取消
196
end;
197
end else MyDownLoad(aURL, aFile, False); //建立新文件下載
198
end;
199
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
200
const AWorkCount: Integer);
201
begin
202
if AbortTransfer then
203
begin //中斷下載
204
IdHTTP1.Disconnect;
205
IdFTP1.Abort;
206
end;
207
ProgressBar1.Position := AWorkCount;
208
Application.ProcessMessages;
209
end;
210
procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
211
const AWorkCountMax: Integer);
212
begin
213
AbortTransfer := False;
214
if AWorkCountMax > 0 then
215
ProgressBar1.Max := AWorkCountMax else
216
ProgressBar1.Max := BytesToTransfer;
217
end;
218
procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
219
begin
220
ProgressBar1.Position := 0;
221
end;
222
procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
223
const AStatusText: string);
224
begin
225
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
226
end;
227
procedure TForm1.Button3Click(Sender: TObject);
228
begin
229
Close;
230
end;
231
end.
程序所實現的主要功能由IdHTTP和IdFTP組件完成，你可借助本代碼學習Get過程實現斷點續傳的方法以及字符串的分析分解方法，初步掌握調試程序時斷點的使用，事件代碼的共用等。這裡我們同樣使用了流格式，不過這次不是內存流而是文件流。
