⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmain.pas

📁 用来下载
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        break;
      end;

      ZeroMemory(@bufByte, SizeOf(bufByte));
      bytes := FormUpdate.ClientSocket1.Socket.ReceiveBuf(bufByte, SizeOf(bufByte));

      //如果实际收到的长度大于服务器标识的长度,则是出错了,不要写入文件中
      if realLength >= recLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '实际收到文件长度大于服务器标识长度,跳过下载');
        break;
      end;

      //如果当前的长度大于服务器标识的长度,则是出错了,不要写入文件中
			if FormUpdate.position = recLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '当前长度大于服务器标识长度,跳过下载');
        break;
      end;

      BlockWrite(f, bufByte, bytes);
      realLength := realLength + bytes;

      //显示下载进度
      FormUpdate.LabelMsg.Caption := '共 ' + FormatFloat('#,##', recLength) + ' 字节,已下载 ' + FormatFloat('#,##', realLength) + ' 字节';
      FormUpdate.GaugeProcess.MaxValue := recLength;
      FormUpdate.GaugeProcess.Progress := realLength;
      //FormUpdate.NotebookStep.Refresh;
      Application.ProcessMessages;
    end;
    CloseFile(f);

    FormUpdate.ClientSocket1.Active := false;
    //*****发送get请求,以得到实际的文件数据_end*****
  except
//    raise;

//    CloseFile(f);
    DeleteFile(local);
    FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '服务器连接失败,取消下载');
    result := false;
    Exit;
  end;
end;
//***********************************************

procedure TFormUpdate.BtnPriorClick(Sender: TObject);
begin
  if step > 0 then
    step := step - 1;
end;

procedure TFormUpdate.BtnNextClick(Sender: TObject);
begin
  if Pos('(*)',EditURL.Text)=0 then
  begin
     ShowMessage('必须在URL中包涵圆括号');
     exit;
  end;
  stoped := false;
  case step of
    0:
      begin
        NotebookStep.PageIndex := NotebookStep.PageIndex + 1;
        step := 1;
        BtnNextClick(Sender);
      end;
    1:
      if CheckConnection then
      begin
        step := 2;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    2:
      if DownloadInfo then
      begin
        step := 3;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    3:
      if AnalysisInfo then
      begin
          step := 4;
          BtnNextClick(Sender);
{        if files.Count = 0 then
        begin
          step := 4;
          BtnNext.Enabled := false;
          Exit;
        end
        else
        begin
          step := 4;
          BtnNextClick(Sender);
        end;
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
}
      end;

    4: begin
       step := 5;
       DownloadFiles
       end;
  end;
end;

procedure TFormUpdate.BtnCancelClick(Sender: TObject);
begin
  stoped := true;
  if (step >= 4) or (step = 0) then
    Close;
end;

function TFormUpdate.CheckConnection: Boolean;
begin
  result := false;
  try
    Memo1.Lines.Add('正在检测本地网络...');
    if InternetGetConnectedState(nil, 0) then
    begin
      Memo1.Lines.Add('连接本地网络成功');
      result := true;
    end
    else
    begin
      Memo1.Lines.Add('不能连接,请检查本地网络设置');
      Exit;
    end;
    Application.ProcessMessages;

    Memo1.Lines.Add('正在检测服务器...');
    if InternetCheckConnection(PChar(EditURL.Text), 1, 0) then
    begin
      Memo1.Lines.Add('连接服务器成功');
      result := true;
    end
    else
    begin
      Memo1.Lines.Add('不能连接,请检查服务器状态');
		  Exit;
    end;
    Application.ProcessMessages;
  except
    raise;
    Exit;
  end;
end;

function TFormUpdate.DownloadInfo: Boolean;
begin
   Memo1.Clear;
   Result:=true;
{  try
    SelectDirectory('请选择要保存到哪里',savePath);
    RunDosCommand('wget.exe ' + '-m -t0 -l10 -c -v -P, --directory-prefix='+savepath+' '+EditURL.Text, Memo1.Lines);
    result := false;
    item := ListViewFiles.Items.Add;
    item.StateIndex := 0;
    item.Caption := '下载课件信息...';
    Memo1.Lines.Add('正在下载课件信息...');
    Application.ProcessMessages;
  except
    raise;
    Exit;
  end
}  
end;

function TFormUpdate.AnalysisInfo: Boolean;
var
  i :Integer;
  urlstr,newstr,kconstr:string;
  procedure addhtml(const kurl:string);
  var i:integer;
  begin
     if RightStr(savePath,1)<>'\' then savePath:=savePath+'\';
     with  DownFileTable do
     begin
         Append;
         DownFileTableurl.Value:=kurl+'/content.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\content.htm';
         Append;
         DownFileTableurl.Value:=kurl+'/title.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\title.htm';
         Append;
         DownFileTableurl.Value:=kurl+'/page.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\page.htm';

         Append;
         DownFileTableurl.Value:=kurl+'/left.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\left.htm';

         Append;
         DownFileTableurl.Value:=kurl+'/remoteclip.asx';
         DownFileTableloalpath.Value:=savePath+kconstr+'\remoteclip.asx';

         Append;
         DownFileTableurl.Value:=kurl+'/localclip.asx';
         DownFileTableloalpath.Value:=savePath+kconstr+'\localclip.asx';

         Append;
         DownFileTableurl.Value:=kurl+'/content.xml';
         DownFileTableloalpath.Value:=savePath+kconstr+'\content.xml';

         Append;
         DownFileTableurl.Value:=kurl+'/media.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\media.htm';
         Append;
         DownFileTableurl.Value:=kurl+'/log.htm';
         DownFileTableloalpath.Value:=savePath+kconstr+'\log.htm';

         Append;
         DownFileTableurl.Value:=kurl+'/images/2.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\2.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/cacu.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\cacu.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/clock.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\clock.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/cw1.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\cw1.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/fav.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\fav.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/full.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\full.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/help.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\help.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/mw1.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\mw1.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/note.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\note.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/images/vfull.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\vfull.gif';
         Append;
         DownFileTableurl.Value:=kurl+'/images/xCSS.css';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\xCSS.css';
         Append;
         DownFileTableurl.Value:=kurl+'/images/zoomout.gif';
         DownFileTableloalpath.Value:=savePath+kconstr+'\images\zoomout.gif';

         Append;
         DownFileTableurl.Value:=kurl+'/contents/000.asf';
         DownFileTableloalpath.Value:=savePath+kconstr+'\contents\000.asf';
          for i := 0 to 300 do
          begin
            Append;
            DownFileTableurl.Value:=kurl+'/contents/'+(IntToStr(i)+'.swf');
            DownFileTableloalpath.Value:=savePath+kconstr+'\contents\'+(IntToStr(i)+'.swf');
            Application.ProcessMessages;
            if stoped then exit;
          end;
         DownFileTable.Post;
     end;
  end;
  function Getkconstr(const s:string):string;
  var p:Integer;
  begin
      p:=Length(s);
       while s[p]<>'/' do Dec(p);
       result:=Copy(s,p+1,Length(s));
  end;

begin
  result := false;
  DownFileTable.Clear;
  DownFileTable.Open;
  savePath:= Edit1.Text;
  Memo1.Lines.Add('正在分析课件信息...');
  try
    DownFileTable.DisableControls;
    for i:=SpinEdit1.Value to SpinEdit2.Value do
    begin
        newstr:=RightStr('0000'+inttostr(i),se1.Value);
        urlstr:=StringReplace(EditURL.Text,'(*)',newstr,[rfIgnoreCase]);
        kconstr:=Getkconstr(urlstr);  //课的目录名
        addhtml(urlstr);
        if stoped then exit;
        Application.ProcessMessages;
    end;
    DownFileTable.EnableControls;
    if DownFileTable.RecordCount > 0 then
      Memo1.Lines.Add('分析课件信息完成,有可用下载')
    else
      Memo1.Lines.Add('分析课件信息完成,无可用下载');
    result := true;
  except
    raise;
    Memo1.Lines.Add('不能分析课件信息');
    Exit;
  end;
end;

function TFormUpdate.DownloadFiles: Boolean;
var
  i, n: Integer;
  fileHandle: LongInt;
  filedate: TdateTime;
  remote, local: String;
  Dir:string;
  toghterDwn:Byte;
begin
  result := false;
  savePath:=Edit1.Text;
  toghterDwn:=SpinEdit3.value;
  try
    //比较UPDATEINFO和savePath的文件时间
    DownFileTable.First;
    DownFileTable.DisableControls;
    repeat
        fileHandle := FileOpen(DownFileTableloalpath.Value, fmOpenRead);
        if fileHandle <> -1 then
         fileDate := FileDateToDateTime(FileGetDate(fileHandle));
        FileClose(fileHandle);
        remote := DownFileTableurl.Value;
        local := DownFileTableloalpath.Value;
        Memo1.Lines.Add('连接远程文件:' + remote);
        try
          if Download(remote, local) then
          begin
             DownFileTable.Edit;
             DownFileTablelog.Value:='下载成功';
             DownFileTable.Post;
          end
          else
          begin
             DownFileTable.Edit;
             DownFileTablelog.Value:='下载失败';
             DownFileTable.Post;
          end;
        except
        end;
        DownFileTable.Next;
        Application.ProcessMessages;
    until DownFileTable.Eof;
    DownFileTable.EnableControls;
  except
    raise;
    Memo1.Lines.Add('不能下载文件');
    DownFileTable.EnableControls;
    Exit;
  end;

end;


procedure TFormUpdate.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if (step >= 4) or (step = 0) then
    CanClose := true
  else if MessageBox(handle, '本次更新没有完成,要退出吗?', '信息提示', MB_YESNO + MB_ICONQUESTION) = ID_YES then
    CanClose := true;
end;

procedure TFormUpdate.BtnLogClick(Sender: TObject);
begin
  if Height = 300 then Height := 386 else Height := 300;
end;

procedure TFormUpdate.EditURL1Change(Sender: TObject);
begin
  BtnNext.Enabled := (EditURL.Text <> '');
end;

procedure TFormUpdate.Edit1Change(Sender: TObject);
begin
   savePath:=Edit1.Text;
end;

procedure TFormUpdate.SpeedButton1Click(Sender: TObject);
begin
    savePath:='e:\shjlearn';
    SelectDirectory(savePath,[sdAllowCreate, sdPerformCreate, sdPrompt],0);
    Edit1.Text:=savePath;
end;

procedure TFormUpdate.DownFileTableNewRecord(DataSet: TDataSet);
begin
  DownFileTableIco.Value:=0;
end;

procedure TFormUpdate.EditURL2Change(Sender: TObject);
begin
  editurl.Text:=EditURL2.Text;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -