|
HL3.56插件的lyy登录器主程序源码,网络家园定制版,适配的华立插件3.56 编译通过
- type
- TUpdateing = record
- TempFile: string;
- FromURL: string;
- ToPathFile: string;
- FileDateTime: TDateTime;
- end;
- PTUpdateing = ^TUpdateing;
- type
- TForm_Update = class(TForm)
- Timer1: TTimer;
- suiForm1: TsuiForm;
- ListView_files: TsuiListView;
- Label4: TLabel;
- Button2: TsuiButton;
- suiThemeManager1: TsuiThemeManager;
- Label1: TLabel;
- IdHTTP1: TIdHTTP;
- Timer2: TTimer;
- ProgressBarCount: TsuiProgressBar;
- VCLUnZip1: TVCLUnZip;
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure Timer1Timer(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Timer2Timer(Sender: TObject);
- procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
- AWorkCountMax: Int64);
- procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
- AWorkCount: Int64);
- private
- Tuping: TList;
- //IsReStart: Boolean; //是否当前文件
- //AppFilseName: string; //当前文件名
- m_BoStopDown: Boolean; //停止下载
- sWorkCount: Integer;
- function HttpDownLoad(aURL, aFile: string; var ErrorMsg: string): Boolean;
- procedure StartUP();
- public
- DownUrl: string; //HTTP下载目录
- Runexe: string; //更新完毕后运行的文件
- end;
- var
- Form_Update : TForm_Update;
- implementation
- uses Mir3, Func, MAIN;
- {$R *.dfm}
- //http方式下载
- function TForm_Update.HttpDownLoad(aURL, aFile: string; var ErrorMsg: string): Boolean;
- var
- TStream : TFileStream;
- begin //Http方式下载
- try
- TStream := TFileStream.Create(aFile, fmCreate);
- try
- IdHTTP1.Request.ContentRangeStart := 0;
- IdHTTP1.Get(aURL, TStream); //开始下载
- Result := True;
- finally
- TStream.Free;
- end;
- except
- on e: exception do
- begin
- ErrorMsg := e.message;
- Result := False;
- end;
- end;
- end;
- function Zip(ZipFile,UnzipDir:String):Boolean; //压缩或解压缩文件
- var
- vcluzip:TVCLUnZip;
- begin
- Result:=False;
- vcluzip:=TVCLUnZip.Create(nil);
- try
- with vcluzip do
- begin
- try
- ZipName:=ZipFile;
- ReadZip;
- FilesList.Add('*.*');
- DoAll := True;
- DestDir := UnzipDir;
- RecreateDirs := False;
- RetainAttributes := True;
- Unzip;
- Result:=True;
- except
- Application.MessageBox('解压文件失败','错误',MB_OK+MB_ICONINFORMATION);
- Result:=False;
- exit;
- end;
- end;
- finally
- vcluzip.Free;
- end;
- end;
- procedure TForm_Update.StartUP();
- var
- NFile, TFile : string;
- PUDL : PTUpdateList;
- PUIN : PTUpdateing;
- PUOUT : PTUpdateing;
- SelfPath : string;
- SelfDir : string;
- SelfFileTime : TDateTime;
- SelfFile : string;
- FormURL : string;
- i : Integer;
- AddFile : TListItem;
- FileCount : Integer;
- ErrorMsg : string;
- sToFile : string;
- zpName : string;
- zpDir : string;
- begin
- Label4.Caption := '正在分析更新信息...';
- SelfPath := FullPath;
- SelfPath := copy(SelfPath, 1, Length(SelfPath) - 1);
- //Delay(1000);
- for i := 0 to UPList.Count - 1 do
- begin
- PUDL := UPList.Items;
- NFile := SelfPath + PUDL^.FilePath + PUDL^.ToFile;
- //Label4.Caption := '正在分析:' + NFile;
- Application.ProcessMessages;
- try
- if not FileExists(NFile) then //文件不存在
- begin
- TFile := FullPath + 'update\' + PUDL^.FromFile;
- FormURL := _sDefUrl + PUDL^.FilePath + PUDL^.FromFile;
- FormURL := Q_ReplaceStr(FormURL, '\', '/');
- New(PUIN);
- PUIN^.TempFile := TFile;
- PUIN^.FromURL := FormURL;
- PUIN^.ToPathFile := NFile;
- PUIN^.FileDateTime := PUDL^.FileDateTime;
- Tuping.Add(PUIN);
- sToFile := PUDL^.ToFile;
- if Q_LowerCase(ExtractFileExt(PUDL^.FromFile)) = '.zip' then
- begin
- sToFile := PUDL^.ToFile + '(zip)';
- end;
- ListView_files.Items.BeginUpdate;
- AddFile := ListView_files.Items.Add;
- AddFile.Caption := sToFile;
- AddFile.SubItems.Add(DateTimeToStr(PUDL^.FileDateTime));
- AddFile.SubItems.Add('△等待下载..');
- ListView_files.Items.EndUpdate;
- continue;
- end;
- SelfFileTime := GetFileDateTime(NFile, fttLastWrite);
- if SecondsBetween(SelfFileTime, PUDL^.FileDateTime) > 30 then
- begin
- TFile := FullPath + 'update\' + PUDL^.FromFile;
- FormURL := _sDefUrl + PUDL^.FilePath + PUDL^.FromFile;
- FormURL := Q_ReplaceStr(FormURL, '\', '/');
- New(PUIN);
- PUIN^.TempFile := TFile;
- PUIN^.FromURL := FormURL;
- PUIN^.ToPathFile := NFile;
- PUIN^.FileDateTime := PUDL^.FileDateTime;
- Tuping.Add(PUIN);
- sToFile := PUDL^.ToFile;
- if Q_LowerCase(ExtractFileExt(PUDL^.FromFile)) = '.zip' then
- begin
- sToFile := PUDL^.ToFile + '(zip)';
- end;
- ListView_files.Items.BeginUpdate;
- AddFile := ListView_files.Items.Add;
- AddFile.Caption := sToFile;
- AddFile.SubItems.Add(DateTimeToStr(PUDL^.FileDateTime));
- AddFile.SubItems.Add('△等待下载..');
- ListView_files.Items.EndUpdate;
- continue;
- end;
- except
- end;
- end;
- Label4.Caption := '更新信息分析完毕...';
- FileCount := Tuping.Count;
- if FileCount = 0 then
- begin
- Close;
- Exit;
- end;
- for i := 0 to FileCount - 1 do
- begin
- Application.ProcessMessages;
- if m_BoStopDown then Exit;
- PUOUT := Tuping.Items;
- Label4.Caption := '正在连接服务器...';
- Label1.Caption := '正在下载(' + Q_IntToStr(i + 1) + '/' + Q_IntToStr(FileCount) + '):' + PUOUT^.ToPathFile;
- SelfDir := ExtractFileDir(PUOUT^.ToPathFile);
- if not DirectoryExists(SelfDir) then CreateDir(SelfDir);
- if m_BoStopDown then Exit;
- ErrorMsg := '';
- ListView_files.Items.SubItems[1] := '↓正在下载...';
- DelFile(PUOUT^.TempFile);
- if not HttpDownLoad(PUOUT^.FromURL, PUOUT^.TempFile, ErrorMsg) then
- begin
- ListView_files.Items.SubItems[1] := '×' + ErrorMsg;
- if Q_PosStr('timed out.', ErrorMsg) <> 0 then
- begin
- MessShow(2, '连接自动更新服务器超时,无法完成更新!');
- m_BoStopDown := True;
- Exit;
- end;
- continue;
- end;
- if m_BoStopDown then
- begin
- ListView_files.Items.SubItems[1] := '♀更新被终止.'
- end
- else
- begin
- if Q_LowerCase(ExtractFileExt(PUOUT^.TempFile)) = '.zip' then
- begin
- //RAR压缩文件
- try
- Label4.Caption := '正在解压文件...';
- SelfFile := ExtractFileName(PUOUT^.TempFile);
- SelfFile := ChangeFileExt(SelfFile, '');
- SelfFile := FullPath + 'update\' + SelfFile;
- ProgressBarCount.Min := 0;
- ProgressBarCount.Max := 100;
- zpDir := FullPath + 'update';
- ZpName := PUOUT^.TempFile;
- if Zip(ZpName,zpDir) then
- begin
- ListView_files.Items.SubItems[1] := '√解压成功.';
- Label4.Caption := '正在复制文件...';
- if FileExists(SelfFile) then
- begin
- SetFileDateTime(SelfFile, fttLastWrite, PUOUT^.FileDateTime);
- DelFile(PUOUT^.ToPathFile); //删除目标文件
- CopyFile(PChar(SelfFile), PChar(PUOUT^.ToPathFile), False);
- DelFile(PUOUT^.TempFile); //删除update目录中的RAR文件
- DelFile(SelfFile); //删除update目录中解压出的文件
- Label4.Caption := '更新完成.';
- ListView_files.Items.SubItems[1] := '√更新完成.';
- end
- else
- begin
- ListView_files.Items.SubItems[1] := '×压缩文件内部文件名不正确.';
- end;
- end
- else
- begin
- ListView_files.Items.SubItems[1] := '×解压失败.';
- end;
- except
- on e: exception do
- begin
- ListView_files.Items.SubItems[1] := '×' + e.message;
- end;
- end;
- end
- else
- begin
- //非压缩文件
- try
- Label4.Caption := '正在复制文件...';
- if FileExists(PUOUT^.TempFile) then
- begin
- SetFileDateTime(PUOUT^.TempFile, fttLastWrite, PUOUT^.FileDateTime);
- DelFile(PUOUT^.ToPathFile); //删除目标文件
- CopyFile(PChar(PUOUT^.TempFile), PChar(PUOUT^.ToPathFile), False);
- DelFile(PUOUT^.TempFile); //删除update目录中的升级文件
- Label4.Caption := '更新完成.';
- ListView_files.Items.SubItems[1] := '√更新完成.';
- end
- else
- begin
- ListView_files.Items.SubItems[1] := '×下载文件意外丢失.';
- end;
- except
- on e: exception do
- begin
- ListView_files.Items.SubItems[1] := '×' + e.message;
- end;
- end;
- end;
- end;
- end;
- m_BoStopDown := True;
- end;
- procedure TForm_Update.Timer1Timer(Sender: TObject);
- begin
- Timer1.Enabled := False;
- ProgressBarCount.Max := 0;
- ProgressBarCount.Min := 0;
- StartUP();
- end;
- procedure TForm_Update.FormShow(Sender: TObject);
- begin
- Tuping := TList.Create;
- m_BoStopDown := False;
- //IsReStart := False;
- suiThemeManager1.FileTheme := Form1.suiFileTheme1;
- suiThemeManager1.UIStyle := Form1.suiThemeManager_form.UIStyle;
- Label1.Caption := '';
- Label4.Caption := '正在分析更新信息..';
- suiForm1.Caption := Mir3ServerName + '补丁自动更新...';
- ListView_files.Items.Clear;
- Timer1.Enabled := True;
- Timer2.Enabled := True;
- end;
- procedure TForm_Update.FormClose(Sender: TObject;
- var Action: TCloseAction);
- var
- i : Integer;
- begin
- try
- for i := 0 to Tuping.Count - 1 do
- begin
- Dispose(PTUpdateing(Tuping.Items));
- end;
- FreeAndNil(Tuping);
- // ClientSocket1.Active := False;
- ProgressBarCount.Position := 0;
- ListView_files.Items.Clear;
- except
- end;
- {finally
- if IsReStart then
- begin
- ShellExecute(Handle, 'open', PChar(FullPath + 'Mir3Up.exe'), PChar(ExtractFileName(ParamStr(0))), PChar(FullPath), SW_NORMAL);
- Application.Terminate;
- end
- else
- begin
- if (UpperCase(Runexe) <> AppFilseName) and FileExists(Runexe) then
- begin
- ShellExecute(Handle, 'open', PChar(FullPath + Runexe), nil, PChar(FullPath), SW_NORMAL);
- Application.Terminate;
- end;
- end;
- end; }
- end;
- procedure TForm_Update.Button2Click(Sender: TObject);
- begin
- m_BoStopDown := True;
- end;
- procedure TForm_Update.Timer2Timer(Sender: TObject);
- begin
- if m_BoStopDown then
- begin
- Timer2.Enabled := False;
- IdHTTP1.Disconnect;
- Close;
- end;
- end;
- procedure TForm_Update.IdHTTP1WorkBegin(ASender: TObject;
- AWorkMode: TWorkMode; AWorkCountMax: Int64);
- begin
- ProgressBarCount.Min := 0;
- ProgressBarCount.Position := 0;
- ProgressBarCount.Max := AWorkCountMax;
- sWorkCount := AWorkCountMax;
- end;
- procedure TForm_Update.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
- AWorkCount: Int64);
- begin
- if m_BoStopDown then IdHTTP1.Disconnect; //中断下载
- Application.ProcessMessages;
- Label4.Caption := '下载进度:' + Format('%d/%d', [AWorkCou[sale=200]1[/sale]nt, sWorkCount]);
- ProgressBarCount.Position := AWorkCount;
- end;
- end.
复制代码
|
上一篇:新1.4C登录器Delphi源码冷雨夜适配King1.4c插件下一篇:冷雨夜Ei3.0登录器源码Delphi全套+网关+反外挂插件
|