初学dll：调用自己编写的dll,第一次可以，第二次不行，？？

[bennyhxz]

请教各位：

我的自定义dll如下：

返回给定字符串的最右边n个字符

*************************************************************************
library mydll;
uses
SysUtils,
Classes;

function right(ch:pchar;n:cardinal):pchar;stdcall;export;
var temp:string;
begin
temp:=strpas(ch);
Result:=ch;
if n>=strlen(ch) then exit;
temp:=copy(temp,strlen(ch)-n+1,n);
strpcopy(Result,temp);
end;
{$R *.res}
exports
right name 'myright' ;
begin
end.
*******************************************************************
调用程序如下：
三个 edit 一个按钮:把 edit1.text 的最右边的 strtoint(edit2.text) 个字符放在 edit3.text中。

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
pro=function(ch:pchar;i:cardinal):pchar;stdcall;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var ch:pchar;
n:integer;
fp:Tfarproc;
mo:Thandle;
begin
ch:=pchar('');
mo:=loadlibrary('mydll.dll');
if not assigned(mo) then
begin
messagebox(self.Handle ,'load mydll.dll faile!','load',mb_ok+mb_iconwarning);
exit;
end;
fp:=getprocaddress(mo,'myright');
if not assigned(fp) then
begin
freelibrary(mo);
messagebox(self.Handle ,'getproceddrss faile!','getproddress',mb_ok+mb_iconwarning);
exit;
end;
n:=strtoint(edit2.Text);
strpcopy(ch,edit1.Text);
edit3.Text :=pro(fp)(ch,n);
freelibrary(mo);
end;
************************************************************************

问题是：第一次单击按钮能得到预期结果，但再次单击按钮就得不到预期的结果了。为什么？

[yjf7888]

自定义dll建议改为：

*************************************************************************
library mydll;
uses
SysUtils,
Classes;

procedure right(ch:pchar;n:word);stdcall;export;
var temp:string;
begin
temp:=strpas(ch);
if n>=strlen(ch) then exit;
temp:=copy(temp,strlen(ch)-n+1,n);
strpcopy(ch,temp);
end;
{$R *.res}
exports
right name 'myright' ;
begin
end.


调用程序：

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
pro=procedure (ch:pchar;i:cardinal);stdcall;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var ch:pchar;
n:integer;
fp:pro;
mo:Thandle;
begin
//ch:=pchar('');?无意义,删去
mo:=loadlibrary('mydll.dll');
if not assigned(mo) then
begin
messagebox(self.Handle ,'load mydll.dll faile!','load',mb_ok+mb_iconwarning);
exit;
end;
fp:=getprocaddress(mo,'myright');
if not assigned(fp) then
begin
freelibrary(mo);
messagebox(self.Handle ,'getproceddrss faile!','getproddress',mb_ok+mb_iconwarning);
exit;
end;
n:=strtoint(edit2.Text);
ch:=strnew(pchar(edit1.text));
ch:=strnew(pchar(edit1.text));//strpcopy(ch,edit1.Text);不对，ch未分配内存 fp(ch,n);
edit3.text:=strpas(ch);
strdispose(ch);
freelibrary(mo);
end

[yjf7888]

Sorry!多了一行ch:=strnew(pchar(edit1.text));应该可以运行了。
另：在我的电脑上
if not assigned(mo) 有问题，改为if mo=0可以运行。

[yjf7888]

使用pchar型一定要分配足够的内存，用完要回收。

[pdsinfo]

^$^

[cszhz]

up^_^

[bennyhxz]

非常 thank！！！ yjf7888

[luoming]

好东西,我又学到了不少