uses Shellapi;
CONST
RASCS_PAUSED = $1000;
RASCS_DONE = $2000;
RASCS_OpenPort = 0;
RASCS_PortOpened = 1;
RASCS_ConnectDevice = 2;
RASCS_DeviceConnected = 3;
RASCS_AllDevicesConnected = 4;
RASCS_Authenticate = 5;
RASCS_AuthNotify = 6;
RASCS_AuthRetry = 7;
RASCS_AuthCallback = 8;
RASCS_AuthChangePassword = 9;
RASCS_AuthProject = 10;
RASCS_AuthLinkSpeed = 11;
RASCS_AuthAck = 12;
RASCS_ReAuthenticate = 13;
RASCS_Authenticated = 14;
RASCS_PrepareForCallback = 15;
RASCS_WaitForModemReset = 16;
RASCS_WaitForCallback = 17;
RASCS_Projected = 18;
{$IFNDEF WINVER31}
RASCS_StartAuthentication = 19;
RASCS_CallbackComplete = 20;
RASCS_LogonNetwork = 21;
{$ENDIF}
RASCS_Interactive = RASCS_PAUSED;
RASCS_RetryAuthentication = RASCS_PAUSED + 1;
RASCS_CallbackSetByCaller = RASCS_PAUSED + 2;
RASCS_PasswordExpired = RASCS_PAUSED + 3;
RASCS_Connected = RASCS_DONE;
RASCS_Disconnected = RASCS_DONE + 1;
DNLEN = 15; // Maximum domain name length
UNLEN = 256; // Maximum user name length
PWLEN = 256; // Maximum password length
RAS_MaxEntryName = 256;
RAS_MaxDeviceName = 128;
RAS_MaxPhoneNumber = 128;
RAS_MaxCallbackNumber = RAS_MaxPhoneNumber;
RAS_MaxDeviceType = 16;
type LPRasDialParamsA = ^TRasDialParamsA;
TRasDialParamsA = record
dwSize: LongInt;
szEntryName: Array[0..RAS_MaxEntryName] of AnsiChar;
szPhoneNumber: Array[0..RAS_MaxPhoneNumber] of AnsiChar;
szCallbackNumber: Array[0..RAS_MaxCallbackNumber] of AnsiChar;
szUserName: Array[0..UNLEN] of AnsiChar;
szPassword: Array[0..PWLEN] of AnsiChar;
szDomain: Array[0..DNLEN] of AnsiChar;
{$IFDEF WINVER41}
dwSubEntry: Longint;
dwCallbackId: Longint;
{$ENDIF}
end;
LPRasDialParams = ^TRasDialParams;
TRasDialParams = TRasDialParamsA;
type LPRasEntryNameA = ^TRasEntryNameA;
TRasEntryNameA = record
dwSize: Longint;
szEntryName: Array[0..RAS_MaxEntryName] of AnsiChar;
end;
LPRasEntryName = ^TRasEntryName;
TRasEntryName = TRasEntryNameA;
type LPRasDialExtensions = ^TRasDialExtensions;
TRasDialExtensions = record
dwSize: LongInt;
dwfOptions: LongInt;
hwndParent: HWND;
reserved: LongInt;
end;
type THRasConn = Longint;
type
LPRasConnState = ^TRasConnState;
TRasConnState = Integer;
type LPRasConnA = ^TRasConnA;
TRasConnA = record
dwSize: Longint;
hrasconn: THRasConn;
szEntryName: Array[0..RAS_MaxEntryName] of AnsiChar;
{$IFNDEF WINVER31}
szDeviceType: Array[0..RAS_MaxDeviceType] of AnsiChar;
szDeviceName: Array[0..RAS_MaxDeviceName] of AnsiChar;
{$ENDIF}
{$IFDEF WINVER41}
szPhonebook: Array[0..MAX_PATH - 1] of AnsiChar;
dwSubEntry: Longint;
{$ENDIF}
end;
LPRasConn = ^TRasConn;
TRasConn = TRasConnA;
type LPRasConnStatusA = ^TRasConnStatusA;
TRasConnStatusA = record
dwSize: Longint;
rasconnstate: TRasConnState;
dwError: LongInt;
szDeviceType: Array[0..RAS_MaxDeviceType] of AnsiChar;
szDeviceName: Array[0..RAS_MaxDeviceName] of AnsiChar;
{$IFDEF WINVER41}
swPhoneNumber: Array[0..RAS_MaxPhoneNumber] of AnsiChar;
{$ENDIF}
end;
LPRasConnStatus = ^TRasConnStatus;
TRasConnStatus = TRasConnStatusA;
Var
Dialparams:TRasDialParamsA;
RasData
ointer;
implementation
function RasDial; external 'rasapi32.dll' name 'RasDialA';
function RasHangUp; external 'rasapi32.dll' name 'RasHangUpA';
function RasGetEntryDialParams; external 'rasapi32.dll' name 'RasGetEntryDialParamsA';
function RasEnumEntries; external 'rasapi32.dll' name 'RasEnumEntriesA';
function RasEnumConnections; external 'rasapi32.dll' name 'RasEnumConnectionsA';
function RasGetConnectStatus; external 'rasapi32.dll' name 'RasGetConnectStatusA';
function RasGetErrorString; external 'rasapi32.dll' name 'RasGetErrorStringA';
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;
function ActiveConn:String;
var
bufsize: Longint;
numEntries: Longint;
entries: Array[1..100] of TRasConn;
stat: TRasConnStatus;
begin
entries[1].dwSize := SizeOf(TRasConn);
bufsize := SizeOf(TRasConn) * 100;
FillChar(stat, Sizeof(TRasConnStatus), 0);
stat.dwSize := Sizeof(TRasConnStatus);
if RasEnumConnections(@entries[1], bufsize, numEntries)=0 then
if numEntries > 0 then
begin
RasGetConnectStatus(entries[1].hrasconn, stat);
RasData := Pointer(entries[1].hrasconn);
Result:=StatusString(stat.rasconnstate, stat.dwError);
end
else
Result:='None';
end;
procedure RasCallback(msg: Integer; state: TRasConnState;
error: Longint); stdcall
begin
ActiveConn;
end;
procedure Dailup;
Var
hRas: THRasConn;
fp: LongBool;
bufsize,numEntries: Longint;
entries,p: LPRasEntryName;
lstEntries:TStringList;
eUserName,ePassword:String;
i : integer;
begin
lstEntries:=TStringList.Create;
entries := AllocMem(SizeOf(TRasEntryName));
entries^.dwSize := SizeOf(TRasEntryName);
bufsize := SizeOf(TRasEntryName);
if RasEnumEntries(nil, nil, entries, bufsize, numEntries)= 0 then
begin
if numEntries > 0 then
begin
p := entries;
for i := 0 to numEntries - 1 do
begin
lstEntries.Add(p^.szEntryName);
Inc(p);
end;
end;
end;
FreeMem(entries);
//GetEntryParams
FillChar(dialparams, SizeOf(TRasDialParamsA), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, lstEntries[0]);
end;
if RasGetEntryDialParams(nil, dialparams, fp)=0 then
with dialparams do
begin
eUserName := szUserName;
if fp then ePassword := szPassword;
end;
//Dailup
hRas := 0;
FillChar(dialparams, SizeOf(TRasDialParams), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParamsA);
StrPCopy(szEntryName, lstEntries[0]);
StrPCopy(szUserName, eUserName);
StrPCopy(szPassword, ePassword);
end;
RasDial(nil, nil, dialparams, 0, @RasCallback, hRas);
lstEntries.Free;
end;
procedure TForm1.Button1OnClick(Sender:TObject);
Var
bufsize,numEntries: Longint;
entries: LPRasEntryName;
hRas: THRasConn;
begin
entries := AllocMem(SizeOf(TRasEntryName));
entries^.dwSize := SizeOf(TRasEntryName);
bufsize := SizeOf(TRasEntryName);
if RasEnumEntries(nil, nil, entries, bufsize, numEntries)= 0 then
if numEntries > 0 then
begin
Dailup;
{ 以下代码挂断
hRas := Longint(RasData);
if hRas <> 0 then
if RasHangUp(hRas) = 0 then
begin
Sleep(1000);
ActiveConn;
end;}
end;
FreeMem(entries);
end;