⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 Delphi最新三层源码(1.0),对delphi有帮助
💻 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 + -