Mega Code Archive
Rasapi ile internete bağlanmak-bağlantıyı kesmek-yeni bağlantı eklemek-bağlantı bilgisi düzenlemek
<![CDATA[
//Forma 1 adet ListBox, 3 adet LabeledEdit, 4 adet Button
//3 adet SpeedButton, 1 adet Label ekleyin.
//Button captionlarını (Yeni,Değiştir,Düzenle,Sil) yapın.
//LabeledEdit lerin EditLabel captionlarını
//(Kullanıcı Adı,Şifre,Telefon) yapın.
//SpeedButton captionlarını
//(Ara,Bağlantıyı Kes,Yandaki Değerlerle Bağlan) yapın.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
ListBox1: TListBox;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label1: TLabel;
SpeedButton3: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TRasEntryName = record
dwSize : LongInt;
szEntryName : Array[0..256] of AnsiChar;
end;
LPRasEntryName=^TRasEntryName;
type
TRasIPAddr = record
a,b,c,d : Byte;
end;
TRasDialParams = record
dwSize : LongInt;
szEntryName : Array[0..256] of AnsiChar;
szPhoneNumber : Array[0..128] of AnsiChar;
szCallBackNumber : Array[0..128] of AnsiChar;
szUserName : Array[0..256] of AnsiChar;
szPassword : Array[0..256] of AnsiChar;
szDomain : Array[0..15] of AnsiChar;
{$IFDEF WINVER41}
dwSubEntry : LongInt;
dwCallBackId : LongInt;
{$ENDIF}
end;
TRasEntry = record
dwSize,dwOptions,
dwCountryID,
dwCountryCode : LongInt;
szAreaCode : Array[0..10] of AnsiChar;
szLocalPhoneNumber : Array[0..128] of AnsiChar;
szAlternatesOffset : LongInt;
ipaddr,ipaddrDns,
ipaddrDnsAlt,
ipaddrWins,
ipaddrWinsAlt : TRasIPAddr;
dwFrameSize,
dwNetProtocols,
dwFramingProtocol : LongInt;
szScript : Array[0..MAX_PATH-1] of AnsiChar;
szAutoDialDll : Array[0..MAX_PATH-1] of AnsiChar;
szAutoDialFunc : Array[0..MAX_PATH-1] of AnsiChar;
szDeviceType : Array[0..16] of AnsiChar;
szDeviceName : Array[0..128] of AnsiChar;
szX25PadType : Array[0..32] of AnsiChar;
szX25Address : Array[0..200] of AnsiChar;
szX25Facilities : Array[0..200] of AnsiChar;
szX25UserData : Array[0..200] of AnsiChar;
dwChannels : LongInt;
dwReserved1,
dwReserved2 : LongInt;
{$IFDEF WINVER41}
dwSubEntries,
dwDialMode,
dwDialExtraPercent,
dwExtraSampleSeconds,
dwHangUpExtraPercent,
dwHangUpExtraSampleSeconds : LongInt;
dwIdleDisconnectSeconds : LongInt;
{$ENDIF}
end;
LPRasDialExtensions = ^TRasDialExtensions;
TRasDialExtensions = record
dwSize : LongInt;
dwfOptions : LongInt;
hwndParent : HWND;
reserved : LongInt;
end;
function RasEnumEntries(reserved:PChar; lpszPhoneBook: PChar; entrynamesArray:LPRasEntryName;
var lpcb: LongInt; var lpcEntries:LongInt):LongInt;stdcall;
function RasEnumEntries; external 'rasapi32.dll' name 'RasEnumEntriesA';
function RasGetEntryDialParams(lpszPhoneBook: PChar; var lpDialParams:TRasDialParams;
var lpfPassword: LongBool): LongInt;stdcall;
function RasGetEntryDialParams; external 'rasapi32.dll' name 'RasGetEntryDialParamsA';
function RasGetErrorString(errorValue: Integer; errorString: PChar; cBufSize:LongInt):LongInt;stdcall;
function RasGetErrorString; external 'rasapi32.dll' name 'RasGetErrorStringA';
function RasGetEntryProperties(lpszPhoneBook, szEntry: PChar; lpbEntry: Pointer;
var lpdEntrySize: LongInt; lpbDeviceInfo: Pointer;
var lpddwDeviceInfoSize: LongInt):LongInt;stdcall;
function RasGetEntryProperties;external 'rasapi32.dll' name 'RasGetEntryPropertiesA';
function RasDial(lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PChar;
var params: TRasDialParams; dwNotifierType: LongInt; lpNotifies: Pointer;
var rasConn: LongInt):LongInt;stdcall;
function RasDial; external 'rasapi32.dll' name 'RasDialA';
function RasHangUp(hConn: LongInt):LongInt;stdcall;
function RasHangUp;external 'rasapi32.dll' name 'RasHangUpA';
function RasCreatePhonebookEntry(hwndParentWindow: HWND; lpszPhoneBook: PChar):LongInt;stdcall;
function RasCreatePhonebookEntry;external 'rasapi32.dll' name 'RasCreatePhonebookEntryA';
function RasRenameEntry(lpszPhoneBook, szEntryOld, szEntryNew: PChar):LongInt;stdcall;
function RasRenameEntry;external 'rasapi32.dll' name 'RasRenameEntryA';
function RasEditPhonebookEntry(hwndParentWindow: HWND; lpszPhoneBook: PChar; lpszEntryName: PChar):LongInt;stdcall;
function RasEditPhonebookEntry;external 'rasapi32.dll' name 'RasEditPhonebookEntryA';
function RasDeleteEntry(lpszPhoneBook, szEntry: PChar):LongInt;stdcall;
function RasDeleteEntry;external 'rasapi32.dll' name 'RasDeleteEntryA';
var
Form1 : TForm1;
BaglantiNo : LongInt;
BaglantiParametreleri: TRasDialParams;
BaglantiZamani : TDateTime;
implementation
{$R *.dfm}
procedure RasCallBack(msg:Integer; state:Integer;dwError:LongInt);stdcall;
var
durum: Array[0..255] of Char;
begin
with Form1 do
begin
if (dwError<>0) then
RasGetErrorString(dwError, durum, 256)
else
case state of
0 : durum:='Bağlantı noktası açılıyor';
1 : durum:='Bağlantı noktası açıldı';
2 : durum:='Bağlantı başlatılıyor';
5 : durum:='Şifre sorgulanıyor';
14 : durum:='Şifre doğrulandı';
$2000: begin
durum :='Bağlantı sağlandı.';
caption :='Bağlantı sağlandı.';
BaglantiZamani:=Now;
end;
$2001:begin
durum :='Bağlantı kesildi ve hata oluştu';
Caption :='Bağlantı kesildi.';
end;
end;
Label1.Caption:=durum;
end;
end;
procedure Listele;
var BaglantiAdi : array[1..20] of TRasEntryName;
i,x,BufSize,BagSayisi: LongInt;
begin
Form1.ListBox1.Clear;
BaglantiAdi[1].dwSize:=SizeOf(BaglantiAdi[1]);
BufSize:=SizeOf(BaglantiAdi);
x:=RasEnumEntries(nil,nil,@BaglantiAdi,BufSize,BagSayisi);
if x=0 then
for i:=1 to BagSayisi do
Form1.ListBox1.Items.Add(StrPas(BaglantiAdi[i].szEntryName))
else
ShowMessage('Bağlantı Kayıtları Okunamadı.');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BaglantiNo:=0;
Listele;
SpeedButton2.Enabled:=False;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
sifreli : LongBool;
ErrNo,ESize,DSize : LongInt;
Entry : TRasEntry;
Secili : String;
cTxt : Array[0..255] of Char;
BaglantiParametreleri : TRasDialParams;
begin
Secili:=ListBox1.Items[Form1.ListBox1.ItemIndex];
BaglantiParametreleri.dwSize:=SizeOf(TRasDialParams);
StrLCopy(BaglantiParametreleri.szEntryName, PChar(Secili), 256);
ErrNo:=RasGetEntryDialParams(nil,BaglantiParametreleri,sifreli);
if (ErrNo=0) then
begin
LabeledEdit1.Text:=BaglantiParametreleri.szUserName;
if sifreli then
LabeledEdit2.Text:=BaglantiParametreleri.szPassword
else
LabeledEdit2.Text:='';
end
else
begin
RasGetErrorString(ErrNo, cTxt, 256);
ShowMessage('Bağlantı Bilgileri Alınamadı:'+cTxt);
end;
eSize:=0;
dSize:=0;
Entry.dwSize:=SizeOf(TRasEntry);
RasGetEntryProperties(nil, PChar(secili),nil, eSize, nil, dSize);
ErrNo:=RasGetEntryProperties(nil, PChar(secili), @Entry, eSize, nil, dSize);
if (ErrNo=0) then
with Entry do
begin
if (dwCountryCode<>null) and (szAreaCode<>'') then
LabeledEdit3.Text:=IntToStr(dwCountryCode)+'('+szAreaCode+')'+szLocalPhoneNumber
else
LabeledEdit3.Text:=szLocalPhoneNumber;
end
else
begin
RasGetErrorString(ErrNo, cTxt, 256);
ShowMessage('Bağlantı Bilgileri Alınamadı: '+cTxt);
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
ErrNo : LongInt;
begin
SpeedButton1.Enabled:=False;
SpeedButton2.Enabled:=True;
ErrNo:=RasDial(nil, nil, BaglantiParametreleri, 0, @RasCallBack, BaglantiNo);
if (ErrNo<>0) then
begin
if (BaglantiNo<>0) then
RasHangUp(BaglantiNo); //bağlantıyı kes
Label1.Caption:='Bağlantı Kesildi.';
ShowMessage('Arama yapılamadı');
SpeedButton1.Enabled:=True;
SpeedButton2.Enabled:=False;
SpeedButton3.Enabled:=True;
end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if (BaglantiNo<>0) then
RasHangUp(BaglantiNo);
BaglantiNo:=0;
Label1.Caption:='Bağlantı Kesildi.';
Caption :='Bağlantı Kesildi.';
SpeedButton1.Enabled:=True;
SpeedButton2.Enabled:=False;
SpeedButton3.Enabled:=True;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
var
ErrNo: LongInt;
begin
SpeedButton1.Enabled:=False;
SpeedButton2.Enabled:=True;
SpeedButton3.Enabled:=False;
BaglantiParametreleri.dwSize:=SizeOf(TRasDialParams);
StrPlCopy(BaglantiParametreleri.szEntryName,'',256);
StrPlCopy(BaglantiParametreleri.szCallBackNumber,'',256);
StrPlCopy(BaglantiParametreleri.szDomain,'',15);
StrPlCopy(BaglantiParametreleri.szUserName,LabeledEdit1.Text,256);
StrPlCopy(BaglantiParametreleri.szPassword,LabeledEdit2.Text,256);
StrPlCopy(BaglantiParametreleri.szPhoneNumber,LabeledEdit3.Text,128);
BaglantiNo:=0;
ErrNo:=RasDial(nil,nil,BaglantiParametreleri,0,@RasCallBack,BaglantiNo);
if (ErrNo<>0) then
begin
RasHangUp(BaglantiNo);
Label1.Caption:='Bağlantı Kesildi.';
ShowMessage('Arama Yapılamadı');
SpeedButton1.Enabled:=True;
SpeedButton2.Enabled:=False;
SpeedButton3.Enabled:=True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if (RasCreatePhoneBookEntry(Handle,nil)<>0) then
ShowMessage('Yeni bağlantı girişi oluşturulamadı')
else
Listele;
end;
procedure TForm1.Button2Click(Sender: TObject);
var yeni,eski : String;
begin
if (ListBox1.ItemIndex>=0) then
begin
eski:=ListBox1.Items[ListBox1.ItemIndex];
yeni:=InputBox('Bağlantı Adını Değiştir','Yeni Ad:',eski);
if (yeni<>'') then
if (RasRenameEntry(nil,PChar(eski), PChar(yeni))<>0) then
ShowMessage('Ad değiştirilemedi')
else
Listele;
end
else
ShowMessage('Listeden bir bağlantı seçmelisiniz');
end;
procedure TForm1.Button3Click(Sender: TObject);
var s: String;
begin
if (ListBox1.ItemIndex>=0) then
begin
s:=ListBox1.Items[ListBox1.ItemIndex];
if (RasEditPhoneBookEntry(Handle, nil, PChar(s))<>0) then
ShowMessage('Düzenleme sayfası açılamadı')
else
Listele;
end
else
ShowMessage('Listeden bir bağlantı seçmelisiniz');
end;
procedure TForm1.Button4Click(Sender: TObject);
var s: String;
begin
if (ListBox1.ItemIndex>=0) then
begin
s:=ListBox1.Items[ListBox1.ItemIndex];
if MessageDlg(s+' bağlantısını silmek istiyor musunuz?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
if (RasDeleteEntry(nil, PChar(s))<>0) then
ShowMessage('Bağlantı silinemedi')
else
Listele;
end
else
ShowMessage('Listeden bir bağlantı seçmelisiniz');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (BaglantiNo<>0) then
RasHangUp(BaglantiNo);
end;
end.
]]>