我试过了,在WIN2000下是不能对端口操作的,除非用API数.
解决方案 »
- TMemoryStream保存到数据库
- adotest的问题
- 禁止程序在虚拟机运行。
- 以下的这个小写数字转大写数字的函数如何修改?
- TClientDataSet中某个字段的ProviderFlags有什么用?怎么用???
- 怎样获得ACCESS数据表的字段类型的返回值?
- 我用delphi、oracle数据库、本地库sqlanywhere,ADO连接数据库,怎样把oracle的表和数据复制到本地库sqlanywhere上??
- 请问TVarData的用法? 谢谢!
- winsocket长久保持连接怎样实现?应采用多线程吗?这样行吗?
- 诚聘程序员
- 两个表的结构一模一样,我如何把查询到的一些记录直接"复制"到另一表中?insert into table1 values (select * from table2 where ..),不
- 做个商业软件是否要交gif编码版权费给Unysis公司呢?
procedure TForm1.Button1Click(Sender: TObject);
var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware',false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for i := 0 to ts.Count -1 do begin
Memo1.Lines.Add(reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
end;
设定串口
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
Buffer : PCommConfig;
size : DWORD;
begin
CommPort := 'COM1';
{Open the comm port}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if hCommFile=INVALID_HANDLE_VALUE then
begin
ShowMessage('Unable to open '+ CommPort);
exit;
end;
{Allocate a temporary buffer}
GetMem(Buffer, sizeof(TCommConfig));
{Get the size of the CommConfig structure}
{as it may be different than documented}
size := 0;
GetCommConfig(hCommFile, Buffer^, size);
{Free the temporary buffer}
FreeMem(Buffer, sizeof(TCommConfig));
{Allocate the CommConfig structure}
GetMem(Buffer, size);
GetCommConfig(hCommFile, Buffer^, size);
{Change the baud rate}
Buffer^.dcb.BaudRate := 1200;
{Set the comm port to the new configuration}
SetCommConfig(hCommFile, Buffer^, size);
{Free the buffer}
FreeMem(Buffer, size);
{Close the comm port}
CloseHandle(hCommFile);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
Buffer : PCommConfig;
size : DWORD;
begin
CommPort := 'COM1';
{Open the comm port}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if hCommFile=INVALID_HANDLE_VALUE then
begin
ShowMessage('Unable to open '+ CommPort);
exit;
end;
{Get a temporary buffer}
GetMem(Buffer, sizeof(TCommConfig));
{Get the size of the CommConfig structure}
{as it may be different than documented}
size := 0;
GetCommConfig(hCommFile, Buffer^, size);
{Free the temporary buffer}
FreeMem(Buffer, sizeof(TCommConfig));
{Get the CommConfig structure}
GetMem(Buffer, size);
GetCommConfig(hCommFile, Buffer^, size);
{Pop up the comm port config dialog}
if CommConfigDialog(PChar(CommPort),Form1.Handle,Buffer^) = true then begin
{Set the com port to the values entered}
{in the dialog if the user pressed ok}
SetCommConfig(hCommFile, Buffer^, size);
end;
{Free the buffer}
FreeMem(Buffer, size);
{Close the comm port}
CloseHandle(hCommFile);
end;
unit frmComm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls,GeoUtils,GeoGPS;
const MAXBLOCK = 160;
type
TComm = record
idComDev : THandle;
fConnected : Boolean;
end;
TCommForm = class(TForm)
ComboBox1: TComboBox;
Button1: TButton;
StatusBar1: TStatusBar;
Button2: TButton;
ComboBox2: TComboBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
TCommThread = Class(TThread)
protected
procedure Execute;override;
public
constructor Create;
end;
var
CommForm: TCommForm;
CommHandle : THandle;
Connected : Boolean;
CommThread : TCommThread;
implementation
{$R *.DFM}
uses
frmMain,frmMdiMapView;
procedure TCommThread.Execute;
var
dwErrorFlags,dwLength : DWORD;
ComStat : PComStat;
fReadStat : Boolean;
InChar : Char;
AbIn : String;
XX,YY : double; //经度、纬度
VID : string; //车号
begin
while Connected do begin
GetMem(ComStat,SizeOf(TComStat));
ClearCommError(CommHandle, dwErrorFlags, ComStat);
if (dwErrorFlags > 0) then begin
PurgeComm(CommHandle,(PURGE_RXABORT and PURGE_RXCLEAR));
// return 0;
end;
dwLength := ComStat.cbInQue;
if (dwLength>0) then begin
fReadStat := ReadFile(CommHandle, InChar, 1,dwLength, nil);
if (fReadStat) then begin
if (InChar <> Chr(13)) and (Length(abIn) < MAXBLOCK+5 ) then AbIn := AbIn + InChar
else begin
...
{接收完毕,}
end;//if (fReadStat>0){
end; //if (dwLength>0){
FreeMem(ComStat);
end;{while}
end;
constructor TCommThread.Create;
begin
FreeOnTerminate := TRUE;
inherited Create(FALSE); //Createsuspended = false
end;
procedure TCommForm.Button1Click(Sender: TObject);
var
CommTimeOut : TCOMMTIMEOUTS;
DCB : TDCB;
fRetVal : Boolean;
begin
StatusBar1.SimpleText := '连接中...';
CommHandle := CreateFile((PCharComboBox1.Text),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
if CommHandle = INVALID_HANDLE_VALUE then begin
StatusBar1.SimpleText := '连接失败';
Exit;
end;
StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接!';
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
CommTimeOut.ReadTotalTimeoutMultiplier := 0;
CommTimeOut.ReadTotalTimeoutConstant := 0;
SetCommTimeouts(CommHandle, CommTimeOut);
GetCommState(CommHandle,DCB);
DCB.BaudRate := 9600;
DCB.ByteSize := 8;
DCB.Parity := NOPARITY;
DCB.StopBits := ONESTOPBIT;
fRetVal := SetCommState(CommHandle, DCB);
if (fRetVal) then begin
Connected := TRUE;
try
CommThread := TCommThread.Create;
except
Connected := FALSE;
CloseHandle(CommHandle);
fRetVal := FALSE;
StatusBar1.SimpleText := '线程建立失败';
Exit;
end;
end
else begin
Connected := FALSE;
CloseHandle(CommHandle);
end;
end;
procedure TCommForm.Button2Click(Sender: TObject);
begin
Connected := FALSE;
CloseHandle(CommHandle);
{终止线程}
CommThread.Terminate;
StatusBar1.SimpleText := '关闭端口'+ComboBox1.Text;
end;
procedure TCommForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Connected := FALSE;
CloseHandle(CommHandle);
statusBar1.SimpleText := '关闭端口'+ComboBox1.Text;
end;
end.
CloseHandle : 关闭串行口
SetupComm : 设置通信缓冲区的大小
ReadFile : 读串口操作
WriteFile : 写串口操作
SetCommState : 设置通信参数
GetCommState : 获取默认通信参数
ClearCommErro: r清除串口错误并获取当前状态 除上述几个函数外,还要经常用到一个重要的记录DCB(设备控制块)。DCB中记录有可定义的串行口参数,设置串行口参数时必须先用GetCommState函数将系统默认值填入DCB控制块,然后才可把用户想改变的自定义值设定。在WIN95/NT中进行串行通信除了解基本的通信操作函数外,还要掌握多线程编程。线程是进程内部执行的路径,是操作系统分配CPU时间的基本实体。每个进程都由单线程开始完成应用程序的执行。串行通信需要利用多线程技术实现,其主要的处理逻辑可以表述如下:进程一开始先由主线程做一些必要的初始化工作,然后主线程根据需要在适当时候建立通信监视线程监视通信口,当指定的串行口事件发生时,向主线程发送WM_COMMNOTIFY消息(由于WIN95取消了WM_COMMNOTIFY消息,因此必须自己创建),主线程对其进行处理。若不需要WM_COMMNOTIFY消息,则主线程终止通信监视线程。多线程同时执行,将会引起对共享资源的冲突。为避免冲突,就要用同步多线程对共享资源进行访问。WIN95提供了许多保持线程同步的方法,笔者采用创建事件对象来保持线程同步。通过CraeteEvent()创建事件对象,使用SetEvent() 或PulseEvent()函数将事件对象设置成信号同步。在应用程序中,利用WaitSingleObject() 函数等待同步的触发,等到指定的事件被其它线程设置为有信号时,才继续向下执行程序。Delphi下的具体实现方法 Delphi的强大功能和支持多线程的面向对象编程技术,使得实现串行通信非常简单方便。它通过调用外部的API函数来实现,主要步骤如下:首先,利用CreateFile函数打开串行口,以确定本应用程序对此串行口的占有权,并封锁其它应用程序对此串口的操作;其次,通过GetCommState函数填充设备控制块DCB,再通过调用SetCommState函数配置串行口的波特率、数据位、校验位和停止位。然后,创建串行口监视线程监视串行口事件。在此基础上就可以在相应的串口上操作数据的传输;最后,用CloseHandle函数关闭串行口。具体的程序如下,本程序用Delphi3.0编制在Win95环t境下调试通过,已投入实际应用中,供广大读者参考。程序:
unit comdemou;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
Wm_commNotify=Wm_User+12;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
Procedure comminitialize;
Procedure MsgcommProcess(Var Message:Tmessage); Message Wm_commnotify;
{ Private declarations }
public
{ Public declarations }
end;
// 线 程 声 明
TComm=Class(TThread)
protected
procedure Execute;override;
end;
var
Form1: TForm1;
hcom,Post_Event:Thandle;
lpol:Poverlapped;
implementation
{$R *.DFM}
Procedure TComm.Execute; // 线 程 执 行 过 程
var
dwEvtMask:Dword;
Wait:Boolean;
Begin
fillchar(lpol,sizeof(toverlapped),0);
While True do Begin
dwEvtMask:=0;
Wait:=WaitCommEvent(hcom,dwevtmask,lpol); // 等 待 串 行 口事 件;
if Wait Then Begin
waitforsingleobject(post_event,infinite); // 等 待 同 步 事件 置 位;
resetevent(post_event); // 同 步 事 件 复 位;
PostMessage(Form1.Handle,WM_COMMNOTIFY,0,0);// 发 送 消 息;
end;
end;
end;
procedure Tform1.comminitialize; // 串 行 口 初 始 化
var
lpdcb:Tdcb;
Begin
hcom:=createfile('com2',generic_read or generic_write,0,nil,open_existing,
file_attribute_normal or file_flag_overlapped,0);// 打 开 串行 口
if hcom=invalid_handle_value then
else
setupcomm(hcom,4096,4096); // 设 置 输 入, 输 出 缓 冲区 皆 为4096 字 节
getcommstate(hcom,lpdcb); // 获 取 串 行 口 当 前 默 认设 置
lpdcb.baudrate:=2400;
lpdcb.StopBits:=1;
lpdcb.ByteSize:=8;
lpdcb.Parity:=EvenParity; // 偶 校 验
Setcommstate(hcom,lpdcb);
setcommMask(hcom,ev_rxchar);
// 指 定 串 行 口 事 件 为 接 收 到 字 符;
end;
Procedure TForm1.MsgcommProcess(Var Message:Tmessage);
var
Clear:Boolean;
Coms:Tcomstat;
cbNum,ReadNumber,lpErrors:Integer;
Read_Buffer:array[1..100]of char;
Begin
Clear:=Clearcommerror(hcom,lpErrors,@Coms);
if Clear Then Begin
cbNum:=Coms.cbInQue;
ReadFile(hCom,Read_Buffer,cbNum,ReadNumber,lpol);
// 处 理 接 收 数 据
SetEvent(Post_Event); // 同 步 事 件 置 位
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
comminitialize;
post_event:=CreateEvent(nil,true,true,nil); // 创 建 同 步事 件;
Tcomm.Create(False); // 创 建 串 行 口 监 视 线 程;
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls,GeoUtils,GeoGPS;
const MAXBLOCK = 160;
type
TComm = record
idComDev : THandle;
fConnected : Boolean;
end;
TCommForm = class(TForm)
ComboBox1: TComboBox;
Button1: TButton;
StatusBar1: TStatusBar;
Button2: TButton;
ComboBox2: TComboBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
TCommThread = Class(TThread)
protected
procedure Execute;override;
public
constructor Create;
end;
var
CommForm: TCommForm;
CommHandle : THandle;
Connected : Boolean;
CommThread : TCommThread;
implementation
{$R *.DFM}
uses
frmMain,frmMdiMapView;
procedure TCommThread.Execute;
var
dwErrorFlags,dwLength : DWORD;
ComStat : PComStat;
fReadStat : Boolean;
InChar : Char;
AbIn : String;
XX,YY : double; file://经度、纬度
VID : string; file://车号
begin
while Connected do begin
GetMem(ComStat,SizeOf(TComStat));
ClearCommError(CommHandle, dwErrorFlags, ComStat);
if (dwErrorFlags > 0) then begin
PurgeComm(CommHandle,(PURGE_RXABORT and PURGE_RXCLEAR));
// return 0;
end;
dwLength := ComStat.cbInQue;
if (dwLength>0) then begin
fReadStat := ReadFile(CommHandle, InChar, 1,dwLength, nil);
if (fReadStat) then begin
if (InChar <> Chr(13)) and (Length(abIn) < MAXBLOCK+5 ) then AbIn := AbIn + InChar
else begin
...
{接收完毕,}
end;//if (fReadStat>0){
end; file://if (dwLength>0){
FreeMem(ComStat);
end;{while}
end;
constructor TCommThread.Create;
begin
FreeOnTerminate := TRUE;
inherited Create(FALSE); file://Createsuspended = false
end;
//
procedure TCommForm.Button1Click(Sender: TObject);
var
CommTimeOut : TCOMMTIMEOUTS;
DCB : TDCB;
fRetVal : Boolean;
begin
StatusBar1.SimpleText := '连接中...';
CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL
, 0);
if CommHandle = INVALID_HANDLE_VALUE then begin
StatusBar1.SimpleText := '连接失败';
Exit;
end;
StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接!';
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
CommTimeOut.ReadTotalTimeoutMultiplier := 0;
CommTimeOut.ReadTotalTimeoutConstant := 0;
SetCommTimeouts(CommHandle, CommTimeOut);
GetCommState(CommHandle,DCB);
DCB.BaudRate := 9600;
DCB.ByteSize := 8;
DCB.Parity := NOPARITY;
DCB.StopBits := ONESTOPBIT;
fRetVal := SetCommState(CommHandle, DCB);
if (fRetVal) then begin
Connected := TRUE;
try
CommThread := TCommThread.Create;
except
Connected := FALSE;
CloseHandle(CommHandle);
fRetVal := FALSE;
StatusBar1.SimpleText := '线程建立失败';
Exit;
end;
end
else begin
Connected := FALSE;
CloseHandle(CommHandle);
end;
end;
procedure TCommForm.Button2Click(Sender: TObject);
begin
Connected := FALSE;
CloseHandle(CommHandle);
{终止线程}
CommThread.Terminate;
StatusBar1.SimpleText := '关闭端口'+ComboBox1.Text;
end;
procedure TCommForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Connected := FALSE;
CloseHandle(CommHandle);
StatusBar1.SimpleText := '关闭端口'+ComboBox1.Text;
end;
end.