dms.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

  var LockType: TADOLockType; var CommandType: TCommandType;
  var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
  const Command: _Command; const Recordset: _Recordset);
begin
  if Copy(UpperCase(CommandText), 1, 6) = 'UPDATE' then
    if Pos('SET', UpperCase(CommandText)) = 0 then
    begin
      EventStatus := esCancel;
      frmMains.Memo1.Text := Copy('Not Execute: ' + CommandText + #13#10#13#10 + frmMains.Memo1.Text,1 , 10240);
      Exit;
    end;
  frmMains.Memo1.Text := Copy(CommandText + #13#10#13#10 + frmMains.Memo1.Text,1 , 10240);
end;

//pAppUserGroup.AfterUpdateRecord
procedure TDatas.pAppUserGroupAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukModify:
    if IsModify(DeltaDS, 'gName') then
    begin
      SqlExec('update AppUser set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('update AppGroupAction set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('update AppGroupDesktop set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('update AppGroupDesktopClass set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('update AppGroupField set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('update AppGroupMenu set gName = ''' + DeltaDS.FieldByName('gName').NewValue + ''' ' +
        'where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
    end;
  ukDelete:
    begin
      SqlExec('delete from AppUser where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('delete from AppGroupAction where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('delete from AppGroupDesktop where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('delete from AppGroupDesktopClass where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('delete from AppGroupField where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
      SqlExec('delete from AppGroupMenu where gName = ''' + DeltaDS.FieldByName('gName').OldValue + '''');
    end;
  end;
end;

//pAppUserAfter.UpdateRecord
procedure TDatas.pAppUserAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukDelete:
    begin
      SqlExec('delete from AppInCommonUse where uId = ' + IntToStr(DeltaDS.FieldByName('ID').OldValue));
      SqlExec('delete from AppSort where uId = ' + IntToStr(DeltaDS.FieldByName('ID').OldValue));
      SqlExec('delete from AppFilter where uId = ' + IntToStr(DeltaDS.FieldByName('ID').OldValue));
    end;
  end;
end;

{-Common End-}

//Set JQJ
procedure TDatas.SetJQJ(strHPID: string; SL, DJ: double; Kind: string);
var
  dblZKCL, dblOLDJ, dblJQJ: double;
begin
  dblZKCL := Str2Float(GetFieldValue('select sum(JCS) from HPKC where HPID = ' + strHPID));
  dblOLDJ := Str2Float(GetFieldValue('select JQJ from HP where ID = ' + strHPID));
  if Kind = '+' then
  begin
    //((现总数 + 处理数) * 现价 + 处理数 * 处理价) / (现总数 + 处理数)
    if dblZKCL <> 0 then
      dblJQJ := RoundPlus((RoundPlus(dblZKCL * dblOLDJ, 3) + RoundPlus(SL * DJ, 3)) / (dblZKCL + SL), 3)
    else
      dblJQJ := 0;
    SqlExec('update HP set JQJ = ' + Float2Str(dblJQJ) + ' where ID = ' + strHPID);
  end
  else
  begin
    //(现总数 * 现价 - 处理数 * 处理价) / (现总数 - 处理数)
    if dblZKCL - SL <> 0 then
      dblJQJ := RoundPlus((RoundPlus(dblZKCL * dblOLDJ, 3) - RoundPlus(SL * DJ, 3)) / (dblZKCL - SL), 3)
    else
      dblJQJ := 0;
    SqlExec('update HP set JQJ = ' + Float2Str(dblJQJ) + ' where ID = ' + strHPID);
  end;
end;

//客户
procedure TDatas.pKhAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    begin
      SqlExec('update KH set QMJE = ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
        'where ID = ' + GetValue(DeltaDS, 'ID', gtNew));
      SqlExec('insert into XSKDZB (ID, DJBH, KHID, JE, YSJE, XSLX, BZ) ' +
        'values(-' + GetValue(DeltaDS, 'ID', gtNew) + ', ''期初应收'', ' +
        GetValue(DeltaDS, 'ID', gtNew) + ', ' +
        GetValue(DeltaDS, 'QCJE', gtNew) + ', 0, 0, ''客户期初应收款'')');
    end;
  ukModify:
    if IsModify(DeltaDS, 'QCJE') then
    begin
      SqlExec('update KH set QMJE = QMJE - ' + GetValue(DeltaDS, 'QCJE', gtOld) +
        ' + ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
        'where ID = ' + GetValue(DeltaDS, 'ID', gtOld));
      if CheckRecord('select ID from XSKDZB where ID = -' + GetValue(DeltaDS, 'ID', gtCur)) then
        SqlExec('update XSKDZB set JE = ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
          'where ID = -' + GetValue(DeltaDS, 'ID', gtOld))
      else
        SqlExec('insert into XSKDZB (ID, DJBH, KHID, JE, YSJE, XSLX, BZ) ' +
          'values(-' + GetValue(DeltaDS, 'ID', gtCur) + ', ''期初应收'', ' +
          GetValue(DeltaDS, 'ID', gtCur) + ', ' +
          GetValue(DeltaDS, 'QCJE', gtNew) + ', 0, 0, ''客户期初应收款'')');
    end;
  ukDelete:
    SqlExec('delete from XSKDZB where ID = -' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//供应商
procedure TDatas.pGysAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    begin
      SqlExec('update GYS set QMJE = ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
        'where ID = ' + GetValue(DeltaDS, 'ID', gtNew));
      SqlExec('insert into CGSHZB (ID, DJBH, GYSID, JE, YFJE, CGLX, BZ) ' +
        'values(-' + GetValue(DeltaDS, 'ID', gtNew) + ', ''期初应付'', ' +
        GetValue(DeltaDS, 'ID', gtNew) + ', ' +
        GetValue(DeltaDS, 'QCJE', gtNew) + ', 0, 0, ''供应商期初应付款'')');
    end;
  ukModify:
    if IsModify(DeltaDS, 'QCJE') then
    begin
      SqlExec('update GYS set QMJE = QMJE - ' + GetValue(DeltaDS, 'QCJE', gtOld) +
        ' + ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
        'where ID = ' + GetValue(DeltaDS, 'ID', gtOld));
      if CheckRecord('select ID from CGSHZB where ID = -' + GetValue(DeltaDS, 'ID', gtCur)) then
        SqlExec('update CGSHZB set JE = ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
          'where ID = -' + GetValue(DeltaDS, 'ID', gtOld))
      else
        SqlExec('insert into CGSHZB (ID, DJBH, GYSID, JE, YFJE, CGLX, BZ) ' +
          'values(-' + GetValue(DeltaDS, 'ID', gtCur) + ', ''期初应付'', ' +
          GetValue(DeltaDS, 'ID', gtCur) + ', ' +
          GetValue(DeltaDS, 'QCJE', gtNew) + ', 0, 0, ''供应商期初应付款'')');
    end;
  ukDelete:
    SqlExec('delete from CGSHZB where ID = -' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//帐户
procedure TDatas.pZhAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    SqlExec('update ZH set QMJE = ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
      'where ID = ' + GetValue(DeltaDS, 'ID', gtNew));
  ukModify:
    if IsModify(DeltaDS, 'QCJE') then
      SqlExec('update ZH set QMJE = QMJE - ' + GetValue(DeltaDS, 'QCJE', gtOld) +
        ' + ' + GetValue(DeltaDS, 'QCJE', gtNew) + ' ' +
        'where ID = ' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//仓库
procedure TDatas.pCkAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    SqlExec('insert into HPKC (CKID, HPID, QCS, JCS) ' +
      'select ' + GetValue(DeltaDS, 'ID', gtNew) + ', ID, 0, 0 from HP');
  ukDelete:
    SqlExec('delete from HPKC where CKID = ' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//售价种类
procedure TDatas.pSjzlAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukDelete:
    SqlExec('delete from HPSJ where SJZLID = ' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//货品
procedure TDatas.pHpAfterUpdateRecord(Sender: TObject; SourceDS: TDataSet;
  DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukDelete:
    begin
      SqlExec('delete from HPKC where HPID = ' + GetValue(DeltaDS, 'ID', gtOld));
      SqlExec('delete from HPSJ where HPID = ' + GetValue(DeltaDS, 'ID', gtOld));
    end;
  end;
end;

//采购订单总表
procedure TDatas.pCgddzbAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukDelete:
    SqlExec('delete from CGDD where ZBID = ' + GetValue(DeltaDS, 'ID', gtOld));
  end;
end;

//采购收货总表
procedure TDatas.pCgshzbAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    begin
      //GYS
      SqlExec('update GYS set QMJE = QMJE + iif(' + GetValue(DeltaDS, 'CGLX', gtNew) + ' = 2, ' + GetValue(DeltaDS, 'JE', gtNew) + ', 0) ' +
        'where ID = ' + GetValue(DeltaDS, 'GYSID', gtNew));
      //ZH
      SqlExec('update ZH set QMJE = QMJE - iif(' + GetValue(DeltaDS, 'CGLX', gtNew) + ' = 1, ' + GetValue(DeltaDS, 'JE', gtNew) + ', 0) ' +
        'where ID = ' + GetValue(DeltaDS, 'ZHID', gtNew));
    end;
  ukModify:
    begin
      //GYS
      if IsModify(DeltaDS, 'GYSID') or IsModify(DeltaDS, 'CGLX') or IsModify(DeltaDS, 'JE') then
      begin
        SqlExec('update GYS set QMJE = QMJE - iif(' + GetValue(DeltaDS, 'CGLX', gtOld) + ' = 2, ' + GetValue(DeltaDS, 'JE', gtOld) + ', 0) ' +
          'where ID = ' + GetValue(DeltaDS, 'GYSID', gtOld));
        SqlExec('update GYS set QMJE = QMJE + iif(' + GetValue(DeltaDS, 'CGLX', gtCur) + ' = 2, ' + GetValue(DeltaDS, 'JE', gtCur) + ', 0) ' +
          'where ID = ' + GetValue(DeltaDS, 'GYSID', gtCur));
      end;
      //ZH
      if IsModify(DeltaDS, 'ZHID') or IsModify(DeltaDS, 'CGLX') or IsModify(DeltaDS, 'JE') then
      begin
        SqlExec('update ZH set QMJE = QMJE + iif(' + GetValue(DeltaDS, 'CGLX', gtOld) + ' = 1, ' + GetValue(DeltaDS, 'JE', gtOld) + ', 0) ' +
          'where ID = ' + GetValue(DeltaDS, 'ZHID', gtOld));
        SqlExec('update ZH set QMJE = QMJE - iif(' + GetValue(DeltaDS, 'CGLX', gtCur) + ' = 1, ' + GetValue(DeltaDS, 'JE', gtCur) + ', 0) ' +
          'where ID = ' + GetValue(DeltaDS, 'ZHID', gtCur));
      end;
      //HP
      if IsModify(DeltaDS, 'CKID') then
      begin
        SqlExec('update CGSH J, HPKC K set K.JCS = K.JCS - J.SL ' +
          'where J.ZBID = ' + GetValue(DeltaDS, 'ID', gtOld) + ' and ' +
          'J.HPID = K.HPID and K.CKID = ' + GetValue(DeltaDS, 'CKID', gtOld));
        SqlExec('update CGSH J, HPKC K set K.JCS = K.JCS + J.SL ' +
          'where J.ZBID = ' + GetValue(DeltaDS, 'ID', gtOld) + ' and ' +
          'J.HPID = K.HPID and K.CKID = ' + GetValue(DeltaDS, 'CKID', gtCur));
      end;
    end;
  ukDelete:
    begin
      //JQJ
      with Tmpl do
      begin
        Close;
        Sql.Text := 'select * from CGSH where ZBID = ' + GetValue(DeltaDS, 'ID', gtOld);
        Open;
        while not Eof do
        begin
          SetJQJ(FieldByName('HPID').AsString, FieldByName('SL').AsFloat, FieldByName('DJ').AsFloat, '-');
          Next;
        end;
        Close;
      end;
      //GYS
      SqlExec('update GYS set QMJE = QMJE - iif(' + GetValue(DeltaDS, 'CGLX', gtOld) + ' = 2, ' + GetValue(DeltaDS, 'JE', gtOld) + ', 0) ' +
        'where ID = ' + GetValue(DeltaDS, 'GYSID', gtOld));
      //ZH
      SqlExec('update ZH set QMJE = QMJE + iif(' + GetValue(DeltaDS, 'CGLX', gtOld) + ' = 1, ' + GetValue(DeltaDS, 'JE', gtOld) + ', 0) ' +
        'where ID = ' + GetValue(DeltaDS, 'ZHID', gtOld));
      //HP
      SqlExec('update CGSH J, HPKC K set K.JCS = K.JCS - J.SL ' +
        'where J.ZBID = ' + GetValue(DeltaDS, 'ID', gtOld) + ' and ' +
        'J.HPID = K.HPID and K.CKID = ' + GetValue(DeltaDS, 'CKID', gtOld));
      SqlExec('delete from CGSH where ZBID = ' + GetValue(DeltaDS, 'ID', gtOld));
    end;
  end;
end;

//采购收货
procedure TDatas.pCgshAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
var
  dblDj: Double;
begin
  case UpdateKind of
  ukInsert:
    begin
      //JQJ (必需在 SET JCS 之前)
      SetJQJ(GetValue(DeltaDS, 'HPID', gtNew), Str2Float(GetValue(DeltaDS, 'SL', gtNew)),
        Str2Float(GetValue(DeltaDS, 'DJ', gtNew)), '+');
      //JCS
      SqlExec('update HPKC set JCS = JCS + ' + GetValue(DeltaDS, 'SL', gtNew) + ' ' +
        'where HPID = ' + GetValue(DeltaDS, 'HPID', gtNew) + ' and ' +
        'CKID = ' + GetValue(DeltaDS, 'CKID', gtNew));
    end;
  ukModify:
    if IsModify(DeltaDS, 'HPID') or IsModify(DeltaDS, 'SL') or IsModify(DeltaDS, 'DJ') then
    begin
      //JQJ
      SetJQJ(GetValue(DeltaDS, 'HPID', gtOld), Str2Float(GetValue(DeltaDS, 'SL', gtOld)),
        Str2Float(GetValue(DeltaDS, 'DJ', gtOld)), '-');
      //OLD HP JCS
      SqlExec('update HPKC set JCS = JCS - ' + GetValue(DeltaDS, 'SL', gtOld) + ' ' +
        'where HPID = ' + GetValue(DeltaDS, 'HPID', gtOld) + ' and ' +
        'CKID = ' + GetValue(DeltaDS, 'CKID', gtCur));
      //JQJ
      SetJQJ(GetValue(DeltaDS, 'HPID', gtCur), Str2Float(GetValue(DeltaDS, 'SL', gtCur)),
        Str2Float(GetValue(DeltaDS, 'DJ', gtCur)), '+');
      //NEW HP JCS
      SqlExec('update HPKC set JCS = JCS + ' + GetValue(DeltaDS, 'SL', gtCur) + ' ' +
        'where HPID = ' + GetValue(DeltaDS, 'HPID', gtCur) + ' and ' +
        'CKID = ' + GetValue(DeltaDS, 'CKID', gtCur));
    end;
  ukDelete:
    begin
      //JQJ (必需在 SET JCS 之前)
      SetJQJ(GetValue(DeltaDS, 'HPID', gtOld), Str2Float(GetValue(DeltaDS, 'SL', gtOld)),
        Str2Float(GetValue(DeltaDS, 'DJ', gtOld)), '-');
      //JCS
      SqlExec('update HPKC set JCS = JCS - ' + GetValue(DeltaDS, 'SL', gtOld) + ' ' +
        'where HPID = ' + GetValue(DeltaDS, 'HPID', gtOld) + ' and ' +
        'CKID = ' + GetValue(DeltaDS, 'CKID', gtOld));
    end;
  end;
  if UpdateKind in [ukInsert, ukModify] then
  begin
    dblDJ := GetCurValue(DeltaDS, 'DJ');
    if VarToFloat(GetFieldValue('select JJ from HP where ID = ' + GetValue(DeltaDS, 'HPID', gtCur))) <> dblDJ then
      SqlExec('update HP set JJ = ' + FloatToStr(dblDJ) + ', JJJ = JJ where ID = ' + GetValue(DeltaDS, 'HPID', gtCur));
  end;
end;

//采购付款总表
procedure TDatas.pCgfkzbAfterUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
  case UpdateKind of
  ukInsert:
    begin
      //GYS