BillsEditor/CU/ProjectFileManager.pas

unit ProjectFileManager;

interface

uses
  DB,
  Classes,
  Windows,
  SysUtils,
  CustomDoc,
  ConstVarUnit,
  ConstTypeUnit,
  ConstMethodUnit,
  ScProjectManager,
  ProjectPropertyUnit,
  ProjectManagerDM,
  FileOprUnit,
  ExportDecorateUnit,
  SingleObjectAggregateUnit,
  ImportDecorate;

type

  TProjectFileMgr = class
  private
    FFileOpr          : TFileOpr;
    FProjectProperty  : TProjectProperty;
    FProjectMgrDM     : TProjectMgrDM;
    FProjectManager   : TProjectManager;
    FCloseProjectProc : TNotifyEvent;
    FOpenProjectProc  : TOpenProjectProc;
    FImportFlag       : Integer;

    
    function GetBidLotProjectDS: TDataSet;
    function GetGatherProjectDS: TDataSet;
    function GetGatherBidDS: TDataSet;    
    function CreateNewFile(const aFileName: string; var aNewName: string): Boolean;
    function GetProjectFullPath(aProjKind: Integer): string;
    procedure OpenDB;
    function GetProjectPropertyFilePath(aProjKind: Integer; var aFilePath: string): Boolean;
    procedure ReadProjectProperty(const aFilePath: string);
    procedure CheckProjectOpen(const aFilePath: string);

    procedure AddProject(aProjFile: TProjectFile; aProjList: TList; var aFullPath: string);
    procedure GetProjectFile(aProjID: Integer; aProjList: TList);
  public
    constructor Create;
    destructor Destroy; override;

    function CreateNewProjectOpen(const aShortName: string; aProjType, aProjKind: Integer): string;
    function CreateNewProjectForOneKey(const aShortName: string; var aID: Integer; aGatherID: Integer; aRaise: Boolean = True): string;
    function CreateNewProject(const aShortName: string; var aID: Integer; aGatherID: Integer): string;
    procedure OpenProject(aProjType, aProjKind: Integer);
    procedure DeleteProject(aProjKind: Integer);

    { Refresh ProjectProperty }
    procedure RefreshProjectProperty(aProjKind: Integer);
    procedure WriteProjectProperty;

    function GetProjectFlag(aID: Integer): Integer;
    { Locate }
    procedure LocateBuildProject(aID: Integer);
    function GetProjectName(aProjKind: Integer): string;
    function GetParentID(aID: Integer): Integer;
    function GetProjID(aProjKind: Integer): Integer;
    procedure RenameProject(aProjKind: Integer; const aNewProjName: string);
    { import and export }
    procedure ImportProject(const aShortName, aFullPath: string; aProjKind: Integer);
    procedure ExportProject(const aNewProjName: string; aProjKind: Integer; aIsSingle: Boolean);
    procedure ImportProjects(const aFileName: string);
    procedure ExportProjects(const aFileName: string; aProjKind: Integer);
    { buildproject list }
    procedure GetBuildProjectList(aString: TStrings);
    procedure GetNameByID(aID: Integer; var aProjName, aFullName: string);
    procedure GetBidLotsByID(aID: Integer; aStrings: TStrings);
    { get build project recordno }
    function GetBuildProjRecordNo: Integer;

    property GatherProjectDS: TDataSet read GetGatherProjectDS;
    property BidLotProjectDS: TDataSet read GetBidLotProjectDS;
    property GatherBidDS: TDataSet read GetGatherBidDS;
    property ProjectProperty: TProjectProperty read FProjectProperty write FProjectProperty;
    property ProjectManager: TProjectManager read FProjectManager write FProjectManager;
    property CloseProjectProc: TNotifyEvent read FCloseProjectProc write FCloseProjectProc;
    property OpenProjectProc: TOpenProjectProc read FOpenProjectProc write FOpenProjectProc;
    property ProjectMgrDM: TProjectMgrDM read FProjectMgrDM;
    property FileOpr: TFileOpr read FFileOpr;
  end;

implementation

{ TProjectFileMgr }

procedure TProjectFileMgr.AddProject(aProjFile: TProjectFile;
  aProjList: TList; var aFullPath: string);
var
  iLoop: Integer;
  iFlag: Integer;
  iGatherID: Integer;
  strUnknowName: string;
  strFullName: string;
  sNewProjName: string;
begin
  repeat
    strUnknowName := GetRandomName;
  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);

  aFullPath := '我的清单\' + strUnknowName + '.smb';

  iGatherID := 0;
  for iLoop := 0 to aProjList.Count - 1 do
  begin
    if TProjectFile(aProjList.List^[iLoop]).ID = aProjFile.GatherID then
    begin
      iGatherID := TProjectFile(aProjList.List^[iLoop]).NewID;
      Break;
    end;
  end;

  if aProjList.Count = 0 then
  begin
    if aProjFile.Flag = 1 then
    begin
      sNewProjName := aProjFile.ProjName;
      FProjectMgrDM.CheckSameProjectName(1, sNewProjName, False);
      aProjFile.ProjName := sNewProjName;
      FImportFlag := 1;
    end
    else if aProjFile.Flag = 2 then
    begin
      iGatherID := FProjectMgrDM.GetProjectID(1);
      sNewProjName := aProjFile.ProjName;
      FProjectMgrDM.CheckSameProject(iGatherID, sNewProjName, False);
      aProjFile.ProjName := sNewProjName;
      FImportFlag := 2;
    end
    else if aProjFile.Flag = 3 then
    begin
      iGatherID := FProjectMgrDM.GetProjectID(2);
      sNewProjName := aProjFile.ProjName;
      FProjectMgrDM.CheckSameProject(iGatherID, sNewProjName, False);
      aProjFile.ProjName := sNewProjName;
      FImportFlag := 3;
    end;
  end;

  aProjFile.NewID := FProjectMgrDM.AddProject(aProjFile.ProjName, strUnknowName, aFullPath, iGatherID, aProjFile.Flag);
  aProjList.Add(aProjFile);
  aFullPath := FFileOpr.ExtractFilePath(ParamStr(0)) + aFullPath;
end;

function TProjectFileMgr.GetProjectFlag(aID: Integer): Integer;
begin
  Result := FProjectMgrDM.GetProjectFlag(aID);
end;

procedure TProjectFileMgr.CheckProjectOpen(const aFilePath: string);
begin
  if FProjectManager.CheckProjectExists(aFilePath) <> -1 then
    raise Exception.Create('该项目已被打开,请先关闭项目再进行操作!');
end;

constructor TProjectFileMgr.Create;
begin
  FProjectProperty := TProjectProperty.Create;
  FFileOpr := TFileOpr.Create;
  FProjectMgrDM := TProjectMgrDM.Create(nil);
  OpenDB;
end;

function TProjectFileMgr.CreateNewFile(const aFileName: string;
  var aNewName: string): Boolean;
var
  strTemPath: string;
begin
  strTemPath := Format('%sData\%s', [FFileOpr.ExtractFilePath(ParamStr(0)), BudgetTemplateFile]);
  aNewName := Format('%s我的清单\%s.smb', [FFileOpr.ExtractFilePath(ParamStr(0)), aFileName]);
  Result := CopyFile(PChar(strTemPath), PChar(aNewName), True);
end;

function TProjectFileMgr.CreateNewProjectOpen(const aShortName: string;
  aProjType, aProjKind: Integer): string;
var
  iID: Integer;
  strUnknowName: string;
  strFullName: string;
  sShortName: string;
  vProject: TProject;
begin
  sShortName := aShortName;
  FProjectMgrDM.CheckSameProjectName(aProjKind, sShortName);

  repeat
    strUnknowName := GetRandomName;
  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);

  strFullName := '我的清单\' + strUnknowName + '.smb';
  iID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aProjKind);

  CreateNewFile(strUnknowName, Result);

  if Assigned(FOpenProjectProc) then
    FOpenProjectProc(Result, aShortName, aProjType, iID);

  vProject := FProjectManager.GetProjectByID(iID);
  if aProjKind = 1 then
  begin
    FProjectMgrDM.RefreshBidLot(iID);
    // 新建的项目不打开。这里采用打开后关闭的方式比较简单。
    // 因为有些工作是必须在打开后才处理的，如初始化原始清单等。
    vProject.ForceUndoSave := True;
    FCloseProjectProc(vProject);
  end
  else if aProjKind = 2 then
  begin
    FProjectMgrDM.RefreshBidLot(GetProjID(1), True);
    iID := FProjectManager.CheckProjectExists(GetProjectFullPath(1));

    if iID <> -1 then
    begin
      SingleObjectAggregate.BidLotDM.Project := FProjectManager.Projects[iID];
      SingleObjectAggregate.BidLotDM.Notify(boAdd, aShortName, strFullName);
      SingleObjectAggregate.BidLotDM.SyncProjectView;
    end;

  end;

end;

function TProjectFileMgr.CreateNewProject(const aShortName: string;
  var aID: Integer; aGatherID: Integer): string;
var
  strUnknowName: string;
  strFullName  : string;
  sShortName   : string;
begin
  sShortName := aShortName;
  FProjectMgrDM.CheckSameProject(aGatherID, sShortName);

  repeat
    strUnknowName := GetRandomName;
  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);

  strFullName := '我的清单\' + strUnknowName + '.smb';
  aID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aGatherID, 3);

  CreateNewFile(strUnknowName, strFullName);
  Result := strFullName;
  FProjectMgrDM.RefreshGatherBid;
end;

procedure TProjectFileMgr.DeleteProject(aProjKind: Integer);
var
  I, iIdx: Integer;
  strFilePath: string;
  sgFiles: TStrings;
begin
  sgFiles := TStringList.Create;
  try
    if aProjKind = 2 then
    begin
      iIdx := FProjectManager.CheckProjectExists(GetProjectFullPath(1));
      if iIdx <> -1 then
      begin
        SingleObjectAggregate.BidLotDM.Project := FProjectManager.Projects[iIdx];
        SingleObjectAggregate.BidLotDM.Notify(boDelete, GetProjectName(2), FProjectMgrDM.GetFileName(2));
        SingleObjectAggregate.BidLotDM.SyncProjectView;
      end;
    end;

    FProjectMgrDM.DeleteProjects(aProjKind, sgFiles);
    for I := 0 to sgFiles.Count - 1 do
    begin
      strFilePath := sgFiles[I];
      if strFilePath = '' then Continue;
      strFilePath := FFileOpr.ExtractFilePath(ParamStr(0)) + strFilePath;
      iIdx := FProjectManager.CheckProjectExists(strFilePath);
      if iIdx <> -1 then
        FCloseProjectProc(FProjectManager.Projects[iIdx]);
      FFileOpr.DeleteFile(strFilePath);
    end;
  finally
    sgFiles.Free;
  end;
//  if aProjKind <> 1 then
//    FProjectMgrDM.RefreshBidLot(FProjectMgrDM.GetProjectID(1));
end;

destructor TProjectFileMgr.Destroy;
begin
  FFileOpr.Free;
  FProjectProperty.Free;
  FProjectMgrDM.Free;
  inherited;
end;

procedure TProjectFileMgr.ExportProject(const aNewProjName: string;
  aProjKind: Integer; aIsSingle: Boolean);
var
  strFullPath: string;
  Decorator: TDecorator;
begin
  strFullPath := GetProjectFullPath(aProjKind);
  if (aProjKind <> 1) or aIsSingle then
  begin
    FFileOpr.CopyFile(strFullPath, aNewProjName);

    Decorator := TBillsDecorator.Create(aNewProjName, {$Include ThirdPart.inc});
    try
      Decorator.Decorate;
    finally
      Decorator.Free;
    end;

  end
  else
  begin
    // nothing
  end;
end;

procedure TProjectFileMgr.ExportProjects(const aFileName: string;
  aProjKind: Integer);
var
  I, iProjID: Integer;
  ProjFile: TProjectFile;
  FileList: TList;
begin
  FileList := TList.Create;
  try
    if GetProjectFullPath(aProjKind) = '' then
    begin
      MessageError(0, '未定义项目不能导出!');
      Exit;
    end;
    iProjID := FProjectMgrDM.GetProjectID(aProjKind);
    GetProjectFile(iProjID, FileList);
    TCustomProjectDoc.ExportProjects(aFileName, FileList);
  finally
    for I := 0 to FileList.Count - 1 do
      TProjectFile(FileList.List^[I]).Free;
    FileList.Free;
  end;
end;

function TProjectFileMgr.GetBidLotProjectDS: TDataSet;
begin
  Result := FProjectMgrDM.aqBidLotProject;
end;

procedure TProjectFileMgr.GetBuildProjectList(aString: TStrings);
begin
  FProjectMgrDM.GetBuildProjectList(aString);
end;

function TProjectFileMgr.GetBuildProjRecordNo: Integer;
begin
  Result := FProjectMgrDM.GetBuildProjRecordNo - 1;
end;

function TProjectFileMgr.GetGatherBidDS: TDataSet;
begin
  Result := FProjectMgrDM.aqGatherBid;
end;

function TProjectFileMgr.GetGatherProjectDS: TDataSet;
begin
  Result := FProjectMgrDM.atGatherProject;
end;

procedure TProjectFileMgr.GetProjectFile(aProjID: Integer;
  aProjList: TList);
var
  I: Integer;
  iFlag: Integer;
  iGatherID: Integer;
  strProjName: string;
  strFullPath: string;
  ProjectFile: TProjectFile;
  projectIDList: TList;
begin
  FProjectMgrDM.GetValues(aProjID, iGatherID, iFlag, strProjName, strFullPath);
  if aProjID = -1 then Exit;
  ProjectFile := TProjectFile.Create(nil);
  ProjectFile.ID := aProjID;
  ProjectFile.Flag := iFlag;
  ProjectFile.GatherID := iGatherID;
  ProjectFile.ProjName := strProjName;
  ProjectFile.FullPath := FFileOpr.ExtractFilePath(ParamStr(0)) + strFullPath;
  aProjList.Add(ProjectFile);

  projectIDList := TList.Create;
  try
    FProjectMgrDM.GetBidLots(aProjID, projectIDList);
    for I := 0 to projectIDList.Count - 1 do
      GetProjectFile(Integer(projectIDList[I]), aProjList);
  finally
    projectIDList.Free;
  end;
end;

function TProjectFileMgr.GetProjectFullPath(aProjKind: Integer): string;
var
  strFilePath: string;
  sFullName: string;
begin
  strFilePath := ParamStr(0);
  strFilePath := FFileOpr.ExtractFilePath(strFilePath);
  sFullName := FProjectMgrDM.GetFileName(aProjKind);
  if sFullName <> '' then
    Result := strFilePath + sFullName
  else
    Result := '';
end;

function TProjectFileMgr.GetProjectName(aProjKind: Integer): string;
begin
  Result := FProjectMgrDM.GetProjectName(aProjKind);
end;

procedure TProjectFileMgr.ImportProject(const aShortName, aFullPath: string; aProjKind: Integer);

  procedure DecorateExprs(const AFileName: string);
  var
    imDecorator: TImportDecorator;
  begin
    imDecorator := TImportDecorator.Create(AFileName);
    try
      imDecorator.Decorate;
    finally
      imDecorator.Free;
    end;
  end;

var
  strUnknowName: string;
  strFullName: string;
  sShortName: string;
begin
  sShortName := aShortName;
  FProjectMgrDM.CheckSameProjectName(aProjKind, sShortName);
  
  repeat
    strUnknowName := GetRandomName;
  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);

  strFullName := '我的清单\' + strUnknowName + '.smb';
  FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aProjKind);

  strFullName := Format('%s%s', [FFileOpr.ExtractFilePath(ParamStr(0)), strFullName]);
  FFileOpr.CopyFile(aFullPath, strFullName);
  DecorateExprs(strFullName);

  FProjectMgrDM.RefreshBidLot(GetProjID(1), True);
end;

procedure TProjectFileMgr.ImportProjects(const aFileName: string);
begin
  TCustomProjectDoc.ImportProjects(aFileName, AddProject);
  
  if FImportFlag = 1 then
    FProjectMgrDM.RefreshBuildProject
  else if FImportFlag = 2 then
    FProjectMgrDM.RefreshBidLot(GetProjID(1), True)
  else
    FProjectMgrDM.RefreshGatherBid(True);
end;

procedure TProjectFileMgr.LocateBuildProject(aID: Integer);
begin
  FProjectMgrDM.LocateBuildProject(aID);
end;

procedure TProjectFileMgr.OpenDB;
var
  strDBName: string;
begin
  strDBName := FFileOpr.ExtractFilePath(ParamStr(0));
  strDBName := strDBName + 'Data\ProjectManager.dat';
  if FFileOpr.FileExists(strDBName) then
    FProjectMgrDM.OpenDataBase(strDBName);
end;

procedure TProjectFileMgr.OpenProject(aProjType, aProjKind: Integer);
begin
  if FProjectMgrDM.CanOpen(aProjKind) then
  begin
    FProjectProperty.CloseArcFile;
    FOpenProjectProc(GetProjectFullPath(aProjKind),
              FProjectMgrDM.GetProjectName(aProjKind),
              aProjType,
              FProjectMgrDM.GetProjectID(aProjKind));
    FProjectProperty.Connection := FProjectManager.ActiveProject.Connection;
  end;
end;

procedure TProjectFileMgr.RenameProject(aProjKind: Integer;
  const aNewProjName: string);
var
  sNewProjName: string;
begin
  sNewProjName := aNewProjName;
  CheckProjectOpen(GetProjectFullPath(aProjKind));
  FProjectMgrDM.CheckSameProjectName(aProjKind, sNewProjName);
  FProjectMgrDM.RenameProject(aProjKind, aNewProjName);
  
  if (aProjKind = 2) and (GetProjID(1) <> 1) then
    SingleObjectAggregate.BidLotDM.Notify(boReName, aNewProjName, FProjectMgrDM.GetFileName(2));
end;

procedure TProjectFileMgr.GetBidLotsByID(aID: Integer; aStrings: TStrings);
begin
  FProjectMgrDM.GetBidLotsByID(aID, aStrings);
end;

procedure TProjectFileMgr.GetNameByID(aID: Integer; var aProjName,
  aFullName: string);
begin
  FProjectMgrDM.GetNameByID(aID, aProjName, aFullName);
end;

procedure TProjectFileMgr.RefreshProjectProperty(aProjKind: Integer);
var
  sFilePath: string;
begin
  if not GetProjectPropertyFilePath(aProjKind, sFilePath) then Exit;

  if sFilePath <> '' then
    ReadProjectProperty(sFilePath)
  else
  begin
    FProjectProperty.InitProjectProperty;
    FProjectProperty.Connection := nil;
  end;
end;

procedure TProjectFileMgr.ReadProjectProperty(const aFilePath: string);
var
  iIdx: Integer;
begin
  if not Assigned(FProjectManager) then Exit;
  
  iIdx := FProjectManager.CheckProjectExists(aFilePath);
  if iIdx <> -1 then
  begin
    FProjectProperty.Connection := FProjectManager.Projects[iIdx].Connection;
    FProjectProperty.GetProjectProperty;
  end
  else
  begin
    FProjectProperty.GetProjectProperty(aFilePath);
  end;
end;

procedure TProjectFileMgr.WriteProjectProperty;
//var
//  iIdx: Integer;
begin
//  iIdx := FProjectManager.CheckProjectExists(FProjectProperty.FileName);
//  if iIdx <> -1 then
//    FProjectProperty.Connection := FProjectManager.Projects[iIdx].Connection;
  
  FProjectProperty.SaveProperty;
end;

function TProjectFileMgr.GetProjID(aProjKind: Integer): Integer;
begin
  Result := FProjectMgrDM.GetProjectID(aProjKind);
end;

function TProjectFileMgr.GetParentID(aID: Integer): Integer;
begin
  Result := FProjectMgrDM.GetParentID(aID);
end;

function TProjectFileMgr.GetProjectPropertyFilePath(aProjKind: Integer; var aFilePath: string): Boolean;
begin
  Result := True;

  if aProjKind in [1, 2] then
  begin
    aFilePath := GetProjectFullPath(aProjKind);
  end
  else if aProjKind = 3 then
  begin
    aFilePath := GetProjectFullPath(3);
  end
  else
    Result := False;
end;

function TProjectFileMgr.CreateNewProjectForOneKey(
  const aShortName: string; var aID: Integer; aGatherID: Integer;
  aRaise: Boolean): string;
var
  strUnknowName: string;
  strFullName  : string;
  sShortName   : string;
begin
  sShortName := aShortName;

  repeat
    strUnknowName := GetRandomName;
  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);

  strFullName := '我的清单\' + strUnknowName + '.smb';
  aID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aGatherID, 3);

  CreateNewFile(strUnknowName, strFullName);
  Result := strFullName;
  FProjectMgrDM.RefreshGatherBid;
end;


end.