delphi - Wininet InternetSetStatusCallback 不起作用

Question

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

我发现了一些使用 InternetSetStatusCallback 函数的示例。我实现了一个回调函数 StatusCallback 并将其地址传递给 InternetSetStatusCallback。 InternetSetStatusCallback 给我返回 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.

Answer 1

Read the documentation :

The callback function specified in the lpfnInternetCallback parameter will not be called on ... the connection handle when the dwContext handle of InternetConnect is set to zero (INTERNET_NO_CALLBACK).

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