📄 weijie_data.pas

📁 DELPHI做的制衣厂管理系统,功能完善,可能马上使用,SQL2000数据库
💻 PAS
📖 第 1 页 / 共 3 页
字号:
12 3 下一页
unit Weijie_Data;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, WeijieServerPrg_TLB, StdVcl, ADODB, DB, Provider, forms;

type
  TWeiJieServer = class(TRemoteDataModule, IWeiJieServer)
    ADOCN: TADOConnection;
    CMD: TADOCommand;
    ADOSProc1: TADOStoredProc;
    ADOSProc2: TADOStoredProc;
    ADO_Pub: TADODataSet;
    PClient: TDataSetProvider;
    PStock: TDataSetProvider;
    PHGoods: TDataSetProvider;
    PGoods: TDataSetProvider;
    PUser: TDataSetProvider;
    PPub: TDataSetProvider;
    ADOSProc3: TADOStoredProc;
    ADOStock: TADODataSet;
    ADOClient: TADODataSet;
    ADOHGoods: TADODataSet;
    ADOGoods: TADODataSet;
    ADOUser: TADODataSet;
    cdMaster: TADODataSet;
    cdItem: TADODataSet;
    dsMaster: TDataSource;
    pGetDocument: TDataSetProvider;
    dsColor: TDataSetProvider;
    cdColor: TADODataSet;
    ADOPub: TADOStoredProc;
    PGetZhangbenCW: TDataSetProvider;
    PGetZhangbenCK: TDataSetProvider;
    pubCm: TADODataSet;
    procedure PClientUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PStockUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PHGoodsUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PGoodsUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PUserUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure ADOCNBeforeConnect(Sender: TObject);
    procedure dsColorUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PGetZhangbenCWGetData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure PGetZhangbenCKGetData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure RemoteDataModuleCreate(Sender: TObject);
  private
     iPrint: integer;
     function GetPrint() :integer;
     function ApplyUpdateStock(mData,iData: OleVariant): String;
     function ApplyUpdateStockPlan(mData, iData: OleVariant): String;
     function ApplyUpdateHgoods(mData,iData: OleVariant): string;
     function ApplyUpdateGoods(mData,iData: OleVariant): string;
     function DoUpChangePass(ccode,cpassO,cPassN: STRING):integer;
     Procedure DoGetZhangBenCWJX(DataSet: TCustomClientDataSet);
     Procedure DoGetZhangBenCKJX(DataSet: TCustomClientDataSet);
     function DoAccountBookTotal(IYEA: Integer; IMON: Smallint; DDATE: TDateTime;
      const ccpt: WideString):String;
     function DoPubLogin(const ccode, cpass: String; var cuser,cgroup: Widestring): integer;
     function DoApplyUpdateMoney(vData: OleVariant): string;
     function DoTrashDocumment(iKey: Integer; iOpt: Integer): string;
     procedure DoGetDocument(csou,cdec,cdh: string; iOpt: integer);
     function ck6712A(runT: Integer):boolean;

     function doSetUserImpower(const cUser: string; oData: OleVariant):string;
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function IApplyUpdateStock(mData, iData: OleVariant): Smallint; safecall;
    function IApplyUpdateGoods(mData, iData: OleVariant): Smallint; safecall;
    function IApplyUpdateHGoods(mData, iData: OleVariant): Smallint; safecall;
    function IApplyUpdateStockPlan(mData, iData: OleVariant): Smallint;
      safecall;
    function IUpChangePass(const ccode, cPassO, cPassN: WideString): Smallint;
      safecall;
    function IAccountBookTotal(IYEA: Integer; IMON: Smallint; DDATE: TDateTime;
      const ccpt: WideString): Smallint; safecall;
    function IPubLogin(const ccode, cpass: WideString; var cuser,
      cgroup: WideString): Smallint; safecall;
    function IApplyUpdateMoney(VData: OleVariant): Smallint; safecall;
    function ITrashDocument(iKey: Integer; iOpt: Smallint): Smallint; safecall;
    procedure IGetDocument(const csou, cdec, cdh: WideString; iOpt: Integer);
      safecall;
    function ISetUserImpower(const cUser: WideString;
      oData: OleVariant): Smallint; safecall;
  public
    { Public declarations }
  end;

implementation
uses
   Registry;

{$R *.DFM}

class procedure TWeiJieServer.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 TWeiJieServer.PClientUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
   dataset.FieldByName('IKey').ProviderFlags:=
      dataset.FieldByName('IKey').ProviderFlags+[pfinkey];
end;

procedure TWeiJieServer.PStockUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
   dataset.FieldByName('IKey').ProviderFlags:=
      dataset.FieldByName('IKey').ProviderFlags+[pfinkey];
end;

procedure TWeiJieServer.PHGoodsUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
   dataset.FieldByName('IKey').ProviderFlags:=
      dataset.FieldByName('IKey').ProviderFlags+[pfinkey];
end;

procedure TWeiJieServer.PGoodsUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
   dataset.FieldByName('ikey').ProviderFlags:=
      dataset.FieldByName('ikey').ProviderFlags+[pfinkey];
end;

procedure TWeiJieServer.PUserUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
   dataset.FieldByName('CCode').ProviderFlags:=
      dataset.FieldByName('CCode').ProviderFlags+[pfinkey];
end;

procedure TWeiJieServer.ADOCNBeforeConnect(Sender: TObject);
begin
   If ck6712A(199) Then Begin
      ADOcN.ConnectionString := '';
      halt;
   end;
   ADOcn.ConnectionString :=
      'Provider=SQLOLEDB.1;Password="";Persist Security Info=True;User ID=sa;Initial Catalog=WeiJieData';
   ADOcn.KeepConnection := true;
   ADOcn.DefaultDatabase := 'WeiJieData';
end;

function TWeiJieServer.ApplyUpdateGoods(mData, iData: OleVariant): string;
VAR cdTem: TclientDataSet;
    ikey,idl: integer;
begin
   result := '';
   if not (iPrint < 0) then //is time
      exit;
   iKey := 0;
   cdTem := TclientDataSet.Create(nil);
   try
   
      try
         ADOCn.BeginTrans;

         idl := cdTem.fieldbyname('idl').AsInteger;
         ADOSProc3.Close;
         ADOSProc3.ProcedureName := 'P_ApplyGoodsMaster';
         ADOSProc3.Parameters.Refresh;
         ADOSProc3.Parameters.ParamValues['@CDH'] := cdTem.fieldbyname('CDH').AsString;
         ADOSProc3.Parameters.ParamValues['@IKeyClient'] := cdTem.fieldbyname('IKeyClient').AsInteger;
         ADOSProc3.Parameters.ParamValues['@DDatePZ'] := cdTem.fieldbyname('DDatePZ').AsDateTime;
         ADOSProc3.Parameters.ParamValues['@DDateJH'] := cdTem.fieldbyname('DDateJH').AsDateTime;
         ADOSProc3.Parameters.ParamValues['@CUser'] := cdTem.fieldbyname('CUser').AsString;
         ADOSProc3.Parameters.ParamValues['@FJE'] := cdTem.fieldbyname('FJE').AsFloat;
         ADOSProc3.Parameters.ParamValues['@IDL'] := cdTem.fieldbyname('IDL').AsInteger;
         ADOSProc3.Parameters.ParamValues['@IKey'] := IKEY;
         ADOSProc3.ExecProc;
         IKey := ADOSProc3.Parameters.ParamValues['@IKey'];

         IF IKEY = -1 THEN BEGIN
            Result := '单号重复啦,请仔细检查!';
            Exit;
         END;
         IF IKEY = 0 THEN BEGIN
            Result := '出现不明错误,保存失败,请稍后再试!';
            Exit;
         END;

         ADOSProc3.Close;
         ADOSProc3.ProcedureName := 'P_ApplyGoodsItem';
         ADOSProc3.Parameters.Refresh;
         cdTem.First;
         WHILE NOT cdTem.Eof DO BEGIN
            ADOSProc3.Parameters.ParamValues['@IKeyM'] := IKEY;
            ADOSProc3.Parameters.ParamValues['@ICodeCp'] := cdTem.fieldbyname('IKeyCp').AsInteger;
            if idl < 0 then begin
               ADOSProc3.Parameters.ParamValues['@FSl'] := -cdTem.fieldbyname('FSl').AsFloat;
               ADOSProc3.Parameters.ParamValues['@FZL'] := -cdTem.fieldbyname('FZL').AsFloat;
            end
            else Begin
               ADOSProc3.Parameters.ParamValues['@FSl'] := cdTem.fieldbyname('FSl').AsFloat;
               ADOSProc3.Parameters.ParamValues['@FZL'] := cdTem.fieldbyname('FZL').AsFloat;
            end;
            ADOSProc3.ExecProc;
            cdTem.Next;
         END;  //             END While

         ADOCn.CommitTrans;
      except
         on E:Exception do
         Result := E.Message;
      end;

   finally
      if ADOCn.InTransaction then
         ADOCn.RollbackTrans;
      cdTem.Free;
   end;
end;

function TWeiJieServer.ApplyUpdateHgoods(mData, iData: OleVariant): string;
VAR cdTem: TclientDataSet;
    ikey,idl: integer;
begin
   result := '';
   if not (iPrint < 0) then //is time
      exit;
   iKey := 0;
   cdTem := TclientDataSet.Create(nil);
   try
   
      try
         ADOCn.BeginTrans;

         idl := cdTem.fieldbyname('idl').AsInteger;
         ADOSProc3.Close;
         ADOSProc3.ProcedureName := 'P_ApplyHGoodsMaster';
         ADOSProc3.Parameters.Refresh;
         ADOSProc3.Parameters.ParamValues['@CDH'] := cdTem.fieldbyname('CDH').AsString;
         ADOSProc3.Parameters.ParamValues['@IKeyClient'] := cdTem.fieldbyname('IKeyClient').AsInteger;
         ADOSProc3.Parameters.ParamValues['@DDatePZ'] := cdTem.fieldbyname('DDatePZ').AsDateTime;
         ADOSProc3.Parameters.ParamValues['@DDateJH'] := cdTem.fieldbyname('DDateJH').AsDateTime;
         ADOSProc3.Parameters.ParamValues['@CUser'] := cdTem.fieldbyname('CUser').AsString;
         ADOSProc3.Parameters.ParamValues['@FJE'] := cdTem.fieldbyname('FJE').AsFloat;
         ADOSProc3.Parameters.ParamValues['@IDL'] := cdTem.fieldbyname('IDL').AsInteger;
         ADOSProc3.Parameters.ParamValues['@IKey'] := IKEY;
         ADOSProc3.ExecProc;
         IKey := ADOSProc3.Parameters.ParamValues['@IKey'];

         IF IKEY = -1 THEN BEGIN
            Result := '单号重复啦,请仔细检查!';
            Exit;
         END;
         IF IKEY = 0 THEN BEGIN
            Result := '出现不明错误,保存失败,请稍后再试!';
            Exit;
         END;

         ADOSProc3.Close;
         ADOSProc3.ProcedureName := 'P_ApplyHGoodsItem';
         ADOSProc3.Parameters.Refresh;
         cdTem.First;
         WHILE NOT cdTem.Eof DO BEGIN
            ADOSProc3.Parameters.ParamValues['@IKeyM'] := IKEY;
            ADOSProc3.Parameters.ParamValues['@IKeySTK'] := cdTem.fieldbyname('IKeyCp').AsInteger;
            if idl < 0 then begin
               ADOSProc3.Parameters.ParamValues['@FSl'] := -cdTem.fieldbyname('FSl').AsFloat;
               ADOSProc3.Parameters.ParamValues['@FZL'] := -cdTem.fieldbyname('FZL').AsFloat;
            end
            else Begin
               ADOSProc3.Parameters.ParamValues['@FSl'] := cdTem.fieldbyname('FSl').AsFloat;
               ADOSProc3.Parameters.ParamValues['@FZL'] := cdTem.fieldbyname('FZL').AsFloat;
            end;
            ADOSProc3.ExecProc;
            cdTem.Next;
         END;  //             END While

         ADOCn.CommitTrans;
      except
         on E:Exception do
         Result := E.Message;
      end;

   finally
      if ADOCn.InTransaction then
         ADOCn.RollbackTrans;
      cdTem.Free;
   end;
end;

function TWeiJieServer.ApplyUpdateStock(mData, iData: OleVariant): String;
VAR cdTem: TclientDataSet;
    ikey,idl: integer;
begin
   result := '';
12 3 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -