开发者

How do you quickly check if a network location exists using Delphi 5? [duplicate]

This question already has answers here: Closed 13 years ago.

Possible Duplicates:

Speed up File.Exists for non existing network开发者_如何学JAVA shares

Faster DirectoryExists function?

We need to write text to a file on our network, but there may be a situation where that location does not exist and we need to write to another location instead. How do you check quickly that a network location exists? Attempting to write text to a location that does not exist using a 'try...except' takes a whopping 30 seconds(ish). There must be a faster way, surely?

I'd be very grateful if someone could give me some pointers please.

Thanks!


For those of you interested in the answer for a Delphi context, I used the Indy component IdIcmpClient component to ping the IP, as follows:

  IdIcmpClient1.Host:= '10.0.0.999';
  try
    IdIcmpClient1.Ping();
  except
    showmessage('Not found');
  end;

You get a result in just over 3 seconds if it is not there, or almost instantly if it is.


Use FileExists. In Delphi 5, FileExists is built-in (in the SysUtils library)

I'm unsure if there's any way to "quickly" do it. If you notice the time windows take to resolve a network location, through Samba, when it doesn't exists, it takes about your 30 seconds. It has probably something to do with the internal timeout of the windows API for samba calls (just guessing).


I ping the location:

Usage:

bPingSuccess := Ping(szServer, 5000);

unit uPing;

interface

uses
  Windows,
  SysUtils,
  Classes;

type
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;
  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

  IPAddr = TIPAddr;

  TIcmpCreateFile = function(): THandle; stdcall;
  TIcmpCloseHandle = function(icmpHandle: THandle): boolean; stdcall;
  TIcmpSendEcho = function(IcmpHandle: THandle; DestinationAddress: IPAddr; RequestData:
    Pointer; RequestSize: smallint; RequestOptions: pointer; ReplyBuffer: Pointer;
    ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;

const
  IcmpCreateFile: TIcmpCreateFile = nil;
  IcmpCloseHandle: TIcmpCloseHandle = nil;
  IcmpSendEcho: TIcmpSendEcho = nil;

function Ping(InetAddress: string; iTimeout: cardinal): boolean;

implementation

uses
  WinSock;

function Fetch(var AInput: string; const ADelim: string = ' ';
  const ADelete: boolean = True): string;
var
  iPos: integer;
begin
  if ADelim = #0 then
  begin
    // AnsiPos does not work with #0
    iPos := Pos(ADelim, AInput);
  end
  else
  begin
    iPos := Pos(ADelim, AInput);
  end;
  if iPos = 0 then
  begin
    Result := AInput;
    if ADelete then
    begin
      AInput := '';
    end;
  end
  else
  begin
    Result := Copy(AInput, 1, iPos - 1);
    if ADelete then
    begin
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
    end;
  end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
  phe: PHostEnt;
  pac: PChar;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  try
    phe := GetHostByName(PChar(AIP));
    if Assigned(phe) then
    begin
      pac := phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        with TIPAddr(AInAddr).S_un_b do
        begin
          s_b1 := byte(pac[0]);
          s_b2 := byte(pac[1]);
          s_b3 := byte(pac[2]);
          s_b4 := byte(pac[3]);
        end;
      end
      else
      begin
        raise Exception.Create('Error getting IP from HostName');
      end;
    end
    else
    begin
      raise Exception.Create('Error getting HostName');
    end;
  except
    FillChar(AInAddr, SizeOf(AInAddr), #0);
  end;
  WSACleanup;
end;

function Ping(InetAddress: string; iTimeout: cardinal): boolean;
var
  hIcmpDll: HMODULE;
  hIcmpFile: THandle;
  InAddr: IPAddr;
  DW: DWORD;
  rep: array[1..128] of byte;
begin
  Result := False;
  { load a library }
  hIcmpDll := LoadLibrary('icmp.dll');

  if (hIcmpDll = 0) then
  begin
    raise Exception.Create('icmp.dll library can not be loaded or not found. ' +
      SysErrorMessage(GetLastError));
  end;

  try
    { load an address of required procedure}
    @IcmpCreateFile := GetProcAddress(hIcmpDll, 'IcmpCreateFile');
    @IcmpSendEcho := GetProcAddress(hIcmpDll, 'IcmpSendEcho');
    @IcmpCloseHandle := GetProcAddress(hIcmpDll, 'IcmpCloseHandle');

    {if procedure is found in the dll}
    if Assigned(IcmpCreateFile) and Assigned(IcmpSendEcho) and Assigned(IcmpCloseHandle)
      then
    begin
      hIcmpFile := IcmpCreateFile;
      try
        if hIcmpFile = INVALID_HANDLE_VALUE then
          Exit;
        TranslateStringToTInAddr(InetAddress, InAddr);
        DW := IcmpSendEcho(hIcmpFile, InAddr, nil, 0, nil, @rep, 128, iTimeout); //0);
        Result := (DW <> 0);
      finally
        IcmpCloseHandle(hIcmpFile);
      end;
    end;
  finally
    {unload a library}
    FreeLibrary(hIcmpDll);
  end;

end;

end.
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜