sws_update.pas

本程序是在网友vagrant的升级程序上增加了SQL数据库的更新升级功能

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));