📄 unitmain.pas
字号:
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 + -