login.pas

来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 551 行 · 第 1/2 页

  ShowMess('关于...','在不断的修改完善的过程中，会进行程序的版本升级，如果登录'+
                     '时提示说发现新版本程序，务必要按提示进行升级，才可以保证程序的正常使用！', MB_OK);
end;

function TfrmLogin.CheckUpdateInfo: Boolean;
var ls_FileName, ls_Ver, ls_Style: String;
    ls_SQL, ls_Err: String;
    lb_Add: Boolean;
begin
  //检测需要更新的文件
  Result := False;

  ls_SQL := 'SELECT * FROM UPDATEINFO';
  ls_Err := OpenDataSet(dm.qryFree, ls_SQL);
  if ls_Err <> '' then
  begin
    ShowMess('系统错误','从服务器下载程序升级信息时失败，具体为：'+ls_Err, MB_ICONERROR);
    Exit;
  end;

  UpdateList := TStringList.Create;
  ls_Style := '新增文件';
  with dm.qryFree do
  while not Eof do
  begin
    ls_FileName := FieldByName('FileName').AsString;
    if FileExists(AppPath + ls_FileName) then
    begin
      ls_Style := '更新版本';
      ls_Ver := GetVersionInfo(AppPath + ls_FileName);
      if ls_Ver <> FieldByName('FileVer').AsString then
        lb_Add := True;
    end else
      lb_Add := True;

    //处理添加动作
    if lb_Add then
    begin
      Result := True;
      UpdateList.Add(ls_FileName);
      mmUpdate.Lines.Add('更新类型：'+ ls_Style);
      mmUpdate.Lines.Add('文件名称：'+ ls_FileName);
      mmUpdate.Lines.Add('最新版本：'+ FieldByName('FileVer').AsString);
      mmUpdate.Lines.Add('更新日期：'+ FormatDateTime('yyyy-mm-dd HH:mm:ss', FieldByName('FileTime').AsDateTime));
      mmUpdate.Lines.Add('--------------------------------------------');
      mmUpdate.Lines.Add(FieldByName('Note').AsString);
      mmUpdate.Lines.Add('============================================');
    end;

    Next;
  end;
end;

procedure TfrmLogin.btnUpdateClick(Sender: TObject);
var ls_UpdateName, ls_TmpName, ls_URL: String;
    li_Count: Integer;
    lst_Update: TStrings;
begin
  //开始升级
  RzPageControl1.ActivePageIndex := 2;
  pbAll.TotalParts := UpdateList.Count;
  ls_URL := ReadIni('UPDATE','SERVER_URL','');
  lbURL.Caption:= ls_URL;

  Link;  //初始化下载控件

  //下载文件
  lst_Update := TStringList.Create; //生成改名批处理用。
  try
    for li_Count :=0 to UpdateList.Count-1 do
    begin
      ls_TmpName   := GetTempName(UpdateList.Strings[li_Count]);
      ls_UpdateName:= ls_URL + UpdateList.Strings[li_Count];
      lbUpdateing.Caption := UpdateList.Strings[li_Count];

      NMHTTP1.Body:= AppPath + ls_TmpName;
      NMHTTP1.Get(ls_UpdateName);

      //添加批处理
      lst_Update.Add('DEL '+ ls_TmpName+'_' );  
      lst_Update.Add('REN '+ UpdateList.Strings[li_Count] + ' '+ ls_TmpName+'_');
      lst_Update.Add('REN '+ ls_TmpName + ' ' + UpdateList.Strings[li_Count] );
      lst_Update.Add('DEL '+ ls_TmpName+'_' );  

      pbAll.IncPartsByOne;
    end;

    //保存批处理
    lst_Update.SaveToFile(AppPath + 'UPDATE.BAT');
    lst_Update.Free;
  except
    On E: Exception do
    begin
      ShowMess('系统错误','设置更新组件时出错，具体为：'+ E.Message, MB_ICONERROR);
      lst_Update.Free;
    end;
  end;

  Unlink; //断开连接

  //执行批处理改名
  WinExec(Pchar(AppPath + 'UPDATE.BAT'), SW_HIDE);
  //DeleteFile(AppPath + 'UPDATE.BAT');

  //更新完毕
  mmUpdate.Lines.Add('系统已经更新完毕！');
  RzPageControl1.ActivePageIndex := 1;
end;

procedure TfrmLogin.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  UpdateList.Free;
end;

function TfrmLogin.GetSizeInfo(ASize: Currency): String;
begin
  if ASize < 0
  then Result:= '未知'
  else
  if ASize < 1024 then
  begin
    Result:= FloatToStr( ASize )+'B';
  end
  else
  begin
    ASize:= ASize / 1024; //KB
    if ASize < 1024
    then
    begin
      ASize:= Round(ASize * 100) / 100;
      Result:= FloatToStr( ASize )+'KB';
    end
    else
    begin
      ASize:= Round(ASize/ 1024 * 100) / 100;
      Result:= FloatToStr( ASize )+'MB';
    end;
  end;

end;

function TfrmLogin.GetTimeInfo(Timer: Currency): String;
var
  lf_Timer: Currency;
begin
  lf_Timer:= Timer;
  if lf_Timer < 0
  then Result:= '未知'
  else
  if lf_Timer < 60 then
  begin
    Result:= FloatToStr( lf_Timer )+'秒';
  end
  else
  begin
    lf_Timer:= Trunc(lf_Timer / 60);
    Result:= FloatToStr( lf_Timer )+'分'+ FloatToStr(Timer -lf_Timer * 60) +'秒';
  end;
end;

procedure TfrmLogin.UnLink;
begin
  Timer1.Enabled:= False;
  Timer2.Enabled:= False;

  with NMHTTP1 do
  begin
    Cancel;
    Body:= '';
    InputFileMode := False;
    OutputFileMode:= False;
  end;
end;

procedure TfrmLogin.InitLink;
begin
  with pbCurrent do
  begin
    TotalParts    := NMHTTP1.BytesTotal;
    PartsComplete := 0;
    gs_FileSize   := GetSizeInfo(TotalParts);
    gs_time       := '未知';
    IsInit        := True;
  end;
end;

procedure TfrmLogin.Link;
begin
  with NMHTTP1 do
  begin
    InputFileMode  := True;
    OutputFileMode := False;
    Header         := '';
  end;
  
  IsInit:= False;
  Timer1.Enabled:= True;
  Timer2.Enabled:= True;
end;

procedure TfrmLogin.NMHTTP1Failure(Cmd: CmdType);
begin
  unLink;
  mmUpdate.Lines.Add('更新文件失败！');
end;

procedure TfrmLogin.NMHTTP1PacketRecvd(Sender: TObject);
begin
  with pbCurrent do
  begin
    if not IsInit then InitLink;

    X:= NMHTTP1.BytesRecvd;
    PartsComplete   := X;
    lbTimer.Caption := gs_time+'(已复制'+GetSizeInfo(X)+',共'+gs_FileSize+')';
  end;
end;

procedure TfrmLogin.Timer1Timer(Sender: TObject);
begin
  if Timer1.Interval <> 1000
  then Timer1.Interval:= 1000;

  lbSpeed.Caption:= GetSizeInfo(X-Y)+'/秒';
  Y:= X;
end;

procedure TfrmLogin.Timer2Timer(Sender: TObject);
var
  lf_Timer: Real;
begin
  if X - Y <> 0 then
  begin
    lf_Timer:= (NMHTTP1.BytesTotal-NMHTTP1.BytesRecvd) div (X-Y);

    if lf_Timer < 60    //自动调整更新间隔
    then Timer2.Interval:= 1000
    else Timer2.Interval:= 2000;

    gs_time:= GetTimeInfo(lf_Timer);
  end;
end;

procedure TfrmLogin.btnStopUpdateClick(Sender: TObject);
var
  i: Integer;
begin
  UnLink;
  self.Tag:= idCancel;

  //删除已经下载的数据
  for i:= 0 to UpdateList.Count - 1 do
    DeleteFile( GetTempName(UpdateList.Strings[i]));
end;

function TfrmLogin.GetTempName(_FileName: String): String;
var ls_tmp: String;
begin
  Result := '';

  ls_tmp := ExtractFileExt(_FileName);
  if UpperCase(ls_tmp) = '.EXE' then
    Result := StringReplace(_FileName,'.exe','.ex_',[rfReplaceAll, rfIgnoreCase]);
  if UpperCase(ls_tmp) = '.DLL' then
    Result := StringReplace(_FileName,'.dll','.dl_',[rfReplaceAll, rfIgnoreCase]);
end;

procedure TfrmLogin.FormShow(Sender: TObject);
begin
  if RzPageControl1.ActivePageIndex = 0 then
    edtUserCode.SetFocus;
end;

end.