unitmain.pas

用来下载

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList, ComCtrls, Gauges,
  ScktComp, WinInet, IniFiles, ShellApi,FileCtrl, Buttons, Spin, DB, Grids,
  DBGrids, MemDS, VirtualTable,StrUtils, cxStyles, cxCustomData,
  cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData,
  cxImageComboBox, cxProgressBar, cxGridCustomTableView, cxGridTableView,
  cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGridLevel,
  cxGrid, dxCntner, dxEditor, dxExEdtr, dxEdLib;

type
  TBufChar = array[0..4095] of Char;
  TBufByte = array[0..4095] of Byte;

type
  TFormUpdate = class(TForm)
    BtnPrior: TButton;
    BtnNext: TButton;
    Memo1: TMemo;
    BtnLog: TButton;
    BtnCancel: TButton;
    ImageList: TImageList;
    Image1: TImage;
    GroupBox1: TGroupBox;
    NotebookStep: TNotebook;
    GaugeProcess: TGauge;
    LabelMsg: TLabel;
    EditURL1: TEdit;
    Label2: TLabel;
    Edit1: TEdit;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Label1: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    SpeedButton1: TSpeedButton;
    lbl1: TLabel;
    se1: TSpinEdit;
    Label5: TLabel;
    DownFileTable: TVirtualTable;
    DataSource1: TDataSource;
    DownFileTableurl: TStringField;
    DownFileTableloalpath: TStringField;
    DownFileTablelog: TStringField;
    cxGrid1: TcxGrid;
    cxGrid1Level1: TcxGridLevel;
    cxGrid1DBTableView1: TcxGridDBTableView;
    cxGrid1DBTableView1url: TcxGridDBColumn;
    cxGrid1DBTableView1loalpath: TcxGridDBColumn;
    cxGrid1DBTableView1log: TcxGridDBColumn;
    cxStyleRepository1: TcxStyleRepository;
    cxStyle1: TcxStyle;
    cxStyle2: TcxStyle;
    DownFileTableIco: TSmallintField;
    DownFileTablePos: TIntegerField;
    cxGrid1DBTableView1DBColumn1: TcxGridDBColumn;
    cxGrid1DBTableView1DBColumn2: TcxGridDBColumn;
    SpinEdit3: TSpinEdit;
    Label6: TLabel;
    lbl2: TLabel;
    EditURL2: TdxImageEdit;
    EditUrl: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure BtnNextClick(Sender: TObject);
    procedure BtnPriorClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BtnCancelClick(Sender: TObject);
    procedure BtnLogClick(Sender: TObject);
    procedure EditURL1Change(Sender: TObject);

    function CheckConnection: Boolean;
		function DownloadInfo: Boolean;
		function AnalysisInfo: Boolean;
		function DownloadFiles: Boolean;
    procedure Edit1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DownFileTableNewRecord(DataSet: TDataSet);
    procedure EditURL2Change(Sender: TObject);
  private
    ClientSocket1: TClientSocket;
    subSysFile: String; //子系统的更新文件名
    savePath: String; //升级文件路径
    backupPath: String; //备份文件路径
    runExe: String;

    downFileName: String; //下载文件名
    downHostName: String; //服务器名

    canRec: Boolean; //是否可以接收
    stoped: Boolean; //是否停止
    position: LongInt; //上次下载的断点位置
    iniFile: TIniFile; //通用ini
    step: Integer;

	public
		{ Public declarations }
	end;

var
  FormUpdate: TFormUpdate;

const
  CONFIGINI: String = 'config.ini';
  UPDATEINFO: String = 'info.ini'; //本地升级信息文件名

procedure RunDosCommand(Command : string; Output : TStrings);

implementation

{$R *.dfm}

procedure RunDosCommand(Command : string; Output : TStrings);
var
  hReadPipe : THandle;
  hWritePipe : THandle;
  SI : TStartUpInfo;
  PI : TProcessInformation;
  SA : TSecurityAttributes;
//  SD : TSecurityDescriptor;
  BytesRead : DWORD;
  Dest : array[0..1023] of char;
  CmdLine : array[0..512] of char;
  TmpList : TStringList;
  Avail, ExitCode, wrResult : DWORD;
  osVer : TOSVERSIONINFO;
  tmpstr :AnsiString;
begin
  osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
  GetVersionEX(osVer);

  if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
//    InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION);
//    SetSecurityDescriptorDacl(@SD, True, nil, False);
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil;//@SD;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
  end
  else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
  try
    Screen.Cursor := crHourglass;
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    StrPCopy(CmdLine, Command);
    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
       ExitCode := 0;
       while ExitCode = 0 do
       begin
          wrResult := WaitForSingleObject(PI.hProcess, 500);
//        if PeekNamedPipe(hReadPipe, nil, 0, nil, @Avail, nil) then
          if PeekNamedPipe(hReadPipe, @Dest[0], 1024,  @Avail, nil, nil) then
          begin
             if Avail > 0 then
             begin
               TmpList := TStringList.Create;
               try
                 FillChar(Dest, SizeOf(Dest), 0);
                 ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
                 TmpStr := Copy(Dest,0 , BytesRead-1);
                 TmpList.Text := TmpStr;
                 Output.AddStrings(TmpList);
               finally
                 TmpList.Free;
               end;
             end;
          end;
            if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
       end;
       GetExitCodeProcess(PI.hProcess, ExitCode);
       CloseHandle(PI.hProcess);
       CloseHandle(PI.hThread);
     end;
     finally
       CloseHandle(hReadPipe);
       CloseHandle(hWritePipe);
       Screen.Cursor := crDefault;
   end;
end;


procedure TFormUpdate.FormCreate(Sender: TObject);
begin
  BtnNext.Enabled := (EditURL.Text <> '');
	ClientSocket1 := TClientSocket.Create(Application);
	ClientSocket1.ClientType := ctBlocking;
end;

//***********************************************
function GetHostName(str: String): String;
begin
  str := Trim(str);
  if Pos('http://', LowerCase(str)) = 1 then
    str := Copy(str, Length('http://') + 1, Length(str));
  if Pos('/', str) <> 0 then
    str := Copy(str, 0, Pos('/', str) - 1);
  result := str;
end;

function GetFileName(str: String): String;
begin
  str := Trim(str);
  if Pos('http://', LowerCase(str)) = 1 then
    str := Copy(str, Length('http://') + 1, Length(str));
  if Pos('/', str) <> 0 then
    str := Copy(str, Pos('/', str) + 1, Length(str));
  result := str;
end;

function GetFileDate(const fileName: String; var fileDate: TDateTime): Boolean;
var
  age: Integer;
begin
  result := false;
  age := FileAge(filename);
  if age <> -1 then //返回-1表示文件不存在
  begin
    fileDate := FileDateToDateTime(age);
    result := true;
  end;
end;

function SocketRecLine(socket: TCustomWinSocket; timeout: Integer; const CRLF: String = #13#10): String;
var
  bufChar: TBufChar;
  r: Integer;
  strStream: TStringStream; //保存所有的数据
  scktStream: TWinSocketStream;
begin
  strStream := TStringStream.Create('');
  scktStream := TWinSocketStream.Create(socket, timeout);

  //while true do//下面的一句更安全,不过对本程序好象没起作用
  while (socket.Connected = true) do
  begin
    //确定是否可以接收数据 //只能确定接收的超时，可见WaitForData的源码
    if not scktStream.WaitForData(timeout) then break; //continue;
    //这一句是一定要有的，以免返回的数据不正确
    ZeroMemory(@bufChar, SizeOf(bufChar));
    //每次只读一个字符，以免读入了命令外的数据
    r := scktStream.Read(bufChar, 1);
    //读不出数据时也要跳出，要不会死循环
    if r = 0 then break; //test
    //用scktStream.Read能设置超时
    //r:=socket.ReceiveBuf(bufChar, SizeOf(bufChar));
    strStream.Write(bufChar, r);
    //读到回车换行符了
    if Pos(CRLF, strStream.DataString) <> 0 then break;
  end;
  result := strStream.DataString;
  //没有读到回车换行符,就表示有超时错，这时返回空字符串
  if Pos(CRLF, result) = 0 then result := '';

  strStream.Free;
  scktStream.Free;
end;

function Download(var remote, local: String): Boolean;
var
  str: String;
  bufByte: TBufByte;
  bytes: LongInt;
  f: File;
  recLine, RECAll: String; //这一行的内容
  recLength, realLength: LongInt; //服务器返回的长度;实际已经收到的长度
  cl: String; //标志们的值
  totalLength: LongInt; //数据总长
begin
  result := false;
  recLength := 0;
  totalLength := 0;
  try
    AssignFile(f, local);
    FormUpdate.canRec := false;
    FormUpdate.stoped := false;
    if not DirectoryExists(ExtractFilePath(local)) then
       ForceDirectories(ExtractFilePath(local));
    if FileExists(local) = true then
    begin
      Reset(f, 1);
      FormUpdate.position := FileSize(f);
    end
    else
    begin
      ReWrite(f, 1);
      FormUpdate.position := 0;
    end;

    Seek(f, FormUpdate.position);
    FormUpdate.ClientSocket1.Active := false;
    FormUpdate.ClientSocket1.Host := GetHostName(remote);
    FormUpdate.ClientSocket1.Port := 80;

    str := '';
    FormUpdate.downFileName := GetFileName(remote);
    FormUpdate.downHostName := GetHostName(remote);


    //*****取得文件长度以确定什么时候结束接收*****[通过"head"请求得到]
    FormUpdate.ClientSocket1.Active := true;
    str := '';
    str := str + 'HEAD /' + FormUpdate.downFileName + ' HTTP/1.1' + #13#10;

    //-----不使用缓存-----我附加的
    //与以前的服务器兼容
    str := str + 'Pragma: no-cache' + #13#10;
    //新的
    str := str + 'Cache-Control: no-cache' + #13#10;
    //-----不使用缓存_end-----

    str := str + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;

    //下面这句必须要有
    str := str + 'Host: ' + FormUpdate.downHostName + #13#10;
    str := str + #13#10;
    FormUpdate.ClientSocket1.Socket.SendText(str);


    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');
      recLine := SocketRecLine(FormUpdate.ClientSocket1.Socket, 60 * 1000);

      //-----计算文件的长度-----
      if Pos(LowerCase('Content-Length: '), LowerCase(recLine)) = 1 then
      begin
        cl := Copy(recLine, Length('Content-Length: ') + 1, Length(recLine));
        totalLength := StrToInt(Trim(cl));
      end;
      //-----计算文件的长度_end-----

      if recLine = #13#10 then break;
    end;
    FormUpdate.clientsocket1.Active := false;
    //*****取得文件长度以确定什么时候结束接收_end*****



    //*****发送get请求，以得到实际的文件数据*****
    FormUpdate.clientsocket1.Active := true;
    str := '';
    str := str + 'GET /' + FormUpdate.downFileName + ' HTTP/1.1' + #13#10;
    str := str + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;

    //应该可以不要str := str + 'Accept-Language: zh-cn' + #13#10;
    //应该可以不要str := str + 'Accept-Encoding: gzip, deflate' + #13#10;

    //-----不使用缓存-----我附加的
    //与以前的服务器兼容
    //str := str + 'Pragma: no-cache' + #13#10;
    //新的
    //str := str + 'Cache-Control: no-cache' + #13#10;
    //----不使用缓存-----end

    str := str + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
    //接受数据的范围,可选
    str := str + 'RANGE: bytes=' + IntToStr(FormUpdate.position) + '-' + #13#10;

    //下面这句必须要有
    str := str + 'Host: ' + FormUpdate.downHostName + #13#10;

    //应该可以不要
    //str := str + 'Connection: Keep-Alive' + #13#10;
    str := str + #13#10;
    FormUpdate.ClientSocket1.Socket.SendText(str);

    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');
      recLine := SocketRecLine(FormUpdate.ClientSocket1.Socket, 60 * 1000);

      //-----是否可接收-----
      if Pos(LowerCase('Content-Range:'), LowerCase(recLine)) = 1 then
      begin
        FormUpdate.canRec := true;
      end;
      //-----是否可接收-----end

      //-----计算要接收的长度-----
      if Pos(LowerCase('Content-Length: '), LowerCase(recLine)) = 1 then
      begin
        cl := Copy(recLine, Length('Content-Length: ') + 1, Length(recLine));
        recLength := StrToInt(Trim(cl));
      end;
      //-----计算要接收的长度-----end;
      RECAll:=RECAll+recLine;
      //头信息收完了
      if recLine = #13#10 then break;
    end;

    realLength := 0;
    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');

      //不能接收则退出
      if FormUpdate.canRec = false then
      begin
        Close(f);
        DeleteFile(local);
        FormUpdate.Memo1.Lines.Add(local + '文件下载失败');
        FormUpdate.Memo1.Lines.Add(RECALL);
        break;
      end;

      //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if FileSize(f) >= totalLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(local + '文件下载完成');