Подключиться к Интернету, определить активные соединения, определить и сохранить параметры соединения

как из Вашей программы подключиться к Интернету, определить активные соединения, определить и сохранить параметры соединения. Все эти функции находятся в rasapi32.dll. Описания этих функций для Delphi есть в модуле res.pas. Его можно скачать на сайте program.dax.ru (14 Кбайт).
Эта программа заполняет ListBox1 всеми соединениями, ListView1 - всеми активными соединениями. При двойном щелчке по соединению в Edit1 и Edi2 кладутся имя пользователя и пароль (если он сохранен). Кнопка "Dial Up" устанавливает соединение, "Save" сохраняет имя пользователя и пароль. "Hang Up" разрывает соединение. "Update Entries" и "Udate Conns" обновляют информацию о соединениях. В том случае, если связь разорвалась сама, для установления соединения необходимо сначала нажать "Hang Up".
Скачать необходимые для компиляции файлы проекта можно на program.dax.ru. Доступны проекты для Delphi3 и для Delphi5.
uses Ras;
var
 CurrentState: string = ;
{ Эта функция возвращает строку с
 расшифровкой значений state и error: }
function StateStr(state: TRasConnState; error: longint): string;
var buf: array [0..511] of char; { В help-е написано,
 что 512 байт хватит всегда }
begin
 if error <> 0 then
 begin
 case RasGetErrorString(error, @buf, sizeof(buf)) of
 0: result := buf;
 ERROR_INVALID_PARAMETER: Result := 'Invalid parameter';
 else Result := 'Error code: ' + IntToStr(error);
 end;
 end
 else case state of
 RASCS_OpenPort: result := 'Opening port';
 RASCS_PortOpened: result := 'Port opened';
 RASCS_ConnectDevice: result := 'Connecting device';
 RASCS_DeviceConnected: result := 'Device connected';
 RASCS_AllDevicesConnected: result := 'All devices connected';
 RASCS_Authenticate: result := 'Start authenticating';
 RASCS_AuthNotify: result := 'Authentication: notify';
 RASCS_AuthRetry: result := 'Authentication: retry';
 RASCS_AuthCallback: result := 'Authentication: callback';
 RASCS_AuthChangePassword: result := 'Authentication: change password';
 RASCS_AuthProject: result := 'Authentication: projecting';
 RASCS_AuthLinkSpeed: result := 'Authentication: link speed';
 RASCS_AuthAck: result := 'Authentication: acknowledge';
 RASCS_ReAuthenticate: result := 'Authentication: reauthenticate';
 RASCS_Authenticated: result := 'Authenticated';
 RASCS_PrepareForCallback: result := 'Preparing for callback';
 RASCS_WaitForModemReset: result := 'Waiting for modem reset';
 RASCS_WaitForCallback: result := 'Waiting for callback';
 RASCS_Projected: result := 'Projected';
 RASCS_StartAuthentication: result := 'Start authentication';
 RASCS_CallbackComplete: result := 'Callback complete';
 RASCS_LogonNetwork: result := 'Logging on network';
 RASCS_Interactive: result := 'Interactive';
 RASCS_RetryAuthentication: result := 'Retry Authentication';
 RASCS_CallbackSetByCaller: result := 'Callback set by caller';
 RASCS_PasswordExpired: result := 'Password expired';
 RASCS_Connected: result := 'Connected';
 RASCS_Disconnected: result := 'Disconnected';
 else result := 'Unknown state';
 end;
end;
// Заполнение s всеми соединениями:
procedure FillEntries(s: TStrings);
var
 EntryCount, bufsize: LongInt;
 entries: LPRasEntryName;
 i: Integer;
begin
 s.Clear;
 s.BeginUpdate;
 bufsize := 0;
 // Определение количества соединений:
 RasEnumEntries(nil, nil, nil, bufsize, EntryCount);
 if EntryCount > 0 then
 begin
 // Выделение памяти под информацию о соединениях:
 GetMem(entries, bufsize);
 FillChar(entries^, bufsize, 0);
 entries^.dwSize := sizeof(TRasEntryName);
 // Получение информации о соединениях:
 RasEnumEntries(nil, nil, entries, bufsize, EntryCount);
 // Заполнение s названиями соединений:
 for i := 0 to EntryCount - 1 do
 begin
 s.Add(entries^.szEntryName);
 Inc(entries);
 end;
 // Освобождение памяти:
 Dec(entries, EntryCount);
 FreeMem(entries);
 end;
 s.EndUpdate;
end;
// Заполнение items всеми активными соединениями:
procedure FillConnections(items: TListItems);
var
 conns: LPRasConn;
 ConnCount, bufsize: LongInt;
 li: TListItem;
 i: Integer;
 status: TRASCONNSTATUS;
begin
 items.BeginUpdate;
 items.Clear;
 bufsize := 0;
 // Определение количества активных соединений:
 RasEnumConnections(nil, bufsize, ConnCount);
 if ConnCount > 0 then
 begin
 // Выделение памяти:
 GetMem(conns, bufsize);
 conns^.dwSize := SizeOf(TRasConn);
 // Заполнение conns информацией об активных соединениях:
 RasEnumConnections(conns, bufsize, ConnCount);
 status.dwSize := SizeOf(TRasConnStatus);
 // Заполнение items названиями соединений:
 for i := 0 to ConnCount - 1 do
 begin
 li := items.Add;
 li.Data := Pointer(conns^.hrasconn);
 li.Caption := conns^.szEntryName;
 li.SubItems.Add(conns^.szDeviceType);
 li.SubItems.Add(conns^.szDeviceName);
 RasGetConnectStatus(conns^.hrasconn, status);
 li.SubItems.Add(StateStr(status.rasconnstate, status.dwError));
 Inc(conns);
 end;
 // Освобождение памяти:
 Dec(conns, ConnCount);
 FreeMem(conns);
 end;
 items.EndUpdate;
end;
{ Процедура разрывает соединение и дожидается завершения операции: }
procedure HangUpAndWait(conn: Integer);
var
 status: TRasConnStatus;
begin
 RasHangUp(conn); // Разрыв соединения
 status.dwSize := SizeOf(TRasConnStatus);
 // Ожидание уничтожения соединения:
 repeat
 Application.ProcessMessages;
 sleep(0);
 until RasGetConnectStatus(conn, status) = ERROR_INVALID_HANDLE;
end;
{ Эта процедура будет вызываться при любых изменениях в соединении: }
procedure RasNotifier(msg: integer; state: TRasConnState; error: Cardinal); stdcall;
begin
 CurrentState := StateStr(state, error);
 Form1.ListBox2.Items.Add(CurrentState);
 // Обновление информации об активных соединениях:
 FillConnections(Form1.ListView1.Items);
 if error <> 0 then
 begin
 Form1.Timer1.Enabled := False;
 Form1.Caption := CurrentState;
 end
 else
 begin
 Form1.Timer1.Enabled := False;
 Form1.Timer1.Enabled := True;
 Form1.Timer1.Tag := 0;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 { Установка свойств компонентов (может быть реализована
 через ObjectInspector: }
 Timer1.Enabled := False;
 Button1.Caption := 'Update Entries';
 Button2.Caption := 'Update Conns';
 Button3.Caption := 'Hang Up';
 Button4.Caption := 'Dial Up';
 Button5.Caption := 'Save';
 ListView1.ViewStyle := vsReport; // Вид таблицы
 // Добавление колонок:
 ListView1.Columns.Add.Caption := 'Name';
 ListView1.Columns.Add.Caption := 'Device Type';
 ListView1.Columns.Add.Caption := 'Device Name';
 ListView1.Columns.Add.Caption := 'State';
 // Заполнение компонентов информацией:
 FillEntries(ListBox1.Items);
 FillConnections(ListView1.Items);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Обновление списка соединений:
 FillEntries(ListBox1.Items);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 // Обновление информации об активных соединениях:
 FillConnections(ListView1.Items);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
 { Если соединений нет - выход, если одно - выделить его, если
 несколько, но ни одно не выделено - выход }
 case ListView1.Items.Count of
 0: Exit;
 1: ListView1.Selected := ListView1.Items[0];
 else if ListView1.Selected = nil then Exit;
 end;
 // Разрыв соединения:
 HangUpAndWait(LongInt(ListView1.Selected.Data));
 // Обновление информации об актив
 FillConnections(ListView1.Items);
end;
procedure TForm1.Button4Click(Sender: TObject);
var
 params: TRasDialParams;
 hRas: THRasConn;
begin
 if ListBox1.ItemIndex < 0 then Exit;
 ListBox2.Clear;
 // Заполнение params
 FillChar(params, SizeOf(TRasDialParams), 0);
 params.dwSize := SizeOf(TRasDialParams);
 StrPCopy(params.szEntryName, ListBox1.Items[ListBox1.ItemIndex]);
 StrPCopy(params.szUserName, Edit1.Text);
 StrPCopy(params.szPassword, Edit2.Text);
 // Установка связи:
 RasDial(nil, nil, params, 0, @RasNotifier, hRas);
end;
procedure TForm1.Button5Click(Sender: TObject);
var
 params: TRasDialParams;
begin
 // Сохранение имени пользователя и пароля:
 params.dwSize := SizeOf(TRasDialParams);
 StrPCopy(params.szEntryName, ListBox1.Items[ListBox1.ItemIndex]);
 StrPCopy(params.szUserName, Edit1.Text);
 StrPCopy(params.szPassword, Edit2.Text);
 RasSetEntryDialParams(nil, params, false);
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
 params: TRasDialParams;
 passw: LongBool;
begin
 if ListBox1.ItemIndex < 0 then Exit;
 // Определение имени пользователя и пароля:
 fillchar(params, SizeOf(TRasDialParams), 0);
 params.dwSize := SizeOf(TRasDialParams);
 StrPCopy(params.szEntryName, ListBox1.Items[ListBox1.ItemIndex]);
 RasGetEntryDialParams(nil, params, passw);
 Edit1.Text := params.szUserName;
 if passw then
 begin
 // Пароль доступен
 Edit2.Text := params.szPassword;
 Button4.SetFocus;
 end
 else
 begin
 // Пароль не доступен
 Edit2.Text := ;
 Edit2.SetFocus;
 end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 { Если действие происходит дольше секунды - в заголовок окна
 помещается информация о действии и время, которое оно
 происходит }
 Form1.Caption := CurrentState + ' - ' + IntToStr(Timer1.Tag);
 Timer1.Tag := Timer1.Tag + 1;
end;
Source: http://delphiworld.narod.ru
ID: 03575
Category:Связь