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;
     Wm_ycommNotify=Wm_User+101;
type
  TForm1 = class(TForm)
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    Edit1: TEdit;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    Procedure MsgcommProcess(Var Message:Tmessage); Message Wm_ycommNotify;
    Procedure WMCOMMNOTIFY(Var Message:Tmessage); Message Wm_mycommNotify;
    procedure Button2Click(Sender: TObject);
  private
    

    { Private declarations }
  public
    { Public declarations }
  end;
  TComm=Class(TThread)
  protected
     procedure Execute;override;
  end;

var
  Form1: TForm1;
  hcom,Post_Event:Thandle;

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;
lVarString : LPVarString;
lReturn : Longint;
ToF: file;
NumWritten:Integer;
Read_Os:Toverlapped;
ErrorFlag:DWORD;
Receive:bool;


procedure CommWatch(Ptr:Pointer);stdcall; // 通讯监视线程

var

dwEvtMask,dwTranser : Dword;

Ok : Boolean;

Os : Toverlapped;

begin

Receive :=True;

FillChar(Os,SizeOf(Os),0);

Os.hEvent :=CreateEvent(nil,True,False,nil); // 创建重叠读事件对象

if Os.hEvent=null then

begin

MessageBox(0,'Os.Event Create Error !','Notice',MB_OK);

Exit;

end;

if (not SetCommMask(hCommFile,EV_RXCHAR)) then

begin

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

Exit;

end;

while(Receive) do

begin

dwEvtMask:=0;

// 等待通讯事件发生

if not WaitCommEvent(hCommFile,dwEvtMask,@Os) then

begin

if ERROR_IO_PENDING=GetLastError then

GetOverLappedResult(hCommFile,Os,dwTranser,True)

end;

if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then

begin

// 等待允许传递WM_COMMNOTIFY通讯消息

WaitForSingleObject(Post_event,INFINITE);

// 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息

ResetEvent(Post_Event);

// 传递WM_COMMNOTIFY通讯消息

Ok:=PostMessage(Form1.Handle,WM_COMMNOTIFY,hCommFile,0);

if (not Ok) then

begin

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

Exit;

end;

end;

end;

CloseHandle(Os.hEvent); // 关闭重叠读事件对象

end;





Procedure TComm.Execute;    // 线 程 执 行 过 程
var
dwEvtMask:Dword;
Wait:Boolean;
Begin
fillchar(lpol,sizeof(toverlapped),0);
While True do Begin
      dwEvtMask:=0;
      Wait:=WaitCommEvent(hCommFile,dwevtmask,lpol);      // 等 待 串 行 口 事 件；
      if Wait Then Begin
         waitforsingleobject(post_event,infinite);   // 等 待 同 步 事 件 置 位；
         resetevent(post_event);                     // 同 步 事 件 复 位；
         PostMessage(Form1.Handle,Wm_mycommNotify,0,0);// 发 送 消 息；
         end;
      end;
end;

Procedure TForm1.MsgcommProcess(Var Message:Tmessage);
var
Clear:Boolean;
Coms:Tcomstat;
cbNum,ReadNumber,lpErrors:Integer;
Read_Buffer:array[1..2048]of byte;
dwNumberOfBytesRead : Dword;
Begin
Clear:=ClearCommError( hCommFile, Error, nil );
if Clear Then Begin
   begin

fillchar(Read_Buffer,sizeof(Read_Buffer),#0);
FillChar(Read_Os,SizeOf(Read_Os),0);

// Create Event for Overlapped Read

Read_Os.hEvent :=CreateEvent(nil,true,False,nil);

if Read_Os.hEvent=null then

begin

CloseHandle(hCommFile);

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

Exit;

end;

// 接收通讯数据

if (not ReadFile( hCommFile,Read_Buffer,2048,

dwNumberOfBytesRead,@Read_os )) then

begin

ErrorFlag := GetLastError();

if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then

begin

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

Receive :=False;

CloseHandle(Read_Os.hEvent);

CloseHandle(Post_Event);

CloseHandle(hCommFile);

Exit;

end

else

begin

WaitForSingleObject(hCommFile,INFINITE); // 等待操作完成

GetOverlappedResult(hCommFile,Read_os,

dwNumberOfBytesRead,False);

end;

end;

if dwNumberOfBytesRead>0 then

begin

Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;

//ReceiveData := Read_Os.Offset;

// 处理接收的数据

BlockWrite(ToF, Read_Buffer, dwNumberOfBytesRead, NumWritten);


end;

end;

// 允许发送下一个WM_COMMNOTIFY消息

SetEvent(Post_Event);


   end;
end;




procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数

var

CommState : ComStat;

dwNumberOfBytesRead : Dword;

ErrorFlag : Dword;

InputBuffer : Array [0..1024] of Char;

begin

if not ClearCommError(hCommFile,ErrorFlag,@CommState) then

begin

MessageBox(0,'ClearCommError !','Notice',MB_OK);

PurgeComm(hCommFile,Purge_Rxabort or Purge_Rxclear);

Exit;

end;

if (CommState.cbInQue>0) then

begin

fillchar(InputBuffer,CommState.cbInQue,#0);

// 接收通讯数据

if (not ReadFile( hCommFile,InputBuffer,CommState.cbInQue,

dwNumberOfBytesRead,@Read_os )) then

begin

ErrorFlag := GetLastError();

if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then

begin

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

Receive :=False;

CloseHandle(Read_Os.hEvent);

CloseHandle(Post_Event);

CloseHandle(hCommFile);

Exit;

end

else

begin

WaitForSingleObject(hCommFile,INFINITE); // 等待操作完成

GetOverlappedResult(hCommFile,Read_os,

dwNumberOfBytesRead,False);