📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, DBClient,ADODB, Provider, TypInfo,
Mask, DBCtrls, TValueObjectListUnit;
type
TForm1 = class(TForm)
Button1: TButton;
DataSource1: TDataSource;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
ds1: TClientDataSet;
Button6: TButton;
Button7: TButton;
Button8: TButton;
ListBox1: TListBox;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
DBGrid1: TDBGrid;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
DBEdit3: TDBEdit;
DBEdit4: TDBEdit;
DBEdit5: TDBEdit;
Button13: TButton;
Button14: TButton;
Button15: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button14Click(Sender: TObject);
private
{ Private declarations }
procedure GetClassProperties(AClass: TClass; AStrings: TStrings);
public
{ Public declarations }
end;
var
Form1: TForm1;
pp: TValueObjectList;
implementation
uses ServerFrm, BOPrototypeManagerUnit, UserBO, UserVO, BOServiceUnit,
ValueObjectUnit, UserDAOValueObjectUnit, RDMCardServerUnit;
{$R *.dfm}
{
function TVOListCds.GetVOList: TValueObjectList;
begin
result := FVOList;
if PVOList = nil then
ReSult := nil;
end;
procedure TVOListCds.SetVOList(Value: TValueObjectList);
var
i, j: integer;
userBO: TUserBO;
userVOList: TUserVOList;
userVO: TUserVO;
begin
if Value = nil then
begin
Exit;
end;
userVOList := TUserVOList(Value);
for i:=1 to userVOList.CountItem do
begin
userVO := TUserVO(userVOList.GetItem(1,i));
for j:=0 to userVO.pParmCount do
begin
if not Active then open;
insert;
FieldByName('id').Value:=userVO.pID;
FieldByName('name').Value:=userVO.pName;
FieldByName('password').Value:=userVO.pPwd;
Post;
end;
end;
end;
}
procedure TForm1.GetClassProperties(AClass: TClass; AStrings: TStrings);
var
PropCount, I: SmallInt;
PropList: PPropList;
PropStr: string;
begin
PropCount := GetTypeData(AClass.ClassInfo).PropCount;
GetPropList(AClass.ClassInfo, PropList);
for I := 0 to PropCount - 1 do
begin
case PropList[I]^.PropType^.Kind of
tkClass: PropStr := '[Class] ';
tkMethod: PropStr := '[Method]';
tkSet: PropStr := '[Set] ';
tkEnumeration: PropStr := '[Enum] ';
else
PropStr := '[Field] ';
end;
PropStr := PropStr + PropList[I]^.Name;
PropStr := PropStr + ': ' + PropList[I]^.PropType^.Name;
AStrings.Add(PropStr);
end;
FreeMem(PropList);
end;
procedure TForm1.Button1Click(Sender: TObject);
{
var
userBO: TUserBO;
userVOList: TUserVOList;
userVO: TUserVO;
oo: OleVariant;
i,j: integer;
//ds: TVOListCds; }
begin
// userBO := TUserBO.Create;
// userVOList := userBO.pUserVOList;
// ds := TVOListCds.Create(self);
// ds.PVOList := userVOList;
// oo := userBO.pUserVOOle;
{ if not VarIsArray(oo) then
begin
ShowMessage('无数据');
Exit;
end;
ClientDataSet1.AppendData(oo, true);
with ClientDataSet1 do
begin
for i:=1 to userVOList.CountItem do
begin
userVO := TUserVO(userVOList.GetItem(1,i));
for j:=0 to userVO.pParmCount do
begin
if not Active then open;
ClientDataSet1.Append;
FieldByName('id').Value:=userVO.pID;
FieldByName('name').Value:=userVO.pName;
FieldByName('password').Value:=userVO.pPwd;
Post;
end;
end;
end;
}
end;
procedure TForm1.Button2Click(Sender: TObject);
var
userBO: TUserBO;
ds : TDataSet;
begin
{
// CdsMain.AfterInsert := CdsMainAfterInsert;
CdsMain.Name := 'CdsMain';
CdsMain.ProviderName := 'DataSetProvider1';
CdsMain.PacketRecords := 50;
with CdsMain.FieldDefs.AddFieldDef do
begin
DataType := ftGuid;
Required := true;
Name := 'FID';
Size := 38;
end;
with CdsMain.FieldDefs.AddFieldDef do
begin
DataType := ftString;
Name := 'FCode';
Size := 25;
end;
// CdsMain.CreateDataSet; Disable this command
CdsMain.Open();
showmessage(Inttostr(CdsMain.RecordCount)); }
end;
procedure TForm1.Button3Click(Sender: TObject);
var
//dd: TFieldTypeList;
pp: TFieldType;
j: integer;
begin
{dd := TFieldTypeList.Create;
dd.AddItem(ftString);
pp := dd.GetItem(1);
if pp = ftString then
ShowMessage(inttostr(dd.CountItem)); }
end;
{
for i:=1 to usList.Count-1 do
begin
user:= (usList.GetItem(1,i) as TUserVo);
ShowMessage(user.pName);
end; }
procedure TForm1.Button4Click(Sender: TObject);
var
pp: TValueObjectList;
user: TUserVO;
usList, usTmp: TUserVOList;
userBO, p1: TUserBO;
gg, oo: OleVariant;
i,j: integer;
wsPrv: WideString;
tmpDS: TDataSet;
os : TFieldType;
i_i :integer;
begin
usList := TUserVOList.create;
usTmp := TUserVOList.Create;
with frmServer.pLdmDataSet do
begin
try
tmpDS := SelectLDMDS(sqlSelect, wsPrv);
usList.prepareTable(tmpDS);
except
ShowMessage('数据存取失败!');
end;
for i_i := 1 to tmpDS.RecordCount do
begin
user := TUserVO.Create;
usList.pDataSet.Append;
usList.pDataSet.Fields[0].Value := tmpDS.Fields[0].Value;
usList.pDataSet.Fields[1].Value := tmpDS.Fields[1].Value;
usList.pDataSet.Fields[2].Value := tmpDS.Fields[2].Value;
user.pID := tmpDS.Fields[0].Value;
user.pName := tmpDS.Fields[1].Value;
user.pPwd:= tmpDS.Fields[2].Value;
usList.AddItem(1,user);
tmpDS.Next;
end;
end;
DataSource1.DataSet := usList.pDataSet;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
dd: TUserBO;
oo, pp: Olevariant;
ss: TValueObject;
ii: Olevariant;
i,j, k: iNTEGER;
a1, a2, a3: Olevariant;
ak : TDataType;
dfdfsdfd: integer;
user: TUserVO;
begin
dd:= TUserBO.Create;
dd.InitBusinessObj;
user := TUserVO(dd.PDAOObj.createDAOValue);
user.pID := 'admin';
user.pName := '系统员';
user.pPwd:= 'sa';
dd.PDAOObj.insertDAOValue(user);
ShowMessage(intToStr(dd.PDAOObj.PVOList.pRealKey));
user.pID := 'adm';
user.pPwd := 'sa';
dd.PDAOObj.updateDAOValue(user);
end;
procedure TForm1.Button6Click(Sender: TObject);
var
dd: TUserBO;
oo, pp: Olevariant;
ss: TValueObject;
ii: Olevariant;
i,j, k: iNTEGER;
a1, a2, a3: Olevariant;
ak : TDataType;
dfdfsdfd: integer;
user:TUserVO;
begin
dd:= TUserBO.Create;
dd.InitBusinessObj;
user := TUserVO(dd.PDAOObj.createDAOValue);
user.pID := 'admin';
user.pName := '姓名';
user.pPwd := 'admin';
//dd.PVOClass(dd.createDAOValue);
//pp := dd.getDAOValueList;
end;
procedure TForm1.Button7Click(Sender: TObject);
var
dd: TUserBO;
oo, pp: Olevariant;
ss: TValueObject;
ii: Olevariant;
i,j, k, k1: iNTEGER;
a1, a2, a3: Olevariant;
ak : TDataType;
dfdfsdfd: integer;
user:TUserVO;
js: Olevariant;
begin
dd:= TUserBO.Create;
pp := dd.PDAOObj.getDAOValueList;
dd.InitBusinessObj;
a1 :=pp;
dd.PDAOObj.setDAOValueList(a1);
oo := dd.PDAOObj.getDAOValueList;
for i:=0 to VarArrayHighBound(oo,1) do
begin
pp := oo[i];
if not VarIsArray(pp) then
Exit;
for j:=0 to VarArrayHighBound(pp,1) do
begin
a1 := pp[j];
for k:=0 to VarArrayHighBound(a1,1) do
begin
ShowMessage( a1[k] );
end;
end;
end;
end;
procedure TForm1.Button8Click(Sender: TObject);
var
dd: TUserBO;
oo, pp: Olevariant;
ss: TValueObject;
ii: Olevariant;
i,j, k: iNTEGER;
a1, a2, a3: Olevariant;
ak : TDataType;
dfdfsdfd: integer;
user: TUserVO;
begin
dd:= TUserBO.Create;
dd.InitBusinessObj;
{
for i:=0 to dd.PDAOObj.PVOList.CountItem-1 do
begin
ShowMessage((ss as TUserVO).pName);
end;
exit; }
ss := TValueObject(dd.PDAOObj.PVOList.GetItem(0));
ShowMessage(inttostr(dd.PDAOObj.PVOList.CountItem));
if ss<> nil then
dd.PDAOObj.deleteDAOValue(ss)
else
ShowMessage('nil');
ShowMessage(intToStr(dd.PDAOObj.PVOList.pRealKey));
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
GetClassProperties( TUserBO ,ListBox1.Items);
end;
procedure TForm1.Button10Click(Sender: TObject);
var
userBO: TUserBO;
voListObj: OleVariant;
pp: TValueObjectList;
ii: TPersistent;
dd: TClass;
begin
{
if FindClass('TuserBO') <> nil then
begin
ii := TPersistentClass(FindClass('TUserBO')).Create;
userBO := TUserBO(ii);
end
else
ShowMessage('no found!'); }
userBO := TuserBO.Create;
userBO.InitBusinessObj;
voListObj := userBO.PDAOObj.getDAOValueList;
userBO.PDAOObj.PVOList.OLEToDS(voListObj);
dataSource1.DataSet := userBO.PDAOObj.PVOList.pDataSet;
end;
procedure TForm1.Button11Click(Sender: TObject);
var
ss : TClass;
dd : TBOPrototype;
tmpClass: TClass;
ii :TPersistent;
userBO : TUserBO;
begin {
ss := BOPrototype.PBOClsList.Items[0];
ShowMessage(ss.ClassName);
dd := TBOPrototype.CreateEx;
dd.PBOClsList.Add(TEdit);
SHowmessage(intToStr(dd.PBOClsList.Count)); }
tmpClass := BOPrototype.findRegClsName('TUserBO');
if FindClass(tmpCLass.ClassName) <> nil then
begin
ii := TPersistentClass(FindClass('TUserBO')).Create;
end
else
ShowMessage('no found!');
// userBO := TuserBO.CreateEx;
// userBO.InitBO;
// voListObj := userBO.PDAOObj.getDAOValueList;
//if ii is TUserBO then
// ShowMessage(ii.ClassName);
(ii as TUserBO).InitBusinessObj;
ShowMessage( intToStr( (ii as TUserBO).PDAOObj.PVOList.pRealKey ));
end;
procedure TForm1.Button12Click(Sender: TObject);
var
boService: TBOService;
oo,pps: olevariant;
dd: TUserVO;
begin
boService := TBOService.Create;
boService.bo_GetVoList('TUserBO', '', pps);
boService.bo_GetVoList('TUserBO', '', oo);
pp := TValueObjectList.Create;
pp.OLEToDS(oo);
pp.pVOClassName := TUserVO;
dataSource1.DataSet := pp.pDataSet;
DBEdit1.DataSource := dataSource1;
DBEdit2.DataSource := dataSource1;
DBEdit3.DataSource := dataSource1;
DBEdit4.DataSource := dataSource1;
DBEdit5.DataSource := dataSource1;
DBEdit1.DataField := pp.pDataSet.Fields[0].FieldName;
DBEdit2.DataField := pp.pDataSet.Fields[1].FieldName;
DBEdit3.DataField := pp.pDataSet.Fields[2].FieldName;
DBEdit4.DataField := pp.pDataSet.Fields[3].FieldName;
DBEdit5.DataField := pp.pDataSet.Fields[4].FieldName;
{pp.pDataSet.First;
pp.pDataSet.Next;
//dd:= TUserVO.Create;
dd := TUserVO( pp.GetDSItem(1, pp.pDataSet) ); }
// ShowMessage ( dd.pName );
end;
procedure TForm1.Button14Click(Sender: TObject);
var
rd: TRDMCardServer;
ws: wideString;
pR, pM: WideString;
begin
rd := TRDMCardServer.Create(self);
{rd.SelectData('select * from users', ws);
}
rd.BeginTrans(pR, pM);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -