我试图检测ftp服务器何时关闭在应用程序中打开的连接。我正在使用WinInet功能。
我发现了一些使用InternetSetStatusCallback函数的示例。我实现了一个回调函数StatusCallback，并将其地址传递给了InternetSetStatusCallback的调用。 InternetSetStatusCallback给我返回类型为PFNInternetStatusCallback的状态。状态不是INTERNET_INVALID_STATUS_CALLBACK，表示我的函数StatusCallback被接受为回调函数，但从未调用该回调函数。我试图通过使服务器超时并手动关闭服务器来触发它。
我的Delphi代码如下。有人可以帮我吗？还是会以不正确的方式检测连接状态？
谢谢
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.
最佳答案
Read the documentation：
在lpfnInternetCallback中指定的回调函数
参数不会在...时被调用
InternetConnect的dwContext句柄设置为零
（INTERNET_NO_CALLBACK）。
您确实将dwContext的InternetConnect()参数设置为零。
关于delphi - Wininet InternetSetStatusCallback不起作用，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/12427247/