delphixe3中运行程序后报错Project Project1.exe raised exception class $C0000005 wit

时间:2022-05-12 18:36:17
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,Registry,
  nrclasses, nrcomm, rtcInfo, rtcConn, rtcTcpCli,Unit2;

type
  TForm1 = class(TForm)
    cbb2: TComboBox;
    tv1: TTreeView;
    cbb1: TComboBox;
    scrlbx1: TScrollBox;
    scrlbx2: TScrollBox;
    edt1: TEdit;
    lbl1: TLabel;
    btn1: TButton;
    btn2: TButton;
    nrcm1: TnrComm;
    edt2: TEdit;
    lbl2: TLabel;
    btn3: TButton;
    btn4: TButton;
    edt3: TEdit;
    edt4: TEdit;
    lbl3: TLabel;
    lbl4: TLabel;
    rtctcpclnt1: TRtcTcpClient;
    edt5: TEdit;
    edt6: TEdit;
    lbl5: TLabel;
    lbl6: TLabel;
    btn5: TButton;
    mmo1: TMemo;
    btn6: TButton;
    btn7: TButton;
    procedure cbb1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure nrcm1AfterReceive(Com: TObject; Buffer: Pointer;
      Received: Cardinal);
    procedure btn3Click(Sender: TObject);
    procedure cbb2Change(Sender: TObject);
    procedure tv1Change(Sender: TObject; Node: TTreeNode);
    procedure btn5Click(Sender: TObject);
    procedure rtctcpclnt1DataReceived(Sender: TRtcConnection);
    procedure rtctcpclnt1Connect(Sender: TRtcConnection);
    procedure btn6Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
 c:Integer;
 str:TStrings;
 idd,idd1,idd2:string;
{$R *.dfm}


procedure TForm1.btn1Click(Sender: TObject);
begin
 nrcm1.SendString('\RDID');
 c:=1;
end;


procedure TForm1.btn2Click(Sender: TObject);
begin
 nrcm1.SendString('\STID'+edt1.Text);
 c:=2;
end;


procedure TForm1.btn3Click(Sender: TObject);
begin
 nrcm1.SendString('\STALL?');
 Sleep(200);
 c:=3;
end;


procedure TForm1.btn5Click(Sender: TObject);
begin
 rtctcpclnt1.ServerAddr:=edt5.Text;
 rtctcpclnt1.ServerPort:=edt6.Text;
 rtctcpclnt1.Connect;
 rtctcpclnt1.Write('hsware');
end;


procedure TForm1.btn6Click(Sender: TObject);
begin
 rtctcpclnt1.Write('\READ'+Copy(tv1.Selected.Text,4,2));
end;


procedure TForm1.btn7Click(Sender: TObject);
begin
mmo1.Clear;
end;


procedure TForm1.cbb1Change(Sender: TObject);
var
 i,s,n:Integer;
 Node1:TTreeNode;
begin
 s:=0;
 n:=1;
 if cbb1.ItemIndex=0 then
   Node1:=tv1.Items.Add(nil,'集中器')
 else
 if cbb1.ItemIndex=1 then
   begin
     if tv1.Selected=nil then
        ShowMessage('选择集中器后添加探头')
     else
     if tv1.Selected.Level=1 then
      ShowMessage('只能添加到这里了!')
     else
     Form2.Show;
   end;
end;


procedure TForm1.cbb2Change(Sender: TObject);
var
 b,c:Integer;
begin
 b:=Length(cbb2.Text);
 c:=StrToInt(Copy(cbb2.Text,b,8));
 nrcm1.Active:=False;
 nrcm1.ComPortNo:=c;
 nrcm1.Active:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 reg: TRegistry; // 注: 要引用Registry单元
 Namelst: TStrings;
 i: integer;
begin
 Namelst := TStringList.Create;
 reg := TRegistry.Create;
 reg.RootKey := HKEY_LOCAL_MACHINE;
 reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', true);
 reg.GetValueNames(Namelst);
 Form1.cbb2.Clear;

 for i := 0 to Namelst.Count - 1 do
  Form1.cbb2.Items.Add(reg.ReadString(Namelst[i]));

 Form1.cbb2.ItemIndex := 0;
 reg.CloseKey;
 reg.Free;
 Namelst.Free;
end;

//代码就是在这段出错了!!!!!!!!!!!!!!!!!!!!!
procedure TForm1.nrcm1AfterReceive(Com: TObject; Buffer: Pointer;
  Received: Cardinal);
var
 i:Integer;
 s:string;
begin
s:='';
  for i := 0 to Received-1 do
   s:=s+PAnsiChar(Buffer)[i];

   if c=1 then
   edt1.Text:=Copy(s,18,6);

   if c=2 then
   ShowMessage('修改成功!');

   if c=3 then
   str:=TStringList.Create;
   str.Delimiter:=';';
   str.DelimitedText:=s;
   for i := 0 to str.Count-1 do
        idd:=str[0];
        idd1:=str[1];
        idd2:=str[2];
     edt2.Text:=Copy(idd,7,20);
     edt3.Text:=idd1;
     edt4.Text:=idd2;
end;


procedure TForm1.rtctcpclnt1Connect(Sender: TRtcConnection);
begin
 ShowMessage('连接成功!');
end;


procedure TForm1.rtctcpclnt1DataReceived(Sender: TRtcConnection);
var
s:string;
begin
 s:=Sender.Read;
 if s<>'' then
 mmo1.Lines.Add(s);
end;

procedure TForm1.tv1Change(Sender: TObject; Node: TTreeNode);
begin
 if tv1.Selected.Level=0 then
   begin
    scrlbx2.Visible:=True;
    scrlbx1.Visible:=False;
    edt2.Text:='';
    edt3.Text:='';
    edt4.Text:='';
   end;


 if tv1.Selected.Level=1 then
   begin
    scrlbx1.Visible:=True;
    scrlbx2.Visible:=False;
   end;
end;

end.

3 个解决方案

#1


建议采取跟踪调试的方式,找到出错的地方,再解决。

#2


连个错误提示都没有?
下断跟踪吧

#3


for i := 0 to Received-1 do

这个received 估计默认值是-1或0,就是什么也没收到,因此在此句前加一个判断:
if received<1 then exit;

#1


建议采取跟踪调试的方式,找到出错的地方,再解决。

#2


连个错误提示都没有?
下断跟踪吧

#3


for i := 0 to Received-1 do

这个received 估计默认值是-1或0,就是什么也没收到,因此在此句前加一个判断:
if received<1 then exit;