(急）求助：程序运行跳出提示“Project Project1.exe raised exception class EAcessViolation……”

  用Delphi编的一个解码程序，在运行程序后会跳出一个提示“Project Project1.exe raised exception class EAcessViolation with message 'Access violation at address 0045201E in module 'Project1.exe'. Write of address 00000004.Use Step or Run to continue.”

  设置断点调试后在运行到栈的初始化程序constructor TStack.Create 中的Top：=nil时出现这条错误信息。

  麻烦高手们帮我看看到底是哪里有问题，如何改正，不胜感激

  全部代码如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Memo1: TMemo;
    Label3: TLabel;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  ElementType=Char;
  Pointer=^StackNode;
  StackNode=record
              Element:ElementType;
              Next:Pointer;
            end;
  TStack=class
          constructor Create;
          destructor Destroy;
          function IsEmpty:Boolean;
          procedure Push(Item:ElementType);
          procedure Pop(var Item:ElementType);
          private
            Top:Pointer;
        end;
    function Decode(S:String):String;

var
  Form1: TForm1;
  Stack,Stack1:TStack;
  S,S1,S2:String;
  Count:Integer;

implementation

{$R *.dfm}
constructor TStack.Create;
begin
  Top:=nil
end;

destructor TStack.Destroy;
var P:Pointer;
begin
  while Top<>nil do
  begin
    P:=Top;
    Top:=Top^.Next;
    dispose(P);
  end;
end;

function TStack.IsEmpty:Boolean;
begin
  IsEmpty:=Top=nil;
end;

procedure TStack.Push(Item:ElementType);
var P:Pointer;
begin
  new(P);
  P^.Element:=Item;
  P^.Next:=Top;
  Top:=P;
end;

procedure TStack.Pop(var Item:ElementType);
var P:Pointer;
begin
  if IsEmpty then Form1.Memo2.Text:='栈为空，出错'
  else
  begin
    Item:=Top^.Element;
    P:=Top;
    Top:=Top^.Next;
    dispose(P);
  end;
end;

function Decode(S:String):String;
var C:Char;
    i,j,k,m,N:Integer;
begin
  i:=1;
  j:=Count;
  k:=1;
  m:=0;
  S1:='';
  S2:='';
  while i<=Count do
  begin
    Stack.Push(S[i]);
    i:=i+1;
  end;
  while j>=1 do
  begin
    Stack.Pop(S[j]);
    S1:=S1+s[j];
    j:=j-1;
  end;
  while k<=Count do
  begin
    C:=S1[k];
    if not((C='a') or (C='o') or (C='e') or (C='i') or (C='u')) then
    begin
      Stack1.Push(C);
      k:=k+1;
      m:=m+1;
      N:=k;
    end
    else
    begin
      while m>=0 do
      begin
        Stack1.Pop(S1[k-1]);
        S2:=S2+S1[k-1];
        k:=k-1;
        m:=m-1;
      end;
      k:=N;
      S2:=S2+C;
    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Stack.Create;
  Stack1.Create;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if(Key=VK_RETURN) then
  begin
    S:=Form1.Edit1.Text;
    Form1.Edit1.Text:='';
    if S<>'' then Form1.Memo1.Text:=S
    else
    Form1.Memo1.Text:='未输入！ 请重新输入密码！';
    Count:=Length(S);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Decode(S);
  Form1.Memo2.Text:=S2;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Stack.Destroy;
  Stack1.Destroy;
  Stack.Create;
  Stack1.Create;
  Form1.Memo1.Text:='';
  Form1.Memo2.Text:='';
  Form1.Edit1.Text:='';
  S1:='';
  S2:='';
  Count:=0;
end;

end.

17 个解决方案

#1

function Decode(S:String):String;
改为
function Decode(Var S:String):String;
试试

#2

up

#3

其实我感觉是Top这个指针有问题，因为好像一到有Top的地方就出错，但又找不出具体是什么的问题，还请各位高手帮忙看看

#4

Stack.Create;
Stack1.Create; 
//这两句错了，最好在FormDestroy加上下面两句

procedure TForm1.FormCreate(Sender: TObject);
begin
  Stack := TStack.Create;
  Stack1 := TStack.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(Stack) then Stack.Destroy;
  if Assigned(Stack1) then Stack1.Destroy;
end;

#5

willflyz谢谢你帮忙，当按照你说的改了还是出现一样的错误信息

#6

引用 4 楼 willflyz 的回复:

Stack.Create;
Stack1.Create;
//这两句错了，最好在FormDestroy加上下面两句
Delphi(Pascal) codeprocedure TForm1.FormCreate(Sender: TObject);begin
  Stack := TStack.Create;
  Stack1 := TStack.Create;end;procedure TForm1.FormDestroy(Sender: TObject);beginif Assigned(Stack)then Stack.Destroy;if Assigned(Stack1)then Stack1.Destroy;end;

程序假死

#7

你这个堆栈的类我测试了没有问题，问题应该是在你的Decode function里面，你再理一下你的算法

#8

代码怎摸用呀？

#9

整个程序最开始一步是创建Form1，在这里调用TStack.Create就出错了，还没有到Decode。

我把整个程序发到ftp://public.sjtu.edu.cn上了，用户名是plyjswx，密码public,里面的解码文件夹就是整个程序，麻烦各位高手直接下下来帮我看看吧，不胜感激

#10

up

#11

通过你的map文件定位一下错误位置？

#12

用map定位是第61行Top：=nil,这句有什么错呢，麻烦高手帮忙看看

#13

  TStack=class 
          constructor Create(Top:Pointer);overload;



constructor TStack.Create(Top:Pointer); 
begin 
  Top:=nil 
end; 


这样试试

#14

daijie_1谢谢你，不过好像你说的改法也没有效果

很感谢大家的建议，不过可不可以先自己试一下，有效果的再提出来呢

#15

引用 14 楼 plyjswx 的回复:

daijie_1谢谢你，不过好像你说的改法也没有效果

很感谢大家的建议，不过可不可以先自己试一下，有效果的再提出来呢

up

#16

  TStack=class 
    public // create和destroy要放在public段里
          constructor Create; override; // 重载父类的构造函数
          destructor Destroy; 
          function IsEmpty:Boolean; 
          procedure Push(Item:ElementType); 
          procedure Pop(var Item:ElementType); 
          private 
            Top:Pointer; 
        end; 

constructor TStack.Create; 
begin 
  inherited; // 这里加上
  Top:=nil 
end; 

destructor TStack.Destroy; 
var P:Pointer; 
begin 
  while Top <>nil do 
  begin 
    P:=Top; 
    Top:=Top^.Next; 
    dispose(P); 
  end; 
  inherited; // 这里加上
end; 

procedure TForm1.FormCreate(Sender: TObject);
begin
  Stack := TStack.Create;
  Stack1 := TStack.Create;
end;

#17

wintergoes太感谢了，照你说的改了没有出错了,太厉害了