jvras32.pas

East make Tray Icon in delphi

function TJvRas32.Dial(Index: Integer): Boolean;
var
  RASDialParams: TRASDialParams;
  R: DWORD;
  X: Integer;
begin
  if not RasAvailable or (FConnection <> 0) then
    Result := False
  else
  begin
    FillChar(RASDialParams, SizeOf(RASDialParams), #0);
    FConnection := 0;
    with RASDialParams do
    begin
      dwSize := SizeOf(TRASDialParams);
      StrLCopy(szEntryName, PChar(PhoneBook[Index]), RAS_MAXENTRYNAME);
      X := Self.EntryIndex;
      Self.EntryIndex := Index;
      StrLCopy(szUserName, PChar(FUsername), RAS_MAXENTRYNAME);
      StrLCopy(szPassword, PChar(FPassword), RAS_MAXENTRYNAME);
      Self.EntryIndex := X;
      szDomain := '*';
      szCallbackNumber := '*';
      szPhoneNumber := '';
    end;
    if Assigned(FRasDial) then
    begin
      if FPhoneBookPath <> '' then
        R := FRasDial(nil, PChar(FPhoneBookPath), @RASDialParams, $FFFFFFFF, FHandle, FConnection)
      else
        R := FRasDial(nil, nil, @RASDialParams, $FFFFFFFF, FHandle, FConnection);
      Result := R = 0;
    end
    else
      Result := False;
  end;
end;

function TJvRas32.EditConnection(Index: Integer): Boolean;
begin
  Result := False;
  if RasAvailable then
  begin
    RefreshPhoneBook;
    if Index < PhoneBook.Count then
      Result := FRasEditPhonebookEntry(FPHandle, nil, PChar(PhoneBook[Index])) = 0;
  end;
end;

function TJvRas32.GetConnected: Boolean;
var
  Status: TRASConnStatus;
begin
  if RasAvailable and (FConnection <> 0) then
  begin
    Status.dwSize := SizeOf(TRASConnStatus);
    FRasGetConnectStatus(FConnection, @Status);
    Result := Status.rasConnstate = RASCS_Connected;
  end
  else
    Result := False;
end;

procedure TJvRas32.RefreshPhoneBook;
var
  RASEntryName: array [1..50] of TRasEntryName;
  I, BufSize, Entries: DWORD;
begin
  { Build internal copy. }
  if FPhoneBook = nil then
    FPhoneBook := TStringList.Create;
  if RasAvailable then
  begin
    FPhoneBook.BeginUpdate;
    try
      FPhoneBook.Clear;
      RASEntryName[1].dwSize := SizeOf(RASEntryName[1]);
      BufSize := SizeOf(RASEntryName);

      if Assigned(FRasEnumEntries) then
      begin
        if FPhoneBookPath <> '' then
          I := FRasEnumEntries(nil, PChar(FPhoneBookPath), @RASEntryName[1], BufSize, Entries)
        else
          I := FRasEnumEntries(nil, nil, @RASEntryName[1], BufSize, Entries);
        if (I = 0) or (I = ERROR_BUFFER_TOO_SMALL) then
          for I := 1 to Entries do
            if (I < 51) and (RASEntryName[I].szEntryName[0] <> #0) then
              FPhoneBook.Add(StrPas(RASEntryName[I].szEntryName));
      end;
    finally
      FPhoneBook.EndUpdate;
    end;
  end;
end;

function TJvRas32.HangUp: Boolean;
var
  Rc: Longint;
  I: Integer;
  RasConnStatus: TRASConnStatus;
begin
  Result := False;
  if RasAvailable and (FConnection <> 0) then
  begin
    Rc := FRasHangUp(FConnection);
    if Rc <> 0 then
    begin
      RasConnStatus.dwSize := SizeOf(TRASConnStatus);
      I := 0;
      while True do
      begin
        Rc := FRasGetConnectStatus(FConnection, @RasConnStatus);
        if Rc = ERROR_INVALID_HANDLE then
        begin
          Rc := 0;
          Break;
        end;
        Sleep(10);
        Inc(I);
        if I > 9 then
          Break; // don't want an infinite loop...
      end;
    end;
    Result := Rc = 0;
    FConnection := 0;
  end;
end;

procedure TJvRas32.SetEntryIndex(const Value: Integer);
var
  RasDial: TRASDialParams;
  Res: LongBool;
begin
  if RasAvailable then
  begin
    FEntryIndex := Value;

    FEntry := '';
    FUsername := '';
    FPhoneNumber := '';
    FDomain := '';
    FCallBackNumber := '';
    FPassword := '';

    if FEntryIndex >= PhoneBook.Count then
    begin
      if PhoneBook.Count > 0 then
        FEntryIndex := 0
      else
        FEntryIndex := -1;
    end;

    if FEntryIndex <> -1 then
    begin
      FEntry := PhoneBook[FEntryIndex];

      FillChar(RasDial, SizeOf(TRASDialParams), #0);
      StrLCopy(RasDial.szEntryName, PChar(PhoneBook[FEntryIndex]), RAS_MAXENTRYNAME);
      RasDial.dwSize := SizeOf(TRASDialParams);

      if Assigned(FRasGetEntryDialParams) then
        if FRasGetEntryDialParams(nil, RasDial, Res) = 0 then
          with RasDial do
          begin
            FUsername := StrPas(szUserName);
            FPassword := StrPas(szPassword);
            FDomain := StrPas(szDomain);
            FCallBackNumber := StrPas(szCallbackNumber);
            FPhoneNumber := StrPas(szPhoneNumber);
          end;
    end;
  end;
end;

procedure TJvRas32.WndProc(var Msg: TMessage);
begin
  if (Msg.Msg = RASEvent) and (FConnection <> 0) then
  begin
    case Msg.WParam of
      RASCS_OpenPort:
        if Assigned(FOnOpenPort) then
          FOnOpenPort(Self);
      RASCS_PortOpened:
        if Assigned(FOnPortOpened) then
          FOnPortOpened(Self);
      RASCS_ConnectDevice:
        if Assigned(FOnConnectDevice) then
          FOnConnectDevice(Self);
      RASCS_DeviceConnected:
        if Assigned(FOnDeviceConnected) then
          FOnDeviceConnected(Self);
      RASCS_AllDevicesConnected:
        if Assigned(FOnAllDevicesConnected) then
          FOnAllDevicesConnected(Self);
      RASCS_Authenticate:
        if Assigned(FOnAuthenticate) then
          FOnAuthenticate(Self);
      RASCS_AuthNotify:
        if Assigned(FOnAuthNotify) then
          FOnAuthNotify(Self);
      RASCS_AuthRetry:
        if Assigned(FOnAuthRetry) then
          FOnAuthRetry(Self);
      RASCS_AuthCallback:
        if Assigned(FOnAuthCallback) then
          FOnAuthCallback(Self);
      RASCS_AuthChangePassword:
        if Assigned(FOnAuthChangePassword) then
          FOnAuthChangePassword(Self);
      RASCS_AuthProject:
        if Assigned(FOnAuthProject) then
          FOnAuthProject(Self);
      RASCS_AuthLinkSpeed:
        if Assigned(FOnAuthLinkSpeed) then
          FOnAuthLinkSpeed(Self);
      RASCS_AuthAck:
        if Assigned(FOnAuthAck) then
          FOnAuthAck(Self);
      RASCS_ReAuthenticate:
        if Assigned(FOnReAuthenticate) then
          FOnReAuthenticate(Self);
      RASCS_Authenticated:
        if Assigned(FOnAuthenticated) then
          FOnAuthenticated(Self);
      RASCS_PrepareForCallback:
        if Assigned(FOnPrepareForCallback) then
          FOnPrepareForCallback(Self);
      RASCS_WaitForModemReset:
        if Assigned(FOnWaitForModemReset) then
          FOnWaitForModemReset(Self);
      RASCS_Interactive:
        if Assigned(FOnInteractive) then
          FOnInteractive(Self);
      RASCS_RetryAuthentication:
        if Assigned(FOnRetryAuthentication) then
          FOnRetryAuthentication(Self);
      RASCS_PasswordExpired:
        if Assigned(FOnPasswordExpired) then
          FOnPasswordExpired(Self);
      RASCS_Connected:
        if Assigned(FOnConnected) then
          FOnConnected(Self);
      RASCS_DisConnected:
        if Assigned(FOnDisconnected) then
          FOnDisconnected(Self);
      RASCS_WaitForCallBack:
        if Assigned(FOnWaitForCallBack) then
          FOnWaitForCallBack(Self);
    end;
  end
  else
    Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TJvRas32.GetPhoneBook: TStrings;
begin
  if FPhoneBook = nil then
    FPhoneBook := TStringList.Create;
  if FPhoneBook.Count = 0 then
    RefreshPhoneBook;
  Result := FPhoneBook;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.