?? sws_update.pas
字號:
unit Sws_update;
interface
uses
filectrl, Variants,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Menus, db,
Buttons, Grids, ToolWin, ExtCtrls, ImgList, ExtDlgs,IdBaseComponent, IdComponent,shellapi, IdTCPConnection, IdTCPClient, IdHTTP,
Gauges,inifiles,ScktComp, RzButton, RzLabel, RzBckgnd, RzTabs, RzPanel,
ADODB, RzPrgres;
type
Tbuf_char = array[0..4095] of char;
Tbuf_byte = array[0..4095] of byte;
type
TForm_Update = class(TForm)
HTTPFiles: TIdHTTP;
z: TImageList;
RzPanel8: TRzPanel;
RzPanel9: TRzPanel;
RzPanel10: TRzPanel;
Image1: TImage;
RzPanel11: TRzPanel;
RzPanel12: TRzPanel;
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
RzPanel4: TRzPanel;
RzBackground2: TRzBackground;
RzLabel1: TRzLabel;
RzPanel7: TRzPanel;
Label2: TLabel;
Edt_url: TEdit;
ListBox_servers: TListBox;
TabSheet2: TRzTabSheet;
RzPanel1: TRzPanel;
ListView_files: TListView;
RzPanel2: TRzPanel;
Gauge_process: TGauge;
RzPanel3: TRzPanel;
RzBackground1: TRzBackground;
RzPanel5: TRzPanel;
RzBackground3: TRzBackground;
TabSheet3: TRzTabSheet;
Memo1: TMemo;
RzPanel6: TRzPanel;
RzBackground4: TRzBackground;
RzLabel2: TRzLabel;
RzLabel3: TRzLabel;
RzBackground5: TRzBackground;
btn_pre: TRzBitBtn;
btn_next: TRzBitBtn;
RzBackground6: TRzBackground;
RzBackground7: TRzBackground;
RzLabel4: TRzLabel;
TabSheet4: TRzTabSheet;
Memo2: TMemo;
ADOQuery1: TADOQuery;
ADOConnection1: TADOConnection;
RzPanel13: TRzPanel;
RzBackground8: TRzBackground;
RzLabel5: TRzLabel;
RzPanel16: TRzPanel;
RzBackground11: TRzBackground;
Button1: TRzBitBtn;
Button2: TRzBitBtn;
TabSheet5: TRzTabSheet;
RzPanel17: TRzPanel;
RzBackground12: TRzBackground;
RzLabel6: TRzLabel;
Memo3: TMemo;
RzBitBtn1: TRzBitBtn;
ADOTable1: TADOTable;
RzPanel14: TRzPanel;
RzProgressBar1: TRzProgressBar;
procedure FormCreate(Sender: TObject);
procedure ListBox_serversClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure RzPageControl1Change(Sender: TObject);
procedure btn_preClick(Sender: TObject);
procedure btn_nextClick(Sender: TObject);
procedure RzBitBtn1Click(Sender: TObject);
private
{ Private declarations }
g_path: string;
sys_id: string;
AppIni: TIniFile;
files: TStringList;
function ExistNewFile: Boolean;
public
{ Public declarations }
// Ep:integer;
ClientSocket1: TClientSocket;
filename1: string;
serfilename: string;
serhost1: string;
can_rec1: boolean;
stop1: boolean;
sj:boolean;
end;
var
Form_Update: TForm_Update;
root:string;
pos1: longint;
implementation
{$R *.dfm}
procedure TForm_Update.FormCreate(Sender: TObject);
var i,j:integer;
servers: TStrings;
begin
root:= ExtractFilePath(ParamStr(0));
self.sj:=true;
ClientSocket1 := TClientSocket.create(application);
ClientSocket1.ClientType := ctBlocking;
files := TStringList.Create;
ListBox_servers.Items.Clear;
try
g_path := ExtractFilePath(application.ExeName);
if copy(g_path, length(g_path), 1) <> '\' then g_path := g_path + '\';
AppIni := TIniFile.Create(g_path + 'chis.ini');
sys_id := AppIni.ReadString('chis', 'SubSys', '');
servers := TStringList.Create;
AppIni.ReadSectionValues('update', servers);
for i := 0 to servers.Count - 1 do
begin
ListBox_servers.Items.Add(copy(servers[i], 1, pos('=', servers[i]) - 1));
if i = 0 then Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i]));
end;
finally
AppIni.Free;
end;
end;
function getfiledate(const filename2: string; var d: TDateTime): Boolean;
var
DosFileTime: integer;
begin
result := false;
DosFileTime := FileAge(filename2);
if DosFileTime <> -1 then //返回-1表示文件不存在
begin
d := FileDateToDateTime(DosFileTime);
result := true;
end;
end;
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 (socket1.Connected = true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1, sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1 = 0 then break; //test
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;
function Download(var host1, file1: string): Boolean;
var
url1: string;
buf1: Tbuf_byte;
rec1: longint;
f1: file;
cmd1: string;
reclen1, real_reclen1: longint;
value1: string;
total_len1: longint;
begin
try
assignfile(f1, file1);
Form_Update.can_rec1 := false;
Form_update.stop1 := false;
if FileExists(file1) = true then
begin
reset(f1, 1);
pos1 := filesize(f1);
end
else
begin
rewrite(f1, 1);
pos1 := 0;
end;
seek(f1, pos1);
Form_Update.ClientSocket1.Active := false;
Form_Update.ClientSocket1.Host := get_host1(host1);
Form_Update.ClientSocket1.Port := 80;
url1 := '';
Form_Update.serfilename := get_file1(host1);
Form_Update.serhost1 := get_host1(host1);
Form_Update.ClientSocket1.Active := false;
Form_Update.ClientSocket1.Active := true;
url1 := '';
url1 := url1 + 'HEAD /' + Form_Update.serfilename + ' HTTP/1.1' + #13#10;
url1 := url1 + 'Pragma: no-cache' + #13#10;
url1 := url1 + 'Cache-Control: no-cache' + #13#10;
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: ' + Form_Update.serhost1 + #13#10;
url1 := url1 + #13#10;
Form_Update.ClientSocket1.Socket.SendText(url1);
while Form_Update.ClientSocket1.Active = true do
begin
if Form_Update.stop1 = true then break;
cmd1 := socket_rec_line1(Form_Update.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;
if cmd1 = #13#10 then break;
end;
Form_Update.clientsocket1.Active := false;
Form_Update.clientsocket1.Active := true;
url1 := '';
url1 := url1 + 'GET /' + Form_Update.serfilename + ' HTTP/1.1' + #13#10;
url1 := url1 + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;
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=' + inttostr(pos1) + '-' + #13#10;
url1 := url1 + 'Host: ' + Form_Update.serhost1 + #13#10;
url1 := url1 + #13#10;
Form_Update.ClientSocket1.Socket.SendText(url1);
while Form_Update.ClientSocket1.Active = true do
begin
if Form_Update.stop1 = true then break;
cmd1 := socket_rec_line1(Form_Update.ClientSocket1.Socket, 60 * 1000);
if pos(lowercase('Content-Range:'), lowercase(cmd1)) = 1 then
begin
Form_Update.can_rec1 := true;
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;
if cmd1 = #13#10 then break;
end;
real_reclen1 := 0;
while Form_Update.ClientSocket1.Active = true do
begin
if Form_Update.stop1 = true then break;
if Form_Update.can_rec1 = false then break;
if filesize(f1) >= total_len1 then
begin
//showmessage('文件已經下載完畢了!');
result := true;
Form_Update.Memo1.Lines.Add(file1 + '文件下載完成' + #13#10);
break;
end;
zeromemory(@buf1, sizeof(buf1));
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -