callform.~pas

这是我找到的一份老外编写的程序

unit Callform;

interface

uses
	SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
	Forms, Dialogs, StdCtrls, Tapi, ExtCtrls;

type
TfrmTAPICall = class(TForm)
  Label1: TLabel;
		Edit1: TEdit;
		btnCall: TButton;
  Memo1: TMemo;
		btnDropCall: TButton;
  grpMode: TRadioGroup;
		procedure FormCreate(Sender: TObject);
		procedure FormDestroy(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btnCallClick(Sender: TObject);
  procedure btnDropCallClick(Sender: TObject);
  procedure grpModeClick(Sender: TObject);
private
{ Private declarations }
  lineApp: THLineApp;
  line: THLine;
  call: THCall;
  CallParams: TlineCallParams;
public
{ Public declarations }
end;

var
	frmTAPICall: TfrmTAPICall;

implementation

{$R *.DFM}

uses Main;

var
	buf:array[0..1023] of char;
	callinfo: TLineCallInfo absolute buf;
	{
		these two variables points to the same address.
		since lineGetCallInfo expects a buffer with a TLineCallInfo on top.
	}

{
	TAPI Callback procedure: called for TAPI messages
	you MUST use 'stdcall' since it is called by Windows
}
procedure lineCallback(hDevice, dwMsg, dwCallbackInstance,
		dwParam1, dwParam2, dwParam3: LongInt);
{$IFDEF WIN32}
  stdcall;
{$ELSE}
  export;
{$ENDIF}
var
  s: string;
  hCall: THCall;
begin
  if dwMsg = LINE_REPLY then { result of LineMakeCall }
    if dwParam2 < 0 then
      frmTAPICall.Memo1.Lines.Add('Reply error')
    else
      frmTAPICall.Memo1.Lines.Add('LINE_REPLY ok')
  else if dwMsg = LINE_CALLSTATE then	{ change in line state }
  begin
    hCall := THCall(hDevice);
    case dwParam1 of
    LINECALLSTATE_IDLE:		{ call terminated }
      if hcall <> 0 then
      begin
      	lineDeallocateCall(hCall);	{ you must deallocate the call }
      	frmTAPICall.Memo1.Lines.Add('Idle - call deallocated');
      	frmTAPICall.btnCall.Enabled := True;
      	frmTAPICall.btnDropCall.Enabled := False;
      end;
    LINECALLSTATE_CONNECTED:	{ Service connected }
      if hCall <> 0 then
      begin
      	s := 'Connected: ';
      	callinfo.dwTotalSize := 1024;
      	if lineGetCallInfo(hCall, callinfo) = 0 then
          if callinfo.dwAppNameSize > 0 then
          {$IFDEF WIN32}
	    s := s + (buf + callinfo.dwAppNameOffset); { this is more C-ish... }
          {$ELSE}
	    s := s + StrPas((buf + callinfo.dwAppNameOffset)); { this is more C-ish... }
          {$ENDIF}
	  frmTAPICall.Memo1.Lines.Add(s);
      end;
    LINECALLSTATE_PROCEEDING:		{ call proceeding (dialing) }
      frmTAPICall.Memo1.Lines.Add('Proceeding');
    LINECALLSTATE_DIALING:			{ dialing }
      frmTAPICall.Memo1.Lines.Add('Dialing');
    LINECALLSTATE_DISCONNECTED:	{ disconnected }
      begin
        s := 'Disconnected: ';
        if dwParam2 = LINEDISCONNECTMODE_NORMAL then
          s := s + 'normal'
        else if dwParam2 = LINEDISCONNECTMODE_BUSY then
       	  s := s + 'busy';
        frmTAPICall.Memo1.Lines.Add(s);
        frmTAPICall.btnDropCall.Click;
      end;
    LINECALLSTATE_BUSY: { busy }
      frmTAPICall.Memo1.Lines.Add('Busy');
    end;
  end;
end;

procedure TfrmTAPICall.FormCreate(Sender: TObject);
var
  nDevs, tapiVersion: Longint;
  extid: TLineExtensionID;
begin
  { Initialize TAPI }
  { Zeros CallParams structure }
  FillChar(CallParams, sizeof(CallParams), 0);
  with CallParams do
  begin
    dwTotalSize := sizeof(CallParams);
    dwBearerMode := LINEBEARERMODE_VOICE;
    dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE;
  end;
  if lineInitialize(lineApp, HInstance, lineCallback, nil, nDevs) < 0 then
  { < 0 is an error }
    lineApp := 0
  else if nDevs = 0 then		{ no TAPI devices?? }
  begin
    lineShutDown(lineApp);
    lineApp := 0;
  end
  else if lineNegotiateAPIVersion(lineApp, 0, $00010000, $10000000, tapiVersion, extid) < 0 then
  { Check for version (copied from a TAPI sample) }
  begin
    lineShutDown(lineApp);
    lineApp := 0;
  end
  { Open a line for outbound calls (here I use first device, normally the modem) }
  else if lineOpen(lineApp, LINEMAPPER, line, tapiVersion, 0, 0, LINECALLPRIVILEGE_NONE, 0, @CallParams) < 0 then
  begin
    lineShutDown(lineApp);
    lineApp := 0;
    line := 0;
  end;
  if line = 0 then
    Memo1.Lines.Add('Error!!');
end;

procedure TfrmTAPICall.FormDestroy(Sender: TObject);
begin
  { Terminate TAPI }
  if line <> 0 then
    lineClose(line);
  if lineApp <> 0 then
    lineShutDown(lineApp);
  frmMain.Call := False;
end;

procedure TfrmTAPICall.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmTAPICall.btnCallClick(Sender: TObject);
var
  c: array[0..30] of char;
begin
  if Length(Edit1.Text) > 0 then
  begin
    Memo1.Lines.Clear;
    StrPCopy(c, Edit1.Text);
    if lineMakeCall(line, call, c, 0, @CallParams) < 0 then
      Memo1.Lines.Add('Error in lineMakeCall')
    else
    begin
      btnCall.Enabled := False;
      btnDropCall.Enabled := True;
    end;
  end;
end;

procedure TfrmTAPICall.btnDropCallClick(Sender: TObject);
	begin
	if LineDrop(call, nil, 0) < 0 then
		Memo1.Lines.Add('Error in lineDrop')
	end;

procedure TfrmTAPICall.grpModeClick(Sender: TObject);
	begin
	if grpMode.ItemIndex = 0 then
		CallParams.dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE
	else
		CallParams.dwMediaMode := LINEMEDIAMODE_DATAMODEM;
	end;

end.