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.