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

📄 dms.pas

📁 delphi作得信息业进销存源码.功能全面,运行稳定.
💻 PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
    FykzSRZCLBID: TIntegerField;
    FykzZY: TStringField;
    FykzaBH: TStringField;
    FykzaMC: TStringField;
    FykzJE: TFloatField;
    Qtsrzb: TADOQuery;
    IntegerField8: TIntegerField;
    StringField9: TStringField;
    DateField5: TDateField;
    SmallintField3: TSmallintField;
    StringField10: TStringField;
    SmallintField4: TSmallintField;
    StringField11: TStringField;
    StringField12: TStringField;
    StringField16: TStringField;
    FloatField5: TFloatField;
    StringField20: TStringField;
    StringField21: TStringField;
    Qtsr: TADOQuery;
    IntegerField9: TIntegerField;
    IntegerField10: TIntegerField;
    DateField6: TDateField;
    IntegerField11: TIntegerField;
    StringField22: TStringField;
    StringField23: TStringField;
    StringField24: TStringField;
    FloatField6: TFloatField;
    pQtsrzb: TDataSetProvider;
    pQtsr: TDataSetProvider;
    Yhckqk: TADOQuery;
    IntegerField14: TIntegerField;
    DateField7: TDateField;
    SmallintField6: TSmallintField;
    StringField27: TStringField;
    StringField28: TStringField;
    StringField29: TStringField;
    FloatField7: TFloatField;
    StringField30: TStringField;
    StringField31: TStringField;
    pYhckqk: TDataSetProvider;
    YhckqkZHID: TSmallintField;
    YhckqkaZHMC: TStringField;
    XskdHelp: TADOQuery;
    pXskdHelp: TDataSetProvider;
    XskdHelpID: TIntegerField;
    XskdHelpDJBH: TStringField;
    XskdHelpRQ: TDateField;
    XskdHelpaXSLX: TStringField;
    XskdHelpJE: TFloatField;
    XskdHelpaKHBH: TStringField;
    XskdHelpaKHMC: TStringField;
    CgshHelp: TADOQuery;
    pCgshHelp: TDataSetProvider;
    CgshHelpID: TIntegerField;
    CgshHelpDJBH: TStringField;
    CgshHelpRQ: TDateField;
    CgshHelpaCGLX: TStringField;
    CgshHelpJE: TFloatField;
    CgshHelpaGYSBH: TStringField;
    CgshHelpaGYSMC: TStringField;
    Thgc: TADOQuery;
    IntegerField15: TIntegerField;
    IntegerField16: TIntegerField;
    DateField8: TDateField;
    IntegerField19: TIntegerField;
    StringField25: TStringField;
    StringField26: TStringField;
    StringField32: TStringField;
    FloatField8: TFloatField;
    pThgc: TDataSetProvider;
    Sjzl: TADOQuery;
    SjzlID: TIntegerField;
    SjzlXH: TSmallintField;
    SjzlMC: TStringField;
    SjzlBZ: TStringField;
    pSjzl: TDataSetProvider;
    HpQCJQJ: TFloatField;
    XskdDJ: TFloatField;
    XsthCBDJ: TFloatField;
    ThgcDJ: TFloatField;
    HpJQJ: TFloatField;
    ZhQCJE: TFloatField;
    ZhQMJE: TFloatField;
    ZhITMP: TIntegerField;
    CgshzbSKQX: TIntegerField;
    CgshzbYFJE2: TFloatField;
    XskdzbYSJE2: TFloatField;
    CgshzbYFJE3: TFloatField;
    XskdzbYSJE3: TFloatField;
    {-Common Begin-}
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure CnWillExecute(Connection: TADOConnection;
      var CommandText: WideString; var CursorType: TCursorType;
      var LockType: TADOLockType; var CommandType: TCommandType;
      var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
      const Command: _Command; const Recordset: _Recordset);
    procedure pAppUserGroupAfterUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TClientDataSet;
      UpdateKind: TUpdateKind);
    procedure pAppUserAfterUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TClientDataSet;
      UpdateKind: TUpdateKind);
    procedure pCgddzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pHpAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgshzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgshAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pKhAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pGysAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pSjzlAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCkAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgfkzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgfkAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgthzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCgthAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXsddzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXskdzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXskdAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXsskzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXsskAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXsthzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pXsthAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pLlzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pLlAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pTlzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pTlAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCpjczbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCpjcAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pKcpdzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pKcpdAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pChtjzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pChtjAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCkdbzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pCkdbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pQtkcbdzbAfterUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TClientDataSet;
      UpdateKind: TUpdateKind);
    procedure pQtkcbdAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pFykzzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pQtsrzbAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pZhAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
    procedure pYhckqkAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
      DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
  private
    { Private declarations }
    procedure SetFieldValue(strSql:string; Ds: TDataSet; strFields: string);
    procedure SqlExec(strSql: string);
    function CheckRecord(strSql: string):Boolean;  //检查是否有符合条件的记录
    function GetFieldValue(strSql: string):Variant;  //返回sql语句的字段值（一个）
    function IsModify(DeltaDS: TClientDataSet; strFieldName: string): boolean;
    function GetCurValue(DeltaDS: TClientDataSet; strFieldName: string): Variant;
    function GetValue(DeltaDS: TClientDataSet; strFieldName: string;
      GetValueType: TGetValueType): string;
    //Set JQJ
    procedure SetJQJ(strHPID: string; SL, DJ: double; Kind: string);
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure SetFilter(Filter: OleVariant); safecall;
  public
    { Public declarations }
  end;

implementation

uses Variants, Mains, ComFun;

{$R *.DFM}

{-Common Begin-}

//RemoteDataModuleCreate
procedure TDatas.RemoteDataModuleCreate(Sender: TObject);
begin
  Cn.ConnectionString := 'Data Source=' + ExtractFilePath(Application.ExeName) + 'Data.Mdb';
end;

//UpdateRegistry
class procedure TDatas.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;

//SetFilter
procedure TDatas.SetFilter(Filter: OleVariant);
var
  DataSet : TDataSet;
begin
  DataSet := TDataSet( Self.FindComponent( VarToStr(Filter[0]) ) );
  DataSet.Filter := VarToStr(Filter[1]);
  DataSet.Filtered := DataSet.Filter <> '';
end;

//strFields:要赋值的字段列表，用';'分开
procedure TDatas.SetFieldValue(strSql: string; Ds: TDataSet;
  strFields: string);
var
  strFieldName: string;
  i: integer;
begin
  Tmp.Close;
  Tmp.SQL.Text := strSql;
  Tmp.Open;
  i := 0;
  while strFields <> '' do
  begin
    if Pos(';', strFields) <> 0 then
    begin
      strFieldName := copy(strFields, 1, Pos(';', strFields)-1);
      strFields := copy(strFields, Pos(';', strFields)+1, length(strFields));
    end else
    begin
      strFieldName := strFields;
      strFields := '';
    end;
    ds.FieldByName(strFieldName).Value := Tmp.Fields[i].Value;
    inc(i);
  end;
  Tmp.Close;
end;

//执行SQL语句
procedure TDatas.SqlExec(strSql: string);
begin
  with Tmp do
  begin
    Close;
    Sql.Text := strSql;
    ExecSQL;
    Close;
  end;
end;

//检查是否有符合条件的记录
function TDatas.CheckRecord(strSql: string): Boolean;
begin
  with Tmp do
  begin
    Close;
    Sql.Text := strSql;
    Open;
    Result := not IsEmpty;
    Close;
  end;
end;

//返回sql语句的字段值（一个）
function TDatas.GetFieldValue(strSql: string): Variant;
begin
  with Tmp do
  begin
    Sql.Text := strSql;
		Open;
		if not IsEmpty then
			Result := Fields[0].Value
		else
			Result := null;
		Close;
	end;
end;

//判断某字段是否有修改过
function TDatas.IsModify(DeltaDS: TClientDataSet;
  strFieldName: string): boolean;
begin
  result := (not VarIsEmpty(DeltaDS.FieldByName(strFieldName).NewValue)) and
    (DeltaDS.FieldByName(strFieldName).NewValue <>
    DeltaDS.FieldByName(strFieldName).OLdValue);
end;

//返回当前值
function TDatas.GetCurValue(DeltaDS: TClientDataSet;
  strFieldName: string): Variant;
begin
  if IsModify(DeltaDS, strFieldName) then
    result := DeltaDS.FieldByName(strFieldName).NewValue
  else
    result := DeltaDS.FieldByName(strFieldName).OldValue;
end;

//返回旧值、新值或当前值（返回字符型）
function TDatas.GetValue(DeltaDS: TClientDataSet; strFieldName: string;
  GetValueType: TGetValueType): string;
var
  v: Variant;
begin
  case GetValueType of
    gtOld: v := DeltaDS.FieldByName(strFieldName).OldValue;
    gtNew: v := DeltaDS.FieldByName(strFieldName).NewValue;
    gtCur: v := GetCurValue(DeltaDS, strFieldName);
  end;
  if DeltaDS.FieldByName(strFieldName) is TStringField then
  begin
    if VarIsEmpty(v) or (v = null) then
      Result := ''
    else
      Result := VarToStr(v);
  end
  else if DeltaDS.FieldByName(strFieldName) is TNumericField then
  begin
    if VarIsEmpty(v) or (v = null) then
      Result := '0'
    else
      Result := VarToStr(v);
  end
  else
    result := VarToStr(v);
end;

//CnWillExecute
procedure TDatas.CnWillExecute(Connection: TADOConnection;
  var CommandText: WideString; var CursorType: TCursorType;
12345

⌨️ 快捷键说明

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