Há um tempo, escrevi uma aula para discar o Windows devido a necessidades de trabalho. Agora, ele suporta a leitura da lista de conexões dial-up do Windows, discando, desligando, criação/exclusão de conexões e pode ser usada para 98/2000/XP.以后有时间写成component，加入对拨号事件的支持。
usos
ras, Classes, SysUtils, StrUtils, Windows, Forms;
tipo
ERasError = Exception;
tipo
TRASConnection = class
Privado
FPlatForm: integer;
FConnected: boolean;
Frasentries: TStringList;
Frasconn: HRASCONN;
FPARAMS: Rasdialparams;
Ferrno: Inteiro;
função getPassword: string;
Procedimento setPassword (senha: string);
função getphoneno: string;
procedimento setphoneno (número: string);
função getCallback: string;
Procedimento setCallback (número: string);
função getDomain: string;
Procedimento SetDomain (domínio: string);
função getUserName: string;
Procedimento SetUserName (nome de usuário: string);
função getentryname: string;
Procedimento setEntryName (entrada: string);
função getConnected: boolean;
Procedimento setConnected (Avalue: Boolean);
função getRAsEntries: tStringList;
público
Propriedade RasEntries: TStringList Read Getrasentries;
Propriedade PhoneNumber: String leia getphoneno write setphoneno;
Propriedade de chamada de renovação: string leia getCallback write setCallback;
Domínio da propriedade: String Leia GetDomain Write SetdomAin;
Propriedade EntryName: String Leia GetentryName Write setEntryName;
Nome de usuário da propriedade: string leia getUserName Write setUserName;
Senha da propriedade: string leia getPassword write setpassword;
Propriedade ativa: boolean leia getConnected write setConnected;
Procedimento Connect;
procedimento desconectado;
função getErrorCode: Integer;
Procedimento FreeAndHanup;
construtor Criar;
destruidor destruir;
procedimento Createrasentry;
Procedimento deleTerasEntry (AENTRYNAME: String);
//function GetErrorReason: integer;
fim;
Implementação
{ TRASConnection }
procedure TRASConnection.Connect;
var
i: integer;
s: string;
Começar
Fparams.dWSize: = sizeof (RasDialParams);
i: = rasdial (nil, nil, @fparams, 0, nil, @frasconn);
Se eu <> 0 então comece
Ferrno: = i;
caso i de
691: s: = 'A verificação da identidade falhou!';
692: S: = 'A abertura da porta falhou!';
676: s: = 'A linha está ocupada, por favor, espere e disque novamente!';
677: S: = 'Erro de resposta à voz!';
678: S: = 'Sem resposta!';
679: S: = 'Sem sinal de transportadora!';
680: s: = 'sem tom de discagem!';
outro
S: = 'Erro desconhecido!';
fim;
Rashangup (Frasconn);
levantar eraserror.create (s);
fim
else fConnected: = true;
fim;
procedimento trasconnection.disconnect;
Começar
Rashangup (Frasconn);
Frasconn: = 0;
fim;
function trasconnection.getCallback: string;
Começar
Resultado: = string (fparams.szCallbackNumber);
fim;
function TRASConnection.GetConnected: Boolean;
var
Eu, Len, num: Inteiro;
X: Matriz de Rasconn;
Começar
Resultado: = false;
SetLength (x, 1);
x [0] .dWSize: = sizeof (rasconn);
len: = x [0] .dWSize;
num: = 0;
RasenumConnections (@x [0], @len, @num);
Se num> 0, então comece
SetLength (x, num);
x [0] .dWSize: = sizeof (rasconn);
len := x[0].dwSize; num := 0;
RasenumConnections (@x [0], @len, @num);
para i: = 1 para num do
Se strComp (x [i - 1] .szentryname, pchar (nome de entrada)) = 0 então comece
Frasconn: = x [i - 1] .hrasconn;
Resultado: = true;
Quebrar;
fim;
fim;
SetLength (x, 0);
fim;
function trasconnection.getDomain: string;
Começar
Resultado: = string (fparams.szDomain);
fim;
function trasconnection.getErrorCode: Integer;
Começar
Resultado: = Ferrno;
fim;
function trasconnection.getpassword: string;
Começar
Resultados: = '*********';
fim;
function tasconnection.getphoneno: string;
Começar
Resultado: = string (fparams.szphoneNumber);
fim;
function trasconnection.getEntryName: string;
Começar
Resultado: = string (fparams.szentryname);
fim;
function tasconnection.getUserName: string;
Começar
Resultado: = string (fparams.szusername);
fim;
procedimento trasconnection.setCallback (número: string);
Começar
Strlcopy (fparams.szcallbackNumber, pchar (número), sizeof (fparams.szcallbackNumber) - 1);
fim;
Procedimento trasconnection.setConnected (Avalue: Boolean);
Começar
se avaliar e não forem conectados, conecte -se
caso contrário, se não estiver avalia e se conecte, desconecte;
fim;
procedimento trasconnection.setDomain (domínio: string);
Começar
Strlcopy (fparams.szDomain, pchar (domínio), sizeof (fparams.szDomain) - 1);
fim;
Procedimento trasconnection.setPassword (senha: string);
Começar
StrLCopy(FParams.szPassword, PChar(Password), sizeof(FParams.szPassword) - 1);
fim;
procedimento trasconnection.setphoneno (número: string);
Começar
Strlcopy (fparams.szphoneNumber, pchar (número), sizeof (fparams.szphoneNumber) - 1);
fim;
procedimento trasconnection.SetEntryName (entrada: string);
var
I: Inteiro;
Começar
para i: = 0 a Frasentries.count - 1 do
Se Frasentries.strings [i] = entrada então comece
Strcopy (fparams.szentryname, pchar (entrada));
Saída;
fim;
Strcopy (fparams.szentryname, '');
fim;
Procedimento trasconnection.setUserName (nome de usuário: string);
Começar
Strlcopy (fparams.szusername, pchar (nome de usuário), sizeof (fparams.szusername) - 1);
fim;
procedimento trasconnection.freeandHangup;
Começar
if Active then DisConnect;
Livre;
fim;
function trasconnection.getrasEntries: tStringList;
var
Ren: Matriz de Rasentryname;
Ren98: Matriz de Rasentryname98;
C, L: Inteiro;
Começar
Frasentries.clear;
C: = 0;
caso fplatform de
Ver_platform_win32_windows:
Começar
SetLength (Ren98, 1);
Ren98 [0] .dWSize: = sizeof (rasentryname98);
l: = sizeof (rasentryname98);
Se Rasenumentries (nil, nil, @ren98 [0], @l, @c) = error_buffer_too_small então comece
setLength (Ren, C);
Rasenumentries (nil, nil, @ren98 [0], @l, @c);
fim;
enquanto C> 0 começa
Frasentries.add (String (Ren98 [C - 1] .SzentryName));
Dez (c);
fim;
SetLength (ren98, 0);
fim;
Ver_platform_win32_nt:
Começar
setLength (Ren, 1);
Ren [0] .dWSize: = sizeof (rasentryname);
l: = sizeof (rasentryname);
Se Rasenumentries (nil, nil, @ren [0], @l, @c) = error_buffer_too_small então comece
setLength (Ren, C);
Rasenumentries (nil, nil, @ren [0], @l, @c);
fim;
enquanto C> 0 começa
Frasentries.add (String (Ren [C - 1] .SzentryName));
Dez (c);
fim;
SetLength (Ren, 0);
fim;
fim;
Se Frasentries.Count> 0 então Entryname: = Frasentries.Strings [0];
Resultados: = Frasentries;
fim;
construtor trrasconection.create;
var
OS: OsversionInfoa;
Começar
herdado;
Os.dwosversionInfosize: = sizeof (OsversionInfoa);
Getversion (OS);
Fplatform: = os.dwplatformid;
Frasentries: = tStringList.create;
Getrasentries;
fim;
Destructor trasconnection.Destroy;
Começar
Frasentries.Free;
herdado;
fim;
Procedimento Trasconnection.CreaReSentry;
Começar
Rascreatephonebookentry (Application.Handle, NIL);
fim;
procedimento trasconnection.deleterasentry (aEntryName: string);
var
I: Inteiro;
Começar
i: = FASENTRIES.INDEXOF (AENTRYNAME);
Se eu = -1, então saia;
Frasentries.Delete (i);
Se AENTRYNAME = ENTRINGNAME então
Se Frasentries.count> 0 então o nome da entrada: = Frasentries.strings [0]
else EntryName: = '';
Rasdeleteentry (nil, pchar (aentryname));
fim;
Api声明：
função rasdial (
LPRASDIALEXTENSions: prasdialextensions;
LPSZPhonebook: LPCTSTR;
LPRASDIALPARAMS: LPRASDIALPARAMS;
dWnotifierType: dword;
lpvnotifier: ponteiro;
LPHRASCONN: LPHRASCONN): DWORD;
stdcall;
Função Rashangup (Rasconn: HRASCONN): DWORD;
stdcall;
função rasgetentrydialparams (
LPSZPhonebook: LPCTSTR;
lprasdialparams: LPRASDIALPARAMS;
lpfpassword: lpbool): dword;
stdcall;
função Rasenumentries (
Reservado: LPCTSTR;
LPSZPhonebook: LPCTSTR;
LPRASENTRYNAME: LPRASENTRYNAME;
LPCB: lpdword;
lpcentries: lpdword): dword;
stdcall;
função raseditphonebookEntry (
HWND: HWND;
LPSZPhonebook: LPCTSTR;
lpszentryName: LPCTSTR): DWORD;
stdcall;
função rasgetentryproperties (
LPSZPhonebook: LPCTSTR;
LPSzentry: LPCTSTR;
LPrasentry: LPrasentry;
lpdwentryInfosize: lpdword;
lpbdeviceInfo: pbyte;
lpdwdeviceInfosize: lpdword): dword;
stdcall;
função rassetEntryproperties (
LPSZPhonebook: LPCTSTR;
LPSzentry: LPCTSTR;
LPrasentry: LPrasentry;
dwentryInfosize: dword;
lpbdeviceInfo: pbyte;
dwDeviceInfosize: dword): dword;
stdcall;
Função RasenumConnections (
LPRASCONN: LPRASCONN;
LPCB: lpdword;
lpcconnections: lpdword): dword;
stdcall;
função RasenumDevices (
lprasdevinfo: lprasdevinfo;
LPCB: lpdword;
LPCDEVICES: LPDWORD): DWORD;
stdcall;
função rascreatephonebookentry (
Identificador: hwnd;
stdcall;
função rasdeleteentry (
LPSZPhonebook: PCHA;
lpszentry: pchar): dword;
stdcall;