dll调用出错,请大家看看错在哪?问题解决立刻给分(100),在线等. ( 积分: 100 )

调用文件:
unit hanzi;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

function getstr(resstr:string):string;stdcall;
external 'GethanziIndex.dll' ;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edit2.Text:=getstr(trim(edit1.Text));
end;
end.

dll文件:
library GethanziIndex;
uses
SysUtils,
Classes;

{$R *.res}
function GetPYIndexChar(hzchar: string): char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4: result := 'A';
$B0C5..$B2C0: result := 'B';
$B2C1..$B4ED: result := 'C';
$B4EE..$B6E9: result := 'D';
$B6EA..$B7A1: result := 'E';
$B7A2..$B8C0: result := 'F';
$B8C1..$B9FD: result := 'G';
$B9FE..$BBF6: result := 'H';
$BBF7..$BFA5: result := 'J';
$BFA6..$C0AB: result := 'K';
$C0AC..$C2E7: result := 'L';
$C2E8..$C4C2: result := 'M';
$C4C3..$C5B5: result := 'N';
$C5B6..$C5BD: result := 'O';
$C5BE..$C6D9: result := 'P';
$C6DA..$C8BA: result := 'Q';
$C8BB..$C8F5: result := 'R';
$C8F6..$CBF9: result := 'S';
$CBFA..$CDD9: result := 'T';
$CDDA..$CEF3: result := 'W';
$CEF4..$D188: result := 'X';
$D1B9..$D4D0: result := 'Y';
$D4D1..$D7F9: result := 'Z';
else
result := char(0);
end;
end;

function getstr(resstr:string):string;stdcall; (函数的目的:如果输入的是英语或数字就保持不变,如果是汉字就去汉字首字母)
var
i, j: integer;
str1, str2, res: string;
begin
str1 := resstr;
j := 0;
i := 1;
while i <= length(resstr) do
begin
if (str1 in ['a'..'z', 'A'..'Z', '1'..'9', '0', '#', '.', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')','`','/','-','=','+','/','|',';',':','?']) then
begin
res := res + str1;
j := j + 1;
i:=i+1;
continue;
end;
str2 := str1[2 * i - 1 - j] + str1[2 * i - j];
res := res + trim(getpyindexchar(str2));
i:=i+2;
j:=j+2;
end;
result :=res;

end;

exports
getstr;
begin
end.
在函数getstr()返回值的时候有时会报invalid pointer operation的错误,输入单个数字
如'1','a',就会报错

调用文件:
unit hanzi;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

function getstr(resstr:string):string;stdcall;
external 'GethanziIndex.dll' ;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edit2.Text:=getstr(trim(edit1.Text));
end;
end.

dll文件:
library GethanziIndex;
uses
SysUtils,
Classes;

{$R *.res}
function GetPYIndexChar(hzchar: string): char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4: result := 'A';
$B0C5..$B2C0: result := 'B';
$B2C1..$B4ED: result := 'C';
$B4EE..$B6E9: result := 'D';
$B6EA..$B7A1: result := 'E';
$B7A2..$B8C0: result := 'F';
$B8C1..$B9FD: result := 'G';
$B9FE..$BBF6: result := 'H';
$BBF7..$BFA5: result := 'J';
$BFA6..$C0AB: result := 'K';
$C0AC..$C2E7: result := 'L';
$C2E8..$C4C2: result := 'M';
$C4C3..$C5B5: result := 'N';
$C5B6..$C5BD: result := 'O';
$C5BE..$C6D9: result := 'P';
$C6DA..$C8BA: result := 'Q';
$C8BB..$C8F5: result := 'R';
$C8F6..$CBF9: result := 'S';
$CBFA..$CDD9: result := 'T';
$CDDA..$CEF3: result := 'W';
$CEF4..$D188: result := 'X';
$D1B9..$D4D0: result := 'Y';
$D4D1..$D7F9: result := 'Z';
else
result := char(0);
end;
end;

function getstr(resstr:string):string;stdcall; (函数的目的:如果输入的是英语或数字就保持不变,如果是汉字就去汉字首字母)
var
i, j: integer;
str1, str2, res: string;
begin
str1 := resstr;
j := 0;
i := 1;
while i <= length(resstr) do
begin
if (str1 in ['a'..'z', 'A'..'Z', '1'..'9', '0', '#', '.', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')','`','/','-','=','+','/','|',';',':','?']) then
begin
res := res + str1;
j := j + 1;
i:=i+1;
continue;
end;
str2 := str1[2 * i - 1 - j] + str1[2 * i - j];
res := res + trim(getpyindexchar(str2));
i:=i+2;
j:=j+2;
end;
result :=res;

end;

exports
getstr;
begin
end.
在函数getstr()返回值的时候有时会报invalid pointer operation的错误,输入单个数字
如'1','a',就会报错

function getstr(resstr:string):string;stdcall;
改为
function getstr(resstrChar)Char;stdcall;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

建议,所有DLL都不要用STRING类型参数
参考WINAPI的做法,用PCHAR,调用者分配内存

恩,谢谢提醒
但我不知道该怎么写参数

可以帮我修改一下程序吗?

指针我学的不好

xianguo:你好,可以帮我改改程序吗?在调用的时候应该怎么写?

改成:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit2.Text:=getstr(trim(edit1.Text))^;
end;
end.

function getstr(resstrchar)char;stdcall;
var
i, j: integer;
str1, str2, res: string;
begin
str1 := resstr^;
j := 0;
i := 1;
while i <= length(str1) do
begin
if (str1 in ['a'..'z', 'A'..'Z', '1'..'9', '0', '#', '.', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')','`','/','-','=','+','/','|',';',':','?']) then
begin
res := res + str1;
j := j + 1;
i:=i+1;
continue;
end;
str2 := str1[2 * i - 1 - j] + str1[2 * i - j];
res := res + trim(getpyindexchar(str2));
i:=i+2;
j:=j+2;
end;
result :=pchar(res);

end;

结果只返回一个字母,不知道问题出在什么地方

在 dll 用 string 你加上

user shareMem

library IMSG;
uses windows, Classes, SysUtils, inifiles;


function GETINIkey(IniFile: pchar; MAINKEY: pchar; SUBKEY: pchar): pchar; stdcall; //export;
var
myini: Tinifile;
s: string;
begin
// curpath:=extractfilepath(Application.exename);
myini := Tinifile.Create(IniFile);
// result := PCHAR(Myini.readString(mainkey, subkey, ''));
s := myini.readString(MAINKEY, SUBKEY, '');
getmem(result, length(s) + 1);
strcopy(result, pchar(s));
myini.Free;
end;


procedure writeINIkey(IniFile: pchar; MAINKEY: pchar; SUBKEY: pchar; value: pchar); stdcall; //export;
var
myini: Tinifile;
begin
myini := Tinifile.Create(IniFile);
myini.WriteString(MAINKEY, SUBKEY, value);
myini.Free;
end;


function GETmdbCONSTR(): pchar; stdcall; //export;
var IniFile: pchar;
MAINKEY: pchar;
provider: pchar;
datasource: pchar;
s: string;
begin
IniFile := './config.ini';
MAINKEY := 'ACCES数据库连接';
provider := 'Provider';
datasource := 'Data Source';
s := '';
s := s + 'Provider=' + GETINIkey(IniFile, MAINKEY, provider);
s := s + ' data source=' + GETINIkey(IniFile, MAINKEY, datasource);
getmem(result, length(s) + 1);
strcopy(result, pchar(s));
end;


function GETSQLCONSTR(): pchar; stdcall; //export;
var IniFile: pchar;
MAINKEY: pchar;
DbServerIP: pchar;
DBName: pchar;
USERID: pchar;
LogPass: pchar;
s: string;
begin
IniFile := './config.ini';
MAINKEY := 'sqlserver数据库连接';
DbServerIP := 'SQLCA_ServerName';
DBName := 'SQLCA_Database';
USERID := 'SQLCA_LogId';
LogPass := 'SQLCA_LogPass';
s := 'Provider=SQLOLEDB.1;Persist Security Info=False;Password=' + GETINIkey(IniFile, MAINKEY, LogPass) + ';User ID=' + GETINIkey(IniFile, MAINKEY, USERID) + ';Initial Catalog=' + GETINIkey(IniFile, MAINKEY, DBName) + ';Data Source=' + GETINIkey(IniFile, MAINKEY, DbServerIP);
// result := pchar('Provider=SQLOLEDB.1;Persist Security Info=False;User ID=' + GETINIkey(IniFile, MAINKEY, userID) + ';Initial Catalog=' + GETINIkey(IniFile, MAINKEY, dbname) + ';Data Source=' + GETINIkey(IniFile, MAINKEY, dbserverip));
getmem(result, 255);

if GETINIkey(IniFile, '访问', 'DB') = 'ACCESS' then
strcopy(result, GETmdbCONSTR())
else
strcopy(result, pchar(s));
end;

function its(i: integer): pchar; stdcall; //inttostr
begin
result := pchar(inttostr(i));
end;

function sti(s: pchar): integer; stdcall; //strtoint
begin
result := strtoint(s);
end;



function Ask(s: pchar): boolean; stdcall;
begin
result := false;
if messagebox(GetActiveWindow(), s, '提示', mb_YESNO + MB_ICONQUESTION) = idYes then result := true;
end;

function Iif(mBool: boolean; mDataA, mDataB: Variant): Variant; stdcall;
begin
if mBool then
result := mDataA
else result := mDataB;
end; { Iif }


{* 获取本机的计算机名称}

function GetLocalName(): pchar; stdcall;
var
CNameBuffer: pchar;
fl_loaded: boolean;
CLen: ^DWord;
begin
getmem(CNameBuffer, 255);
New(CLen);
CLen^ := 255;
fl_loaded := GetComputerName(CNameBuffer, CLen^);
if fl_loaded then
result := CNameBuffer
else
result := '未知';
// FreeMem(CNameBuffer, 255);
Dispose(CLen);
end;


function ISdate(STR: pchar): boolean; stdcall;
begin
result := true;
try
strtodatetime(STR);
except
result := false;
// Application.MessageBox('请输合法的日期数,格式:xxxx年xx月xx日', '提示信息', mb_iconerror);
end;
end;

//判断是否为整数

function ISInt(STR: pchar): boolean; stdcall;
begin
result := true;
try
strtoint(STR);
except
result := false;
// Application.MessageBox('请输入整型数!', '提示信息', mb_iconerror);
end;
end;

//判断是否为实数

function ISfloat(STR: pchar): boolean; stdcall;
begin
result := true;
try
strtofloat(STR);
except
result := false;
// Application.MessageBox('请输入实型数!', '提示信息', mb_iconerror);
end;
end;

{计算每月天数}



procedure delay(ii: integer); stdcall;
var
CT: LONGINT;
begin
CT := GETTICKCOUNT div 1000;
while ((GETTICKCOUNT div 1000) < (CT + ii)) do begin

end;

end;

procedure delayF(ii: integer);
var
CT: LONGINT;
begin
CT := GETTICKCOUNT;
while GETTICKCOUNT < (CT + ii) do begin

end;

end;

function RMB(NN: real): pchar;
var
HZ, NS, NW, NA, N1, N2: string;
LA, X, Nk: integer;
begin
if NN > 9999999999999.99 then begin
// MSG('金额溢出.', mtError, [mbOk], 0);
messagebox(0, '金额溢出!', '提示', mb_ok + MB_ICONASTERISK);
HZ := '';
result := pchar(HZ);
exit;
end;
if NN = 0 then begin
HZ := '零元';
result := pchar(HZ);
exit;
end;
NS := '零壹贰叁肆伍陆柒捌玖';
NW := '分角元拾佰仟万拾佰仟亿拾佰仟万';
NN := strtofloat(FormatFloat('0.00', NN)); //这句是经过网友jycjd调试得出的结果
NA := FloatToStr(NN * 100);
LA := length(NA);
X := 1;
HZ := '';
while X <= LA do begin
Nk := Ord(NA[X]) - Ord('0');
N1 := Copy(NS, Nk * 2 + 1, 2);
N2 := Copy(NW, LA * 2 + 1 - X * 2, 2);
if (Nk = 0) and ((N2 = '亿') or (N2 = '万') or (N2 = '元')) then begin
if Copy(HZ, length(HZ) - 1, 2) = '零' then
HZ := Copy(HZ, 1, length(HZ) - 2);
if Copy(HZ, length(HZ) - 1, 2) = '亿' then
if N2 = '元' then begin
N1 := N2;
N2 := '零';
end
else
N2 := ''
else begin
N1 := N2;
N2 := '零';
end
end
else if Nk = 0 then begin
if Copy(HZ, length(HZ) - 1, 2) = '零' then
N1 := '';
if N2 = '分' then begin
if Copy(HZ, length(HZ) - 1, 2) = '零' then
HZ := Copy(HZ, 1, length(HZ) - 2) + '整'
else
HZ := HZ + '整';
N1 := '';
end;
N2 := '';
end;
HZ := HZ + N1 + N2;
X := X + 1
end;
result := pchar(HZ);
end;

{ 获取指定汉字的拼音索引字母，如：“汉”的索引字母是“H”.}

function GetPYIndexChar(hzchar: string): char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4: result := 'A';
$B0C5..$B2C0: result := 'B';
$B2C1..$B4ED: result := 'C';
$B4EE..$B6E9: result := 'D';
$B6EA..$B7A1: result := 'E';
$B7A2..$B8C0: result := 'F';
$B8C1..$B9FD: result := 'G';
$B9FE..$BBF6: result := 'H';
$BBF7..$BFA5: result := 'J';
$BFA6..$C0AB: result := 'K';
$C0AC..$C2E7: result := 'L';
$C2E8..$C4C2: result := 'M';
$C4C3..$C5B5: result := 'N';
$C5B6..$C5BD: result := 'O';
$C5BE..$C6D9: result := 'P';
$C6DA..$C8BA: result := 'Q';
$C8BB..$C8F5: result := 'R';
$C8F6..$CBF9: result := 'S';
$CBFA..$CDD9: result := 'T';
$CDDA..$CEF3: result := 'W';
$CEF4..$D188: result := 'X';
$D1B9..$D4D0: result := 'Y';
$D4D1..$D7F9: result := 'Z';
else
result := char(32);
end;
end;

{返回字符窜的拼音码}

function GETPYM(CH: pchar): pchar; stdcall;
var
i: integer;
PY: string;
s: string;
begin
s := '';
i := 1;
while i <= length(CH) do begin
PY := Copy(CH, i, 1);
if PY >= Chr(128) then begin
Inc(i);
PY := PY + Copy(CH, i, 1);
s := s + GetPYIndexChar(PY);
end
else
s := s + PY;
Inc(i);
end;
getmem(result, length(s) + 1);

strcopy(result, pchar(s));
end;

function FiveZeroFormat(i: integer): pchar;
var j: integer;
s: string;
begin
j := length(trim(inttostr(i)));
s := '';
if j = 1 then s := '0000' + trim(inttostr(i));
if j = 2 then s := '000' + trim(inttostr(i));
if j = 3 then s := '00' + trim(inttostr(i));
if j = 4 then s := '0' + trim(inttostr(i));
if j = 5 then s := trim(inttostr(i));
result := pchar(s);
end;

function myspace(s: pchar; i: integer): pchar;
var j: integer; ts: string;
begin
ts := '';
if i < 1 then begin
result := ''; exit; end;
if length(s) > i then begin
result := ''; exit; end;
for j := 0 to i - length(s) do ts := ts + ' ';
result := pchar(ts);

end;



function CoCreateGuid(out guid: TGUID): HResult; stdcall;
external 'ole32.dll' name 'CoCreateGuid';

function GetGuid(): pchar; stdcall;
var X: TGUID;
s: string;
i: integer;
begin
CoCreateGuid(X);
result := pchar(GUIDToString(X));

end;


exports
writeINIkey name 'writeinikey',
GetLocalName name 'getlocalname',
Iif name 'iif',
GETINIkey name 'getinikey',
GETSQLCONSTR name 'getsqlconstr',
GETmdbCONSTR name 'getmdbconstr',
ISInt name 'isint',
ISfloat name 'isfloat',
ISdate name 'isdate',
delay name 'delay',

Ask name 'ask',
its name 'its',
sti name 'sti',
GETPYM name 'getpym',
GetGuid name 'GetGuid';
begin
end.

多人接受答案了。