Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyThread = class(TThread)
  private
    FStr : String;
    fHost : String;
    FPort:Word;
    FUser,FPassword:String;
    { Private declarations }
  protected
    procedure ShowLog(const aStr:String);
    procedure DoShowLog;
    procedure OnTheradTerminate(Sender: TObject);
    constructor Create(aHost:String;aPort:Word;aUser,aPassword:String);
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create(aHost: String; aPort: Word; aUser,
  aPassword: String);
begin
  inherited Create(True);
  OnTerminate := OnTheradTerminate;
  fHost     := aHost;
  FPort     := aPort;
  FUser     := auser;
  FPassword := aPassword;
end;


procedure TMyThread.DoShowLog;
begin
  Form1.Memo1.Lines.Add(fStr)
end;

function FtpChk(strHost, strUser, strPwd: string;Port: Integer; var errStr:String): Boolean;
var
  hNet, hFTP: HINTERNET;
  e,i:cardinal;
  buf:Array[1..1024] of Char;
begin
  Result := True;
  { Open an internet session }
  hNet := InternetOpen('MSIE 6.0', // Agent
                        INTERNET_OPEN_TYPE_PRECONFIG, // AccessType  INTERNET_OPEN_TYPE_DIRECT /INTERNET_OPEN_TYPE_PRECONFIG
                        nil,  // ProxyName
                        nil, // ProxyBypass
                        0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE
  if hNet = nil then
  begin
    errStr := 'Unable to get access to WinInet.Dll - '+SysErrorMessage(GetLastError);
    Result:= False;
    Exit;
  end;
  { Connect to the FTP Server }
  hFTP := InternetConnect(hNet, // Handle from InternetOpen
                          PChar(strHost), // FTP server
                          port, // (INTERNET_DEFAULT_FTP_PORT),
                          PChar(StrUser), // username
                          PChar(strPwd),  // password
                          INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
                          0, // flag: 0 or INTERNET_FLAG_PASSIVE
                          0);// User defined number for callback
  if hFTP = nil then
  begin
    errStr := SysErrorMessage(GetLastError);
    i := SizeOf(buf);
    if InternetGetLastResponseInfo(e, @buf[1], i) then
      errStr := errStr+' - #'+IntToStr(e)+' - '+buf;
    Result:= False;
    InternetCloseHandle(hNet);
    Exit;
  end;
  InternetCloseHandle(hFTP);
  InternetCloseHandle(hNet);
end;

procedure TMyThread.Execute;
var er:String;
begin
  while Not terminated do
    if FtpChk(fHost, fuser, fPassword, fport, er) then
      ShowLog('OK')
    else
    ShowLog('False - '+er)
end;

procedure TMyThread.OnTheradTerminate(Sender: TObject);
begin
  if FatalException<>nil then
    Application.ShowException(Exception(FatalException));
  ShowMessage('поток завершен');
end;

procedure TMyThread.ShowLog(const aStr: String);
begin
  fStr := aStr;
  Synchronize(DoShowLog);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  with TMyThread.Create(edit1.text, Strtoint(edit2.text), edit3.text, edit4.text) do
    Resume;
end;

end.