BillsEditor/DB/ProjectManagerDM.pas

unit ProjectManagerDM;

interface

uses
  SysUtils,
  Classes,
  ADODB,
  DB,
  ConstVarUnit,
  DBClient,
  Windows,
  Provider;

type
  TProjectMgrDM = class(TDataModule)
    ADOConnection: TADOConnection;
    aqBidLotProject: TADOQuery;
    atGatherProject: TADOTable;
    atGatherProjectID: TIntegerField;
    atGatherProjectProjectName: TWideStringField;
    atGatherProjectUnKnowName: TWideStringField;
    atGatherProjectFullName: TWideStringField;
    atGatherProjectGatherID: TIntegerField;
    atGatherProjectFlag: TIntegerField;
    aqCheckData: TADOQuery;
    aqGatherBid: TADOQuery;
    procedure atGatherProjectAfterScroll(DataSet: TDataSet);
    procedure aqBidLotProjectAfterScroll(DataSet: TDataSet);
  private
    { Do SQL }
    procedure OpenSQL(aQuery: TADOQuery; const aSql: string);
    procedure ExecuteSQL(aQuery: TADOQuery; const aSql: string);

    function HasRecords(aProjKind: Integer): Boolean;
    procedure RefreshData;
    procedure DeleteProject(aProjID: Integer; aStrings: TStrings);
    procedure InnerDeleteProject(aProjKind: Integer);
    procedure RefreshGatherBid(aProjID, aBidLotID: Integer); overload;
    function GetMaxProjectID: Integer;
    procedure InsertProject(aID, aGatherID, aFlag: Integer; const aProjName, aUnKnowName, aFullName: string);
  public
    procedure RefreshBidLot(aProjID: Integer; ALocateLast: Boolean = False);
    procedure RefreshGatherBid(aIsImport: Boolean = False); overload;
    procedure RefreshBuildProject;
    
    procedure OpenDataBase(const aDataBase: string);
    { locate record }
    procedure LocateBuildProject(aID: Integer);
    { get Name }
    function GetProjectName(aProjKind: Integer): string;
    function GetFileName(aProjKind: Integer): string;
    function GetProjectID(aProjKind: Integer): Integer;
    { get name by id }
    function GetParentID(aID: Integer): Integer;
    procedure GetNameByID(aID: Integer; var aProjName, aFullName: string);
    procedure GetBidLotsByID(aID: Integer; aStrings: TStrings);
    { get values by aprojID }
    procedure GetValues(var aProjID, aGatherID, aFlag: Integer; var aProjName, aFullPath: string);
    procedure GetBidLots(aProjID: Integer; aProjList: TList);
    procedure GetBuildProjectList(aString: TStrings);
    function GetBuildProjRecordNo: Integer;
    function GetProjectFlag(aID: Integer): Integer;
    { Check }
    function CanOpen(aProjKind: Integer): Boolean;
    procedure CheckSameProjectName(aProjKind: Integer; var aNewProjName: string; aRaise: Boolean = True);
    function ChackSameProjectForOneKey(aGatherID: Integer; var aNewProjName: string; var IsExist: Boolean): Boolean;
    procedure CheckSameProject(aGatherID: Integer; var aNewProjName: string; aRaise: Boolean = True);
    function CheckUnknowNameExists(const aUnknowName: string): Boolean;
    { project }
    procedure DeleteProjects(aProjKind: Integer; aStrings: TStrings);
    function AddProject(const aProjName, aUnknowName, aFullName: string; aProjKind: Integer): Integer; overload;
    function AddProject(const aProjName, aUnknowName, aFullName: string; aGatherID, aFlag: Integer): Integer; overload;
    { rename }
    procedure RenameProject(aProjKind: Integer; const aNewProjectName: string);
  end;

implementation

uses
  DateUtils,
  ScUtils,
  ProjectFileManager,
  MainForm,
  Variants;

{$R *.dfm}

{ TProjectMgrDM }

procedure TProjectMgrDM.RefreshBidLot(aProjID: Integer; ALocateLast: Boolean);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where (GatherID = %d) and (Flag = 2)', [aProjID]);
  OpenSQL(aqBidLotProject, sSql);

  if ALocateLast then
    aqBidLotProject.Last;

  RefreshGatherBid;
end;

procedure TProjectMgrDM.atGatherProjectAfterScroll(DataSet: TDataSet);
begin
  if DataSet.RecordCount > 0 then
    RefreshBidLot(DataSet['ID'])
  else
    RefreshBidLot(0);
end;

function TProjectMgrDM.GetFileName(aProjKind: Integer): string;
begin
  if aProjKind = 1 then
  begin
    if VarIsNull(atGatherProject['FullName']) then
    begin
      Result := '';
      Exit;
    end;
    Result := atGatherProject['FullName']
  end
  else if aProjKind = 2 then
  begin
    if VarIsNull(aqBidLotProject['FullName']) then
    begin
      Result := '';
      Exit;
    end;
    Result := aqBidLotProject['FullName'];
  end
  else
  begin
    if VarIsNull(aqGatherBid['FullName']) then
    begin
      Result := '';
      Exit;
    end;
    Result := aqGatherBid['FullName'];
  end;
end;

procedure TProjectMgrDM.DeleteProject(aProjID: Integer; aStrings: TStrings);
var
  sSql: string;
  adoQuery: TADOQuery;
begin
  adoQuery := TADOQuery.Create(nil);
  try
    with adoQuery do
    begin
      Connection := ADOConnection;

      sSql := Format('Select * From ProjectManager Where GatherID = %d', [aProjID]);
      OpenSQL(adoQuery, sSql);

      First;
      while not Eof do
      begin
        aStrings.Add(FieldByName('FullName').AsString);
        DeleteProject(FieldByName('ID').AsInteger, aStrings);
        Delete;
      end;
    end;
  finally
    adoQuery.Free;
  end;
end;

function TProjectMgrDM.CheckUnknowNameExists(const aUnknowName: string): Boolean;
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager where UnKnowName = ''%s''', [aUnknowName]);
  OpenSQL(aqCheckData, sSql);

  Result := aqCheckData.RecordCount <> 0;
end;

function TProjectMgrDM.AddProject(const aProjName, aUnknowName,
  aFullName: string; aProjKind: Integer): Integer;
var
  BookMark: TBookmark;
  iGatherID: Integer;
begin
  Result := GetMaxProjectID;

  if aProjKind = 1 then
    atGatherProject.AppendRecord([Result, aProjName, aUnknowName, aFullName, 0, 1])
  else if aProjKind = 2 then
  begin
    iGatherID := atGatherProjectID.AsInteger;
    InsertProject(Result, iGatherID, 2, aProjName, aUnknowName, aFullName);
//    atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, iGatherID, 2]);
  end
  else
  begin
    iGatherID := aqBidLotProject['ID'];
    InsertProject(Result, iGatherID, 3, aProjName, aUnknowName, aFullName);
//    atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, iGatherID, 3]);
  end;
end;

procedure TProjectMgrDM.OpenDataBase(const aDataBase: string);
begin
  ADOConnection.Connected := False;
  ADOConnection.ConnectionString := Format(SAdoConnectStr, [aDataBase, 'Admin', '']);
  ADOConnection.Connected := True;
  RefreshData;
end;

procedure TProjectMgrDM.RefreshData;
begin
  atGatherProject.Connection := ADOConnection;
  aqBidLotProject.Connection := ADOConnection;
  aqCheckData.Connection := ADOConnection;
  aqGatherBid.Connection := ADOConnection;

  atGatherProject.Open;
  with atGatherProject do
  begin
    Filter := 'Flag=1';
    Filtered := True;
  end;
end;

function TProjectMgrDM.GetProjectName(aProjKind: Integer): string;
begin
  Result := '';
  if aProjKind = 1 then
    Result := atGatherProject['ProjectName']
  else if aProjKind = 2 then
  begin
    if aqBidLotProject.RecordCount > 0 then
      Result := aqBidLotProject['ProjectName'];
  end
  else
    if aqGatherBid.RecordCount > 0 then
      Result := aqGatherBid['ProjectName'];
end;

procedure TProjectMgrDM.RenameProject(aProjKind: Integer; const aNewProjectName: string);
begin
  if aProjKind = 1 then
  begin
    atGatherProject.Edit;
    atGatherProjectProjectName.Value := aNewProjectName;
    atGatherProject.Post;
  end
  else if aProjKind = 2 then
  begin
    aqBidLotProject.Edit;
    aqBidLotProject['ProjectName'] := aNewProjectName;
    aqBidLotProject.Post;
  end
  else
  begin
    aqGatherBid.Edit;
    aqGatherBid['ProjectName'] := aNewProjectName;
    aqGatherBid.Post;
  end;
end;

function TProjectMgrDM.CanOpen(aProjKind: Integer): Boolean;
begin
  Result := True;
  {if aProjKind = 1 then
    Result := atGatherProjectID.Value <> 1;    }
end;

procedure TProjectMgrDM.RefreshGatherBid(aProjID, aBidLotID: Integer);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where ' +
                 '((GatherID = %d) or (GatherID = %d)) and (Flag = 3)',
                 [aProjID, aBidLotID]);
                 
  OpenSQL(aqGatherBid, sSql);
end;

function TProjectMgrDM.GetProjectID(aProjKind: Integer): Integer;
begin
  if aProjKind = 1 then
    Result := atGatherProject['ID']
  else if aProjKind = 2 then
  begin
    if aqBidLotProject.RecordCount > 0 then
      Result := aqBidLotProject['ID']
    else
      Result := -1;
  end
  else
  begin
    if aqGatherBid.RecordCount > 0 then
      Result := aqGatherBid['ID']
    else
      Result :=  -1;
  end;
end;

procedure TProjectMgrDM.GetValues(var aProjID, aGatherID, aFlag: Integer;
  var aProjName, aFullPath: string);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where ID = %d', [aProjID]);
  OpenSQL(aqCheckData, sSql);

  with aqCheckData do
  begin
    if RecordCount > 0 then
    begin
      aGatherID := FieldByName('GatherID').AsInteger;
      aFlag := FieldByName('Flag').AsInteger;
      aProjName := FieldByName('ProjectName').AsString;
      aFullPath := FieldByName('FullName').AsString;
    end
    else
    begin
      aProjID := -1;
    end;
  end;
end;

procedure TProjectMgrDM.GetBidLots(aProjID: Integer; aProjList: TList);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where GatherID = %d', [aProjID]);
  OpenSQL(aqCheckData, sSql);
  
  with aqCheckData do
  begin
    First;
    while not Eof do
    begin
      aProjList.Add(Pointer(FieldByName('ID').AsInteger));
      Next;
    end;
  end;
end;

function TProjectMgrDM.AddProject(const aProjName, aUnknowName,
  aFullName: string; aGatherID, aFlag: Integer): Integer;
begin
  Result := GetMaxProjectID;
  InsertProject(Result, aGatherID, aFlag, aProjName, aUnknowName, aFullName);

//  atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, aGatherID, aFlag])
end;

procedure TProjectMgrDM.aqBidLotProjectAfterScroll(DataSet: TDataSet);
begin
  if DataSet.RecordCount > 0 then
    RefreshGatherBid(atGatherProjectID.AsInteger, DataSet['ID']);
end;

procedure TProjectMgrDM.RefreshGatherBid(aIsImport: Boolean);
begin
  if aqBidLotProject.RecordCount > 0 then
    RefreshGatherBid(atGatherProjectID.AsInteger, aqBidLotProject['ID'])
  else
    RefreshGatherBid(atGatherProjectID.AsInteger, -2);

  if aIsImport then aqGatherBid.Last;
end;

function TProjectMgrDM.HasRecords(aProjKind: Integer): Boolean;
begin
  if aProjKind = 1 then
    Result := atGatherProject.RecordCount > 0
  else if aProjKind = 2 then
    Result := aqBidLotProject.RecordCount > 0
  else
    Result := aqGatherBid.RecordCount > 0;
end;

procedure TProjectMgrDM.GetBuildProjectList(aString: TStrings);
begin
  OpenSQL(aqCheckData, 'Select * From ProjectManager where Flag = 1');

  with aqCheckData do
  begin
    First;
    while not Eof do
    begin
      aString.AddObject(FieldByName('ProjectName').AsString,
                        Pointer(FieldByName('ID').AsInteger));
      Next;
    end;
  end;
end;

procedure TProjectMgrDM.LocateBuildProject(aID: Integer);
begin
  if atGatherProjectID.AsInteger <> aID then
    atGatherProject.Locate('ID', aID, []);
end;

procedure TProjectMgrDM.DeleteProjects(aProjKind: Integer; aStrings: TStrings);
var
  iID: Integer;
  sSql: string;
begin
  with aqCheckData do
  begin
    iID := GetProjectID(aProjKind);
    aStrings.Add(GetFileName(aProjKind));

    InnerDeleteProject(aProjKind);

    sSql := Format('Select * From ProjectManager Where GatherID = %d', [iID]);
    OpenSQL(aqCheckData, sSql);

    First;
    while not Eof do
    begin
      aStrings.Add(FieldByName('FullName').AsString);
      DeleteProject(FieldByName('ID').AsInteger, aStrings);
      Delete;
    end;
  end;
end;

procedure TProjectMgrDM.InnerDeleteProject(aProjKind: Integer);
begin
  case aProjKind of
    1: atGatherProject.Delete;
    2: aqBidLotProject.Delete;
    else aqGatherBid.Delete;
  end;
end;

function TProjectMgrDM.GetBuildProjRecordNo: Integer;
begin
  Result := atGatherProject.RecNo;
end;

function TProjectMgrDM.GetProjectFlag(aID: Integer): Integer;
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where ID = %d', [aID]);
  OpenSQL(aqCheckData, sSql);

  Result := aqCheckData.FieldByName('Flag').AsInteger;
end;

procedure TProjectMgrDM.CheckSameProjectName(aProjKind: Integer; var aNewProjName: string; aRaise: Boolean);
var
  sSql: string;
  iGatherID1, iGatherID2: Integer;
begin
  if aProjKind = 1 then
  begin
    iGatherID1 := 0;
    iGatherID2 := -1;
  end
  else
  begin
    if aProjKind = 2 then
    begin
      iGatherID1 := atGatherProjectID.AsInteger;
      iGatherID2 := iGatherID1;
    end
    else
    begin
      iGatherID1 := atGatherProjectID.AsInteger;
      if aqBidLotProject.RecordCount > 0 then
        iGatherID2 := aqBidLotProject['ID']
      else
        iGatherID2 := iGatherID1;
    end;
  end;

  sSql := Format('Select * From ProjectManager where ' +
                 '(ProjectName = ''%s'') and ((GatherID = %d) or (GatherID = %d))',
                 [aNewProjName, iGatherID1, iGatherID2]);

  OpenSQL(aqCheckData, sSql);

  if aqCheckData.RecordCount <> 0 then
  begin
    if aRaise then raise Exception.Create('已存在同名项目!')
    else
    begin
      aNewProjName := aNewProjName + '(复件)';
      CheckSameProjectName(aProjKind, aNewProjName, False);
    end;
  end;
end;

procedure TProjectMgrDM.CheckSameProject(aGatherID: Integer;
  var aNewProjName: string; aRaise: Boolean);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager where ' +
                 '(ProjectName = ''%s'') and (GatherID = %d)',
                 [aNewProjName, aGatherID]);

  OpenSQL(aqCheckData, sSql);

  if aqCheckData.RecordCount <> 0 then
  begin
    if aRaise then raise Exception.Create('已存在同名项目!')
    else
    begin
      aNewProjName := aNewProjName + '(复件)';
      CheckSameProject(aGatherID, aNewProjName, False);
    end;
  end;
end;

procedure TProjectMgrDM.GetBidLotsByID(aID: Integer; aStrings: TStrings);
var
  sFullName: string;
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager where GatherID = %d', [aID]);
  OpenSQL(aqCheckData, sSql);

  aStrings.Clear;
  with aqCheckData do
  begin
    First;
    while not Eof do
    begin
      sFullName := FieldByName('FullName').AsString;
      aStrings.AddObject(FieldByName('ProjectName').AsString, Pointer(sFullName));
      Integer(sFullName) := 0;
      Next;
    end;
  end;
end;

procedure TProjectMgrDM.GetNameByID(aID: Integer; var aProjName,
  aFullName: string);
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager where ID = %d', [aID]);
  OpenSQL(aqCheckData, sSql);

  with aqCheckData do
  begin
    if RecordCount > 0 then
    begin
      aProjName := FieldByName('ProjectName').AsString;
      aFullName := FieldByName('FullName').AsString;
    end
    else
    begin
      aProjName := '';
      aFullName := '';
    end;
  end;
end;

function TProjectMgrDM.GetMaxProjectID: Integer;
begin
  OpenSQL(aqCheckData, 'Select Max(ID) as ID From ProjectManager');
  Result := aqCheckData.FieldByName('ID').AsInteger + 1;
end;

procedure TProjectMgrDM.InsertProject(aID, aGatherID, aFlag: Integer;
  const aProjName, aUnKnowName, aFullName: string);
var
  sSql: string;
begin
  sSql := Format('Insert Into ProjectManager (ID, ProjectName, UnKnowName, FullName, GatherID, Flag) ' +
                 'Values (%d, ''%s'', ''%s'', ''%s'', %d, %d)',
                 [aID, aProjName, aUnKnowName, aFullName, aGatherID, aFlag]);

  ExecuteSQL(aqCheckData, sSql);
end;

procedure TProjectMgrDM.ExecuteSQL(aQuery: TADOQuery;
  const aSql: string);
begin
  with aQuery do
  begin
    SQL.Clear;
    SQL.Add(aSql);
    ExecSQL;
  end;
end;

procedure TProjectMgrDM.OpenSQL(aQuery: TADOQuery;
  const aSql: string);
begin
  with aQuery do
  begin
    SQL.Clear;
    SQL.Add(aSql);
    Open;
  end;
end;

function TProjectMgrDM.GetParentID(aID: Integer): Integer;
var
  sSql: string;
begin
  sSql := Format('Select * From ProjectManager Where ID = %d', [aID]);
  OpenSQL(aqCheckData, sSql);

  Result := aqCheckData.FieldByName('GatherID').AsInteger;
end;

procedure TProjectMgrDM.RefreshBuildProject;
begin
  with atGatherProject do
  begin
    Active := False;
    Active := True;
    Filter := 'Flag=1';
    Filtered := True;
    Last;
  end;
end;

function TProjectMgrDM.ChackSameProjectForOneKey(aGatherID: Integer;
  var aNewProjName: string; var IsExist: Boolean): Boolean;
var
  sSql: string;
  iID: Integer;
  I, iIdx: Integer;
  strFilePath: string;
begin
  try
    IsExist := False;
    Result := True;
    sSql := Format('Select * From ProjectManager where ' +
                   '(ProjectName = ''%s'') and (GatherID = %d)',
                   [aNewProjName, aGatherID]);

    OpenSQL(aqCheckData, sSql);

    if aqCheckData.RecordCount <> 0 then
    begin
      if MessageQuest(0, '该名称的项目清单文件已存在，是否覆盖？', '询问', MB_YESNO) = ID_YES then
      begin
        IsExist := True;
        // 将数据删除 这里还要修改，参照Delete方法
        strFilePath := aqCheckData.FieldByName('FullName').AsString;
        strFilePath := MainFrm.ProjectFileManager.FileOpr.ExtractFilePath(ParamStr(0)) + strFilePath;
        iIdx := MainFrm.ProjectFileManager.ProjectManager.CheckProjectExists(strFilePath);
        if iIdx <> -1 then
          MainFrm.ProjectFileManager.CloseProjectProc(MainFrm.ProjectFileManager.ProjectManager.Projects[iIdx]);
        MainFrm.ProjectFileManager.FileOpr.DeleteFile(strFilePath);
        aqCheckData.delete;
      end
      else
        Result := False;
    end;
  finally
  end;
end;

end.