2

我试图检测 ftp 服务器何时关闭我在应用程序中打开的连接。我正在使用 WinInet 功能。

我找到了一些使用该InternetSetStatusCallback功能的示例。我实现了一个回调函数StatusCallback，并在调用中传递了它的地址InternetSetStatusCallback。InternetSetStatusCallback给我一个 type 的状态PFNInternetStatusCallback。状态不是INTERNET_INVALID_STATUS_CALLBACK，这意味着我的函数StatusCallback被接受为回调函数，但从未调用过回调函数。我试图通过让服务器超时连接并手动关闭服务器来触发它。

我的德尔福代码如下。有人可以帮我吗？或者这会以不正确的方式检测连接状态吗？

谢谢

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,
  WinInet,
  Winsock;

type
  TForm1 = class(TForm)
    lblConnected:   TLabel;
    Label2:         TLabel;
    tmrNOOP:        TTimer;
    btnConnect:     TButton;
    btnDisconnect:  TButton;
    Memo1:          TMemo;
    procedure btnConnectClick( Sender: TObject );
    procedure btnDisconnectClick( Sender: TObject );
    procedure SendNOOP( Sender: TObject );
  private
    FFtpRootHandle:     HINTERNET;
    FFtpSessionHandle:  HINTERNET;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{
  N.b. we DO need to define FtpCommand here as it has been defined incorrectly
  in WinInet.pas (missing last parameter)
}
function FtpCommand(
  hConnect:         HINTERNET;
  fExpectResponse:  BOOL;
  dwFlags:          DWORD;
  lpszCommand:      PChar;
  dwContext:        DWORD;
  out FtpCmd:       HINTERNET ): BOOL; stdcall; external 'wininet.dll' name 'FtpCommandA';

procedure StatusCallback(
  hInet:        HINTERNET;
  Context:      DWORD_PTR;
  Status:       DWORD;
  pInformation: Pointer;
  InfoLength:   DWORD ); stdcall;
var
  s: string;
begin
  case Status of
    INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
    INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ';
    INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address';
    INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
    INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
    INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
    INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
    INTERNET_STATUS_INTERMEDIATE_RESPONSE: s :=
      'Received an intermediate (100 level) status code message from the server';
    INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PChar(pInformation);
    INTERNET_STATUS_PREFETCH: s := 'Not implemented';
    INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request ';
    INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
      PChar(pInformation);
    INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
    INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' +
      IntToStr(Integer(pInformation)) + ' Byte';
    INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PChar(pInformation);
    INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' +
      IntToStr(Integer(pInformation)) + ' Byte';
    INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server.';
    INTERNET_STATUS_STATE_CHANGE:
      begin
        s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
        case DWORD(pInformation) of
          INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
          INTERNET_STATE_DISCONNECTED: s := s + #13#10 +
            'Disconnected state. No network connection could be established.';
          INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
          INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
          INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
        end;
      end;
  end;
  Writeln(s);
end;

procedure TForm1.btnConnectClick( Sender: TObject );
var
  flags:  Cardinal;
  Status: PFNInternetStatusCallback;
  I:      Integer;
begin
  FFtpRootHandle :=
    InternetOpen(
      Pchar( 'NOOP TESTER'),
      INTERNET_OPEN_TYPE_DIRECT,
      nil,
      nil,
      0 );

  if not Assigned( FFtpRootHandle ) then
  begin
    RaiseLastOSError();
    Exit;
  end;

  flags := INTERNET_FLAG_PASSIVE or INTERNET_FLAG_NO_UI;
  FFtpSessionHandle :=
    InternetConnect(
      FFtpRootHandle,
      PAnsiChar( '127.0.0.1' ),
      Word( 21 ),
      PAnsiChar( 'x11' ),
      PAnsiChar( 'x11' ),
      INTERNET_SERVICE_FTP,
      Flags,
      INTERNET_FLAG_ASYNC );

  Status := InternetSetStatusCallback( FFtpSessionHandle,       INTERNET_STATUS_CALLBACK(@StatusCallback) );
if NativeInt( Status ) = INTERNET_INVALID_STATUS_CALLBACK then
  raise Exception.Create( 'Callback function is not valid' );

if not Assigned( FFtpSessionHandle ) then
begin
    InternetCloseHandle( FFtpRootHandle );
    RaiseLastOSError();
    Exit;
  end;
  lblConnected.Color := clGreen;
  btnConnect.Enabled := false;
  tmrNOOP.Interval := 10000;
  tmrNOOP.Enabled := true;
end;

procedure TForm1.btnDisconnectClick( Sender: TObject );
begin
  tmrNOOP.Enabled := false;
  if Assigned( FFtpSessionHandle ) then
  begin
    InternetCloseHandle( FFtpSessionHandle );
    if Assigned( FFtpRootHandle ) then
    begin
      InternetCloseHandle( FFtpRootHandle );
    end;
  end;
  lblConnected.Color := clRed;
  btnConnect.Enabled := true;
end;

procedure TForm1.SendNOOP( Sender: TObject );
var
  NOOPSuccess:  Boolean;
  FtpCmd:       HINTERNET;
begin
  NOOPSuccess :=
    FtpCommand(
      FFtpSessionHandle,
      false,
      FTP_TRANSFER_TYPE_BINARY,
      PAnsiChar( 'noop' ),
      0,
      FtpCmd );
  if NOOPSuccess then
  begin

  end;
end;

end.
4

1 回答 1

0

阅读文档：

当 InternetConnect 的 dwContext 句柄设置为零 (INTERNET_NO_CALLBACK) 时，将不会调用 lpfnInternetCallback 参数中指定的回调函数...连接句柄。

您确实将dwContext参数设置InternetConnect()为零。

于 2012-09-14T23:38:56.930 回答