我试过了,在WIN2000下是不能对端口操作的,除非用API数.

解决方案 »

  1.   

    如何知道系统有几个串口 
    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;
      

  2.   

    串口通讯的监听 
    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.
      

  3.   

    Delphi中串行通信的实现 基于WIN95/NT的串行通信机制  Windows操作系统的机制禁止应用程序直接访问计算机硬件,但它为程序员提供了一系列的标准API函数,使得应用程序的编制更加方便并且免除了对有关硬件的调试麻烦。在Windows95/NT中,原来Windows3.X的WM_COMMNOTIFY消息已被取消,操作系统为每个通信设备开辟了用户可定义大小的读/写缓冲区,数据进出通信口均由操作系统后台完成,应用程序只需对读/写缓冲区操作即可。WIN95/NT中几个常用的串行通信操作函数如下:   CreatFile  : 打开串行口
       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.
      

  4.   

    Delphi串口通讯的监听  串口程序我后来研究了好久,写了下面的代码,后台生成一个线程监听串口,不影响前台工作。效果很好,一直用于GPS仪器的数据接收。 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; 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.