Fórum Dial Up. Discar e autenticar usuário/senha #253635

ai amigo esta aqui é é grande em da um geito de coloca os coponetes serto vai olhando que vc consegue...

vc coloca este componestes
{TfrmTest = class(TForm)
lstEntries: TListBox;
btnGetEntries: TButton;
btnCreateEntry: TButton;
btnEditEntry: TButton;
grpSelectedEntry: TGroupBox;
btnGetParams: TButton;
btnDialEntry: TButton;
lblUserName: TLabel;
lblPassword: TLabel;
txtUserName: TEdit;
txtPassword: TEdit;
btnHangup: TButton;
optDialMode: TRadioGroup;
lblAsync: TLabel;
lblStatus: TLabel;
btnActiveConn: TButton;
lvConnections: TListView;
btnSetParams: TButton;
txtCopyright: TMemo;
btnRenameEntry: TButton;
btnDeleteEntry: TButton;
Label1: TLabel;}

unit TestForm;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Ras,
StdCtrls, ExtCtrls, ComCtrls;

type
TfrmTest = class(TForm)
lstEntries: TListBox;
btnGetEntries: TButton;
btnCreateEntry: TButton;
btnEditEntry: TButton;
grpSelectedEntry: TGroupBox;
btnGetParams: TButton;
btnDialEntry: TButton;
lblUserName: TLabel;
lblPassword: TLabel;
txtUserName: TEdit;
txtPassword: TEdit;
btnHangup: TButton;
optDialMode: TRadioGroup;
lblAsync: TLabel;
lblStatus: TLabel;
btnActiveConn: TButton;
lvConnections: TListView;
btnSetParams: TButton;
txtCopyright: TMemo;
btnRenameEntry: TButton;
btnDeleteEntry: TButton;
Label1: TLabel;
procedure btnGetEntriesClick(Sender: TObject);
procedure btnCreateEntryClick(Sender: TObject);
procedure btnEditEntryClick(Sender: TObject);
procedure btnDialEntryClick(Sender: TObject);
procedure btnHangupClick(Sender: TObject);
procedure btnGetParamsClick(Sender: TObject);
procedure lstEntriesClick(Sender: TObject);
procedure txtUserNameChange(Sender: TObject);
procedure btnActiveConnClick(Sender: TObject);
procedure btnSetParamsClick(Sender: TObject);
procedure btnRenameEntryClick(Sender: TObject);
procedure btnDeleteEntryClick(Sender: TObject);
private
{ Private declarations }
dialparams: TRasDialParams;
public
{ Public declarations }
end;

var
frmTest: TfrmTest;

implementation

{$R *.DFM}

function StatusString(state: TRasConnState; error: Longint): String;
var
c: Array[0..100] of Char;
s: String;
begin
if error 0 then
begin
RasGetErrorString(error, c, 100);
Result := c;
end
else
begin
s := ´´;
case State of
RASCS_OpenPort:
s := ´Opening port´;
RASCS_PortOpened:
s := ´Port opened´;
RASCS_ConnectDevice:
s := ´Connecting device´;
RASCS_DeviceConnected:
s := ´Device connected´;
RASCS_AllDevicesConnected:
s := ´All devices connected´;
RASCS_Authenticate:
s := ´Start authenticating´;
RASCS_AuthNotify:
s := ´Authentication: notify´;
RASCS_AuthRetry:
s := ´Authentication: retry´;
RASCS_AuthCallback:
s := ´Authentication: callback´;
RASCS_AuthChangePassword:
s := ´Authentication: change password´;
RASCS_AuthProject:
s := ´Authentication: projecting´;
RASCS_AuthLinkSpeed:
s := ´Authentication: link speed´;
RASCS_AuthAck:
s := ´Authentication: acknowledge´;
RASCS_ReAuthenticate:
s := ´Authentication: reauthenticate´;
RASCS_Authenticated:
s := ´Authenticated´;
RASCS_PrepareForCallback:
s := ´Preparing for callback´;
RASCS_WaitForModemReset:
s := ´Waiting for modem reset´;
RASCS_WaitForCallback:
s := ´Waiting for callback´;
RASCS_Projected:
s := ´Projected´;
RASCS_StartAuthentication:
s := ´Start authentication´;
RASCS_CallbackComplete:
s := ´Callback complete´;
RASCS_LogonNetwork:
s := ´Logging on network´;

RASCS_Interactive:
s := ´Interactive´;
RASCS_RetryAuthentication:
s := ´Retry Authentication´;
RASCS_CallbackSetByCaller:
s := ´Callback set by caller´;
RASCS_PasswordExpired:
s := ´Password expired´;

RASCS_Connected:
s := ´Connected´;
RASCS_Disconnected:
s := ´Disconnected´;
end;
Result := s;
end;
end;

// Se ligue de volta de de função RAS
procedure RasCallback(msg: Integer; state: TRasConnState;
error: Longint); stdcall
begin
if error = 0 then
frmTest.lblStatus.Font.Color := clBlue
else
frmTest.lblStatus.Font.Color := clRed;
frmTest.lblStatus.Caption := StatusString(state, error);
frmTest.btnActiveConn.Click;
end;

procedure TfrmTest.btnGetEntriesClick(Sender: TObject);
var
bufsize: Longint;
numEntries: Longint;
entries: Array[1..100] of TRasEntryName;
x: Integer;
begin
btnEditEntry.Enabled := False;
btnGetParams.Enabled := False;
txtUserName.Text := ´´;
txtPassword.Text := ´´;
lstEntries.Items.Clear;
entries[1].dwSize := SizeOf(TRasEntryName);
bufsize := SizeOf(TRasEntryName) * 100;
if RasEnumEntries(nil, nil, @entries[1], bufsize, numEntries) = 0 then
begin
if numEntries > 0 then
begin
for x := 1 to numEntries do
lstEntries.Items.Add(entries[x].szEntryName);
lstEntries.ItemIndex := 0;
lstEntriesClick(lstEntries);
btnEditEntry.Enabled := True;
btnGetParams.Enabled := True;
end;
end
else
ShowMessage(´RasEnumEntries failed.´);
end;

procedure TfrmTest.btnCreateEntryClick(Sender: TObject);
begin
if RasCreatePhonebookEntry(Handle, nil) = 0 then
btnGetEntries.Click
else
ShowMessage(´RasCreatePhonebookEntry failed.´);
end;

procedure TfrmTest.btnEditEntryClick(Sender: TObject);
begin
if RasEditPhonebookEntry(Handle, nil,
PChar(lstEntries.Items[lstEntries.ItemIndex])) 0 then
ShowMessage(´RasEditPhonebookEntry failed.´);
end;

procedure TfrmTest.btnDialEntryClick(Sender: TObject);
var
r: integer;
c: Array[0..100] of Char;
hRas: THRasConn;
begin
Screen.Cursor := crHourglass;
FillChar(dialparams, SizeOf(TRasDialParams), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
StrPCopy(szUserName, txtUserName.Text);
StrPCopy(szPassword, txtPassword.Text);
// Você pode anular número de telefone aqui...
// StrP Copy (Número de telefone de sz, ´xxxxxx´);
end;
hRas := 0;
if optDialMode.ItemIndex = 0 then
// Dial de Sync
begin
lblStatus.ParentFont := True;
lblStatus.Caption := ´Dialing...´;
lblStatus.Refresh;
r := RasDial(nil, nil, dialparams, 0, nil, hRas);
if r = 0 then
begin
lblStatus.Caption := ´Connected´;
btnActiveConn.Click;
end
else
begin
lblStatus.Caption := ´Error´;
if hRas 0 then
RasHangUp(hRas);
end;
end
else
// Dial de Async
r := RasDial(nil, / / Este campo é ignorado em Windows95
nil, / / Lista telefônica: use falta (não usou em Win95)
dialparams,
0, // use chamada atrás função de tipo DIAL de RAS FUNC
@RasCallback, // se ligue de volta função
hRas);
if r 0 then
begin
RasGetErrorString(r, c, 100);
ShowMessage(´RasDial failed: ´ + c);
end;
Screen.Cursor := crDefault;
end;

procedure TfrmTest.btnHangupClick(Sender: TObject);
var
hRas: THRasConn;
begin
hRas := Longint(lvConnections.ItemFocused.Data);
if RasHangUp(hRas) = 0 then
begin
Sleep(1000); // espera 1 segundo
btnActiveConn.Click;
end
else
ShowMessage(´RasHangUp failed.´);
end;

procedure TfrmTest.btnGetParamsClick(Sender: TObject);
var
fp: LongBool;
r: Longint;
c: Array[0..100] of Char;
begin
FillChar(dialparams, SizeOf(TRasDialParams), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
end;
r := RasGetEntryDialParams(nil, dialparams, fp);
if r = 0 then
with dialparams do
begin
txtUserName.Text := szUserName;
if fp then
txtPassword.Text := szPassword;
end
else
begin
RasGetErrorString(r, c, 100);
ShowMessage(´RasGetEntryDialParams failed: ´ + c);
end;
end;

procedure TfrmTest.lstEntriesClick(Sender: TObject);
begin
grpSelectedEntry.Caption := ´Selected entry: ´ +
lstEntries.Items[lstEntries.ItemIndex];
end;

procedure TfrmTest.txtUserNameChange(Sender: TObject);
begin
if lstEntries.ItemIndex = -1 then
Exit;
btnDialEntry.Enabled := (txtUserName.Text ´´);
btnSetParams.Enabled := btnDialEntry.Enabled;
end;

procedure TfrmTest.btnActiveConnClick(Sender: TObject);
var
bufsize: Longint;
numEntries: Longint;
x: Integer;
entries: Array[1..100] of TRasConn;
stat: TRasConnStatus;
begin
entries[1].dwSize := SizeOf(TRasConn);
bufsize := SizeOf(TRasConn) * 100;
btnHangup.Enabled := False;
lvConnections.Items.Clear;
FillChar(stat, Sizeof(TRasConnStatus), 0);
stat.dwSize := Sizeof(TRasConnStatus);
if RasEnumConnections(@entries[1], bufsize, numEntries) = 0 then
begin
if numEntries > 0 then
begin
for x := 1 to numEntries do
with lvConnections.Items.Add, entries[x] do
begin
Data := Pointer(hrasconn);
Caption := szEntryName;
SubItems.Add(szDeviceType);
SubItems.Add(szDeviceName);
RasGetConnectStatus(hrasconn, stat);
SubItems.Add(StatusString(stat.rasconnstate, stat.dwError));
end;
lvConnections.ItemFocused := lvConnections.Items[0];
btnHangup.Enabled := True;
end;
end
else
ShowMessage(´Ras Enum Conexões falharam.´);
end;

procedure TfrmTest.btnSetParamsClick(Sender: TObject);
begin
if Application.MessageBox(PChar(´Save parameters for entry ´ +
lstEntries.Items[lstEntries.ItemIndex] + ´?´), PChar(Caption),
MB_ICONWARNING or MB_YESNO) = IDYES then
begin
with dialparams do
begin
// Nota: como declarado em WIN32.HLP, o Número de telefone de sz não pode ser mudado por
// esta função. O único modo para mudar isto (até onde eu sei) é usar
// Ras Edit Entrada de Lista telefônica e muda isto manualmente. Ou é possível para
// especifique Número de telefone de sz para o Ras Dial função.
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
StrPCopy(szUserName, txtUserName.Text);
StrPCopy(szPassword, txtPassword.Text);
end;
if RasSetEntryDialParams(nil, dialparams, False) 0 then
ShowMessage (´RasSetEntryDialParams failed.´);
end;
end;

procedure TfrmTest.btnRenameEntryClick(Sender: TObject);
var
s: String;
begin
s := InputBox(´Rename entry´, ´Entre em nome de entrada novo´,
lstEntries.Items[lstEntries.ItemIndex]);
if s ´´ then
if RasRenameEntry(nil, PChar(lstEntries.Items[lstEntries.ItemIndex]),
PChar(s)) 0 then
ShowMessage(´RasRenameEntry failed.´)
else
btnGetEntries.Click;
end;

procedure TfrmTest.btnDeleteEntryClick(Sender: TObject);
begin
if Application.MessageBox(PChar(lstEntries.Items[lstEntries.ItemIndex] +
´ conexão será removida: Você está seguro? ´), nil,
MB_YESNO or MB_ICONWARNING) = IDYES then
if RasDeleteEntry(nil, PChar(lstEntries.Items[lstEntries.ItemIndex])) 0 then
ShowMessage(´RasDeleteEntry failed.´)
else
btnGetEntries.Click;
end;

end.

Amigos,
esou precisando muito disso tb.

Vocês conseguiram montar o exe?

abraços,

Uma pergunta antes de começar a ralar para isso virar um .exe.

Esse código efetua a conexão sem usar nada do Windows? Pois o meu problema é que não posso o usar o Dial Up do Windows pois forneço conexão para funcionários e eles não podem saber dos dados da conexão.