unit1.~pas

delphi实现modem两地文件传输。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,tapi;
  
const

WM_myCOMMNOTIFY = WM_USER + 100; // 通讯消息


type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label1: TLabel;
    Edit2: TEdit;
    Procedure MsgcommProcess(Var Message:Tmessage); Message WM_myCOMMNOTIFY;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    end;
  TCommFtB=Class(TThread)
    protected
       procedure Execute;override;
    end;
   






var
  Form1: TForm1;
  CommFtB:TCommFtB;
implementation

{$R *.dfm}

type
  tagModemID=record
    hModem:THANDLE;
    ModemName:char;
 end;

type ModemIDpointer=^tagModemID;
type VarStringponiter=^TVarString;
var
lineApp:THLineApp;//TAPI应用句柄
line:THLine;//线路句柄
call:THCall;//呼叫句柄
CallParams:TLineCallParams;//呼叫参数
nDevs,tapiVersion,errorcod:Longint;//线路设备数、TAPI版本号、错误代码
extid:TLineExtensionID;//TAPI扩展版本号
lineIcon:HICON;//线路设备图标
mid:ModemIDpointer;
str:VarStringponiter;
avarsting:TVarString;
lid,dwsize:LongInt;
mark:integer;
a:PChar;
myhModem,hCommFile:THANDLE  ;// 调 制 解 调 器 句 柄
ModemID:tagModemID;
b:LongInt;
len:DWORD;
RecBuf:DWORD;
buf:array[0..20] of char; // 缓 冲 区
Error:DWORD;	// 错 误 码
Status:PComStat;	// 状 态 码
lpol:POverlapped;
Read_Buffer:DWORD;
lVarString : LPVarString;
lReturn : Longint;
FromF: file;
  NumRead: Integer;
  Buf1: array[1..2048] of byte;
post_event:THandle;


procedure TCommFtB.Execute;
begin
AssignFile(FromF,Form1.Edit2.text);
Reset(FromF, 1);	{ Record size = 1 }
While True do Begin
repeat
waitforsingleobject(post_event,infinite);   // 等 待 同 步 事 件 置 位；
resetevent(post_event);                     // 同 步 事 件 复 位；
BlockRead(FromF, Buf1, SizeOf(Buf1), NumRead);
PostMessage(Form1.Handle,WM_myCOMMNOTIFY,0,0); // 发 送 消 息；
until  ((NumRead=0) or (NumRead<SizeOf(Buf1)));
end;
end;



Procedure TForm1.MsgcommProcess(Var Message:Tmessage);//Message WM_myCOMMNOTIFY;
var

dcb : TDCB;

Error :Boolean;

dwNumberOfBytesWritten,dwNumberOfBytesToWrite,

ErrorFlag,dwWhereToStartWriting : DWORD;

pDataToWrite : PChar;
dwEvtMask:Dword;

write_os: Toverlapped;
lpol:Poverlapped;

begin
dwWhereToStartWriting := 0;

dwNumberOfBytesWritten := 0;

dwNumberOfBytesToWrite :=NumRead;

if (dwNumberOfBytesToWrite=0) then

begin

ShowMessage('Text Buffer is Empty!');

Exit;

end

else

begin

//pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);



//RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);

//Label1.Font.Color :=clRed;

FillChar(Write_Os,SizeOf(write_os),0);

// 为重叠写创建事件对象

Write_Os.hEvent := CreateEvent(nil,True,False,nil);

SetCommMask(hCommFile,EV_TXEMPTY);

Label1.Caption:='正在发送数据...!';

repeat

Label1.Repaint;

// 发送通讯数据


if not WriteFile( hCommFile,Buf1[dwWhereToStartWriting],

dwNumberOfBytesToWrite,dwNumberOfBytesWritten,@write_os ) then

begin

ErrorFlag :=GetLastError;

if ErrorFlag<>0 then

begin

if ErrorFlag=ERROR_IO_PENDING then

begin

WaitForSingleObject(Write_Os.hEvent,INFINITE);

GetOverlappedResult(hCommFile,Write_os,

dwNumberOfBytesWritten,False);

end

else

begin

MessageBox(0,'WriteFile Error!','Notice',MB_OK);

//Receive :=False;

CloseHandle(Write_Os.hEvent);

CloseHandle(Post_Event);

CloseHandle(hCommFile);

Exit;

end;

end;

end;
fillchar(lpol,sizeof(toverlapped),0);

dwEvtMask:=0;

Wait:=WaitCommEvent(hcom,dwevtmask,lpol);

Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );

Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );

until (dwNumberOfBytesToWrite <= 0); // Write the whole thing!
SetEvent(Post_Event);
end;
//Label1.Caption:='发送成功!';
end;


procedure GethModem(hLine:THLINE);
//var
//mid:ModemIDpointer;
//str:VarStringponiter;
//avarsting:TVarString;
//lid,dwsize:LongInt;
//mark:integer;
//hCall: THCall;
//a:PChar;
begin
lVarString := AllocMem(sizeof(lVarString^));
      lVarString^.dwTotalSize := sizeof(lVarString^);


    mark:=lineGetID(hLine, 0, call, LINECALLSELECT_LINE, lVarString^, 'comm/datamodem');
    if mark<0 then
        ShowMessage('无法Modemid')else begin
      {---- Make sure we got all the Varstring}
      if lVarString^.dwNeededSize > lVarString^.dwTotalSize then
      begin
         ReallocMem(lVarString, lVarString^.dwNeededSize);
         lVarString^.dwTotalSize := lVarString^.dwNeededSize;
         lReturn := lineGetID(hLine, 0, call, LINECALLSELECT_LINE, lVarString^, 'comm/datamodem');
         if lReturn < 0 then
         begin
            MessageDlg('Failed to get Line ID', mtError, [mbok], 0);
            lineDeallocateCall(Call);
            Exit;
         end;
      end;

      {---- Get the handle to the comm port}
      myhModem:= PHandle(PChar(lVarString) + SizeOf(TVarString))^;
      {---- Free the memory help by lpVarString}
      FreeMem(lVarString, lVarString^.dwTotalSize);
   end;
   end;


procedure lineCallback(hDevice, dwMsg, dwCallbackInstance, dwParam1, dwParam2, dwParam3: LongInt); stdcall;
{$IFDEF WIN32}
stdcall;
{$ELSE}
export;
{$ENDIF}
var
   s: string;
   hCall : THCall;
   Clear:Boolean;
   Rec_num:DWORD;
begin
   if dwMsg = LINE_REPLY then { result of LineMakeCall }
   begin
      if dwParam2 < 0 then
         ShowMessage('Line Unavailable')
      else
         ShowMessage('Line Ready');
   end

   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 }
            ShowMessage('Idle');
            //fmStatus.CloseStatus;
         end;
      LINECALLSTATE_CONNECTED:	{ Service connected }
         if hCall <> 0 then
         begin
            begin
lVarString := AllocMem(sizeof(lVarString^));
      lVarString^.dwTotalSize := sizeof(lVarString^);


    mark:=lineGetID(line, 0, call, LINECALLSELECT_LINE, lVarString^, 'comm/datamodem');
    if mark<0 then
        ShowMessage('无法Modemid')else begin
      {---- Make sure we got all the Varstring}
      if lVarString^.dwNeededSize > lVarString^.dwTotalSize then
      begin
         ReallocMem(lVarString, lVarString^.dwNeededSize);
         lVarString^.dwTotalSize := lVarString^.dwNeededSize;
         lReturn := lineGetID(line, 0, call, LINECALLSELECT_LINE, lVarString^, 'comm/datamodem');
         if lReturn < 0 then
         begin
            MessageDlg('Failed to get Line ID', mtError, [mbok], 0);
            lineDeallocateCall(Call);
            Exit;
         end;
      end;

      {---- Get the handle to the comm port}
      hCommFile:= PHandle(PChar(lVarString) + SizeOf(TVarString))^;
      {---- Free the memory help by lpVarString}
      FreeMem(lVarString, lVarString^.dwTotalSize);
   end;

		   Clear:=ClearCommError(hCommFile,Error,nil);
                   if Clear Then Begin
                   post_event:=CreateEvent(nil,true,true,nil); // 创 建 同 步 事 件；
                   TcommFtB.Create(False);                  // 创 建 串 行 口 监 视 线 程；
         	//Rec_num:=Status.cbInQue;// bytes in input buffer
   			//ReadFile(myhModem,RecBuf,Rec_num,len,lpol);
                        //ReadFile(myhModem,Read_Buffer,256,len,nil);
//至此已经为数据通信做好了前期准备,可设立标志
      		//WriteFile(myhModem,'Success',7,len,nil);
			//ReadFile(myhModem,Read_Buffer,8,len,nil);
			//ShowMessage(IntToStr(Read_Buffer));
                      end;
end;

         end;
      LINECALLSTATE_DIALING:			{ dialing }
         ShowMessage('Dialing ');
      LINECALLSTATE_DISCONNECTED:	{ disconnected }
         begin
            s := 'Disconnected: ';
            if dwParam2 = LINEDISCONNECTMODE_NORMAL then
               s := s + 'normal'
            else if dwParam2 = LINEDISCONNECTMODE_BUSY then
               s := s + 'busy';
            ShowMessage(s);
            //TTapiTerminal(Me).DropCall;
            //fmStatus.CloseStatus;
         end;
      LINECALLSTATE_BUSY: { busy }
         begin
            ShowMessage('Busy');
            //fmStatus.CloseStatus;
         end;
      end; {case}
   end;
end;





//procedure lineCallback(hDevice,dwMsg,dwCallbackInstance,dwParam1,dwParam2,dwParam3:LongInt)//异步呼叫返回处理函数
//{$IFDEF WIN32}
//stdcall;
//{$ELSE}
//export;
//{$ENDIF}
//var
//Clear:Boolean;
//Rec_num:DWORD;
//hCall: THCall;
//b:LongInt;
//len:LongInt;
//begin
//Rec_num:=0;
//if dwMsg = LINE_REPLY then { LineMakeCall的响应结果}
//if dwParam2 < 0 then {呼叫响应错误处理}
//else if dwMsg = LINE_CALLSTATE then { 呼叫状态信息 }
//begin
//Call:= THCall(hDevice); //类型转换 THCall为LongInt类型

 //case dwParam1 of
//LINECALLSTATE_IDLE: {呼叫无效处理}
//if call <> 0 then
//begin
//lineDeallocateCall(Call);
//end;
//LINECALLSTATE_PROCEEDING:{呼叫正常处理};
//LINECALLSTATE_DIALTONE:{检测到拨号音};
//LINECALLSTATE_DIALING: {正在拨号};
//LINECALLSTATE_CONNECTED:
//begin

//lVarString := AllocMem(sizeof(lVarString^));
  //    lVarString^.dwTotalSize := sizeof(lVarString^);

    //  lineGetID(0, 0, Call, LINECALLSELECT_CALL, lVarString^, 'comm/datamodem');
      //{---- Make sure we got all the Varstring}
     // if lVarString^.dwNeededSize > lVarString^.dwTotalSize then
     // begin
       //  ReallocMem(lVarString, lVarString^.dwNeededSize);
        // lVarString^.dwTotalSize := lVarString^.dwNeededSize;
         //lReturn := lineGetID(0, 0, Call, LINECALLSELECT_CALL, lVarString^, 'comm/datamodem');
         //if lReturn < 0 then
         //begin
           // MessageDlg('Failed to get Line ID', mtError, [mbok], 0);
            //LineDrop(call, nil, 0);
            //Exit;
        // end;
     // end;

     // {---- Get the handle to the comm port}
     // hCommFile := PHandle(PChar(lVarString) + SizeOf(TVarString))^;
     // if  (hCommFile=0 or hCommFile=null) then
     // MessageDlg('Error establishing connection.', mtError, [mbok], 0)
     // else
      //try
         //StartComm(hCommFile);
      //except
         //if hCommFile <> 0 then
            //CloseHandle(hCommFile);
         //DropCall;
         //raise;
      //end;
      {---- Free the memory help by lpVarString}
      //begin
      //FreeMem(lVarString, lVarString^.dwTotalSize);
   //except


	//	   Clear:=ClearCommError( hCommFile, Error, nil );
          //         if Clear Then Begin
            //       post_event:=CreateEvent(nil,true,true,nil); // 创 建 同 步 事 件；
              //     TcommFtB.Create(False);            // 创 建 串 行 口 监 视 线 程；
         	//Rec_num:=Status.cbInQue;// bytes in input buffer
   			//ReadFile(myhModem,RecBuf,Rec_num,len,lpol);
                        //ReadFile(hCommFile,Read_Buffer,Rec_num,len,nil);
//至此已经为数据通信做好了前期准备,可设立标志
      		//WriteFile(hCommFile,'Success',7,len,nil);
			//ReadFile(hCommFile,Read_Buffer,8,len,nil);
			//ShowMessage(IntToStr(Read_Buffer));
                //      end;






//end;
//end;
//LINECALLSTATE_DISCONNECTED:{连接已断开}
//begin{断开原因}
//if dwParam2=LINEDISCONNECTMODE_NORMAL then{正常断开}
//else if dwParam2=LINEDISCONNECTMODE_BUSY then{线路忙}
//b:=LINECALLSTATE_BUSY{线路忙处理};
//end;
//end;
//end;
//end;



procedure dial(dialnumber:string);//dialnumber为电话号码字符串
//var
  //lineApp:THLineApp;//TAPI应用句柄
    //line:THLine;//线路句柄
    //call:THCall;//呼叫句柄
    //CallParams:TLineCallParams;//呼叫参数
    //A,nDevs,tapiVersion,errorcod:Longint;//线路设备数、TAPI版本号、错误代码
    //extid:TLineExtensionID;//TAPI扩展版本号
    //lineIcon:HICON;//线路设备图标

begin
//with CallParams do {CallParams的类型参考VC中的定义，将DWORD改为LongInt}
//begin
  //  dwTotalSize:=20000000;
    //dwBearerMode:=LINEBEARERMODE_VOICE;//承载模式为语音
    //dwMediaMode:=LINEMEDIAMODE_INTERACTIVEVOICE;//媒体模式为交互式语音
   //end;
if lineInitialize(lineApp,HInstance,@lineCallBack,nil,nDevs)<0
then ShowMessage('线路不能初始化处理')//线路不能初始化处理
else
if nDevs=0 then //无TAPI线路设备
 begin
   lineShutDown(lineApp);
   lineApp:=0;
   ShowMessage('无TAPI线路设备');
    end
  else
if lineNegotiateAPIVersion(lineApp,0,$00010003,$00030001,tapiVersion,extid)<0 //协商TAPI版本号 TAPI1.4～TAPI2.0
then begin {TAPI版本不兼容}
lineShutDown(lineApp);
lineApp:=0;
ShowMessage('TAPI版本不兼容');
end
else
//打开线路
 FillChar(CallParams, sizeof(CallParams), 0);
   with CallParams do
   begin
      dwTotalSize := sizeof(CallParams);
      dwBearerMode := LINEBEARERMODE_VOICE;
      dwMediaMode := LINEMEDIAMODE_DATAMODEM;
   end;

   if lineOpen(lineApp, 0, line, tapiVersion, 0, 0, LINECALLPRIVILEGE_NONE, 0, @CallParams) < 0 then
   begin
      lineShutDown(lineApp);
      lineApp := 0;
      line := 0;
   end;
   if line = 0 then
      MessageDlg('Error Initialising Data Communications', mtError, [mbok], 0);
if lineMakeCall(line, call, PChar(dialnumber), 0, @CallParams) < 0 then
      begin
         MessageDlg('Error: Could not make call.', mtError, [mbok], 0);
      end;
//else
//lineHandOff(call,'电话拨号程序',LINEMEDIAMODE_INTERACTIVEVOICE);
//在程序中应当以按钮来触发lineHandOff，从TAPI控制转为人工控制电话
end;

//end;
procedure TForm1.Button1Click(Sender: TObject);
begin
dial(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Form1.Edit2.Text:=OpenDialog1.FileName;
end;



end.