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)Char;
//返回一个SQL语句。并获得一个参数值列表。
public
{ Public declarations }
end;
function ShowForm(CaptionList, FieldName, Field:TStringList
TableName: PChar;
var ValueList:TStringList)Char;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)Char;
var
Count,i:integer;
pAndChar;
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)Char;
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 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)Char;
//返回一个SQL语句。并获得一个参数值列表。
public
{ Public declarations }
end;
function ShowForm(CaptionList, FieldName, Field:TStringList
TableName: PChar;
var ValueList:TStringList)Char;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)Char;
var
Count,i:integer;
pAndChar;
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)Char;
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