Measure/DataModules/ProjectManagerDm.pas

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;

    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;

{$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;
begin
  if HasProject then
  begin
    DeleteAttachmentFiles(FProjectsTree.Selected);
    DeleteAllTenderFiles(FProjectsTree.Selected);
    FProjectsTree.DeleteNode(FProjectsTree.Selected);
    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 SameText('PhasePay', AColumn.FieldName) 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;

end.