SPCOMM控件做个例子却不好使,无法打开端口

Question

unit Mainfrm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SPComm, StdCtrls, ComCtrls;type
  TfrmComm = class(TForm)
    MmoComm: TMemo;
    EdtCommName: TEdit;
    EdtBaudRate: TEdit;
    CmbByteSize: TComboBox;
    CmbParity: TComboBox;
    CmbStopBits: TComboBox;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    stat1: TStatusBar;
    EdtSendText: TEdit;
    lbl6: TLabel;
    BtnOpen: TButton;
    BtnSend: TButton;
    btnClose: TButton;
    Comm: TComm;
    procedure FormCreate(Sender: TObject);
    procedure BtnOpenClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure BtnSendClick(Sender: TObject);
    procedure CommReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure EdtBaudRateExit(Sender: TObject);
    procedure CmbByteSizeChange(Sender: TObject);
    procedure CmbStopBitsChange(Sender: TObject);
    procedure CmbParityChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frmComm: TfrmComm;implementation{$R *.DFM}
//³õʼ»¯ÐÅÏ¢
procedure TfrmComm.FormCreate(Sender: TObject);
begin
   EdtCommName.Text  :='COM1';
   EdtBaudRate.Text :='9600';
   CmbByteSize.ItemIndex :=3;
   CmbParity.ItemIndex :=0;
   CmbStopBits .ItemIndex :=0;
end;
//´ò¿ª¶Ë¿Ú
procedure TfrmComm.btnOpenClick(Sender: TObject);
begin
  //ÉèÖô®¿Ú²ÎÊý
  comm.CommName := edtCommName.Text;
  comm.BaudRate := strToInt(edtBaudRate.Text);
  comm.ByteSize := TByteSize(cmbByteSize.ItemIndex);
  comm.StopBits := TStopBits(cmbStopBits.ItemIndex);
  comm.Parity := TParity(cmbParity.ItemIndex);
  //´ò¿ª´®¿Ú
  try
    Comm.StartComm;
  except
    raise Exception.Create('´ò¿ª´®¿Ú´íÎó');
  end;
  stat1.Panels[0].Text := Comm.CommName + 'ÒÑ´ò¿ª';
  stat1.Refresh;
  btnOpen.Enabled := False;
  btnSend.Enabled := True;
  btnClose.Enabled := True;
end;
//¹Ø±Õ´®¿Ú
procedure TfrmComm.btnCloseClick(Sender: TObject);
begin
 Comm.StopComm;
  self.stat1.Panels[0].Text := Comm.CommName + 'ÒѹرÕ';
  stat1.Refresh;
end;
//·¢ËÍÏûÏ¢
procedure TfrmComm.BtnSendClick(Sender: TObject);
var
  str: Pchar;
  Count: integer;
begin
  str := Pchar(EdtSendText.Text);
  Count := Length(str);
  if Comm.WriteCommData(str, Count) then
    mmoComm.Lines.Add('ÒÑ·¢ËÍ' + intTostr(Count) + '¸ö×Ö·û')
  else
    raise exception.Create('·¢ËÍ´íÎó');
end;
//´®¿Ú½ÓÊÕÊý¾Ý
procedure TfrmComm.CommReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  strRecv : string;
begin
  setLength(strRecv,BufferLength);
  Move(Buffer^,pchar(strRecv)^,BufferLength);
  mmoComm.Lines.Add('ÒÑÊÕµ½£º'+intTostr(BufferLength)+'×Ö½ÚµÄÊý¾Ý');
  mmoComm.Lines.Add(strRecv);
  mmoComm.Invalidate ;
end;
 //ÑéÖ¤²¨ÌØÂÊ
procedure TfrmComm.EdtBaudRateExit(Sender: TObject);var
  i: integer;
begin
  try
    i := strToInt(edtBaudRate.Text)
  except
    edtBaudRate.setfocus;
    raise Exception.Create('²¨ÌØÂÊÉèÖôíÎó');
  end;
    //¸Ä±ä´®¿ÚµÄ²¨ÌØÂÊ
  comm.BaudRate := StrToInt(edtBaudRate.Text);end;procedure TfrmComm.CmbByteSizeChange(Sender: TObject);
begin
//¸Ä±ä´®¿ÚµÄÊý¾Ýλ
  comm.ByteSize := TByteSize(cmbByteSize.ItemIndex);
end;procedure TfrmComm.CmbStopBitsChange(Sender: TObject);
begin
//¸Ä±ä´®¿ÚµÄֹͣλ
  comm.StopBits := TStopBits(cmbStopBits.ItemIndex);
end;procedure TfrmComm.CmbParityChange(Sender: TObject);
begin
    //ÉèÖô®¿ÚµÄÆæżУÑéλ
  comm.Parity := TParity(cmbParity.ItemIndex);
end;end.
我在两台台式机上试,无法打开端口请问哪位大大帮忙看下!

Answer 1

因为本人用本子做的,而本子测试不了,找了两台台式机,遇行程序打开端口时,先是提示LIST OUT INDEX OF BOUND(0)
我看源程序只有下拉框可能出现这个错误,可是也没有什么错误呀!

Answer 2

错误可能是因为没有COM1端口,你应该先枚举出机器的可用com口

Answer 3

  comm.ByteSize := TByteSize(cmbByteSize.ItemIndex);
  comm.StopBits := TStopBits(cmbStopBits.ItemIndex);估计这个越界了，-1...n 

Answer 4

procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0,
    KEY_READ, KeyHandle);  if ErrCode <> ERROR_SUCCESS then
    raise ERegError.Create('打开串口列表的注册表项出错');  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
        Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen);      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else if ErrCode <> ERROR_NO_MORE_ITEMS then
        raise ERegError.Create('打开串口列表的注册表项出错');    until (ErrCode <> ERROR_SUCCESS);    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;
end;列举本机可用串口