wj_htdelete.~pas

完整的公司合同管理系统,基于ACSESS数据库开发,无须安装任何其他插件.附带源码.免费提供.

unit WJ_HTDelete;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DB, ADODB;

type
  TfrmWJ_HTDelete = class(TForm)
    Animate1: TAnimate;
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Label1: TLabel;
    ADOQuery1: TADOQuery;
    ADOTable1: TADOTable;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Init;
    function HtDeleteFuKuan(const HtID : string) : boolean;
    function HtDeleteFuJian(const HtID : string) : boolean;
    function HtDeleteTaiz(const HtID : string) : boolean ;
  end;

  function HtDelete(const HtID : string) : boolean;
var
  frmWJ_HTDelete: TfrmWJ_HTDelete;

implementation
  uses pdm,pub;
{$R *.dfm}
function HtDelete(const HtID : string) : boolean;
begin
  result := false;
  Application.CreateForm(TfrmWJ_HTDelete,frmWJ_HTDelete);
  with frmWJ_HTDelete do
       begin
            Show ;
            Init;
            if HtDeleteFuKuan(HtID) then
               if HtDeleteFuJian(HtID) then
                  if HtDeleteTaiz(HtID) then
                     result := true;
                     Close;
       end;
end;

procedure TfrmWJ_HTDelete.Init;
begin
  Label1.Caption := '';
  Animate1.Active := true;
  ProgressBar1.Position:=0;
end;

function TfrmWJ_HTDelete.HtDeleteFuKuan(const HtID : string) : boolean;
var SqlText : string;
begin
  result := false;
  Label1.Caption := '删除付款明细...';
  SqlText := ' delete from FK where ID='+#39+HtID+#39;
  try
      if HeTong_DeleteQueryData(SqlText,ADOQuery1) then begin
         ProgressBar1.Position:=10;
         result := true;
      end
  except
      result := false;
  end;
end;

function TfrmWJ_HTDelete.HtDeleteFuJian(const HtID : string) : boolean;
   function GetDeleteLoc(var dir : string) : boolean;
     begin
         result := false;
         if FuJian_GetSaveLocation(dir,ADOTable1) then begin
            result := true;
         end else
             application.MessageBox('请先在“系统维护”中设置附件保存路径！','提示',MB_OK+MB_ICONSTOP);
     end;

var SqlText ,dir: string;
begin
  result := false;
  Label1.Caption := '删除付件...';
  SqlText := ' select * from FJ where ID='+#39+HtID+#39;
  try
      if HeTong_GetQueryData(SqlText,ADOQuery1) then begin
         with ADOQuery1 do begin
              if RecordCount>0 then begin
                 ProgressBar1.Max := 100;
                 dir := HtID;
                 if GetDeleteLoc(dir) then
                    begin
                         if DeleteFile(dir) then  begin
                             ProgressBar1.Position := 80;
                             SqlText := ' delete from FJ where ID='+#39+HtID+#39;
                             if HeTong_DeleteQueryData(SqlText,ADOQuery1) then
                                result := true;
                         end;
                    end;
              end else
                  result := true;
         end;
      end;
  except
    result := false;
  end;
end;

function TfrmWJ_HTDelete.HtDeleteTaiz(const HtID : string) : boolean ;
var SqlText : string;
begin
  result := false;
  Label1.Caption := '删除合同台帐...';
  SqlText := ' delete from Taiz where ID='+#39+HtID+#39;
  try
      if HeTong_DeleteQueryData(SqlText,ADOQuery1) then begin
         ProgressBar1.Position:=ProgressBar1.Max;
         result := true;
      end;
  except
    result := false;
  end;

end;

procedure TfrmWJ_HTDelete.Button1Click(Sender: TObject);
begin
  close;
end;

end.