如何用com口进行文件传输?(5分)

  • 主题发起人 主题发起人 青云
  • 开始时间 开始时间

青云

Unregistered / Unconfirmed
GUEST, unregistred user!
利用com(rs-232)口可以进行传送文本
WriteFile(hComm,Pointer(Temp)^,Length(Temp), lrc, nil); //送出数据
ReadFile(hComm, inbuff,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
,但是如何用来发送和接受文件呢?
 
用PCOMM控件吧,实际上是一个动态连接库,很好用我一直用它,在它里面有个发送文件的例子
 
还是自己做的好,用起来顺手
我做了一个串口通讯控件,虽然功能不全,但比较稳定;
unit CommDai;

interface

uses
Windows, Messages, SysUtils, Classes,Forms ;

type
TParity = ( None, Odd, Even );
TStopBits = ( _1, _1_5, _2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
TCommDai = class(TComponent)
private
FBaudRate: DWORD;
FreadComCount:integer;
FCommName: String;
FParity: TParity;
FStopBits: TStopBits;
FRecieveDelay: Word;
hCommHandle:Thandle;
FFtuAddress:word;
FDataBits: TDataBits;
procedure SetBaudRate(const Value: DWORD);
procedure SetParity(const Value: TParity);
procedure SetStopBits(const Value: TStopBits);
procedure SetRecieveDelay(const Value: Word);
procedure SetDataBits(const Value: TDataBits);


{ Private declarations }
protected
{ Protected declarations }
public
property Handle: THandle read hCommHandle write hCommHandle;
property readComCount:integer read FreadComCount;
function SendString(str:string): string;
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
function stringtohex(str:string): string;
Procedure TimeDelay(DT:DWORD);
function StartComm:boolean;
procedure StopComm;
procedure SendByteArray(SendStr:String) ; overload;
procedure SendByteArray(ByteArray:Array of Byte; SendCount:word);overload;
procedure RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);overload;
function BytesToString(Bytes:Array of Byte;Count:word):String;
function RecieveByteArray:string; overload;

{ Public declarations }
published
property CommName: string read FCommName write FCommName; // String read FCommName write
property BaudRate: DWORD read FBaudRate write SetBaudRate; //read FBaudRate write
property Parity: TParity read FParity write SetParity; //read FParity write FParity
property StopBits: TStopBits read FStopBits write SetStopBits; //read FStopBits write SetStopBits
property RecieveDelay :Word read FRecieveDelay write SetRecieveDelay;
property FtuAddress: word read FFtuAddress write FFtuAddress;
property DataBits: TDataBits read FDataBits write SetDataBits;
{ Published declarations }
end;

procedure Register;
{$R CommDai.dcr}
implementation

procedure Register;
begin
RegisterComponents('dai', [TCommDai]);
end;

{ TCommDai }

procedure TCommDai.SetBaudRate(const Value: DWORD);
begin
FBaudRate := Value;
end;


procedure TCommDai.SetParity(const Value: TParity);
begin
FParity := Value;
end;

procedure TCommDai.SetRecieveDelay(const Value: Word);
begin
FRecieveDelay := Value;
end;


procedure TCommDai.SetStopBits(const Value: TStopBits);
begin
FStopBits := Value;
end;
function TCommDai.stringtohex(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+'$'+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
function TCommDai.SendString(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+' '+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
{ public function or procedure}
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
Procedure TCommDai.TimeDelay(DT:DWORD);
var
TT:DWORD;
begin
//取得现在的Tick值
//TT:=GetTickCount();
//计算Tick差值是否超过设置值

// while GetTickCount()-TT<DT do
// begin
sleep(DT);
// Application.ProcessMessages; //释放控制权
// end;
end;

//以下是打开通信端口的程序
function TCommDai.StartComm:boolean;
var
cc:TCOMMCONFIG;
Temp:string;
begin
hCommHandle:=CreateFile(PChar(FCommName),//文件名指针,如com1,com2
GENERIC_READ or GENERIC_WRITE, //存取属性

2, //共享模式 0-不共享, 1-共相书
nil, OPEN_EXISTING, 0, 0); // 打开COM
if (hCommHandle = INVALID_HANDLE_VALUE) then begin // 如果COM 未打开
result:=false;
exit;
end;

GetCommState(hCommHandle,cc.dcb); // 得知目前COM 的状态

cc.dcb.BaudRate:= BaudRate;//CBR_9600; // 设置波特率为9600
cc.dcb.ByteSize:=ord(FDataBits)+5; // 字节为 8 bit
cc.dcb.Parity:=ord(FParity); //NOPARITY; // Parity 为 None
cc.dcb.StopBits:=ord(StopBits); //ONESTOPBIT; // 1 个Stop bit
if not SetCommState(hCommHandle, cc.dcb) then
begin// 设置COM 的状态
MessageBox (0, '通信端口设置错误!!!','',MB_OK);
CloseHandle(hCommHandle);
result:=false;
exit;
end;
result:=true;
end;

procedure TcommDai.StopComm;
begin
SetCommMask( hCommHandle,$0);
CloseHandle(hCommHandle);
end;
procedure TcommDai.SendByteArray(SendStr:string) ;
var StrTemp :string;
SendByteCount :integer;
SendBuff :Array[0..2047] of Byte;
nBytesRead, dwEvent, dwError:LongWORD ;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
i:integer;
begin

StrTemp:=self.stringtohex(SendStr);
SendByteCount:=Length(StrTemp) div 3;
//SetLength(SendBuff,SendByteCount);
for i:=0 to SendByteCount-1 do
SendBuff:=StrToInt(copy(StrTemp,i*3+1,3));
//实际的传送动作
try
WriteFile(hCommHandle,SendBuff, SendByteCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败!','系统提示!',mb_ok+mb_iconinformation);
end;
end;

PROCEDURE TcommDai.SendByteArray(ByteArray:Array of Byte; SendCount:word);
var
lrc:dword;
begin
try
WriteFile(hCommHandle,ByteArray, SendCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败!','系统提示!',mb_ok+mb_iconinformation);
end;
end;

procedure TcommDai.RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);

var
StrTemp :String;
RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
// timedelay(1);
for i:=1 to 50 do
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
if (i>15) and (cs.cbInQue=0) then break;
comp:=cs.cbInQue;
end;
FreadComCount:=i;
// application.MessageBox(pchar(inttostr(i)),'系统提示!',mb_ok+mb_iconinformation);
RecieveCount:=cs.cbInQue;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
RecieveCount:=0;
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, ByteArray,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except

end;

end;




function TcommDai.RecieveByteArray:string; //用不到了
var
StrTemp :String;

RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
pt:pbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin

timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
timedelay(0);
i:=1;
while i<100 do
begin
timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
comp:=cs.cbInQue;
inc(i);
end;


// 数据是否大于我们所准备的Buffer
if cs.cbInQue=0 then
begin
result:='';

exit;
end;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
result:='';
application.MessageBox('接受溢出,可能是未打开端口!','系统提示!',mb_ok+mb_iconinformation);
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, RecieveBuff,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except
application.MessageBox('接受失败!','系统提示!',mb_ok+mb_iconinformation);
end;
StrTemp:='';
for i:=0 to cs.cbInQue -1 do
StrTemp:=StrTemp+inttohex(RecieveBuff,2)+' ';
Result:=StrTemp;
end;

function TcommDai.BytesToString(Bytes:Array of Byte;Count:word):String;
var i :integer;
StrTemp :String;
begin
strTemp:='';
for i:=0 to Count-1 do
strTemp:=strTemp+ inttohex(Bytes,2)+' ';
Result:=strTemp;
end;


procedure TCommDai.SetDataBits(const Value: TDataBits);
begin
FDataBits := Value;
end;

end.
 
附件里的超级终端就能完成这个功能的
 
不错,超级终端是有这个功能,我想通过dephi实现
 
后退
顶部