使用动态链接库引发的问题(50分)

C

coldew

Unregistered / Unconfirmed
GUEST, unregistred user!
是这样的我们在开始数据库时经常会用到查询。天天写天天都是差不多,于是乎就想
把他写成动态链接库的形式。以后就不要写了,直接用。但是我在改的过程中却出现了
错误。我不知道如何去调试。下面是我的源码:
pas文件为
unit FindUnit;

interface

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

type
TfrmFind = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
cmbField: TComboBox;
cmbRel: TComboBox;
edtValue: TEdit;
lsbField: TListBox;
lsbRel: TListBox;
lsbValue: TListBox;
bitAdd: TBitBtn;
bitModify: TBitBtn;
bitDel: TBitBtn;
bitCancel: TBitBtn;
bitHelp: TBitBtn;
bitOK: TBitBtn;
bitClear: TBitBtn;
lsbFieldName: TListBox;
rdoAnd: TRadioButton;
rdoOr: TRadioButton;
cmbFieldName: TComboBox;
procedure lsbFieldClick(Sender: TObject);
procedure bitAddClick(Sender: TObject);
procedure bitModifyClick(Sender: TObject);
procedure bitDelClick(Sender: TObject);
procedure bitClearClick(Sender: TObject);
procedure cmbFieldChange(Sender: TObject);
private
{ Private declarations }
procedure SetCaption(CaptionList: TStringList);
//用于设置面板上的所有标题
procedure SetItem(FieldName, Field: TStringList);
//设置字段名组合框中的项目
function GetSQL(TableName: PChar;var ValueList:TStringList):pChar;
//返回一个SQL语句。并获得一个参数值列表。
public
{ Public declarations }
end;

function ShowForm(CaptionList, FieldName, Field:TStringList
TableName: PChar;
var ValueList:TStringList):pChar;stdcall;
//
var
frmFind: TfrmFind;

implementation

{$R *.dfm}

procedure TfrmFind.lsbFieldClick(Sender: TObject);
var
Index:integer;
begin
Index:=TListBox(Sender).ItemIndex;
lsbFieldName.ItemIndex:=Index;
lsbField.ItemIndex:=index;
lsbRel.ItemIndex:=Index;
lsbValue.ItemIndex:=Index;
cmbFieldName.Text:=lsbField.Items[Index];
cmbField.Text:=lsbField.Items[Index];
cmbRel.Text:=lsbRel.Items[Index];
edtValue.Text:=lsbValue.Items[Index];
end;

procedure TfrmFind.bitAddClick(Sender: TObject);
begin
lsbFieldName.Items.Add(cmbFieldName.Text);
lsbField.Items.Add(cmbField.Text );
lsbRel.Items.Add(cmbRel.Text );
lsbValue.Items.Add(edtValue.Text );
end;

procedure TfrmFind.bitModifyClick(Sender: TObject);
var
Index:integer;
begin
Index:=lsbField.ItemIndex;
lsbFieldName.Items[Index]:=cmbFieldName.Text;
lsbField.Items[Index]:=cmbField.Text;
lsbRel.Items[Index]:=cmbRel.Text;
lsbValue.Items[Index]:=edtValue.Text;
end;

procedure TfrmFind.bitDelClick(Sender: TObject);
begin
lsbFieldName.DeleteSelected;
lsbField.DeleteSelected;
lsbRel.DeleteSelected;
lsbValue.DeleteSelected;
cmbField.ItemIndex:=-1;
cmbRel.ItemIndex:=-1;
edtValue.Clear;
end;

procedure TfrmFind.bitClearClick(Sender: TObject);
begin
lsbFieldName.Clear;
lsbField.Clear;
lsbRel.Clear;
lsbValue.Clear;
cmbFieldName.ItemIndex:=-1;
cmbField.ItemIndex:=-1;
cmbRel.ItemIndex:=-1;
edtValue.Clear;
end;

procedure TfrmFind.cmbFieldChange(Sender: TObject);
begin
cmbFieldName.ItemIndex:=cmbField.ItemIndex;
end;

procedure TfrmFind.SetCaption(CaptionList: TStringList);
var
i:integer;
begin
with CaptionList do for i := Count-1 to 12 do Add('');
with frmFind do
begin
Caption:=CaptionList.Strings[0];
Label1.Caption:=CaptionList.Strings[1];
Label2.Caption:=CaptionList.Strings[2];
Label3.Caption:=CaptionList.Strings[3];
rdoAnd.Caption:=CaptionList.Strings[4];
rdoOr.Caption:=CaptionList.Strings[5];
bitAdd.Caption:=CaptionList.Strings[6];
bitModify.Caption:=CaptionList.Strings[7];
bitDel.Caption:=CaptionList.Strings[8];
bitClear.Caption:=CaptionList.Strings[9];
bitOK.Caption:=CaptionList.Strings[10];
bitCancel.Caption:=CaptionList.Strings[11];
bitHelp.Caption:=CaptionList.Strings[12];
end;
end;

procedure TfrmFind.SetItem(FieldName, Field: TStringList);
var
i,intCount:integer;
begin
intCount:=FieldName.Count;
with cmbFieldName, FieldName do
for i := 0 to intCount-1 do Items.Add(Strings);
with cmbField, Field do
for i := 0 to intCount-1 do Items.Add(Strings);
// cmbFieldName.Items:=FieldName;
// cmbField.Items:=Field;
// 用上面两句就错误
end;

function TfrmFind.GetSQL(TableName: PChar
var ValueList: TStringList):pChar;
var
Count,i:integer;
pAnd:pChar;
begin
Result:=StrAlloc(1000*SizeOf(Char));
StrCopy(Result,'');
Count:=lsbField.Count;
if rdoAnd.Checked then pAnd:=' AND '
else pAnd:=' OR ';
if Count=0 then
begin
StrCopy(Result,'SELECT * FROM ');
StrCat(Result,TableName);
end
else begin
StrCopy(Result,'SELECT * FROM ');
StrCat(Result,TableName);
StrCat(Result,' WHERE ');
end;
for i := 0 to Count-1 do
begin
if lsbRel.Items='*' then
begin
lsbRel.Items:=' LIKE ';
ValueList.Add(lsbValue.Items+'%');
end
else ValueList.Add(lsbValue.Items);
StrCat(Result,PChar(lsbFieldName.Items+lsbRel.Items+':'+lsbField.Items));
if i< Count-1 then StrCat(Result,pAnd);
end;
end;

function ShowForm(CaptionList, FieldName, Field:TStringList;
TableName: PChar
var ValueList:TStringList):pChar;
begin
Result:=StrAlloc(1000*SizeOf(Char));
try
frmFind:=TfrmFind.Create(Application);
with frmFind do
begin
try
SetCaption(CaptionList);
SetItem(FieldName,Field);
if ShowModal=mrOK then Result:=GetSQL(TableName,ValueList);
finally
Free;
end;
end
except
On E:Exception do
Application.MessageBox('Error','Title');
end;
end;

end.

dfm文件为
object frmFind: TfrmFind
Left = 251
Top = 194
Width = 406
Height = 411
Caption = 'frmFind'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 16
object Label1: TLabel
Left = 8
Top = 14
Width = 88
Height = 16
Caption = 'Conditional'
end
object Label2: TLabel
Left = 8
Top = 42
Width = 64
Height = 16
Caption = 'Relation'
end
object Label3: TLabel
Left = 8
Top = 72
Width = 40
Height = 16
Caption = 'Value'
end
object cmbField: TComboBox
Left = 104
Top = 8
Width = 273
Height = 24
Style = csDropDownList
Ctl3D = False
ItemHeight = 16
ParentCtl3D = False
TabOrder = 0
OnChange = cmbFieldChange
end
object cmbRel: TComboBox
Left = 104
Top = 40
Width = 273
Height = 24
Style = csDropDownList
Ctl3D = False
ItemHeight = 16
ParentCtl3D = False
TabOrder = 1
Items.Strings = (
'='
'>'
'<'
'<='
'>='
'<>'
'*')
end
object edtValue: TEdit
Left = 104
Top = 72
Width = 273
Height = 22
Ctl3D = False
ParentCtl3D = False
TabOrder = 2
end
object lsbField: TListBox
Left = 104
Top = 128
Width = 96
Height = 209
BevelEdges = [beLeft, beTop, beBottom]
BevelKind = bkSoft
BorderStyle = bsNone
Ctl3D = False
ItemHeight = 16
ParentCtl3D = False
TabOrder = 3
OnClick = lsbFieldClick
end
object lsbRel: TListBox
Left = 200
Top = 128
Width = 59
Height = 209
BevelEdges = [beTop, beBottom]
BevelKind = bkSoft
BorderStyle = bsNone
Ctl3D = False
ItemHeight = 16
ParentCtl3D = False
TabOrder = 4
OnClick = lsbFieldClick
end
object lsbValue: TListBox
Left = 259
Top = 128
Width = 118
Height = 209
BevelEdges = [beTop, beRight, beBottom]
BevelKind = bkSoft
BorderStyle = bsNone
Ctl3D = False
ItemHeight = 16
ParentCtl3D = False
TabOrder = 5
OnClick = lsbFieldClick
end
object bitAdd: TBitBtn
Left = 16
Top = 140
Width = 75
Height = 25
Caption = 'Add'
TabOrder = 6
OnClick = bitAddClick
end
object bitModify: TBitBtn
Left = 16
Top = 190
Width = 75
Height = 25
Caption = 'Modify'
TabOrder = 7
OnClick = bitModifyClick
end
object bitDel: TBitBtn
Left = 16
Top = 240
Width = 75
Height = 25
Caption = 'Delete'
TabOrder = 8
OnClick = bitDelClick
end
object bitClear: TBitBtn
Left = 16
Top = 290
Width = 75
Height = 25
Caption = 'Clear'
TabOrder = 9
OnClick = bitClearClick
end
object bitOK: TBitBtn
Left = 104
Top = 346
Width = 75
Height = 25
Caption = 'OK'
ModalResult = 1
TabOrder = 10
end
object bitCancel: TBitBtn
Left = 204
Top = 344
Width = 75
Height = 25
Caption = 'Cancel'
ModalResult = 2
TabOrder = 11
end
object bitHelp: TBitBtn
Left = 304
Top = 344
Width = 75
Height = 25
Caption = 'Help'
TabOrder = 12
end
object lsbFieldName: TListBox
Left = 8
Top = 328
Width = 41
Height = 41
ItemHeight = 16
TabOrder = 13
Visible = False
end
object rdoAnd: TRadioButton
Left = 120
Top = 104
Width = 97
Height = 17
Caption = 'And'
Checked = True
TabOrder = 14
TabStop = True
end
object rdoOr: TRadioButton
Left = 248
Top = 104
Width = 89
Height = 17
Caption = 'Or'
TabOrder = 15
end
object cmbFieldName: TComboBox
Left = 8
Top = 328
Width = 41
Height = 24
ItemHeight = 16
TabOrder = 16
Visible = False
end
end
 
问题我还没说完。再先复制我的主控程序

pas文件为:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

function ShowForm(CaptionList, FieldName, Field:TStringList
TableName: PChar;
var ValueList:TStringList):pChar;stdcall;External 'E:/Find.dll';

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
with ListBox1.Items do
begin
Add('查找对话框');
Add('查找字段');
Add('查找关系');
Add('查找的值');
Add('并且');
Add('或者');
Add('增加');
Add('修改');
Add('删除');
Add('清除');
Add('确定');
Add('取消');
Add('帮助');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
p:pChar;
vl,lb1,lb2,lb3:TStringList;
begin
p:=StrAlloc(1000*SizeOf(Char));
vl:=TStringList.Create;
lb1:=TStringList.Create;
lb2:=TStringList.Create;
lb3:=TStringList.Create;
lb1:=TStringList(ListBox1.Items);
lb2:=TStringList(ListBox2.Items);
lb3:=TStringList(ListBox3.Items);
p:=ShowForm(lb1,lb2,lb3,'testtable',vl);
Edit1.Text:=p;
ListBox4.Items:=vl;
//运行第一次OK,但在运行第二次时就出现
{Project E:/Project1.exe faulted with message:'access violation at 0x004063d1:write of address}
{0x00030cb0'. Process Stopped. Use Step or Run to continue. }
//点击第一次OK退出后弹出
{Project E:/Project1.exe faulted with message:'access violation at 0x00236495:write of address}
{0x00030e40'. Process Stopped. Use Step or Run to continue. }
end;

end.
这就是我的问题。是不是太长了。希望你们能看完。在此先谢过。
我的Mail是coldewshadow@163.com
 
是不是因为使用了TStringList而产生的问题。如果是该如果解决。我一定要传字符串列表
进去。
 
的确太长了!!!
TStringList 类用到了String类型。而String变量不可以在dll中作为参数传递。否则就会出现非法操作内存的错误
如果你一定要用TStringList类,那么必须在动态连接库的每一个单元和应用程序中用到DLL的每一个单元中包含ShareMem单元。
并且ShareMem必须是uses列表中的第一个!比如主程序必须写成:
unit Unit1;
interface
uses
ShareMem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls
.....
别忘了,动态连接库FindUnit里也不能漏。
 
先在此谢过阅读过和回答了的朋友。辛苦了。

to darksmile:
我在DLL中经加过ShareMem不行。但我没有主控程序中加入。
其实我不想用这个单元。我个人感觉就不通用一样。我是说C里不好用。
在Delphi中TStringList或TStrings与VC++中什么类型较为匹配。如果不用这种
类型用什么做替代为好。
如果实在不行就只有加进这个单元一试。但我现在还不想试这种方法。
肯请帮助的 Coldew
 
VC++没有对应的类型.TStringList是Delphi自己定义的.好用吧?(VCL就是比MFC好).
如果你要保证通用性,也有一个办法:
string不能作为参数,但Pchar可以,对应于c++的char * ,vb 的val string.完全通用.
第一步.将TStringList转化为string
var
temp : string;
begin
temp := vl.Text;
{ vl 是 TStringList 类型,Text是其属性
假如vl的内容是 vl[0]='edit' vl[1]='find' vl[2]='add'
那么temp的内容是: '"edit","find","add"'
'"'是定界符 ','是分隔符,你也可以自己改,具体看帮助
}
第二步,将pchar作为形参或返回pchar
具体方法你应该知道
第三,将temp还原为TstringList
vl.Text := temp;
字符串又被拆成字符串列表了.
vc,vb都没有这个功能,但只要知道了字符串拆分的格式,
你可以自己编一段VC代码或vb代码实现.
 
在动态链接里还可不可以用TStringList这种类型。
只是不用来做导出函数的参数是不是。
另外在字符串上VC++的功能确实是比Dephi差。这方面也比VB差。不是吗?
但不能说MFC不好。什么东西就有优缺点。不能光拿自己的优势和别人比弱势。
 
动态连接库里当然可以用TStringList类型,只要这个动态连接库是用Delphi编的.
比如:
procedure Test(strs:pchar);
var
strlist : TStringList;
temp : string;
begin
temp := strs;
strlist.text := temp;
......
end;
VC的确是一个很好的开发工具,但是它的类库MFC的确设计的不好,对API的封装一塌糊涂
而且对常用的数据类型的支持也不好.用Delphi开发用它本身的类库一般就可以了.但是
用VC开发软件的程序员很少直接使用VC本身的类.一般都是用第三方编写的MFC扩展类.
你可以比较一下TCanvas类和CDC类,TImageList类和CImageList类.哪个简单,哪个麻烦?
类库的作用就是简化,简化,再简化.方法就是封装,封装,再封装.否则要类库干吗?
 
动态连接库里当然可以用TStringList类型,只要这个动态连接库是用Delphi编的.
比如:
procedure Test(strs:pchar);
var
strlist : TStringList;
temp : string;
begin
temp := strs;
strlist.text := temp;
......
end;
VC的确是一个很好的开发工具,但是它的类库MFC的确设计的不好,对API的封装一塌糊涂
而且对常用的数据类型的支持也不好.用Delphi开发用它本身的类库一般就可以了.但是
用VC开发软件的程序员很少直接使用VC本身的类.一般都是用第三方编写的MFC扩展类.
你可以比较一下TCanvas类和CDC类,TImageList类和CImageList类.哪个简单,哪个麻烦?
类库的作用就是简化,简化,再简化.方法就是封装,封装,再封装.否则要类库干吗?
 
在dll中如果用string作为返回参数,则最好用pchar代替,这样可以不用ShareMem。
 
to darksmile:
我是说在动态链接库中使用TStringList,如果在VC++中使用会不会不能通过。
to songhb:
我知道用PChar代替String,我是想找TStringList的替代类。
 
重申一遍!
动态连接库中可以用TStringList。但是不能用作参数.
VC中没有TStringList的替代类。
 
接受答案了.
 
顶部