(急需高手相助)高分急求:编程实现两机通过Modem和电话线进行通讯、文件传送(重点)!!! (300分)

  • 主题发起人 主题发起人 coolqiang
  • 开始时间 开始时间
C

coolqiang

Unregistered / Unconfirmed
GUEST, unregistred user!
我正在做的一个项目,其中涉及到利用Modem进行通讯,特别是文件的收发。但我以前没做
过,一点思路都没有。在网上找了很久,说得都非常模糊,要么是说利用超级终端进行手
动操作,对我没有帮助。找了一些控件和源码,也都不能用或者不太对劲,万般无奈之下,
只能向各位高手求教了!十万火急!!!
如能详细说明整个思路,并提供源码和资料,帮助我解决问题者,500分重谢!
或者提供控件(最好带源码)及资料,帮助我解决问题者,300答谢!

请注意:提供的资料、源码、控件等,最好是自己研究过,确实对此问题有帮助的,
否则我真的没有那么多时间浪费在这些没有结果的东东上!拜托诸位了!
 
我有使用MSComm控件操纵Modem的例子,但你懂AT命令集吗?不然不能操纵Modem.
 
你可以使用 XModem 协议嘛,把你的具体要求写清楚一点:文件的大小,校验的方式等等,我
替你想想办法,因为这类传输我做得最多了
 
win98本身带了拨号服务的程序,两台机器一台作为拨号服务器,另一台做客户端,
服务器如果是nt和win2000那么一定要安装DHCP服务,这样拨号连接成功后客户机就有
了一个动态ip,在往下就可以用tcp/ip来进行文件传输了!
 
[:)]用VB的MSComm控件,可实现你的文件传输要求。我刚完成一个这样的程序,不过还有待完善
有什么需要发EMAIL给我:fhjd518@sina.com.cn
 
我也正在搞这个东西,我用的是MSComm
其实和串口通讯没有两样,只是多了个拨号建立连接的过程
一般是以下步骤:
1.将发送方的Modem设为自动应答;
2.接收方呼叫发送方,拨通后自动进入数据传输模式;
3.将要发送的文件读入字节流;
4.将要发送的字节写如缓冲区(先将array of byte转换成variant,可能还需要CRC校验);
5.接收方对收到的数据进行处理并重新写成文件就行了.
 
先感谢各位高手对此贴的关注!

御键飞天:
AT命令集我知道一些,也收集了一些AT命令的资料!

SupermanTm:
为什么一定要用XModem协议呢?据我所知,用ZModem好些更合适一些吧!文件大小不
会太大,因为Modem速度不会很快,最多1M吧。校验方式不是传输协议自动有的吗?

shadowno:
我用Win98,你的意思是调用其自身的拨号网络吗?也行啊,只要能实现我要求的功
能。但现在具体如何实现呢?请赐教!

星语心寒:
可以给我用MSComm实现的源码吗?

luckchen8256:
你说的思路跟我开始想的差不多,我现在只是对你说的1、2有些了解,用AT命令可以
实现,后面的我就不太清楚了,可以说得更详细些吗?
 
用delphi自带的NMSTRM和 NMSTRMSERV
看/Delphi5/Demos/FastNet/Strm/Strmdemo例子
 
jammi:
我看了一下,跟Modem没关系啊!
 
可以用apro控件,www.51delphi.com的ftp可以下载,可以用
zmodem协议
 
我做过,可以给你发一份我做过的
mail to: qsilence@sina.com
 
我有Delphi的串口通讯Async 32组件的详细资料,如要我可以发给你。
Mail:Webmaster@eachbuilder.com

下面是一个例程:
unit formMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
CommInt, StdCtrls, ComCtrls;
type
TfrmMain = class(TForm)
Comm1: TComm;
Memo1: TMemo;
Memo2: TMemo;
ButtonOpen: TButton;
ButtonClose: TButton;
ButtonReset: TButton;
EditTransmit: TEdit;
CheckBoxAddLinefeed: TCheckBox;
ButtonTransmit: TButton;
StatusBar1: TStatusBar;
LabelBaudrate: TLabel;
LabelDataBits: TLabel;
LabelStopbits: TLabel;
LabelParity: TLabel;
ComboBaudrate: TComboBox;
ComboDatabits: TComboBox;
ComboStopbits: TComboBox;
ComboParity: TComboBox;
Button1: TButton;
LabelDevName: TLabel;
EditDevName: TEdit;
CheckBoxRTS: TCheckBox;
CheckBoxDTR: TCheckBox;
CheckBoxBREAK: TCheckBox;
CheckBoxXON: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure ButtonOpenClick(Sender: TObject);
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonResetClick(Sender: TObject);
procedure ButtonTransmitClick(Sender: TObject);
procedure Comm1RxChar(Sender: TObject; Count: Integer);
procedure Comm1RxFlag(Sender: TObject);
procedure Comm1TxEmpty(Sender: TObject);
procedure Comm1Break(Sender: TObject);
procedure Comm1Cts(Sender: TObject);
procedure Comm1Dsr(Sender: TObject);
procedure Comm1Error(Sender: TObject; Errors: Integer);
procedure Comm1Ring(Sender: TObject);
procedure Comm1Rlsd(Sender: TObject);
procedure ComboBaudrateChange(Sender: TObject);
procedure ComboDatabitsChange(Sender: TObject);
procedure ComboStopbitsChange(Sender: TObject);
procedure ComboParityChange(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckBoxRTSClick(Sender: TObject);
procedure CheckBoxDTRClick(Sender: TObject);
procedure CheckBoxBREAKClick(Sender: TObject);
procedure CheckBoxXONClick(Sender: TObject);
private
LineData: string;
procedure HandleException(Sender: TObject; E: Exception);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
const
OnOff: array[0..1] of string = ('Off', 'On');
//窗口创建事件
procedure TfrmMain.FormCreate(Sender: TObject);
begin
//Application对象例外处理和本窗口的例外处理过程相关联
Application.OnException := HandleException;
//以下是串口初始化
with ComboBaudrate do
ItemIndex := Items.IndexOf('cbr38400');//波特率:38400 bit/s
with ComboDataBits do
ItemIndex := Items.IndexOf('da8'); //数据位:8位
with ComboParity do
ItemIndex := Items.IndexOf('paNone'); //奇偶校验位:无
with ComboStopbits do
ItemIndex := Items.IndexOf('sb10'); //停止位:无
Comm1.BaudRate := TBaudrate(ComboBaudrate.ItemIndex);
Comm1.Databits := TDataBits(ComboDatabits.ItemIndex);
Comm1.Parity := TParity(ComboParity.ItemIndex);
Comm1.StopBits := TStopBits(ComboStopbits.ItemIndex);
EditDevName.Text := Comm1.DeviceName;
//Comm1对象的通信设备名,例如Com1,Com2等
end;
procedure TfrmMain.HandleException(Sender: TObject; E: Exception);
begin
//若发生通信错误,显示对话框
if E is ECommError then
with E as ECommError do
ShowMessage('Async32 error: ' + Message);
end;
procedure TfrmMain.ButtonOpenClick(Sender: TObject);
begin
{可通过EditDevName.Text设置Comm1.DeviceName值,必须在Comm1.Open进行此操作.}
Comm1.DeviceName := EditDevName.Text;
Comm1.Open;//通信设备打开
Comm1.SetRTSState(true);
Comm1.SetDTRState(true);
Memo1.Lines.add('Device ready: ' + Comm1.DeviceName);
end;
procedure TfrmMain.ButtonCloseClick(Sender: TObject);
begin
Comm1.Close;//通信设备关闭
Memo1.Lines.Add('Device closed: ' + Comm1.DeviceName);
end;
procedure TfrmMain.ButtonResetClick(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
end;
{发送数据}
procedure TfrmMain.ButtonTransmitClick(Sender: TObject);
var
S: string;
Count: Integer;
begin
S := EditTransmit.Text;
if CheckBoxAddLinefeed.Checked then
S := S + #13#10;//字符串S加上回车,换行
Count := Length(S);
Count := Comm1.Write(S[1], Count);//将字符串送入缓冲区
if Count = -1 then
Memo1.Lines.add('Error writing to: ' + Comm1.DeviceName)
else Memo1.Lines.add('Transmitting ' + IntToStr(Count) + ' characters');//若发送失
败Memo1显示错误,否则计算发送字符数
end;
{接收数据并处理}
procedure TfrmMain.Comm1RxChar(Sender: TObject; Count: Integer);
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes, P: Integer;
Begin
//分配内存Buffer,大小与Comm1.ReadBufSize相同
GetMem(Buffer, Comm1.ReadBufSize);
try
Memo1.Lines.add('RxChar signal detected...');
Fillchar(Buffer^, Comm1.ReadBufSize, 0);
//将接收Count字节的字符从收缓冲区读入内存Buffer
Bytes := Comm1.Read(Buffer^, Count);
if Bytes = -1 then
Memo1.Lines.add('Error reading incoming data...')
else
begin
Memo1.Lines.add('Reading ' + IntToStr(Bytes) + v characters');
{以下部分接收数据并进行处理}
for P := 0 to Bytes - 1 do
begin
case Buffer^[P] of
#0, #10:; //接收到#0,#10不加入LineData
#13: begin //#13是换行符
Memo2.Lines.Add(LineData);//把LineData加入Memo2一行
LineData := ' '; //LineData置空
end;
else
begin
LineData := LineData + CharBuf(Buffer^)[P];{把接收到的
CharBuf(Buffer^)[P]加到LineData}
end;
end; //case
end; //for do
end;
Application.ProcessMessages;{中断应用程序的执行,以便Windows能响应事件}
finally
FreeMem(Buffer);//释放Buffer所占内存
end;
end;
procedure TfrmMain.Comm1RxFlag(Sender: TObject);
begin
Memo1.Lines.add('RxFlag signal detected...');{接收到定义为RxFlag的字符}
end;
procedure TfrmMain.Comm1TxEmpty(Sender: TObject);
begin
Memo1.Lines.add('TxEmpty signal detected...');//发缓冲区空检测到
end;
procedure TfrmMain.Comm1Break(Sender: TObject);
begin
Memo1.Lines.add('Break signal detected...');{Break信号(发信号线悬挂)检测到}
end;
procedure TfrmMain.Comm1Cts(Sender: TObject);
begin
Memo1.Lines.add('CTS: ' + OnOff[ord(Comm1.CTS)]); {CTS(clear-to-send)信号On或Off}
end;
procedure TfrmMain.Comm1Dsr(Sender: TObject);
begin
Memo1.Lines.add('DSR: ' + OnOff[ord(Comm1.DSR)]);
{DSR(data-set-ready)信号On或Off}
end;
procedure TfrmMain.Comm1Ring(Sender: TObject);
begin
Memo1.Lines.add('RING: ' + OnOff[ord(Comm1.Ring)]);
{RING(振铃指示)信号On或Off}
end;
procedure TfrmMain.Comm1Rlsd(Sender: TObject);
begin
Memo1.Lines.add('RLSD: ' + OnOff[ord(Comm1.RLSD)]);
{RLSD(receive-line-signal-detect)信号On或Off}
end;
{以下是通信过程中出错提示}
procedure TfrmMain.Comm1Error(Sender: TObject; Errors: Integer);
begin
if (Errors and CE_BREAK > 0) then
Memo1.Lines.add('The hardware detected a break condition.');
if (Errors and CE_DNS > 0) then
Memo1.Lines.add('Windows 95 only: A parallel device is not selected.');
if (Errors and CE_FRAME > 0) then
Memo1.Lines.add('The hardware detected a framing error.');
if (Errors and CE_IOE > 0) then
Memo1.Lines.add('An I/O error occurred during communications with the device.');
if (Errors and CE_MODE > 0) then
begin
Memo1.Lines.add('The requested mode is not supported, or the hFile parameter');
Memo1.Lines.add('is invalid. If this value is specified, it is the only valid
error.');
end;
if (Errors and CE_OOP > 0) then
Memo1.Lines.add('Windows 95 only: A parallel device signaled that it is out of
paper.');
if (Errors and CE_OVERRUN > 0) then
Memo1.Lines.add('A character-buffer overrun has occurred. The next character is
lost.');
if (Errors and CE_PTO > 0) then
Memo1.Lines.add('Windows 95 only: A time-out occurred on a parallel device.');
if (Errors and CE_RXOVER > 0) then
第13章串口通信程序应用剖析385
begin
Memo1.Lines.add('An input buffer overflow has occurred. There is either no');
Memo1.Lines.add('room in the input buffer, or a character was received after');
Memo1.Lines.add('the end-of-file (EOF) character.');
end;
if (Errors and CE_RXPARITY > 0) then
Memo1.Lines.add('The hardware detected a parity error.');
if (Errors and CE_TXFULL > 0) then
begin
Memo1.Lines.add('The application tried to transmit a character, but the
output');
Memo1.Lines.add('buffer was full.');
end;
end;
procedure TfrmMain.ComboBaudrateChange(Sender: TObject);
begin
Comm1.BaudRate := TBaudrate(ComboBaudrate.ItemIndex);//波特率设置
Memo1.Lines.add('Baudrate: ' + ComboBaudrate.Text);
end;
procedure TfrmMain.ComboDatabitsChange(Sender: TObject);
begin
Comm1.Databits := TDataBits(ComboDatabits.ItemIndex);//数据位设置
Memo1.Lines.add('Databits: ' + ComboDatabits.Text);
end;
procedure TfrmMain.ComboStopbitsChange(Sender: TObject);
begin
Comm1.StopBits := TStopBits(ComboStopbits.ItemIndex);//停止位设置
Memo1.Lines.add('StopBits: ' + ComboStopbits.Text);
end;
procedure TfrmMain.ComboParityChange(Sender: TObject);
begin
Comm1.Parity := TParity(ComboParity.ItemIndex);//奇偶检验位设置
Memo1.Lines.add('Parity: ' + ComboParity.Text);
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var
I: Integer;
S: string;
begin
if MessageDlg('This will sent the input a thousand times, continue?',
mtConfirmation, [mbOk, mbCancel], 0) <> mrOk then exit;
S := EditTransmit.Text;
if CheckBoxAddLinefeed.Checked then
S := S + #13#10;
for I := 0 to 1000 do //发送字符串S 1000次进行试验
begin
Comm1.Write(S[1], Length(S));
application.ProcessMessages;//中断应用程序,以便Windows处理别的事件
end;
end;
procedure TfrmMain.CheckBoxRTSClick(Sender: TObject);
begin
Comm1.SetRTSState(CheckBoxRTS.Checked);//设定RTS状态是否检测
end;
procedure TfrmMain.CheckBoxDTRClick(Sender: TObject);
begin
Comm1.SetDTRState(CheckBoxDTR.Checked);//设定DTR状态是否检测
end;
procedure TfrmMain.CheckBoxBREAKClick(Sender: TObject);
begin
Comm1.SetBREAKState(CheckBoxBREAK.Checked);//设定BREAK状态是否检测
end;
procedure TfrmMain.CheckBoxXONClick(Sender: TObject);
begin
Comm1.SetXONState(CheckBoxXON.Checked);//设定XON状态是否检测
end;
end.
 
我们用得这样的方法:
服务器使用nt远程访问服务。安装ftp服务。
客户端只要拨号,登陆,再使用ftp client。

看你的实际情况了,这种方法不适合于所有的机器都是对等的情况。
 
两台机器一台作为拨号服务器,另一台做客户端,通过modem进行拨号,这样拨号连接成功后客户机就有
了一个动态ip,在往下就可以用tcp/ip来进行文件传输了!

 
我以前做过这东西,本来已差不多的了,后来用了Win2000的拨号服务器,
就没有搞了。
 
我只能提供一种思路
用tapi的函数,modem连通后,就对端口操作
下面是我摘自《编程技巧与维护》

用DELPHI进行 Win32环境下串行通讯的程序设计

张秀德 姜新通 张冬生



摘要 由于在Delphi环境中没有提供通讯控件,本文介绍了用Delphi4.0实现的Win32环境下基于线程的串行通讯程序设计,能适当降低数据丢失率以及提高系统可靠性,并给出了一个通讯程序实例。

关键词 串行通讯 多线程 程序设计



在自动化工业控制应用中,经常需要计算机与外围设备进行数据通讯。而异步串行通讯是一种常用的通讯手段。在单任务操作系统中,不能同时处理两件以上不同的任务。Win32是基于线程的多任务操作系统,使得应用程序能同时执行多个任务,即在一个进程中可同时运行多个线程。利用Win32的这个特点,在通讯过程中可以适当降低数据丢失率,提高系统可靠性。

随着Win95系统的逐步普及,程序员们更愿意在Win95下编程。而Delphi也越来越为广大程序员所喜爱。然而,令人遗憾的是在Delphi环境中没有象其它的一些编程语言一样提供标准通讯控件。因此,利用Delphi进行通讯程序设计时,不但要掌握多线程编程技术,还要了解一些与通讯相关的API函数的使用。

一 多线程基本概念

首先介绍进程概念。一个进程通常定义为程序的一个实例。在Win32中,进程占据4GB地址空间。实际上,一个进程可以包含几个线程,它们可以同时执行进程的地址空间中的代码。为了运行所有这些线程,操作系统以轮转方式为每个独立线程分配一些CPU时间片。这给人一种假象,好像这些线程是在同时运行。创建一个Win32进程时,它的第一个线程称为主线程,由系统自动生成。然后可由主线程生成其它的线程,这些线程又可生成更多的线程。

线程描述了进程内的执行,是组成进程的基本单位。每次初始化一个进程时,系统创建一个主线程。通常对于许多应用程序,主线程是应用程序的唯一线程。但是,进程也可以创建额外的线程,目的在于尽可能充分合理的利用CPU时间。线程可以使用CreateThread()函数来创建。

在有若干线程并行运行的环境里,同步各不同线程活动的能力是非常重要的,这样可以避免对共享资源的访问冲突。事件对象是同步线程的最基本形式,它用以向其它线程发信号以表示某一操作已经完成。例如,一个进程可能运行了两个线程。第一个线程从文件读数据到内存缓冲区中。每当数据已被读入,第一个线程就发信号给第二个线程它可以处理数据了。当第二个线程完成了对数据的处理时,它可能需要再次给第一个线程发信号以让第一个线程能够从文件中读入下一块数据。事件可以使用CreateEvent()函数来创建。线程和事件在任何时候都处于两种状态之一:有信号和无信号。当线程被创建和正在运行时,它是无信号的。一旦线程终止,它就变成有信号的。线程可以通过使用SetEvent()和ResetEvent()函数来将事件置成有信号和无信号。

除了以上介绍的概念和函数,在通讯程序中还要用到等待函数WaitForSingleObject()和重叠I/O操作。等待函数能使线程阻塞自身执行,而重叠I/O操作能使费时的操作在后台中运行。

二 通讯程序设计

在Windows环境下,对于串行通讯的控制是通过中断机制驱动的,由系统自行处理。Windows禁止应用程序直接和硬件打交道,程序员只能使用Windows提供的标准函数通过通讯驱动程序与硬件接口。首先,用CreateFile()函数打开通讯端口,然后通过SetupComm() 函数给通讯的输入输出队列分配一定大小的内存缓冲区,接着通过BuildCommDCB()函数 和SetCommState()等函数对主要通讯参数进行设置。初始化完成后就可以利用ReadFile()函数和 WriteFile() 函数对通讯端口进行读写操作了。程序界面如图所示。

本文提供的实例程序使用简单方便。利用一条串行数据线连接在两台计算机Com2之间就可以进行文本文件传输。对于Delphi的具体编程方法这里不再赘述。实例中有详细注释。



unit comunate;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Buttons, StdCtrls, ComCtrls;

const

WM_COMMNOTIFY = WM_USER + 1; // 通讯消息

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

OpenDialog1: TOpenDialog;

Label1: TLabel;

BitBtn1: TBitBtn;

RichEdit1: TRichEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

private

{ Private declarations }

procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;

public

{ Public declarations }

end;



var

Form1: TForm1;

implementation

{$R *.DFM}

var

hNewCommFile,Post_Event: THandle;

Read_os : Toverlapped;

Receive :Boolean;

ReceiveData : Dword;



procedure AddToMemo(Str:PChar;Len:Dword); // 接收的数据送入显示区

begin

str[Len]:=#0;

Form1.RichEdit1.Text:=Form1.RichEdit1.Text+StrPas(str);

end;



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(hNewCommFile,EV_RXCHAR)) then

begin

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

Exit;

end;

while(Receive) do

begin

dwEvtMask:=0;

// 等待通讯事件发生

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

begin

if ERROR_IO_PENDING=GetLastError then

GetOverLappedResult(hNewCommFile,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,hNewCommFile,0);

if (not Ok) then

begin

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

Exit;

end;

end;

end;

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

end;



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

var

CommState : ComStat;

dwNumberOfBytesRead : Dword;

ErrorFlag : Dword;

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

begin

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

begin

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

PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);

Exit;

end;

if (CommState.cbInQue>0) then

begin

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

// 接收通讯数据

if (not ReadFile( hNewCommFile,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(hNewCommFile);

Exit;

end

else

begin

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

GetOverlappedResult(hNewCommFile,Read_os,

dwNumberOfBytesRead,False);

end;

end;

if dwNumberOfBytesRead>0 then

begin

Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;

ReceiveData := Read_Os.Offset;

// 处理接收的数据

AddToMemo(InputBuffer,dwNumberOfBytesRead);

end;

end;

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

SetEvent(Post_Event);

end;



procedure TForm1.Button1Click(Sender: TObject); // 打开文件用于发送

begin

if OpenDialog1.Execute then

begin

Button3.Enabled :=False;

Button4.Enabled :=False;

RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);

Form1.Caption := IntToStr(RichEdit1.GetTextLen);

end;

Button1.Enabled :=False;

end;



procedure TForm1.Button2Click(Sender: TObject); // 发送数据

var

dcb : TDCB;

Error :Boolean;

dwNumberOfBytesWritten,dwNumberOfBytesToWrite,

ErrorFlag,dwWhereToStartWriting : DWORD;

pDataToWrite : PChar;

write_os: Toverlapped;

begin

Form1.Caption :='';

// 打开通讯端口COM2

hNewCommFile:=CreateFile( 'COM2',GENERIC_WRITE,0,

nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );

if hNewCommFile = INVALID_HANDLE_VALUE then

MessageBox(0,'Error opening com port!','Notice',MB_OK);

SetupComm(hNewCommFile,1024,1024); // 设置缓冲区大小及主要通讯参数

GetCommState( hNewCommFile,dcb);

dcb.BaudRate :=9600;

dcb.ByteSize :=8;

dcb.Parity :=NOPARITY;

dcb.StopBits := ONESTOPBIT;

Error := SetCommState( hNewCommFile, dcb );

if ( not Error) then MessageBox(0,'SetCommState Error!','Notice',MB_OK);

dwWhereToStartWriting := 0;

dwNumberOfBytesWritten := 0;

dwNumberOfBytesToWrite :=RichEdit1.GetTextLen;

if (dwNumberOfBytesToWrite=0) then

begin

ShowMessage('Text Buffer is Empty!');

Exit;

end

else

begin

pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);

try

RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);

Label1.Font.Color :=clRed;

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

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

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

SetCommMask(hNewCommFile,EV_TXEMPTY);

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

repeat

Label1.Repaint;

// 发送通讯数据

if not WriteFile( hNewCommFile,pDataToWrite[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(hNewCommFile,Write_os,

dwNumberOfBytesWritten,False);

end

else

begin

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

Receive :=False;

CloseHandle(Read_Os.hEvent);

CloseHandle(Post_Event);

CloseHandle(hNewCommFile);

Exit;

end;

end;

end;

Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );

Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );

until (dwNumberOfBytesToWrite <= 0); // Write the whole thing!

Form1.Caption:=IntToStr(dwWhereToStartWriting);

finally

StrDispose(pDataToWrite);

end;

CloseHandle(hNewCommFile);

end;

Label1.Font.Color :=clBlack;

Label1.Caption:='发送成功!';

Button1.Enabled :=True;

Button3.Enabled :=True;

Button4.Enabled :=True;

end;



procedure TForm1.Button3Click(Sender: TObject); // 接收处理

var

Ok : Boolean;

dcb : TDCB;

com_thread: Thandle;

ThreadID:DWORD;

begin

ReceiveData :=0;

Button1.Enabled :=False;

Button2.Enabled :=False;

RichEdit1.Clear;

// 打开COM2

hNewCommFile:=CreateFile( 'COM2',GENERIC_READ,0,

nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );

if hNewCommFile = INVALID_HANDLE_VALUE then

begin

MessageBox(0,'Error opening com port!','Notice',MB_OK);

Exit;

end;

Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);

if ( not Ok) then

begin

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

Exit;

end;

SetupComm(hNewCommFile,1024,1024);

GetCommState( hNewCommFile, dcb );

dcb.BaudRate :=9600;

dcb.ByteSize :=8;

dcb.Parity :=NOPARITY;

dcb.StopBits := ONESTOPBIT;

Ok := SetCommState( hNewCommFile, dcb );

if ( not Ok) then MessageBox(0,'SetCommState Error!','Notice',MB_OK);

FillChar(Read_Os,SizeOf(Read_Os),0);

Read_Os.Offset := 0;

Read_Os.OffsetHigh := 0;

// Create Event for Overlapped Read

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

if Read_Os.hEvent=null then

begin

CloseHandle(hNewCommFile);

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

Exit;

end;

// Create Event for PostMessage

Post_Event:=CreateEvent(nil,True,True,nil);

if Post_Event=null then

begin

CloseHandle(hNewCommFile);

CloseHandle(Read_Os.hEvent);

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

Exit;

end;

// 建立通信监视线程

Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);

if (Com_Thread=0) then

MessageBox(Handle,'No CraeteThread!',nil,mb_OK);

EscapeCommFunction(hNewCommFile,SETDTR);

Label1.Font.Color :=clRed;

Label1.Caption:='正在接收数据...!';

end;



procedure TForm1.Button4Click(Sender: TObject); // 停止通讯处理

begin

Label1.Font.Color :=clBlack;

Label1.Caption:='infomation';

Form1.Caption := IntToStr(ReceiveData);

Receive :=False;

CloseHandle(Read_Os.hEvent);

CloseHandle(Post_Event);

CloseHandle(hNewCommFile);

Button1.Enabled :=True;

Button2.Enabled :=True;

end;



end.



参考文献

1.Windows95 Windows NT3.5高级编程技术 Jeffrey Richter著

2.基于Windows 95&amp;NT的串行通信编程 李柯 <<微电脑世界>> 1997。5

3.Windows 95中的串行通信 王齐 <<微电脑世界>> 1997。3
 
to: qsilence
可以给我发一份你做过的吗?
antic_ant@hotmail.com
 
to: qsilence
可以给我发一份你做过的吗?
wenqihe@sina.com.cn
 
你好:我和你有相同的景遇,我用mscomm控件能实现两电脑之间通过modem发送字符
但不知道如何发送paradox表,如果你已经有了方法请帮助我下,也请有经验的朋友
伸出援助之手,在下不胜感激!!!,我还有三天的时间就被炒了。希望得到帮助。
emai:zzxhw@163.com
oicq:46350214
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部