0

I have a program created in Delphi 7 that uses ftp downloading. How can i insert into that program to check for a server status? For example if server is online to produce a green image, if server is offline o produce a red image. Here is the code.

    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.
Arioch 'The
  • 15,799
  • 35
  • 62
user3211668
  • 53
  • 1
  • 3
  • 14
  • Do you want to know if the ftp service is running or if the server is still online? – Hidden Jan 31 '14 at 10:58
  • to see if server (any server) is online,by checking his ip – user3211668 Jan 31 '14 at 11:56
  • @user3211668 usually it is done by ICMP protocol commands like ping or traceroute/tracert. Dunno about tracert, but there is a lot components for pinging. However, firewall or network setup might make ping showing different result than real ftp connection. OTOH those are rather exceptinal cases and usuallt the `ping` is a dumb tool that "just works" – Arioch 'The Jan 31 '14 at 12:36
  • possible duplicate of [Delphi Indy Ping Error 10040](http://stackoverflow.com/questions/12723081/delphi-indy-ping-error-10040) – Arioch 'The Jan 31 '14 at 12:38
  • Also if Indy 10 is compilable with D7 then http://stackoverflow.com/questions/12858551 – Arioch 'The Jan 31 '14 at 12:38
  • @Arioch, how this question can be a duplicate of the one you linked ? [`This one maybe`](http://stackoverflow.com/q/21475507/960757). – TLama Jan 31 '14 at 13:14
  • @tlama do you found even better code sample, good – Arioch 'The Jan 31 '14 at 13:27
  • @Arioch, what ? I'm asking you why do you think it's a duplicate of that question. It is not. Ping the server is not enough if you voted to close it because you think there's a solution in that question. Didn't you want to close [`this question`](http://stackoverflow.com/q/21475507/960757) instead ? – TLama Jan 31 '14 at 13:31
  • guys i need something like what online games have. when u go to their website and see ''Server Status: ONLINE'' or Server Status:OFFLINE'', except that i need that inside my program. – user3211668 Jan 31 '14 at 13:34
  • @TLama "that checks if a computer is alive" - the server is computer too. That topis sets the same goal and finds a "good enough" solution. Ping is not a reliable solution, but designing a reliable way would turn into a large discussion about modificating and controlling servers, etc. – Arioch 'The Jan 31 '14 at 13:41
  • @user3211668 then aactualyl making connection to the server is what you need to try, maybe in muktithreading way. Usually, 90-99% times ping would be faster and would give correct results to you. But not always though. Think how accurate your results should be. – Arioch 'The Jan 31 '14 at 13:42
  • @Arioch, no, it wouldn't. The only reliable way is attempt to connect to the FTP server itself. That you are able to ping a machine doesn't mean that there is a running FTP server nor that you're able to connect to it. Well, now back to my question. Why have you voted to close this question as a duplicate with totally different question ? Saying you did it by mistake is also answer... – TLama Jan 31 '14 at 13:48
  • @Close voters, **it is not a duplicate of the question linked by Arioch 'The at all**. He might wanted to close [`this question`](http://stackoverflow.com/q/21475507/960757) instead. – TLama Jan 31 '14 at 14:01
  • @TLama we don't know why they are vote until two votes more. But it would no be anything unusual if they vote for different reasons. – Arioch 'The Jan 31 '14 at 15:21
  • "doesn't mean that there is a running FTP server" that was what the 1st coment was about. And the topicstarter said he want to know if the ocmputer is online, rather than FTP service is active. This is not very different from "that checks if a computer is alive". BTW, "attempt to connect to the FTP server itself" while i mentioned it twice above, is not a reliable answer for neither TS's "is server online" nor your "there is a running FTP server". And if you want to add a lot of nines to 90%, then that difference would become valid. But not as long as we consider ping practically enough – Arioch 'The Jan 31 '14 at 15:26
  • @Arioch'The The other two close votes were both to close as a dupe of the question you linked to. But I just cast the third Leave Open vote, so it's out of the Close queue now. I don't agree that it's a dupe, because there's a difference between "How do I do X?" and "I'm trying to accomplish X in a specific way and it doesn't work. What's wrong with my code?" – Adi Inbar Jan 31 '14 at 15:36

1 Answers1

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}
RobertFrank
  • 7,332
  • 11
  • 53
  • 99
  • `[dcc32 Error] Test1.pas(629): E2197 Constant object cannot be passed as var parameter` Would you please edit the answer and add an example on button click the usage of the function above ? – Bianca Nov 25 '14 at 15:10
  • Bianca: My apologies. I don't mean to be rude or unwelcoming. But, I am sorry: what you're asking is really for me to tutor you on the some basic of Delphi capability. Generally, you'll find that here on Stack Overflow, it is expected that participants have a certain level of expertise so that they can use an answer like the one above. If you're unfamiliar with how to create and use a button or fix a compiler syntactical error, you'll need to learn how to figure out how to do that on your own. – RobertFrank Dec 14 '14 at 15:40