uses Ras;

var

 CurrentState: string = '';

{ Эта функция возвращает строку с

 рассшифровкой значений state и error: }

function StateStr(state: TRasConnState; error: longint): string;

var buf: array [0..511] of char; { В рelp-е написано,

  что 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;