Новая Функция На Подключение К Интернету Delphi

[Lomanu4]

uses
wininet

//potok
Type
VKThread=class(TThread)
  private
   logVK:string;
   i:integer;
  protected
   procedure Execute;override;
   procedure ShowResult;
end;

function IsConnectedToInternet: Boolean;
var
dwConnectionTypes: DWORD;
begin
dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);


procedure potok.Execute;
   var
    connection:DWORD;

begin
  inherited;
  try
    if InternetGetConnectedState(@connection,0)=false then
    begin
      ShowMessage('Подключитесь к интернету');
      exit;

    end;
     //Ваше тело потока
  finally
уберем за собой
  end;

procedure TForm6.Button1Click(Sender: TObject);
var
VK:VKThread;
begin
   VK:=VKThread.Create(False);
end;

procedure TForm6.FormCreate(Sender: TObject);
begin
    if IsConnectedToInternet then

ShowMessage('Connected')
else
ShowMessage('Not Connected.')
end;

 

[Sascha]

Функция не работает правильно так как он проверяет не интернет а состояния сети, я уже писал вроде функцию которая реально работает, напишу еще разHey

unit ArhInetCheckUnit;
interface

uses
{$IFDEF VER260}System.Classes{$ELSE}Classes{$ENDIF},
  httpsend;

type
  TResultNotify = procedure(Sender: TObject; var aResult: Boolean) of object;
  TArhInetCheckThread = class(TThread)
  private
    fURL: string;
    fResult: Boolean;
    fNotify: TResultNotify;
    fHTTP: THTTPSend;
    procedure SetNotify;
  protected
    procedure Execute; override;
  public
    property OnResult: TResultNotify read fNotify write fNotify;
    constructor Create(const aURL: string = 'http://google.ru/'); overload;
    destructor Destroy; override;
  end;

implementation

{ TArhInetCheckThread }

constructor TArhInetCheckThread.Create(const aURL: string);
begin
  inherited Create(True); //SUSPENDED MODE
  fHTTP := THTTPSend.Create;
  fHTTP.UserAgent :=
    'Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.10.289 Version/12.00';
  fURL := aURL;
end;

destructor TArhInetCheckThread.Destroy;
begin
  fHTTP.Free;
  inherited;
end;

procedure TArhInetCheckThread.Execute;
begin
  NameThreadForDebugging('ArhInetCheckThread');
  inherited FreeOnTerminate := True;
  fResult := fHTTP.HTTPMethod('HEAD', fURL);
  Synchronize(SetNotify);
end;

procedure TArhInetCheckThread.SetNotify;
begin
  if Assigned(fNotify) then
    fNotify(self, fResult);
end;

end.

uses  ArhInetCheckUnit;
procedure TForm1.FormShow(Sender: TObject);
var
  Thr: TArhInetCheckThread;
begin
  Thr := TArhInetCheckThread.Create; // в Create можно передать любую ссылку
  Thr.OnResult := thrOnResult;
  Thr.Resume;
  // В позних версиях delphi(delphi 2010+) используйте TThread.start;
  { Поток сам уничтожит себя, благодаря FreeOnTernimate = True
    в перегруженном конструкторе }
end;

procedure TForm1.thrOnResult(Sender: TObject; var aResult: Boolean);
begin
  if aResult then
begin
ShowMessage('Connected')
else
ShowMessage('Not Connected.')
end;
end;

 

[Lomanu4]

Я забыл добавить что он поверфет сеть на телефоне.

 

[Mazahaka_lab]

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

Thr.OnResult := thrOnResult;

[dcc32 Error] Unit2.pas(30): E2003 Undeclared identifier: 'thrOnResult'

 

[Lomanu4]

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

Thr.OnResult := thrOnResult;

[dcc32 Error] Unit2.pas(30): E2003 Undeclared identifier: 'thrOnResult'

Ошибки ?

 

[Mazahaka_lab]

Ошибки ?

я разве не видно по моему сообщению?

 

[Lomanu4]

Какая версия стоит ?
Там написана инструкция вкоде.

 

[Sascha]

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

Вот готовый проект, всё работает.

 

[Mazahaka_lab]

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

Вот готовый проект, всё работает.

Пример работает . Потому что указано

  public
  procedure thrOnResult(Sender: TObject; var aResult: Boolean);
    { Public declarations }

Ну а в вашем уроке вы забыли про это .

Спасибо за пример . Сохраню себе

 

[Sascha]

Пример работает . Потому что указано

  public
  procedure thrOnResult(Sender: TObject; var aResult: Boolean);
    { Public declarations }

Ну а в вашем уроке вы забыли про это .

Спасибо за пример . Сохраню себе

Я не приводил полный код ,ето были только примеры кода .