unit ProjectManagerDm; interface uses TenderBackupManager, SysUtils, Classes, DB, DBClient, Provider, ADODB, Connections, ZhAPI, sdDB, sdProvider, sdIDTree; type TProjectManagerData = class(TDataModule) sdpProjectsInfo: TsdADOProvider; sddProjectsInfo: TsdDataSet; sdvProjectsInfo: TsdDataView; sdpTenderProperty: TsdADOProvider; sddTenderProperty: TsdDataSet; sdvTenderProperty: TsdDataView; sdvProjectsSpare: TsdDataView; procedure sdvProjectsInfoGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure sdvProjectsInfoFilterRecord(ARecord: TsdDataRecord; var Allow: Boolean); procedure DataModuleCreate(Sender: TObject); procedure sdvProjectsInfoBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean); private FConnection: TCommonConnection; FProjectsTree: TsdIDTree; procedure UpdateManagerDataBase; //procedure ReNameCurrentProject(const AName: string); procedure CreateNewProjectFile(const AName: string); procedure DeleteAllTenderFiles(ANode: TsdIDTreeNode); procedure DeleteAttachmentFiles(ANode: TsdIDTreeNode); function CreateBackupFolder(AProjectID: Integer): string; procedure ExportTender(ARec: TsdDataRecord; AFileName: string); function NewID: Integer; public constructor Create; destructor Destroy; override; procedure Open; procedure Save; function HasProject: Boolean; function ExistProject(const AName: string; ANode: TsdIDTreeNode): Boolean; function ProjectID(const AName: string; ANode: TsdIDTreeNode): Integer; // 云版要记下网络文件夹的ID和层次。 function InsertProject(const AName: string; APreNode: TsdIDTreeNode; AFolderID: Integer = -1; AFolderLevel: Integer = -1): TsdIDTreeNode; function InsertSubProject(const AName: string; AParent: TsdIDTreeNode; AFolderID: Integer = -1; AFolderLevel: Integer = -1): TsdIDTreeNode; function InsertTender(const AName: string; AParent: TsdIDTreeNode): TsdIDTreeNode; procedure Delete; procedure ReName(const AName: string; ANode: TsdIDTreeNode); procedure RestoreTender(AID: Integer); procedure RefreshSeedID; procedure CalculateParentInfo(AID: Integer); function BackupPath(AProjectID: Integer): String; procedure AddOpenTenderBackup(AProjectID: Integer); procedure AddSaveTenderBackup(AProjectID: Integer); property ProjectsTree: TsdIDTree read FProjectsTree; end; implementation uses UtilMethods, UpdateDataBase, ProjectCommands, PHPWebDm, ConstUnit, Math; {$R *.dfm} { TProjectManagerData } constructor TProjectManagerData.Create; begin inherited Create(nil); FConnection := TCommonConnection.Create; FProjectsTree := TsdIDTree.Create; FProjectsTree.KeyFieldName := 'ID'; FProjectsTree.ParentFieldName := 'ParentID'; FProjectsTree.NextSiblingFieldName := 'NextSiblingID'; FProjectsTree.AutoCreateKeyID := True; FProjectsTree.AutoExpand := True; FProjectsTree.SeedID := 1; FProjectsTree.DataView := sdvProjectsInfo; end; procedure TProjectManagerData.CreateNewProjectFile(const AName: string); var TempFolder: string; begin try TempFolder := GenerateTempFolder(GetTempFilePath); CopyFileOrFolder(GetEmptyDataBaseFileName, TempFolder + '\Main.dat'); ZipFolder(TempFolder, GetMyProjectsFilePath + AName); finally DeleteFileOrFolder(TempFolder); end; end; procedure TProjectManagerData.Delete; var orgParentID: Integer; begin if HasProject then begin orgParentID := FProjectsTree.Selected.ParentID; DeleteAttachmentFiles(FProjectsTree.Selected); DeleteAllTenderFiles(FProjectsTree.Selected); FProjectsTree.DeleteNode(FProjectsTree.Selected); CalculateParentInfo(orgParentID); Save; end; end; destructor TProjectManagerData.Destroy; begin FProjectsTree.Free; FConnection.Free; inherited; end; function TProjectManagerData.ExistProject(const AName: string; ANode: TsdIDTreeNode): Boolean; var vCur: TsdIDTreeNode; begin Result := False; if not Assigned(ANode) then Exit; vCur := ANode.FirstChild; while not Result and Assigned(vCur) do begin Result := vCur.Rec.ValueByName('Name').AsString = AName; vCur := vCur.NextSibling; end; end; function TProjectManagerData.HasProject: Boolean; begin Result := sddProjectsInfo.RecordCount > 0; end; function TProjectManagerData.InsertProject(const AName: string; APreNode: TsdIDTreeNode; AFolderID: Integer; AFolderLevel: Integer): TsdIDTreeNode; var vNew: TsdIDTreeNode; bOnLine, bCanCreate: Boolean; begin // 云版判断是否已存在的标准是服务端传来的ID,不是单机版所使用的名称。 // 判断条件写在这里面不合适,因为云版调用不正确,应该写到方法外面。 // 现在已经这样了,改起来麻烦,先补丁的方式用着。 if G_IsCloud then bCanCreate := True else if (not G_IsCloud) and (not Assigned(APreNode) or not ExistProject(AName, APreNode.Parent)) then bCanCreate := True else bCanCreate := False; if bCanCreate then begin RefreshSeedID; if Assigned(APreNode) then vNew := FProjectsTree.Add(APreNode.ParentID, APreNode.NextSiblingID) else vNew := FProjectsTree.Add(-1, -1); vNew.Rec.BeginUpdate; vNew.Rec.ValueByName('Type').AsInteger := 0; vNew.Rec.ValueByName('Name').AsString := AName; {--------------------------------------------------------------------------- 恼火的问题:直接写成下面这样,则第二句编译不进: if G_IsOnLine then vNew.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; 这里用局部变量bOnLine转接一下,能解决问题。 ---------------------------------------------------------------------------} bOnLine := G_IsCloud; if bOnLine then begin vNew.Rec.ValueByName('WebID').AsInteger := AFolderID; vNew.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; vNew.Rec.ValueByName('WebFolderLevel').AsInteger := AFolderLevel; end; vNew.Rec.EndUpdate; Result := vNew; Save; end else raise Exception.Create('存在同名类别!'); end; function TProjectManagerData.InsertSubProject(const AName: string; AParent: TsdIDTreeNode; AFolderID: Integer; AFolderLevel: Integer): TsdIDTreeNode; var vNew: TsdIDTreeNode; bOnLine, bCanCreate: Boolean; begin if G_IsCloud then bCanCreate := True else if (not G_IsCloud) and (not ExistProject(AName, AParent)) then bCanCreate := True else bCanCreate := False; if bCanCreate then begin RefreshSeedID; vNew := FProjectsTree.Add(AParent.ID, -1); vNew.Rec.ValueByName('Type').AsInteger := 0; vNew.Rec.ValueByName('Name').AsString := AName; {--------------------------------------------------------------------------- 恼火的问题:直接写成下面这样,则第二句编译不进: if G_IsOnLine then vNew.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; 这里用局部变量bOnLine转接一下,能解决问题。 ---------------------------------------------------------------------------} bOnLine := G_IsCloud; if bOnLine then begin vNew.Rec.ValueByName('WebID').AsInteger := AFolderID; vNew.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; vNew.Rec.ValueByName('WebFolderLevel').AsInteger := AFolderLevel; end; Result := vNew; Save; end else raise Exception.Create('存在同名类别!'); end; function TProjectManagerData.InsertTender(const AName: string; AParent: TsdIDTreeNode): TsdIDTreeNode; var bOnLine: Boolean; begin if not ExistProject(AName, AParent) then begin RefreshSeedID; Result := FProjectsTree.Add(AParent.ID, -1); {--------------------------------------------------------------------------- 恼火的问题:直接写成下面这样,则第二句编译不进: if G_IsOnLine then Result.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; 这里用局部变量bOnLine转接一下,能解决问题。 ---------------------------------------------------------------------------} // if G_IsOnLine then // Result.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; // 编译不进 bOnLine := G_IsCloud; if bOnLine then Result.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; Result.Rec.ValueByName('Type').AsInteger := 1; Result.Rec.ValueByName('Name').AsString := AName; Result.Rec.ValueByName('PhaseCount').AsInteger := 0; Result.Rec.ValueByName('AuditStatus').AsInteger := 0; Result.Rec.ValueByName('FileName').AsString := ExtractSimpleFileName(GetNewGUIDFileName(GetMyProjectsFilePath)); Result.Rec.ValueByName('CreateDate').AsString := FormatDateTime('yyyy-mm-dd', Date); CreateNewProjectFile(Result.Rec.ValueByName('FileName').AsString); Save; end else raise Exception.Create('存在同名标段!'); end; procedure TProjectManagerData.Open; var sFileName: string; FQuery: TADOQuery; begin sFileName := GetAppFilePath + 'Data\ProjectManager.dat'; if FileEncrypted(sFileName) then SimpleDecrypt(sFileName, sFileName); FConnection.Open(sFileName); UpdateManagerDataBase; sdpProjectsInfo.Connection := FConnection.Connection; sddProjectsInfo.Open; sdvProjectsInfo.Open; sdvProjectsSpare.Open; sddProjectsInfo.AddIndex('idxID', 'ID'); sdvProjectsInfo.IndexName := 'idxID'; sdpTenderProperty.Connection := FConnection.Connection; sddTenderProperty.Open; sdvTenderProperty.Open; end; procedure TProjectManagerData.Save; begin sddTenderProperty.Save; sddProjectsInfo.Save; FConnection.Save; end; procedure TProjectManagerData.UpdateManagerDataBase; var vUpdator: TUpdateManagerDB; begin vUpdator := TUpdateManagerDB.Create; try vUpdator.Update(FConnection); finally vUpdator.Free; end; end; procedure TProjectManagerData.sdvProjectsInfoGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); function NumToAuditStatus(AValue: Integer): string; begin case AValue of -1: if ARecord.ValueByName('PhaseCount').AsInteger = 0 then Result := '原报' else Result := '批复'; 0: Result := '原报'; else Result := Format('%d 审', [AValue]); end; end; function GetFormatString(ADigitValue: TsdValue): string; begin if not ADigitValue.IsNull then begin case ADigitValue.AsInteger of 0: Result := '0'; 1: Result := '0.#'; 2: Result := '0.##'; 3: Result := '0.###'; 4: Result := '0.####'; 5: Result := '0.#####'; 6: Result := '0.######'; 7: Result := '0.#######'; 8: Result := '0.########'; 9: Result := '0.#########'; else Result := '0.##########'; end; end else Result := ''; end; function FormatCommonTotalPrice(ATotalPrice: Double): string; var sFormat: string; begin Result := Text; sFormat := GetFormatString(ARecord.ValueByName('CommonDigit')); if sFormat <> '' then Result := FormatFloat(sFormat, ATotalPrice); end; function FormatDealPayTotalPrice(ATotalPrice: Double): string; var sFormat: string; begin Result := Text; sFormat := GetFormatString(ARecord.ValueByName('DealPayDigit')); if sFormat <> '' then Result := FormatFloat(sFormat, ATotalPrice); end; begin if not Assigned(ARecord) then Exit; if SameText(AColumn.FieldName, 'AuditStatus') then if ARecord.ValueByName('Type').AsInteger = 1 then Text := NumToAuditStatus(AValue.AsInteger) else Text := '' else if DisplayText then begin if Pos('TotalPrice', AColumn.FieldName) > 0 then Text := FormatCommonTotalPrice(AValue.AsFloat) else if Pos('PhasePay', AColumn.FieldName) > 0 then Text := FormatDealPayTotalPrice(AValue.AsFloat); end; end; procedure TProjectManagerData.DeleteAllTenderFiles(ANode: TsdIDTreeNode); var iChild: Integer; begin if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do DeleteAllTenderFiles(ANode.ChildNodes[iChild]) else if ANode.Rec.ValueByName('Type').AsInteger = 1 then DeleteFile(GetMyProjectsFilePath + ANode.Rec.ValueByName('FileName').AsString); end; procedure TProjectManagerData.ReName(const AName: string; ANode: TsdIDTreeNode); begin ANode.Rec.ValueByName('Name').AsString := AName; Save; end; procedure TProjectManagerData.RestoreTender(AID: Integer); var vNode: TsdIDTreeNode; sRestoreFile: string; Exportor: TTenderExport; begin vNode := FProjectsTree.FindNode(AID); if not FileExists(GetMyProjectsFilePath + vNode.Rec.ValueByName('FileName').AsString) then Exit; sRestoreFile := GetBackUpFilePath + vNode.Rec.ValueByName('Name').AsString + '[' + FormatDateTime('yyyy-mm-dd hh,nn,ss', Now) + '].mtf'; Exportor := TTenderExport.Create(vNode.Rec, sRestoreFile); try Exportor.Execute; finally Exportor.Free; end; end; procedure TProjectManagerData.sdvProjectsInfoFilterRecord( ARecord: TsdDataRecord; var Allow: Boolean); begin if G_IsCloud then begin if ARecord.ValueByName('WebUserID').AsInteger = PHPWeb.UserID then Allow := True else Allow := False; end else begin if ARecord.ValueByName('WebUserID').AsInteger = 0 then Allow := True else Allow := False; end; end; procedure TProjectManagerData.DataModuleCreate(Sender: TObject); begin // 单机版也要过滤:防止单机版程序能显示所有用户的项目。 // if G_IsOnLine then sdvProjectsInfo.Filtered := True; sdvProjectsSpare.Filtered := True; end; function TProjectManagerData.NewID: Integer; var idxID: TsdIndex; begin if sddProjectsInfo.RecordCount > 0 then begin idxID := sddProjectsInfo.FindIndex('idxID'); Result := idxID.Records[idxID.RecordCount - 1].ValueByName('ID').AsInteger + 1; end else Result := 1; end; procedure TProjectManagerData.RefreshSeedID; begin FProjectsTree.SeedID := NewID; end; function TProjectManagerData.BackupPath(AProjectID: Integer): String; var Rec: TsdDataRecord; begin Result := GetAppFilePath + 'FileBackup\TenderBackup'; Rec := ProjectsTree.FindNode(AProjectID).Rec; if Rec.ValueByName('BackupFolder').AsString = '' then Rec.ValueByName('BackupFolder').AsString := CreateBackupFolder(AProjectID); Result := Result + '\' + Rec.ValueByName('BackupFolder').AsString + '\'; end; function TProjectManagerData.CreateBackupFolder( AProjectID: Integer): string; function GetParentNames(ANode: TsdIDTreeNode): string; var stnParent: TsdIDTreeNode; begin Result := ''; stnParent := ANode.Parent; while Assigned(stnParent) do begin if Result <> '' then Result := stnParent.Rec.ValueByName('Name').AsString + '--' + Result else Result := stnParent.Rec.ValueByName('Name').AsString; stnParent := stnParent.Parent; end; end; var stnNode: TsdIDTreeNode; sGUID, sPath: string; sgs: TStringList; begin stnNode := ProjectsTree.FindNode(AProjectID); Result := stnNode.Rec.ValueByName('BackupFolder').AsString; if Result <> '' then Exit; sPath := GetAppFilePath + 'FileBackup\TenderBackup\'; sGUID := GetNewGUIDFileName(sPath); if FileExists(sGUID) then DeleteFile(sGUID); CreateDirectoryInDeep(sGUID); sgs := TStringList.Create; try sgs.Add('项目备份文件夹'); sgs.Add(Format('项目名称:%s', [stnNode.Rec.ValueByName('Name').AsString])); sgs.Add(Format('所属项目:%s', [GetParentNames(stnNode)])); sgs.Add(Format('创建时间:%s', [DateTimeToStr(Now)])); finally sgs.SaveToFile(sGUID + '\说明.txt'); sgs.Free; end; Result := ExtractSimpleFileName(sGUID) end; procedure TProjectManagerData.sdvProjectsInfoBeforeDeleteRecord( ARecord: TsdDataRecord; var Allow: Boolean); var sOrgFolder, sNewFolder: string; begin if ARecord.ValueByName('BackupFolder').AsString <> '' then begin sOrgFolder := GetAppFilePath + 'FileBackup\TenderBackup\' + ARecord.ValueByName('BackupFolder').AsString; sNewFolder := GetAppFilePath + 'FileBackup\RecycleBackup\' + ARecord.ValueByName('BackupFolder').AsString; CopyFileOrFolder(sOrgFolder, sNewFolder); DeleteFileOrFolder(sOrgFolder); end; end; procedure TProjectManagerData.AddOpenTenderBackup(AProjectID: Integer); var vBackupManager: TBackupManager; BackupRec, Rec: TsdDataRecord; sBackupFile: string; begin Rec := sddProjectsInfo.FindKey('idxID', AProjectID); if not Assigned(Rec) then Exit; vBackupManager := TBackupManager.Create; try vBackupManager.LoadBackupFile(BackupPath(AProjectID)); if vBackupManager.LastestOpenBackupIsToday then Exit; sBackupFile := vBackupManager.OpenBackupFile; if FileExists(sBackupFile) then DeleteFile(sBackupFile); ExportTender(Rec, sBackupFile); finally vBackupManager.Free; end; end; procedure TProjectManagerData.AddSaveTenderBackup(AProjectID: Integer); var vBackupManager: TBackupManager; BackupRec, Rec: TsdDataRecord; sBackupFile: string; begin Rec := sddProjectsInfo.FindKey('idxID', AProjectID); if not Assigned(Rec) then Exit; vBackupManager := TBackupManager.Create; try vBackupManager.LoadBackupFile(BackupPath(AProjectID)); sBackupFile := vBackupManager.SaveBackupFile; if FileExists(sBackupFile) then DeleteFile(sBackupFile); ExportTender(Rec, sBackupFile); finally vBackupManager.Free; end; end; procedure TProjectManagerData.ExportTender(ARec: TsdDataRecord; AFileName: string); var Exportor : TTenderExport; begin Exportor := TTenderExport.Create(ARec, AFileName); try Exportor.Execute; finally Exportor.Free; end; end; function TProjectManagerData.ProjectID(const AName: string; ANode: TsdIDTreeNode): Integer; var vCur: TsdIDTreeNode; begin Result := -1; if not Assigned(ANode) then Exit; vCur := ANode.FirstChild; while (Result = -1) and Assigned(vCur) do begin if vCur.Rec.ValueByName('Name').AsString = AName then Result := vCur.ID; vCur := vCur.NextSibling; end; end; procedure TProjectManagerData.DeleteAttachmentFiles(ANode: TsdIDTreeNode); var sDir: string; procedure DeleteAtch(ANode: TsdIDTreeNode); begin // 如果文件名为空,删除时会删除整个附件文件夹,危险! if ANode.Rec.ValueByName('FileName').AsString = '' then Exit; sDir := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString; DeleteFolder(sDir); end; procedure DeleteNodes(ANode: TsdIDTreeNode); begin if ANode = nil then Exit; if ANode.FirstChild <> nil then DeleteNodes(ANode.FirstChild); if ANode.Rec.ValueByName('Type').AsInteger = 1 then DeleteAtch(ANode); if ANode.NextSibling <> nil then DeleteNodes(ANode.NextSibling); end; begin if not G_IsCloud then begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('Type').AsInteger = 0 then begin if Assigned(ANode.FirstChild) then DeleteNodes(ANode.FirstChild); end else DeleteAtch(ANode); end; end; procedure TProjectManagerData.CalculateParentInfo(AID: Integer); procedure ResetDigit(ANode: TsdIDTreeNode); var iChild, iCommonDigit, iDealPayDigit: Integer; vChild: TsdIDTreeNode; begin iCommonDigit := 0; iDealPayDigit := 0; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := ANode.ChildNodes[iChild]; iCommonDigit := Max(iCommonDigit, vChild.Rec.ValueByName('CommonDigit').AsInteger); iDealPayDigit := Max(iDealPayDigit, vChild.Rec.ValueByName('DealPayDigit').AsInteger); end; ANode.Rec.ValueByName('CommonDigit').AsInteger := iCommonDigit; ANode.Rec.ValueByName('DealPayDigit').AsInteger := iDealPayDigit; end; procedure ReCalculateInfo(ANode: TsdIDTreeNode); var fDeal, fDeal_BGL, fPhase, fEndDeal, fEndChange, fEnd, fPre, fPhasePay, fEndPhasePay: Double; iChild, iCommonDigit, iDealPayDigit: Integer; vChild: TsdIDTreeNode; begin fDeal := 0; fDeal_BGL := 0; fPhase := 0; fEndDeal := 0; fEndChange := 0; fEnd := 0; fPre := 0; fPhasePay := 0; fEndPhasePay := 0; iCommonDigit := - ANode.Rec.ValueByName('CommonDigit').AsInteger; iDealPayDigit := - ANode.Rec.ValueByName('DealPayDigit').AsInteger; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := ANode.ChildNodes[iChild]; fDeal := fDeal + vChild.Rec.ValueByName('DealTotalPrice').AsFloat; fDeal_BGL := fDeal_BGL + vChild.Rec.ValueByName('Deal_BGLTotalPrice').AsFloat; fPhase := fPhase + vChild.Rec.ValueByName('PhaseTotalPrice').AsFloat; fEndDeal := fEndDeal + vChild.Rec.ValueByName('EndDealTotalPrice').AsFloat; fEndChange := fEndChange + vChild.Rec.ValueByName('EndChangeTotalPrice').AsFloat; fEnd := fEnd + vChild.Rec.ValueByName('EndTotalPrice').AsFloat; fPre := fPre + vChild.Rec.ValueByName('PreTotalPrice').AsFloat; fPhasePay := fPhasePay + vChild.Rec.ValueByName('PhasePay').AsFloat; fEndPhasePay := fEndPhasePay + vChild.Rec.ValueByName('EndPhasePay').AsFloat; end; ANode.Rec.ValueByName('DealTotalPrice').AsFloat := CommonRoundTo(fDeal, iCommonDigit); ANode.Rec.ValueByName('Deal_BGLTotalPrice').AsFloat := CommonRoundTo(fDeal_BGL, iCommonDigit); ANode.Rec.ValueByName('PhaseTotalPrice').AsFloat := CommonRoundTo(fPhase, iCommonDigit); ANode.Rec.ValueByName('EndDealTotalPrice').AsFloat := CommonRoundTo(fEndDeal, iCommonDigit); ANode.Rec.ValueByName('EndChangeTotalPrice').AsFloat := CommonRoundTo(fEndChange, iCommonDigit); ANode.Rec.ValueByName('EndTotalPrice').AsFloat := CommonRoundTo(fEnd, iCommonDigit); ANode.Rec.ValueByName('PreTotalPrice').AsFloat := CommonRoundTo(fPre, iCommonDigit); ANode.Rec.ValueByName('PhasePay').AsFloat := CommonRoundTo(fPhasePay, iDealPayDigit); ANode.Rec.ValueByName('EndPhasePay').AsFloat := CommonRoundTo(fEndPhasePay, iDealPayDigit); end; var vNode, vChild: TsdIDTreeNode; iChild: Integer; begin if AID = -1 then Exit; vNode := ProjectsTree.FindNode(AID); if (not Assigned(vNode)) or (vNode.Rec.ValueByName('Type').AsInteger = 1) then Exit; ResetDigit(vNode); ReCalculateInfo(vNode); CalculateParentInfo(vNode.ParentID); end; end.