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.