روش جدید بر قراری ارتباط تلفنی با دلفی

[mjdeveloper]

با این روش می توانید به کامپیوترهای دیگر یا اینترنت از طریق خط تلفن ارتباط برقرار کنید
بدون استفاده از کامپوننت خاصی

این کد رو هنوز کاملا تست نکردم ولی اگر مشکل داشته باشه کم کم رفع می کنم
و تصحیح شده اون رو میذارم بروبچ استفاده کنن

در ضمن اساتید محترم دلفی
اگر کسی اشکالی پیدا کرد یا پیشنهادی داشت حتما خوشحال می شم

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons,strutils;

type
TForm1 = class(TForm)
btnDial: TBitBtn;
edUserName: TEdit;
edPassword: TEdit;
edPhoneNumber: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btnHangup: TBitBtn;
memRasdilaCommand: TMemo;
procedure btnDialClick(Sender: TObject);
procedure btnHangupClick(Sender: TObject);
private
{ Private declarations }
Function create_phoneBook:boolean;
Function Dialup(UserName,Password,PhoneNumber:String):boole an;
procedure HangUp;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.dfm}
//-----------------------------------------------------------------------------

procedure TForm1.btnDialClick(Sender: TObject);
begin
if not Dialup(string(edUserName.Text),string(edPassword.T ext),string(edPhoneNumber.Text)) then
ShowMessage('error');
end;
//-----------------------------------------------------------------------------
function TForm1.create_phoneBook: boolean;
var
pbFile:TextFile;
begin
AssignFile(pbFile,'PhoneBook.pbk');
Rewrite(pbFile);
Writeln(pbfile,'[En_Dial]');
Writeln(pbfile,'Encoding=1');
Writeln(pbfile,'Type=1');
Writeln(pbfile,'AutoLogon=0');
Writeln(pbfile,'UseRasCredentials=1');
Writeln(pbfile,'DialParamsUID=15034062');
Writeln(pbfile,'Guid=BD901E701D41F34BABAB9C989FF50 113');
Writeln(pbfile,'BaseProtocol=1');
Writeln(pbfile,'VpnStrategy=0');
Writeln(pbfile,'ExcludedProtocols=0');
Writeln(pbfile,'LcpExtensions=1');
Writeln(pbfile,'DataEncryption=8');
Writeln(pbfile,'SwCompression=1');
Writeln(pbfile,'NegotiateMultilinkAlways=0');
Writeln(pbfile,'SkipNwcWarning=0');
Writeln(pbfile,'SkipDownLevelDialog=0');
Writeln(pbfile,'SkipDoubleDialDialog=0');
Writeln(pbfile,'DialMode=1');
Writeln(pbfile,'DialPercent=75');
Writeln(pbfile,'DialSeconds=120');
Writeln(pbfile,'HangUpPercent=10');
Writeln(pbfile,'HangUpSeconds=120');
Writeln(pbfile,'OverridePref=15');
Writeln(pbfile,'RedialAttempts=3');
Writeln(pbfile,'RedialSeconds=60');
Writeln(pbfile,'IdleDisconnectSeconds=0');
Writeln(pbfile,'RedialOnLinkFailure=0');
Writeln(pbfile,'CallbackMode=0');
Writeln(pbfile,'CustomDialDll=');
Writeln(pbfile,'CustomDialFunc=');
Writeln(pbfile,'CustomRasDialDll=');
Writeln(pbfile,'AuthenticateServer=0');
Writeln(pbfile,'ShareMsFilePrint=0');
Writeln(pbfile,'BindMsNetClient=1');
Writeln(pbfile,'SharedPhoneNumbers=1');
Writeln(pbfile,'GlobalDeviceSettings=0');
Writeln(pbfile,'PrerequisiteEntry=');
Writeln(pbfile,'PrerequisitePbk=');
Writeln(pbfile,'PreferredPort=');
Writeln(pbfile,'PreferredDevice=');
Writeln(pbfile,'PreferredBps=0');
Writeln(pbfile,'PreferredHwFlow=0');
Writeln(pbfile,'PreferredProtocol=0');
Writeln(pbfile,'PreferredCompression=0');
Writeln(pbfile,'PreferredSpeaker=0');
Writeln(pbfile,'PreferredMdmProtocol=0');
Writeln(pbfile,'PreviewUserPw=1');
Writeln(pbfile,'PreviewDomain=0');
Writeln(pbfile,'PreviewPhoneNumber=1');
Writeln(pbfile,'ShowDialingProgress=1');
Writeln(pbfile,'ShowMonitorIconInTaskBar=1');
Writeln(pbfile,'CustomAuthKey=-1');
Writeln(pbfile,'AuthRestrictions=632');
Writeln(pbfile,'TypicalAuth=1');
Writeln(pbfile,'IpPrioritizeRemote=1');
Writeln(pbfile,'IpHeaderCompression=1');
Writeln(pbfile,'IpAddress=0.0.0.0');
Writeln(pbfile,'IpDnsAddress=0.0.0.0');
Writeln(pbfile,'IpDns2Address=0.0.0.0');
Writeln(pbfile,'IpWinsAddress=0.0.0.0');
Writeln(pbfile,'IpWins2Address=0.0.0.0');
Writeln(pbfile,'IpAssign=1');
Writeln(pbfile,'IpNameAssign=1');
Writeln(pbfile,'IpFrameSize=1006');
Writeln(pbfile,'IpDnsFlags=1');
Writeln(pbfile,'IpNBTFlags=1');
Writeln(pbfile,'TcpWindowSize=0');
Writeln(pbfile,'UseFlags=0');
Writeln(pbfile,'IpSecFlags=0');
Writeln(pbfile,'IpDnsSuffix=');
Writeln(pbfile,'NETCOMPONENTS=');
Writeln(pbfile,'ms_server=0');
Writeln(pbfile,'ms_msclient=1');
Writeln(pbfile,'');
Writeln(pbfile,'MEDIA=serial');
Writeln(pbfile,'Port=com2');
Writeln(pbfile,'Device=');
Writeln(pbfile,'ConnectBPS=115200');
Writeln(pbfile,'');
Writeln(pbfile,'DEVICE=modem');
Writeln(pbfile,'PhoneNumber=');
Writeln(pbfile,'AreaCode=');
Writeln(pbfile,'CountryCode=98');
Writeln(pbfile,'CountryID=98');
Writeln(pbfile,'UseDialingRules=0');
Writeln(pbfile,'Comment=');
Writeln(pbfile,'LastSelectedPhone=0');
Writeln(pbfile,'PromoteAlternates=0');
Writeln(pbfile,'TryNextAlternateOnFail=1');
Writeln(pbfile,'HwFlowControl=1');
Writeln(pbfile,'Protocol=1');
Writeln(pbfile,'Compression=1');
Writeln(pbfile,'Speaker=0');
Writeln(pbfile,'MdmProtocol=0');
CloseFile(pbFile);
if FileExists('PhoneBook.pbk') then
Result:=true
else
Result:=false
end;
//-----------------------------
procedure TForm1.btnHangupClick(Sender: TObject);
var hphone:THandle;
begin
HangUp;
end;
//----------------------------
function TForm1.Dialup(UserName, Password, PhoneNumber: String): boolean;
var
stRasText:string;
pcRasText:array[0..255] of char;
begin
Result:=false;
try
stRasText:='RasDial En_Dial '+
UserName+' '+
Password+' /phone:'+
PhoneNumber+' /PhoneBook:"'+
GetCurrentDir+'\PhoneBook.pbk"';
StrPCopy(pcRasText,stRasText);
if create_phoneBook=true then
begin
screen.Cursor := crHourGlass;
WinExec(pcRasText,SW_HIDE);
Result:=true;
screen.Cursor := crDefault;
end;
except
Result:=false;
end;
end;
//----------------------------
procedure TForm1.HangUp;
begin
screen.Cursor := crHourGlass;
WinExec('RasDial /d',SW_HIDE);

screen.Cursor := crDefault;
end;
//-----------------------------
end.
--------------------------------------------------------------------------------------------
مهدی جعفری

[Bahram0110]

مرسی
اگه فایل پروژه رو هم آپلود کنی عالی میشه

[mjdeveloper]

این هم فایل پروژه ارتباط تلفنی با دلفی برای دوستان
اگر مشکلی داشت لطفا یه خبر بدید

------------------------------------------------------------
مهدی جعفری