Delphi 7 - 检查服务器是否在线

时间：2014-01-31 10:55:21

标签： delphi delphi-7 status remote-server

我在Delphi 7中创建了一个使用ftp下载的程序。 如何插入该程序以检查服务器状态？ 例如，如果服务器在线以生成绿色图像，则如果服务器处于脱机状态，则会生成红色图像。这是代码。

    unit Download;

interface

uses
  Classes, Wininet, Windows, SysUtils, Dialogs, Forms;

type
  GFilesThread = class(TThread)
  private
    LTemp : Longword;             
    STemp : string;              
    FilesToGet : TStringList;     
    FilesSize : Longword;         
    CBackup : integer;            
    CRevision : integer;          
    CForceCheck : boolean;        
    CSwitch : integer;            
    UUrl : string;                
    USelfParam : string;          
    Dir: string;                  
    FSource: TStream;             
  protected
    procedure Execute; override;
    procedure UpdateFileProgress;
    procedure SetFileProgressMax;
    procedure UpdateStatusLabel;
    procedure UpdateFileDecompStat;
    procedure UpdateFilesProgress;
    procedure CheckFiles(FList : TStringList);
    procedure BZProgress(Sender: TObject);
    procedure LockFMain;
    procedure UNLockFMain;
    procedure GetFiles;
    procedure SelfUpdate(SelfVal : string);
    procedure UpdateRevision;
    procedure ModHosts(Lines : TStringList);
    procedure DoUncompressStream(ASource, ADest: TStream);
    procedure DoUncompress(const ASource, ADest: TFileName);
    function HTTPGetFile(const fileURL, FileName: string; sh_progress: boolean): boolean;
  public
    property CreateBackup : integer write CBackup;
    property UpdatesUrl : string write UUrl;
    property LocalRevision : integer write CRevision;
    property ForceCheck : boolean write CForceCheck;
  end;

implementation
uses Launcher, CheckFiles, BZip2, md5, FileList;

// -------- by 667

procedure GFilesThread.UpdateStatusLabel;
begin
  FMain.Label3.Caption:=STemp;
end;

procedure GFilesThread.SetFileProgressMax;
begin
  if(CSwitch=0) then
    FMain.Gauge1.MaxValue:=LTemp;
  if(CSwitch=1) then
    FMain.Gauge2.MaxValue:=LTemp;
end;

procedure GFilesThread.UpdateFileProgress;
begin
  FMain.Gauge1.Progress:=LTemp;
end;

procedure GFilesThread.UpdateFilesProgress;
begin
  FMain.Gauge2.Progress:=LTemp;
end;

procedure GFilesThread.UpdateRevision;
begin
  FMain.UpdateRevision(IntToStr(CRevision));
end;

procedure GFilesThread.UpdateFileDecompStat;
begin
  FMain.Gauge1.Progress:=LTemp;
end;

procedure GFilesThread.BZProgress(Sender: TObject);
begin
  LTemp:=FSource.Position;
  Synchronize(UpdateFileDecompStat);
end;

procedure GFilesThread.LockFMain;
begin
  Fmain.ImgBtn1.Visible:=False;
  Fmain.ImgBtn2.Visible:=False;
  Fmain.ImgBtn5.Enabled:=False;
end;

procedure GFilesThread.UNLockFMain;
begin
  Fmain.ImgBtn1.Visible:=True;
  Fmain.ImgBtn2.Visible:=True;
  Fmain.ImgBtn5.Enabled:=True;
end;

// ---------  by 667

function GFilesThread.HTTPGetFile(const fileURL, FileName: string; sh_progress: boolean): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: Longword;
  f: file;
  sAppName: string;
begin
  Result := False;
  sAppName := 'L2ClientUpdater';
  LTemp:=0;
  hSession := InternetOpen(PChar(sAppName),
  INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
    if (hURL <> nil) then  begin
    try
      DeleteUrlCacheEntry(PChar(fileURL));
      AssignFile(f, FileName);
      Rewrite(f,1);
      repeat
        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen);
        if (sh_progress) then
        begin
          LTemp:=LTemp+BufferLen;
          Synchronize(UpdateFileProgress);
        end;
      until
        BufferLen = 0;
      CloseFile(f);
      Result := True;
    finally
      InternetCloseHandle(hURL);
    end;
  end;
  finally
    InternetCloseHandle(hSession);
  end;
  LTemp:=0;
  Synchronize(UpdateFileProgress);
end;

procedure GFilesThread.DoUncompress(const ASource, ADest: TFileName);
var
  Source, Dest: TStream;
begin
  Source := TFileStream.Create(ASource, fmOpenRead + fmShareDenyWrite);
  try
    Dest := TFileStream.Create(ADest, fmCreate);
    try
      DoUncompressStream(Source, Dest);
    finally
      Dest.Free;
    end;
  finally
    Source.Free;
    DeleteFile(ASource);
  end;
end;

procedure GFilesThread.DoUncompressStream(ASource, ADest: TStream);
const
  BufferSize = 65536;
var
  Count: Integer;
  Decomp: TBZDecompressionStream;
  Buffer: array[0..BufferSize - 1] of Byte;
begin
  FSource := ASource;
  LTemp:=FSource.Size;
  CSwitch:=0;
  Synchronize(SetFileProgressMax);
  Decomp := TBZDecompressionStream.Create(ASource);
  try
    Decomp.OnProgress := BZProgress;
    while True do
    begin
      Count := Decomp.Read(Buffer, BufferSize);
      if Count <> 0 then ADest.WriteBuffer(Buffer, Count) else Break;
    end;
  finally
    Decomp.Free;
    FSource := nil;
    LTemp:=0;
    Synchronize(UpdateFileDecompStat);
  end;
end;


procedure GFilesThread.CheckFiles(FList : TStringList);
var
  i: integer;
  FParam: TStringList;
  FNameLocal: string;
begin
  if(FList.Count>0) and (FList[0]<>'FAIL') and (not terminated) then
  begin
    STemp:='Checking files';
    Synchronize(UpdateStatusLabel);
    CSwitch:=1;
    LTemp:=FList.Count-1;
    Synchronize(SetFileProgressMax);
    FParam:=TStringList.Create;
    for i:=0 to FList.Count-1 do
    begin
      LTemp:=i;
      Synchronize(UpdateFilesProgress);
      FParam:=Tokenize(FList[i],'|');
      FNameLocal:=Dir+FParam[2];
      STemp:='Checking '+FParam[2];
      Synchronize(UpdateStatusLabel);
      if (not FileExists(FNameLocal)) then
      begin
        FilesToGet.Add(FList[i]);
        FilesSize:=FilesSize+StrToInt(FParam[0]);
      end
      else
      begin
        if (MD5Print(MD5File(FNameLocal))<>FParam[1]) then
        begin
          FilesToGet.Add(FList[i]);
          FilesSize:=FilesSize+StrToInt(FParam[0]);
        end;
      end;
    end;
    FParam.Free;
    LTemp:=0;
    Synchronize(UpdateFilesProgress);
    STemp:='';
    Synchronize(UpdateStatusLabel);
  end;
end;

procedure GFilesThread.SelfUpdate(SelfVal : string);
var
  FParam: TStringList;
  FNameLocal: string;
  F:boolean;
begin
  if(SelfVal<>'') then
  begin
    FParam:=TStringList.Create;
    FParam:=Tokenize(SelfVal,'|');
      FNameLocal:=Dir+FParam[2];
      if (MD5Print(MD5File(FNameLocal))<>FParam[1]) then
      begin
        FilesSize:=FilesSize+StrToInt(FParam[0]);
        F:=HTTPGetFile(UUrl+FParam[2]+'.bz2',FNameLocal+'.bz2',True);
        if(F) then begin
          try
           DoUncompress(FNameLocal+'.bz2',Dir+FParam[2]+'.New');
           GenKillerBat(FParam[2]);
           RunApp(Dir+'Update.bat');
          except
            STemp:='Update Failed';
            DeleteFile(FNameLocal);
          end;
        end;
      end;
    FParam.Free;
  end;
end;

procedure GFilesThread.ModHosts(Lines : TStringList);
var
 Hosts : textfile;
 H, HostsStrings, HostLineParam : TStringList;
 HostsPath, temp : string;
 i, z, funnyFlag : integer;
 WindirP : PChar;
 Res : cardinal;
begin
  WinDirP := StrAlloc(MAX_PATH);
  Res := GetWindowsDirectory(WinDirP, MAX_PATH);
  if Res > 0 then
  begin
    if(FileExists(StrPas(WinDirP)+'\system32\drivers\etc\hosts.msn')) then
      HostsPath := StrPas(WinDirP)+'\system32\drivers\etc\hosts.msn'
    else
      HostsPath := StrPas(WinDirP)+'\system32\drivers\etc\hosts';
    AssignFile(Hosts,HostsPath);
    Reset(Hosts);
    HostsStrings:= TStringList.Create;
    H:= TStringList.Create;
    H.Add('#-------- Added by L2Updater --------');
    while (not Eof(Hosts)) do
    begin
      ReadLn(Hosts, temp);
      HostsStrings.Add(Trim(temp));
    end ;
    Reset(Hosts);
    for i:=0 to Lines.Count-1 do
    begin
      funnyFlag:=0;
      HostLineParam:=Tokenize(Lines[i],'|');
      for z:=0 to HostsStrings.Count-1 do
      begin
       if (StrSearch(1,HostsStrings[z],HostLineParam[0])>0) and (HostsStrings[z][1]<>'#') then
       begin
          if (StrSearch(1,HostsStrings[z],HostLineParam[1]+#9)= 0) and (StrSearch(1,HostsStrings[z],HostLineParam[1]+' ')= 0 ) then
          begin
           HostsStrings[z]:= '#'+HostsStrings[z];
           funnyFlag:=1;
          end
          else funnyFlag:=2;
       end;
      end;
      if (funnyFlag=1) or (funnyFlag=0)  then
        H.Add(HostLineParam[1]+#9+HostLineParam[0]);
    end;
    H.Add('#-----------------');
    if H.Count>2 then
    begin
      Rewrite(Hosts);
      STemp:='Applying changes to Hosts';
      Synchronize(UpdateStatusLabel);
      for i:=0 to HostsStrings.Count-1 do
      begin
        WriteLn(Hosts,HostsStrings[i]);
      end;

      for i:=0 to H.Count-1 do
      begin
       WriteLn(Hosts,H[i]);
      end;
      STemp:='Hosts file chamged';
      Synchronize(UpdateStatusLabel);
    end;
      H.Free; HostsStrings.Free; HostLineParam.Free;
  CloseFile(Hosts);
  end;
end;

procedure GFilesThread.GetFiles;
var
  FParam : TStringList;
  i : integer;
  F,  error : boolean;
  LocalFile, BakFile: string;
begin
  error := False;
  if (FilesToGet.Count>0) then
  begin
    FParam:=TStringList.Create;
    LTemp:=FilesToGet.Count-1;
    CSwitch:=1;
    Synchronize(SetFileProgressMax);
    i:=0;
    while (i < FilesToGet.Count) and (not terminated) do
    begin

      FParam:=Tokenize(FilesToGet[i],'|');
      LocalFile:= Dir+FParam[2];
      STemp:='Downloading '+ FParam[2];
      Synchronize(UpdateStatusLabel);


      CSwitch:=0;
      LTemp:= StrToInt(FParam[0]);
      Synchronize(SetFileProgressMax);

      if (not DirectoryExists(ExtractFilePath(LocalFile))) then
        ForceDirectories(ExtractFilePath(LocalFile));
      F:=HTTPGetFile(UUrl+ReplaceStr(FParam[2],'\','/')+'.bz2',LocalFile+'.bz2',True);
      if (F) then
      begin
        try
          if (CBackup=1) then
          begin
            BakFile:=Dir+'backup\'+FParam[2];
            if (not DirectoryExists(ExtractFilePath(BakFile))) then
              ForceDirectories(ExtractFilePath(BakFile));
            CopyFile(PChar(LocalFile),PChar(BakFile),false);
          end;
          STemp:='Extracting '+ FParam[2];
          Synchronize(UpdateStatusLabel);
          DoUncompress(LocalFile+'.bz2',Dir+FParam[2]);
        except
          STemp:='Update Failed';
          error := True;
        end;
      end
      else
      begin
        STemp:='Update Failed';
        error := True;
        Break;
      end;
    inc(i);
    LTemp:=i;
    CSwitch:=1;
    Synchronize(UpdateFilesProgress);
  end;
  LTemp:=0;
  Synchronize(UpdateFilesProgress);
  FParam.Free;
  if (not error) then
    STemp:='All files have been updated.';
  end
  else STemp:='';
end;

procedure GFilesThread.Execute;
var
  List: TListFile;
  CFiles, NFiles, HostsLines : TStringList;
  TRev, IsModHosts : integer;
  F : boolean;
begin
  Dir:=GetCurrentDir+'\';
  FilesSize:=0;
  Synchronize(LockFMain);
  STemp:='Downloading updates list';
  Synchronize(UpdateStatusLabel);
  if(UUrl[length(UUrl)]<>'/') then UUrl:=UUrl+'/';
  F:=HTTPGetFile(UUrl+'files.lst.bz2',Dir+'files.lst.bz2', True);
  if (F) then
  begin
    STemp:='';
    Synchronize(UpdateStatusLabel);
    try
      DoUncompress(Dir+'files.lst.bz2',Dir+'files.lst');
    except
      STemp:='Update Failed';
      Synchronize(UpdateStatusLabel);
      DeleteFile(Dir+'files.lst');
    end;
    if(FileExists(Dir+'files.lst')) then
    begin
      FilesToGet := TStringList.Create;
      List := TListFile.Create(Dir+'files.lst');
      CFiles:=TStringList.Create;
      TRev:=StrToInt(List.GetKeyValue('settings','Rev'));
      IsModHosts:=StrToInt(List.GetKeyValue('settings','ModHosts'));
      if (IsModHosts = 1) then
      begin
        HostsLines:= TStringList.Create;
        HostsLines:= List.GetFSection('hosts');
        try
          ModHosts(HostsLines);
        finally
          HostsLines.Free;
        end;
      end;
      USelfParam:= List.GetFSection('self')[0];
      if(USelfParam<>'FAIL') then SelfUpdate(USelfParam);
      CFiles:=List.GetFSection('files_critical');
      CheckFiles(CFiles); 
      CFiles.Free;
      if (CForceCheck) or (TRev>CRevision) then 
      begin
        if (CBackup=1) then
        begin
          DelDir(Dir+'backup');
          MkDir(Dir+'backup');
        end;
        NFiles:=TStringList.Create;
        NFiles:=List.GetFSection('files_normal');
        CheckFiles(NFiles);
        NFiles.Free;
      end;
      GetFiles;
      List.Destroy;
      FilesToGet.Free;
      DeleteFile(Dir+'files.lst');
      if TRev>CRevision then
      begin
        CRevision:=TRev;
        Synchronize(UpdateRevision);
      end;
    end;
  end
  else
  begin
    STemp:='Update Failed';
    DeleteFile(Dir+'files.lst');
  end;
  Synchronize(UpdateStatusLabel);
  Synchronize(UNLockFMain);
end;

end.

1 个答案:

答案 0 :(得分：1)

function CanConnect(const aUserName, aPassword, aHost: String; out aErrm: string): boolean;
var
  LocalIDFTP: TIdFTP;
begin
  aErrm := '';
  LocalIDFTP := TIdFTP.Create(nil);
  try
    LocalIDFTP.UserName := aUserName;
    LocalIDFTP.Password := aPassword;
    LocalIDFTP.Host     := aHost;
    LocalIDFTP.Passive  := True;
    try
      LocalIDFTP.Connect;
      LocalIDFTP.Quit;
      result := true;
    except
    on E: Exception do
      begin
        aErrm := 'Unable to connect to FTP site: ' +  E.Message;
        Result := FALSE;
      end;
    end;
  finally
    if Assigned(LocalIDFTP) then
      LocalIDFTP.Free
    else
      Result := FALSE;
  end;
end; {CanConnect}
相关问题
最新问题