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,Clipbrd;
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));
rec1 := Form_Update.ClientSocket1.Socket.ReceiveBuf(buf1, sizeof(buf1));
if real_reclen1 >= reclen1 then
begin
//showmessage('文件已经下载完毕了！');
result := true;
Form_Update.Memo1.Lines.Add(Form_update.serfilename + '实际收到文件长度大于服务器标识长度，跳过下载' + #13#10);
break;
end;
if pos1 = reclen1 then
begin
//showmessage('文件已经下载完毕了！');
result := true;
Form_Update.Memo1.Lines.Add(Form_update.serfilename + '当前长度大于服务器标识长度，跳过下载' + #13#10);
break;
end;
blockwrite(f1, buf1, rec1);
real_reclen1 := real_reclen1 + rec1;
//显示下载进度
Form_Update.RzLabel4.caption := '共 ' + FormatFloat('#,##', reclen1) + ' 字节，已下载 ' + FormatFloat('#,##', real_reclen1) + ' 字节';
Form_Update.Gauge_process.MaxValue := reclen1;
Form_Update.Gauge_process.Progress := real_reclen1;
application.ProcessMessages;
end;
closefile(f1);
Form_Update.ClientSocket1.Active := false;
except
closefile(f1);
result := false;
Form_Update.Memo1.lines.add(Form_update.serfilename + '服务器连接失败，取消下载' + #13#10);
end;
end;
procedure TForm_Update.ListBox_serversClick(Sender: TObject);
var i: integer;
begin
Edt_url.Text := '';
for i := 0 to ListBox_servers.Items.Count - 1 do
if ListBox_servers.Selected[i] then
begin
try
AppIni := TIniFile.Create(g_path + '\chis.ini');
Edt_url.Text := AppIni.ReadString('update', ListBox_servers.Items[i], 'http://');
finally
AppIni.Free;
end;
end;
end;
procedure TForm_Update.FormShow(Sender: TObject);
begin
btn_next.SetFocus;
RzPageControl1.HideAllTabs;
end;
procedure TForm_Update.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
try
HTTPFiles.Disconnect;
except
end;
files.Free;
end;
function TForm_Update.ExistNewFile: Boolean;
var i {, iFileHandle}: integer;
filestr: TStringList;
begin
result := false;
filestr := TStringList.Create;
files.Clear;
try
if copy(Edt_url.Text, length(Edt_url.Text), 1) <> '/' then Edt_url.Text := Edt_url.Text + '/';
filestr.Add(HTTPFiles.Get(Edt_url.Text + sys_id + '.htm'));
filestr.SaveToFile(g_path + 'update\update.ini');
filestr.Free;
except
MessageBox(handle, '取得升级信息出错！', '错误提示', MB_OK + MB_ICONERROR);
exit;
end;
files.Clear;
try
AppIni := TIniFile.Create(g_path + '\update\update.ini');
AppIni.ReadSections(files);
finally
AppIni.Free;
end;
result := true;
end;
procedure TForm_Update.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := true;
if HTTPFiles.Connected then
begin
if MessageBox(handle, '正在下载文件，要退出吗？', '信息提示', MB_YESNO + MB_ICONQUESTION) = ID_YES then CanClose := true else CanClose := false;
end;
if btn_next.Caption = '完成升级' then
begin
if MessageBox(handle, '文件下载已经完成，但并没有更新文件，要退出吗？', '信息提示', MB_YESNO + MB_ICONQUESTION) = ID_YES then CanClose := true else CanClose := false;
end;
end;
procedure TForm_Update.Button1Click(Sender: TObject);
begin
RzPageControl1.ActivePageIndex := 2;
end;
procedure TForm_Update.Button2Click(Sender: TObject);
begin
sj := false;
self.stop1 := true;
memo1.Lines.Add('已中断下载;' + #13#10);
// self.Close;
end;
procedure TForm_Update.RzPageControl1Change(Sender: TObject);
begin
if RzPageControl1.ActivePageIndex = 0 then
begin
btn_pre.Enabled := false;
btn_next.Caption := '下一步';
btn_next.Enabled := true;
end
else btn_pre.Enabled := true;
end;
procedure TForm_Update.btn_preClick(Sender: TObject);
begin
//button2.Click;
try
HTTPFiles.Disconnect;
except
end;
RzPageControl1.ActivePageIndex := 0;
btn_next.Caption := '下一步';
btn_next.Enabled := true;
end;
procedure TForm_Update.btn_nextClick(Sender: TObject);
var i: integer;
run_exe, host1, file1: string;
Flist: TListItem;
myblob: TStream;
fd: Tdatetime;
allget: boolean;
begin
if btn_next.Caption = '完成升级' then
begin
btn_next.Enabled := false;
btn_next.Caption := '复制新文件..';
button2.Enabled := false;
for i := 0 to files.Count - 1 do //复制文件更新
begin
copyfile(pchar(g_path + files[i]), pchar(g_path + 'backup\' + files[i] + '.bak'), false);
end;
for i := 0 to files.Count - 1 do //从update复制新文件
begin
copyfile(pchar(g_path + 'update\' + files[i]), pchar(g_path + files[i]), false);
DeleteFile(pchar(g_path + 'update\' + files[i])); //删除update目录中的升级文件
end;
try
AppIni := TIniFile.Create(g_path + 'chis.ini');
run_exe := AppIni.ReadString('chis', 'exe', '');
if run_exe <> '' then shellexecute(handle, 'open', pchar(run_exe), nil, nil, sw_show);
finally
AppIni.Free;
end;
// application.Terminate;
exit;
end;
RzPageControl1.ActivePageIndex := 1;
Gauge_process.MaxValue := 100;
Gauge_process.Progress := 0;
ListView_files.Items.Clear;
Flist := ListView_files.Items.Add;
Flist.Caption := '分析文件升级信息...';
Flist.StateIndex := 0;
Flist.ImageIndex := 0;
if ExistNewFile then //如果存在升级信息
begin
ListView_files.Items.Clear;
Gauge_process.Progress := 0;
for i := 0 to files.Count - 1 do
begin
Flist := ListView_files.Items.Add; //把待升级文件信息写入列表
Flist.Caption := files[i];
Flist.StateIndex := -1;
Flist.ImageIndex := -1;
end;
//下载升级文件
btn_next.Enabled := false;
btn_next.Caption := '正下载文件..';
button2.Enabled := true;
try
AppIni := TIniFile.Create(g_path + 'update\update.ini');
for i := 0 to files.Count - 1 do
begin
ListView_files.Items[i].StateIndex := 0;
ListView_files.Items[i].ImageIndex := 0;
listview_files.Items[i].SubItems.Add(appini.ReadString(files[i], 'datetime', ''));
host1 := Edt_url.Text + files[i];
file1 := g_path + 'update\' + files[i];
memo1.Lines.Add('连接远程文件：' + host1 + #13#10);
if getfiledate(files[i], fd) then
begin
if fd < strtodatetime(Appini.ReadString(files[i], 'datetime', '')) then
begin
listview_files.Items[i].SubItems.Append('需要升级');
if Download(host1, file1) then
begin
allget := true;
ListView_files.Items[i].StateIndex := 1;
ListView_files.Items[i].ImageIndex := 1;
end
else
begin
allget := false;
ListView_files.Items[i].StateIndex := 2;
ListView_files.Items[i].ImageIndex := 2;
end;
end
else
begin
allget := true;
listview_files.Items[i].SubItems.Append('不需更新');
ListView_files.Items[i].StateIndex := 3;
ListView_files.Items[i].ImageIndex := 3;
memo1.Lines.Add(listview_files.Items[i].Caption + '文件不需要更新，跳过下载' + #13#10);
end;
end
else
begin
listview_files.Items[i].SubItems.Append('需要创建');
if Download(host1, file1) then
begin
allget := true;
ListView_files.Items[i].StateIndex := 1;
ListView_files.Items[i].ImageIndex := 1;
end
else
begin
allget := false;
ListView_files.Items[i].StateIndex := 2;
ListView_files.Items[i].ImageIndex := 2;
end;
end;
end;
finally
button2.Enabled := false;
AppIni.Free;
HTTPfiles.Disconnect;
end;
btn_next.Enabled := true;
sj := sj or allget;
if (RzPageControl1.ActivePageIndex = 1) and sj
then btn_next.Caption := '完成升级' else btn_next.Caption := '继续下载';
end;
end;
procedure TForm_Update.RzBitBtn1Click(Sender: TObject);
var datastring, sqlstring: widestring;
i: integer;
myinifile: Tinifile;
strUser, strServer: string;
filename: string;
begin
self.RzPageControl1.ActivePageIndex := 3;
filename := ExtractFilePath(Paramstr(0)) + 'mentorouser.ini';
myinifile := Tinifile.Create(filename);
strServer := myinifile.ReadString('messages', 'server', '(local)');
strUser := myinifile.ReadString('messages', 'dataname', '(local)');
try
ADOConnection1.Connected := false;
datastring := 'Provider=SQLOLEDB.1;Password=mentoro;Persist Security Info=False;User ID=mentorologin;Initial Catalog=' + strUser + ';Data Source=' + strServer;
ADOConnection1.ConnectionString := datastring;
ADOConnection1.Connected := true;
ADOTable1.Active := FALSE;
ADOTable1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";Data Source=SQLtext.mdb;Persist Security Info=True';
ADOTable1.TableName := 'SQLTEXT';
ADOTable1.Active := TRUE;
RzProgressBar1.TotalParts := ADOTable1.RecordCount;
while not ADOTable1.Eof do
begin
ADOQuery1.ParamCheck := false;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.add(ADOTable1.FieldByName('命令').asstring);
memo2.Lines.Add(ADOTable1.FieldByName('命令').asstring);
ADOQuery1.execsql;
ADOTable1.Next;
RzProgressBar1.PartsComplete := RzProgressBar1.PartsComplete + 1;
end;
MessageBox(Handle, '数据升级成功！请保证您的管理系统也是最新的！', '操作提醒', MB_ICONASTERISK);
except
MessageBox(Handle, '数据升级失败！', '操作提醒', MB_ICONHAND);
end;
RzProgressBar1.TotalParts := 0;
end;
procedure SetClipboardText(AStr: string);
var // SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
Data: THandle;
DataPtr: Pointer;
Size: Integer;
WStr: PWideChar;
begin
Size := Length(AStr) * 4;
WStr := AllocMem(Size);
try
// convert to Unicode
StringToWideChar(AStr, WStr, Size);
OpenClipboard(0);
EmptyClipboard;
Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
try
DataPtr := GlobalLock(Data);
try
Move(WStr^, DataPtr^, Size);
SetClipboardData(CF_UNICODETEXT, Data);
finally
GlobalUnlock(Data);
end;
except
GlobalFree(Data);
raise;
end;
finally
CloseClipboard;
FreeMem(WStr);
end;
end;
end.
