udm.pas

简单易用的按件按时计工资管理系统

unit uDM;

interface

uses
  Windows, Messages, SysUtils, Classes, ADODB, DB,StrUtils,
  Provider, DBClient, Variants, Dialogs, dxLayout;

type
  TDM = class(TDataModule)
    ADOConn: TADOConnection;
    dsp: TDataSetProvider;
    ads: TADODataSet;
    asp: TADOStoredProc;
    cdsOrderType: TClientDataSet;
    dsOrderType: TDataSource;
    cdsUnit: TClientDataSet;
    dsUnit: TDataSource;
    cdsTeam: TClientDataSet;
    dsTeam: TDataSource;
    procedure DataModuleDestroy(Sender: TObject);
    procedure dspBeforeUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TCustomClientDataSet; UpdateKind: TUpdateKind;
      var Applied: Boolean);

  private
    FValues: OleVariant;
  public
    //连接
    function SetConnect(const pConnectString: string): boolean; virtual;
    //根据SQL语句取记录集
    procedure GetRecords(const pSQL: string;
      out pData: OleVariant; out pCount, pRecsOut: Integer); virtual;
    //根据SQL语句取单条记录的若干字段值
    procedure GetValues(const pSQL: WideString; out pValues: OleVariant);

    procedure GetRecordsEx(const pTableName, pCondition: string; out pData: OleVariant); virtual;
    //执行存储过程（无返回记录集）
    procedure ExecuteSP(const pSPName: string;
      pParams: OleVariant; var pParamValues: OleVariant); virtual;

    //根据Delta更新数据
    procedure SetInfoBySQL(pDelta: OleVariant; const pSQL: WideString; pValues: OleVariant);
    procedure SetInfoByTableName(const pTableName: WideString; pDelta: OleVariant ; pValues: OleVariant);
    //执行SQL语句（无返回记录集）
    procedure SetInfoByCmd(const pSQL: WideString);

    //执行SQL语句判断有没有记录存在
    function RecordExists(const pSQL: WideString):Boolean;

    procedure GetMasterDatailData(const pMasterTable, pDetailTable, pKeyFieldValue: string;
      out pMasterData, pDetailData: OleVariant); virtual;

    procedure SaveMasterDatailData(const pMasterTable, pDetailTable: string;
      const pMasterData, pDetailData: OleVariant; var pID:string;pOrderID:string;pDate:TDateTime); virtual;
    procedure DelMasterDatailData(const pMasterTable, pDetailTable, pID: string);

    function GetNewOrderID(pTableName:string; pDate:TDateTime):string;
    procedure RefreshSysData;virtual;
  end;

var
  DM: TDM;

implementation

uses uGlobal, uPub_Resource;

{$R *.dfm}

{ TDataModule1 }

procedure TDM.ExecuteSP(const pSPName: string;
  pParams: OleVariant; var pParamValues: OleVariant);
var
  i: Integer;
begin
  try
    asp.Parameters.Clear;
    asp.ProcedureName := pSPName;
    if VarIsArray(pParams) then
      for i := 0 to VarArrayHighBound(pParams, 1) do
      begin
        with asp.Parameters.AddParameter do
        begin
          Name := pParams[i, 0];
          DataType := pParams[i, 1];
          Direction := pParams[i, 2];
          Size := 4096;
          Value := pParamValues[i];
        end;
      end;
    asp.ExecProc;
    with asp.Parameters do
    begin
      for i := 0 to Count - 1 do
      begin
        if Items[i].Direction in [pdInputOutPut, pdOutPut] then
          pParamValues[i] := Items[i].Value;
      end;
    end;
  except
    raise;
  end;
end;


procedure TDM.GetRecords(const pSQL: string;
  out pData: OleVariant; out pCount, pRecsOut: Integer);
var
  theOption: TGetRecordOptions;
begin
  try
    with ads do
    begin
      Close;
      CommandText := pSQL;
    end;
    theOption := [grMetaData, grReset];
    pData := dsp.GetRecords(-1, pRecsOut, Byte(theOption));
  except
    raise;
  end;
end;

function TDM.SetConnect(const pConnectString: string): boolean;
begin
  try
    ADOConn.Close;
    ADOConn.ConnectionString := pConnectString;
    ADOConn.Open;
    Result := True;
  except
    on E: Exception do
    begin
      CloseWaitingDlg;
      Showmessage(CS_ConnectFail + #13#10 + E.Message);
      raise;
    end;
  end;
end;

procedure TDM.SetInfoBySQL(pDelta: OleVariant; const pSQL: WideString; pValues: OleVariant);
var
  ErrorCount: Integer;
begin
  try
    with ads do
    begin
      Close;
      CommandText := pSQL;
    end;
    FValues := pValues;
    dsp.ApplyUpdates(pDelta, 0, ErrorCount);
  except
    raise;
  end;
end;

procedure TDM.SetInfoByCmd(const pSQL: WideString);
begin
  try
    with ADOConn do
    begin
      Execute(pSQL);    
    end;
  except
    Raise;
  end;
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
  ADOConn.Close;
end;


procedure TDM.GetMasterDatailData(const pMasterTable, pDetailTable,
  pKeyFieldValue: string; out pMasterData,
  pDetailData: OleVariant);
var
  sMasterCond, sDetailCond:string;
const
  CS_Cond_KeyValue=' WHERE %s = %s';
begin
  if pKeyFieldValue<>'' then
  begin
    sMasterCond:=Format(CS_Cond_KeyValue, [CS_KeyFieldName, pKeyFieldValue]);
    sDetailCond:=Format(CS_Cond_KeyValue, [CS_MasterDetailFieldName, pKeyFieldValue]);
  end else
  begin
    sMasterCond:='WHERE (1=2)' ;
    sDetailCond:='WHERE (1=2)' ;
  end;

  GetRecordsEx(pMasterTable, sMasterCond, pMasterData ) ;
  GetRecordsEx(pDetailTable, sDetailCond, pDetailData ) ;
end;

procedure TDM.SaveMasterDatailData(const pMasterTable, pDetailTable: string;
  const pMasterData, pDetailData: OleVariant; var pID:string;pOrderID:string; pDate:TDateTime);
var
  pValues: OleVariant;
  sTemp, sOrderID:string;
begin
  ADOConn.BeginTrans ;
  try
    pValues:=null;
    sOrderID:=pOrderID;
    if sOrderID ='' then
    begin
      pValues := VarArrayCreate([0, 0, 0, 1], varVariant);
      sOrderID:=GetNewOrderID(pMasterTable, pDate) ;
      pValues[0, 0] := CS_OrderIDFieldName;
      pValues[0, 1] := sOrderID;
    end;

    if VarIsArray(pMasterData) then
    begin
      SetInfoByTableName(pMasterTable, pMasterData, pValues);
      //ADOConn.CommitTrans ;
    end;
    //获取主键
    pValues:=null;
    if pID = '' then
    begin
      sTemp := 'SELECT ' + CS_KeyFieldName + ' FROM ' + pMasterTable
      + ' WHERE ' + CS_OrderIDFieldName +  ' = ''' + sOrderID + '''';
      GetValues(sTemp, pValues);
      if VarIsArray(pValues) then
        pID:=VarToStr(pValues[0, 1]);
    end;

    if VarIsArray(pDetailData) then
    begin
      pValues := VarArrayCreate([0, 0, 0, 1], varVariant);
      pValues[0, 0] := CS_MasterDetailFieldName;
      pValues[0, 1] := pID;
      SetInfoByTableName(pDetailTable, pDetailData, pValues);
      //ADOConn.CommitTrans ;
    end;
    ADOConn.CommitTrans ;
  except
    ADOConn.RollbackTrans ;
    Raise;
  end;
end;

procedure TDM.GetRecordsEx(const pTableName, pCondition: string;
  out pData: OleVariant);
var
  theOption: TGetRecordOptions;
  i:integer;
  pSQL:string;
begin
  pSQL:='SELECT * FROM ' +  pTableName + ' ' + pCondition;
  try
    with ads do
    begin
      Close;
      CommandText := pSQL;
    end;
    theOption := [grMetaData, grReset];
    pData := dsp.GetRecords(-1, i, Byte(theOption));
  except
    raise;
  end;
end;

procedure TDM.SetInfoByTableName(const pTableName: WideString;pDelta: OleVariant ; pValues: OleVariant);
var
  pSQL:string;
begin
  pSQL:='SELECT * FROM ' +  pTableName;
  SetInfoBySQL(pDelta, pSQL, pValues);
end;

procedure TDM.RefreshSysData;
var
  pData :OleVariant;
begin
  GetRecordsEx(CS_Table_OrderType, '' ,pData);
  cdsOrderType.Data :=pData;
  
  pData:=null;
  GetRecordsEx(CS_Table_OrderType, '' ,pData);
  cdsUnit.Data :=pData;

  pData:=null;
  GetRecordsEx(CS_Table_Team, '' ,pData);
  cdsTeam.Data :=pData;

  with Pub_Resource do
  begin
    grdTeam.DataSource :=dsTeam;
    grdTeam.KeyField :=CS_KeyFieldName;
    CreateCellCols(grdTeam,  cdsTeam);
    layTeam.Active := False;
    layTeam.Assign(grdTeam);
    layTeam.Active := True;
    
  end;
end;

procedure TDM.dspBeforeUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TCustomClientDataSet; UpdateKind: TUpdateKind;
  var Applied: Boolean);
var
  i: Integer;
begin
  if UpdateKind <> ukInsert then Exit;
  if not VarIsArray(FValues) then Exit;
  with DeltaDS do
  begin
    Edit;
    for i := VarArrayLowBound(FValues, 1) to  VarArrayHighBound(FValues, 1) do
      FieldByName(FValues[i, 0]).Value := FValues[i, 1];
  end;
end;

function TDM.GetNewOrderID(pTableName:string; pDate:TDateTime): string;
var
  sDate:string;
  pSQL:string;
  pValues: OleVariant ;
  pOrderID:string;
  function GetNextOrderID(pOrderID:string):string;
  var
    s:string;
    n:integer;
  begin
    s:=Copy(pOrderID, length(sDate) +1,Length(pOrderID));
    if s='' then s:='0';
    n:=StrToInt(s) + 1;
    s:=IntToStr(n);
    Result:= sDate + dupeString('0', 4-Length(s)) + s;

  end;
begin
  pOrderID:='';
  sDate:=FormatDateTime('YYYYMMDD', pDate);
  pSQL:='SELECT MAX('+ CS_OrderIDFieldName +') FROM ' + pTableName + ' WHERE '
       + CS_OrderIDFieldName + ' LIKE ''' + sDate + '%''';
  pValues:=null;
  GetValues(pSQL, pValues);
  if VarIsArray(pValues) then
    pOrderID:= VarToStr(pValues[0, 1]);

  if pOrderID='' then
    pOrderID:= sDate + '0000';

  Result:=GetNextOrderID(pOrderID);


end;

procedure TDM.GetValues(const pSQL: WideString; out pValues: OleVariant);
var
  i: Integer;
  s:string;
begin
  s:=psql;
  try
    with ads do
    begin
      Close;
      CommandText := s;
      Open;
      if not Eof then
      begin
        pValues := VarArrayCreate([0, FieldCount - 1, 0, 1], varVariant);
        for i := 0 to FieldCount - 1 do
        begin
          pValues[i, 0] := Fields[i].FieldName;
          pValues[i, 1] := Fields[i].Value;
        end;
      end;
      Close;
    end;
  except
    Raise;
  end;
end;


function TDM.RecordExists(const pSQL: WideString): Boolean;
var
  iRecsCount,iTmpCount:integer;
  vData:OleVariant;
begin
  iTmpCount:=-1;
  GetRecords(pSQL, vData, iTmpCount,iRecsCount);
  Result:=iRecsCount>=1;
end;

procedure TDM.DelMasterDatailData(const pMasterTable, pDetailTable,
  pID: string);
begin
  ADOConn.BeginTrans ;
  try
    SetInfoByCmd('DELETE * FROM ' + pDetailTable + ' WHERE ' + CS_MasterDetailFieldName + '=' + pID);
    SetInfoByCmd('DELETE * FROM ' + pMasterTable + ' WHERE ' + CS_KeyFieldName + '=' + pID);
    ADOConn.CommitTrans ;
  except
    ADOConn.RollbackTrans ;
    raise;
  end;
  
end;

end.