Internet/IE编程

开发平台：
Delphi

U_Orders.pas：源码内容
							{
 ToDo:      数据模块  
}
unit U_Orders;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, SvrObj_Orders_TLB, Provider, DB, ADODB,Variants;
type
  TOrders = class(TMtsDataModule, IOrders)
    ADO_CNT: TADOConnection;
    QRY_ORDER: TADOQuery;
    DSPRD_ORDER: TDataSetProvider;
    QRY_ORDER_DETAIL: TADOQuery;
    DSPRD_ORDER_DETAIL: TDataSetProvider;
    procedure MtsDataModuleActivate(Sender: TObject);
    procedure MtsDataModuleDeactivate(Sender: TObject);
    procedure MtsDataModuleCreate(Sender: TObject);
    procedure DSPRD_ORDERUpdateError(Sender: TObject;
      DataSet: TCustomClientDataSet; E: EUpdateError;
      UpdateKind: TUpdateKind; var Response: TResolverResponse);
    procedure DSPRD_ORDER_DETAILUpdateError(Sender: TObject;
      DataSet: TCustomClientDataSet; E: EUpdateError;
      UpdateKind: TUpdateKind; var Response: TResolverResponse);
  private
    { Private declarations }
    FErrorMsg: WideString;
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure GetOrder(OrderID: Integer; var RetData: OleVariant); safecall;
    procedure GetOrderDetail(OrderID: Integer; var RetData: OleVariant);
      safecall;
    procedure GetOrders(BeginDate, EndDate: TDateTime;
      var RetData: OleVariant); safecall;
    procedure GetOtherData(var RetData: OleVariant); safecall;
    procedure UpdateOrder(OrderID: Integer; OrderDelta,
      OrderDetailDelta: OleVariant; var IsOk: WordBool;
      var ErrorMsg: WideString); safecall;
  public
    { Public declarations }
  end;
var
  Orders: TOrders;
implementation
{$R *.DFM}
class procedure TOrders.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;
procedure TOrders.GetOrder(OrderID: Integer; var RetData: OleVariant);
begin
  try
    //***************************对ADOQuery初始化*******************************
    QRY_ORDER.Close;
    QRY_ORDER.Connection := ADO_CNT;
    QRY_ORDER.SQL.Clear;
    QRY_ORDER.SQL.Add('select * from Orders where OrderID='+inttostr(OrderID));
    DSPRD_ORDER.DataSet := QRY_ORDER;
    //**************************************************************************
    QRY_ORDER.Open;
    RetData := DSPRD_ORDER.Data;
    SetComplete();
    //提交事务
  except
    SetAbort();
    //回滚事务
  end;
end;
procedure TOrders.GetOrderDetail(OrderID: Integer;
  var RetData: OleVariant);
begin
  try
    //**************************对ADOQuery初始化********************************
    QRY_ORDER_DETAIL.Close();
    QRY_ORDER_DETAIL.Connection := ADO_CNT;
    QRY_ORDER_DETAIL.SQL.Clear();
    QRY_ORDER_DETAIL.SQL.Add('select * from OrderDetails where OrderID='+inttostr(OrderID));
    DSPRD_ORDER_DETAIL.DataSet := QRY_ORDER_DETAIL;
    //**************************************************************************
    QRY_ORDER_DETAIL.Open();
    RetData := DSPRD_ORDER_DETAIL.Data;
    SetComplete();
  except
    SetAbort();
  end;
end;
procedure TOrders.GetOrders(BeginDate, EndDate: TDateTime;
  var RetData: OleVariant);
begin
  try
    //***************************对ADOQuery初始化*******************************
    QRY_ORDER.Close();
    QRY_ORDER.Connection:=ADO_CNT;
    QRY_ORDER.SQL.Clear();
    QRY_ORDER.SQL.Add('SELECT top 100 Orders.OrderID, Customers.CompanyName, Orders.OrderDate, ');
    QRY_ORDER.SQL.Add('      Orders.RequiredDate, Orders.ShippedDate, Orders.ShipName ');
    QRY_ORDER.SQL.Add('FROM Orders INNER JOIN ');
    QRY_ORDER.SQL.Add('      Customers ON Orders.CustomerID = Customers.CustomerID ');
    QRY_ORDER.SQL.Add('where (Orders.OrderDate>='''+DateTimeToStr(BeginDate)+''')');
    QRY_ORDER.SQL.Add('      and (Orders.OrderDate<='''+DateTimeToStr(EndDate)+''')');
    QRY_ORDER.SQL.Add('ORDER BY Orders.OrderDate');
    DSPRD_ORDER.DataSet:=QRY_ORDER;
    //**************************************************************************
    QRY_ORDER.Open();
    RetData:=DSPRD_ORDER.Data;
    SetComplete();
    //调用了SetComplete相当于告诉组件已经任务完成可以做相应的处理了
  except
    SetAbort();
  end;
end;
procedure TOrders.GetOtherData(var RetData: OleVariant);
var
  Query: TAdoQuery;
  Dsprd: TDataSetProvider;
begin
  //**********通过使用动态数组实现数据打包的功能*************
  RetData := VarArrayCreate([0,3], varVariant);
  try
    Query:=TAdoQuery.Create(nil);
    Dsprd:=TDataSetProvider.Create(nil);
    try
      //******************获取员工信息************************
      Dsprd.DataSet:=Query;
      Query.Connection:=ADO_CNT;
      Query.SQL.Add('SELECT EmployeeID,FirstName+ '' ''+LastName AS EmployeeName');
      Query.SQL.Add('FROM Employees');
      Query.Open();
      RetData[0]:=Dsprd.Data;
      //******************获取客户信息************************
      Query.Close();
      Query.SQL.Clear();
      Query.SQL.Add('SELECT CustomerID, CompanyName');
      Query.SQL.Add('FROM Customers');
      Query.Open();
      RetData[1]:=Dsprd.Data;
      //******************获取运输公司信息************************
      Query.Close();
      Query.SQL.Clear();
      Query.SQL.Add('SELECT ShipperID, CompanyName');
      Query.SQL.Add('FROM Shippers');
      Query.Open();
      RetData[2]:=Dsprd.Data;
      //******************获取货品信息************************
      Query.Close();
      Query.SQL.Clear();
      Query.SQL.Add('SELECT ProductID, ProductName,UnitPrice');
      Query.SQL.Add('FROM Products');
      Query.Open();
      RetData[3]:=Dsprd.Data;
    finally
      Query.Free();
      Dsprd.Free();
    end;
    SetComplete();
  except
    SetAbort();
  end;
end;
procedure TOrders.UpdateOrder(OrderID: Integer; OrderDelta,
  OrderDetailDelta: OleVariant; var IsOk: WordBool;
  var ErrorMsg: WideString);
var
  ErrorCount:integer;
  Cltds:TClientDataSet;
begin
  ErrorCount:=0;
  IsOk:=false;
  ErrorMsg:='';
  //*************************初始化ADOQUERY*******************************
  DSPRD_ORDER.DataSet:=QRY_ORDER;
  QRY_ORDER.Connection:=ADO_CNT;
  QRY_ORDER.SQL.Clear();
  QRY_ORDER.SQL.Add('select * from Orders where OrderID=-1');
  //若要实现无状态，这一步是必须的，因为要根据以上语句生成更新语句
  DSPRD_ORDER_DETAIL.DataSet:=QRY_ORDER_DETAIL;
  QRY_ORDER_DETAIL.Connection:=ADO_CNT;
  QRY_ORDER_DETAIL.SQL.Clear();
  QRY_ORDER_DETAIL.SQL.Add('select * from OrderDetails where OrderID=-1');
  //**********************************************************************
  try
    //更新Orders表
    if not VarIsEmpty(OrderDelta) then
      DSPRD_ORDER.ApplyUpdates(OrderDelta,-1,ErrorCount);
      // -1 表示在更新的过程中不允许有错误发生
    //更新Order Details表
    if (not VarIsEmpty(OrderDetailDelta)) and (ErrorCount=0) then
    begin
      Cltds:=TClientDataSet.Create(nil);
      try
        Cltds.Data:=OrderDetailDelta;
        Cltds.First();
        while not Cltds.Eof do
        begin
          case cltds.UpdateStatus of
            usInserted:
            begin
              //新添加的记录要给OrderID字段赋值
              cltds.Edit();
              cltds.FieldByName('OrderID').AsInteger:=OrderID;
              cltds.Post();
            end;
            usUnmodified:
            begin
              //修改过的记录OrderID字段已有，无须赋值
              cltds.Next();
            end;
          end;
          Cltds.Next();
        end;
        DSPRD_ORDER_DETAIL.ApplyUpdates(cltds.Data,-1,ErrorCount);
      finally
        Cltds.Free();
      end;
    end;
    if ErrorCount<>0 then
    begin
      SetAbort();
      ErrorMsg:=FErrorMsg;
      exit;
    end;
    IsOk:=true;
    SetComplete();
  except
    on E:Exception do
    begin
      SetAbort();
      ErrorMsg:=E.Message;
    end;
  end;
end;
procedure TOrders.MtsDataModuleActivate(Sender: TObject);
const
  DB_SERVER   =  'txxtrr';
  DB_USERNAME =  'sa';
  DB_PASSWORD =  '';
begin
  ADO_CNT.ConnectionString:='Provider=SQLOLEDB.1;Password='+DB_PASSWORD+
    ';Persist Security Info=False;User ID='+DB_USERNAME+
    ';Initial Catalog=Northwind;Data Source='+DB_SERVER;
  ADO_CNT.Connected:=true;
  FErrorMsg:='';
end;
procedure TOrders.MtsDataModuleDeactivate(Sender: TObject);
begin
  ADO_CNT.Connected:=false;
end;
procedure TOrders.MtsDataModuleCreate(Sender: TObject);
begin
  Pooled:=true;
end;
procedure TOrders.DSPRD_ORDERUpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
  FErrorMsg:=FErrorMsg+E.Message+#13;
end;
procedure TOrders.DSPRD_ORDER_DETAILUpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
  FErrorMsg:=FErrorMsg+E.Message+#13;
end;
initialization
  TComponentFactory.Create(ComServer, TOrders,
    Class_Orders, ciMultiInstance, tmApartment);
end.

						