一个简单的拨号控件

  • 主题发起人 主题发起人 import
  • 开始时间 开始时间
I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Dialer; interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
TComPort = (dpCOM1,dpCOM2,dpCOM3,dpCOM4);
TMethod = (dmTone,dmPulse);
TDialer = class(TComponent)
private
{ Private declarations }
FComPort : TComPort;
FNumberToDial : string;
FConfirm : boolean;
FMethod : TMethod;
protected
{ Protected declarations }
public
{ Public declarations }
procedure Execute;
published
property ComPort : TComPort read FComPort
write FComPort;
property Confirm : boolean read FConfirm
write FConfirm;
property Method : TMethod read FMethod
write FMethod;
property NumberToDial : string read FNumberToDial
write FNumberToDial;
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TDialer]);
end;
procedure TDialer.Execute;
var
s : string;
CId : Integer;
Status : Integer;
Buf : array[1..32] of Char;
begin
if FConfirm then
begin
if MessageDlg('About to dial the number '+FNumberToDial+'. Are you sure?',
mtConfirmation, [mbYes,mbNo], 0)=mrNo then Exit;
end;
{Create a string to send to modem}
s:=Concat('ATDT',FNumberToDial,^M^J);
if FMethod=dmPulse then s[4]:='P';
{Open Com Port}
StrPCopy(@Buf,'COM ');
Buf[4]:=Chr(49+Ord(FComPort));
CId:=OpenComm(@Buf,512,512);
if CId<0 then
begin
MessageDlg('Unable to open '+StrPas(@Buf),mtError,
[mbOk], 0);
Exit;
end;
{Send phone number to modem}
StrPCopy(@Buf,s);
Status:=WriteComm(CId,@Buf,StrLen(@Buf));
if Status>=0 then
begin
MessageDlg('Pick up the phone',mtInformation,
[mbOk], 0);
WriteComm(CId,'ATH'^M^J,5);
end
else
MessageDlg('Unable to dial number',mtError,
[mbOk], 0);
{Close communication port}
CloseComm(CId);
end;
end.
使用举例:
procedure TForm1.Button1Click(Sender: TObject);
var
TempDialer : TDialer;
begin
TempDialer:=TDialer.Create(Self);
with TempDialer do
begin
ComPort:=dpCom4;
Confirm:=true;
Method:=dmTone;
NumberToDial:='1(222)333-4444';
Execute;
Free;
end;
end;
 

Similar threads

S
回复
0
查看
896
SUNSTONE的Delphi笔记
S
S
回复
0
查看
873
SUNSTONE的Delphi笔记
S
I
回复
0
查看
420
import
I
I
回复
0
查看
541
import
I
I
回复
0
查看
686
import
I
后退
顶部