?? unit1.pas
字號:
unit Unit1;
interface
uses
{} filectrl, inifiles, {} Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls, Gauges, Buttons, ComCtrls, jpeg,
WinSkinData;
type
Tbuf_char = array[0..4095] of char;
Tbuf_byte = array[0..4095] of byte;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Panel2: TPanel;
Image1: TImage;
Panel1: TPanel;
Panel3: TPanel;
g: TGauge;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
Memo1: TMemo;
SkinData1: TSkinData;
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
filename1: string; //本地文件名
serfilename: string; //服務器端文件名
serhost1: string; //服務器地址
can_rec1: boolean; //是否可以接收
stop1: boolean; //是否停止
procedure getinfo;
procedure downloads(frompath, topath: string);
end;
var
Form1: TForm1;
pos1: longint; //上次下載到的位置
procedure msg(Atsh: string; b: integer);
implementation
{$R *.dfm}
procedure msg(Atsh: string; b: integer);
begin
if b = 0 then //錯誤
Application.MessageBox(Pchar(Atsh), '提示', MB_ICONERROR);
if b = 1 then //疑問
Application.MessageBox(Pchar(Atsh), '提示', MB_ICONWARNING);
end;
function app_path1: string;
begin
result := extractfilepath(Application.ExeName);
end;
//接收一行數據//socket,超時，結束符
function socket_rec_line1(socket1: TCustomWinSocket; timeout1: integer; crlf1: string = #13#10): string;
var
buf1: Tbuf_char;
r1: integer;
ts1: TStringStream; //保存所有的數據
FSocketStream: TWinSocketStream;
begin
ts1 := TStringStream.Create('');
FSocketStream := TWinSocketStream.Create(socket1, timeout1);
//while true do//下面的一句更安全,不過對本程序好象沒起作用
while (socket1.Connected = true) do begin
//確定是否可以接收數據
//只能確定接收的超時，可見WaitForData的源碼
if not FSocketStream.WaitForData(timeout1) then break; //continue;
//這一句是一定要有的，以免返回的數據不正確
zeromemory(@buf1, sizeof(buf1));
r1 := FSocketStream.Read(buf1, 1); //每次只讀一個字符，以免讀入了命令外的數據
//讀不出數據時也要跳出，要不會死循環
if r1 = 0 then break; //test
//用FsocketStream.Read能設置超時
//r1:=socket1.ReceiveBuf(buf1,sizeof(buf1));
ts1.Write(buf1, r1);
//讀到回車換行符了
if pos(crlf1, ts1.DataString) <> 0 then begin
break;
end;
end;
result := ts1.DataString;
//沒有讀到回車換行符,就表示有超時錯，這時返回空字符串
if pos(crlf1, result) = 0 then begin
result := '';
end;
ts1.Free;
FSocketStream.Free;
end;
function get_host1(in1: string): string;
begin
in1 := trim(in1);
if pos('http://', lowercase(in1)) = 1 then begin
in1 := copy(in1, length('http://') + 1, length(in1));
end;
if pos('/', in1) <> 0 then begin
in1 := copy(in1, 0, pos('/', in1) - 1);
end;
result := in1;
end;
function get_file1(in1: string): string;
begin
in1 := trim(in1);
if pos('http://', lowercase(in1)) = 1 then begin
in1 := copy(in1, length('http://') + 1, length(in1));
end;
if pos('/', in1) <> 0 then begin
in1 := copy(in1, pos('/', in1) + 1, length(in1));
end;
result := in1;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.ReceiveText);
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
url1: string;
begin
{ url1:='';
url1:=url1+'GET http://clq.51.net/textfile.zip HTTP/1.1'+#13#10;
url1:=url1+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
//應該可以不要url1:=url1+'Accept-Language: zh-cn'+#13#10;
//應該可以不要url1:=url1+'Accept-Encoding: gzip, deflate'+#13#10;
//不使用緩存,我附加的
//與以前的服務器兼容
url1:=url1+'Pragma: no-cache'+#13#10;
//新的
url1:=url1+'Cache-Control: no-cache'+#13#10;
//不使用緩存,我附加的_end;
url1:=url1+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
//接受數據的范圍,可選
url1:=url1+'RANGE: bytes=533200-'+#13#10;
//下面這句必須要有
url1:=url1+'Host: clq.51.net'+#13#10;
url1:=url1+'Connection: Keep-Alive'+#13#10;
url1:=url1+#13#10;
ClientSocket1.Socket.SendText(url1);
}
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
self.stop1 := true;
close;
end;
procedure TForm1.downloads(frompath, topath: string);
var
url1: string;
buf1: Tbuf_byte;
rec1: longint;
f1: file;
cmd1: string; //這一行的內容
reclen1, real_reclen1: longint; //服務器返回的長度;實際已經收到的長度
value1: string; //標志們的值
total_len1: longint; //數據總長
begin
try
// self.Memo1.Lines.Add('開始升級......');
//self.filename1:='c:\temp1.dat';
assignfile(f1, self.filename1);
can_rec1 := false;
self.stop1 := false;
if FileExists(self.filename1) = true then begin
reset(f1, 1);
pos1 := filesize(f1);
end
else begin
rewrite(f1, 1);
pos1 := 0;
end;
seek(f1, pos1);
ClientSocket1.Active := false;
ClientSocket1.Host := get_host1(frompath);
ClientSocket1.Port := 80;
url1 := '';
self.serfilename := get_file1(frompath);
self.serhost1 := get_host1(frompath);
// self.Memo1.Lines.Add('獲得配置參數成功；');
//取得文件長度以確定什么時候結束接收[通過"head"請求得到]
ClientSocket1.Active := false;
ClientSocket1.Active := true;
url1 := '';
url1 := url1 + 'HEAD /' + self.serfilename + ' HTTP/1.1' + #13#10;
//不使用緩存,我附加的
//與以前的服務器兼容
url1 := url1 + 'Pragma: no-cache' + #13#10;
//新的
url1 := url1 + 'Cache-Control: no-cache' + #13#10;
//不使用緩存,我附加的_end;
url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
//下面這句必須要有
//url1:=url1+'Host: clq.51.net'+#13#10;
url1 := url1 + 'Host: ' + self.serhost1 + #13#10;
url1 := url1 + #13#10;
ClientSocket1.Socket.SendText(url1);
while ClientSocket1.Active = true do begin
if self.stop1 = true then break;
cmd1 := socket_rec_line1(ClientSocket1.Socket, 60 * 1000);
//計算文件的長度
if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then begin
value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
total_len1 := strtoint(trim(value1));
end;
//計算文件的長度_end;
if cmd1 = #13#10 then break;
end;
//取得文件長度以確定什么時候結束接收_end;
//發送get請求，以得到實際的文件數據
ClientSocket1.Active := false;
ClientSocket1.Active := true;
url1 := '';
//url1:=url1+'GET http://clq.51.net/textfile.zip HTTP/1.1'+#13#10;
//url1:=url1+'GET /textfile.zip HTTP/1.1'+#13#10;
url1 := url1 + 'GET /' + self.serfilename + ' HTTP/1.1' + #13#10;
url1 := url1 + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;
//應該可以不要url1:=url1+'Accept-Language: zh-cn'+#13#10;
//應該可以不要url1:=url1+'Accept-Encoding: gzip, deflate'+#13#10;
//不使用緩存,我附加的
//與以前的服務器兼容
//url1:=url1+'Pragma: no-cache'+#13#10;
//新的
//url1:=url1+'Cache-Control: no-cache'+#13#10;
//不使用緩存,我附加的_end;
url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
//接受數據的范圍,可選
//url1:=url1+'RANGE: bytes=533200-'+#13#10;
url1 := url1 + 'RANGE: bytes=' + inttostr(pos1) + '-' + #13#10;
//下面這句必須要有
//url1:=url1+'Host: clq.51.net'+#13#10;
url1 := url1 + 'Host: ' + self.serhost1 + #13#10;
//應該可以不要
//url1:=url1+'Connection: Keep-Alive'+#13#10;
url1 := url1 + #13#10;
ClientSocket1.Socket.SendText(url1);
while ClientSocket1.Active = true do begin
if self.stop1 = true then break;
cmd1 := socket_rec_line1(ClientSocket1.Socket, 60 * 1000);
//是否可接收
if pos(lowercase('Content-Range:'), lowercase(cmd1)) = 1 then begin
can_rec1 := true;
end;
//是否可接收_end;
//計算要接收的長度
if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then begin
value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
reclen1 := strtoint(trim(value1));
end;
//計算要接收的長度_end;
//頭信息收完了
if cmd1 = #13#10 then break;
end;
real_reclen1 := 0;
while ClientSocket1.Active = true do begin
if self.stop1 = true then break;
//不能接收則退出
if can_rec1 = false then break;
//如果文件當前的長度大于服務器標識的長度,則是出錯了，不要寫入文件中
if filesize(f1) >= total_len1 then begin
// showmessage('文件已經下載完畢了！');
break;
end;
zeromemory(@buf1, sizeof(buf1));
rec1 := ClientSocket1.Socket.ReceiveBuf(buf1, sizeof(buf1));
//如果實際收到的長度大于服務器標識的長度,則是出錯了，不要寫入文件中
if real_reclen1 >= reclen1 then begin
// showmessage('文件已經下載完畢了！');
break;
end;
//如果當前的長度大于服務器標識的長度,則是出錯了，不要寫入文件中
if pos1 = reclen1 then begin
// showmessage('文件已經下載完畢了！');
break;
end;
blockwrite(f1, buf1, rec1);
real_reclen1 := real_reclen1 + rec1;
// Label1.Caption := FormatFloat('#,##', real_reclen1) + '/' + FormatFloat('#,##', reclen1);
// Label1.Caption := Label1.Caption + '->' + inttostr(trunc((real_reclen1 / reclen1) * 100)) + '%';
g.Progress := trunc((real_reclen1 / reclen1) * 100);
Application.ProcessMessages;
end;
closefile(f1);
// showmessage('ok');
//發送get請求，以得到實際的文件數據_end;
ClientSocket1.Active := false;
except
closefile(f1);
showmessage('discon...');
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
getinfo;
close;
end;
procedure TForm1.getinfo;
var
ini1: tinifile;
//配置文件的下載路徑
configname,
downloadname,
tmpname,
ExeName
: string;
f: file;
begin
self.Memo1.Lines.Add('開始更新......');
self.Memo1.Lines.Add('正在分析配置信息;');
ini1 := tinifile.Create(app_path1 + 'config.ini');
configname := ini1.ReadString('configfile', 'filename', '');
self.filename1 := ini1.ReadString('brjxc', 'temppath', 'c:\temp1.tmp');
downloadname := ini1.ReadString('brjxc', 'filename', 'c:\temp1.tmp');
ExeName := ini1.ReadString('brjxc', 'exename', '1.exe');
tmpname := self.filename1;
//pos1:=filesize(
ini1.Free;
//
self.Memo1.Lines.Add('開始更新配置文件;');
downloads(downloadname, tmpname);
copyfile(Pchar(tmpname), Pchar(app_path1 + 'config.ini'), true);
self.Memo1.Lines.Add('更新配置文件完成;');
self.Memo1.Lines.Add('開始下載主程序;');
deletefile(Pchar(tmpname));
deletefile(Pchar(tmpname));
deletefile(Pchar(app_path1 + 'tmp.tmp'));
//
assignfile(f, app_path1 + ExeName);
// Rename(f, SaveDialog1.FileName);
Rename(f, app_path1 + 'tmp.tmp');
//
downloads(downloadname, tmpname);
copyfile(Pchar(tmpname), Pchar(app_path1 + ExeName), true);
self.Memo1.Lines.Add('更新主程序完成!!');
msg('軟件升級成功,請重新啟動軟件!!', 1);
close;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -