purchaselistbizdm.pas

物流供应链管理系统

unit PurchaseListBizDm;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, PurchaseListBiz_TLB, DB, MConnect, Variants;

type
  TmtsPurchaseListBiz = class(TMtsDataModule, ImtsPurchaseListBiz)
    DComConPurchaseList: TDCOMConnection;
    cdsPurchaseListMaster: TClientDataSet;
    cdsPurchaseListSlave: TClientDataSet;
    DCOMConQuery: TDCOMConnection;
    cdsQuery: TClientDataSet;
    procedure MtsDataModuleActivate(Sender: TObject);
    procedure MtsDataModuleDeactivate(Sender: TObject);
    procedure MtsDataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure DeletePurchaseListById(const AId: WideString); safecall;
    function QueryPurchaseListMasterById(const AId: WideString;
      var ADatas: OleVariant): WordBool; safecall;
    procedure UpdatePurchaseListMaster(var ADatas: OleVariant); safecall;
    function QueryPurchaseListSlaveById(const AId: WideString;
      var ADatas: OleVariant): WordBool; safecall;
    procedure UpdatePurchaseListSlave(var ADatas: OleVariant); safecall;
    function GeneratePurchaseListId: WideString; safecall;
  public
    { Public declarations }
  end;

var
  mtsPurchaseListBiz: TmtsPurchaseListBiz;

implementation
uses BizDBConfig, uBizGlobal, StrUtils;
{$R *.DFM}

class procedure TmtsPurchaseListBiz.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 TmtsPurchaseListBiz.MtsDataModuleActivate(Sender: TObject);
begin

  try
    DComConPurchaseList.Connected := true;
  except
    raise Exception.Create(DCOMCONNECTERROR);
  end;
end;

procedure TmtsPurchaseListBiz.MtsDataModuleDeactivate(Sender: TObject);
begin
  DComConPurchaseList.Connected := false;
end;

procedure TmtsPurchaseListBiz.DeletePurchaseListById(
  const AId: WideString);
var
  i, n: Integer;
begin
  try
    cdsPurchaseListMaster.Open;
    if cdsPurchaseListMaster.Locate('Id', varArrayof([AId]), []) then
    begin
      cdsPurchaseListSlave.Open;
      if cdsPurchaseListSlave.Locate('MasterId', varArrayof([AId]), []) then
      begin
        n := cdsPurchaseListSlave.RecordCount - 1;
        for i := 0 to n do
          cdsPurchaseListSlave.Delete;  { TODO : 可能不正确 }
        cdsPurchaseListSlave.Post;
        cdsPurchaseListSlave.ApplyUpdates(-1);
        cdsPurchaseListSlave.Close;
      end;
      cdsPurchaseListMaster.Delete;
      cdsPurchaseListMaster.Post;
      cdsPurchaseListMaster.ApplyUpdates(-1);
    end
    else
      raise Exception.Create('Rocord Not found!');
    cdsPurchaseListMaster.Close;
    SetComplete;
  except
    SetAbort;
    cdsPurchaseListMaster.Close;
    cdsPurchaseListSlave.Close;
    raise;
  end;

end;

function TmtsPurchaseListBiz.QueryPurchaseListMasterById(
  const AId: WideString; var ADatas: OleVariant): WordBool;
begin
  result := false;
  ADatas := null;
  try
    cdsPurchaseListMaster.Open;
    if cdsPurchaseListMaster.Locate('Id', varArrayof([AId]), []) then
    begin
      ADatas := cdsPurchaseListMaster.Data;
      result := true;
    end;
  finally
    cdsPurchaseListMaster.Close;
  end;

end;

procedure TmtsPurchaseListBiz.UpdatePurchaseListMaster(
  var ADatas: OleVariant);
var
  eCount: Integer;
  OwnerData: OleVariant;
begin
  try
    cdsPurchaseListMaster.Open;
    DComConPurchaseList.GetServer.AS_ApplyUpdates(cdsPurchaseListMaster.ProviderName,
      ADatas, 0, eCount, OwnerData);
    cdsPurchaseListMaster.Close;
    SetComplete;
  except
    SetAbort;
    cdsPurchaseListMaster.Close;
  end;
end;

function TmtsPurchaseListBiz.QueryPurchaseListSlaveById(
  const AId: WideString; var ADatas: OleVariant): WordBool;
begin
  result := false;
  ADatas := null;

  cdsQuery.Close;
  cdsQuery.CommandText := 'select * from t_PurchaseListSlave where masterid='+QuotedStr(AId);
  cdsQuery.Open;
  if cdsQuery.RecordCount > 0 then
  begin
    ADatas := cdsQuery.Data;
    result := true;
  end;

end;

procedure TmtsPurchaseListBiz.UpdatePurchaseListSlave(
  var ADatas: OleVariant);
var
  eCount: Integer;
  OwnerData: OleVariant;
begin
  try
    cdsPurchaseListSlave.Open;
    DComConPurchaseList.GetServer.AS_ApplyUpdates(cdsPurchaseListSlave.ProviderName,
       ADatas, 0, eCount, OwnerData);
    cdsPurchaseListMaster.Close;
    SetComplete;
  except
    SetAbort;
    cdsPurchaseListSlave.Close;
    raise;
  end;
end;

function TmtsPurchaseListBiz.GeneratePurchaseListId: WideString;
var
  Lold: Integer;
  LPrior: string;
  i: Integer;
begin
  Lold := cdsPurchaseListMaster.PacketRecords;
  cdsPurchaseListMaster.PacketRecords := 1;
  cdsPurchaseListMaster.Open;
  cdsPurchaseListMaster.First;
  LPrior := cdsPurchaseListMaster.FieldByName('Id').AsString;
  i := StrToIntDef(RightStr(LPrior,8),0);
  Inc(i);
  result := 'CG' + FormatFloat('00000000',i);
  cdsPurchaseListMaster.PacketRecords := Lold;
  cdsPurchaseListMaster.Close;

end;

procedure TmtsPurchaseListBiz.MtsDataModuleCreate(Sender: TObject);
var
  str: string;
begin
  str := GetComputerName;
  DComConPurchaseList.ComputerName := str;
  DCOMConQuery.ComputerName := str;
end;

initialization
  TComponentFactory.Create(ComServer, TmtsPurchaseListBiz,
    Class_mtsPurchaseListBiz, ciMultiInstance, tmApartment);
end.