unit ProjectPropertyUnit; interface uses ADODB, ScFileArchiver, SysUtils; type TProjectProperty = class private FBuildProjectName: string; FBudgetProjectName: string; { 标段类型 } FProjectType : string; { 编制范围 } FWeaveRange : string; { 建设单位 } FBuildUnit : string; { 工程地点 } FProjectSite : string; { 编制日期 } FWeaveDate : string; { 编制人 } FWeavePerson : string; { 编制人证号 } FWeaveCode : string; { 复核人 } FCheckPerson : string; { 复核人证号 } FCheckCode : string; { 投标人 } FTenderPerson : string; { 数据文件号 } FDataFileCode : string; { 公路等级 } FRoadLevel : string; { 起点桩号 } FFirstPeg : string; { 终点桩号 } FLastPeg : string; { 路线长度 } FRouteLength : string; { 路线宽度 } FRouteWidth : string; FExpressMode : Integer; FQuery : TADOQuery; FDoQuery : TADOQuery; FConnection : TADOConnection; FArchiver : TScProjectFileArchiver; function OpenArcFile(const aFilePath: string): Boolean; procedure ExecuteSql(aQuery: TADOQuery; const aSql: string); procedure OpenSql(aQuery: TADOQuery; const aSql: string); { Access Tables } procedure WriteProjectData; procedure WriteProjProperty; procedure WriteProjFloatProperty; procedure ReadProjectData; procedure ReadProjProperty; procedure ReadProjFloatProperty; { projproperty } function GetMaxProjPropertyID: Integer; function CheckProjProperty(const aName: string): Boolean; procedure WriteProperty(var aMaxID: Integer; const aTableName, aName, aItemValue: string); procedure UpdateProjProperty(const aTableName, aName, aItemValue: string); procedure InsertProjProperty(aID: Integer; const aTableName, aName, aItemValue: string); procedure SetBuildUnit(const Value: string); procedure SetCheckCode(const Value: string); procedure SetCheckPerson(const Value: string); procedure SetDataFileCode(const Value: string); procedure SetFirstPeg(const Value: string); procedure SetLastPeg(const Value: string); procedure SetProjectSite(const Value: string); procedure SetProjectType(const Value: string); procedure SetRoadLevel(const Value: string); procedure SetRouteLength(const Value: string); procedure SetRouteWidth(const Value: string); procedure SetTenderPerson(const Value: string); procedure SetWeaveCode(const Value: string); procedure SetWeaveDate(const Value: string); procedure SetWeavePerson(const Value: string); procedure SetWeaveRange(const Value: string); procedure SetConnection(const Value: TADOConnection); procedure SetExpressMode(const Value: Integer); public constructor Create; destructor Destroy; override; procedure CloseArcFile; procedure SaveProperty; procedure InitProjectProperty; // project has not opened yet procedure GetProjectProperty(const aFilePath: string); overload; // project has opened procedure GetProjectProperty; overload; property Connection: TADOConnection read FConnection write SetConnection; property BuildProjectName: string read FBuildProjectName write FBuildProjectName; property BudgetProjectName: string read FBudgetProjectName write FBudgetProjectName; { 标段类型 } property ProjectType: string read FProjectType write SetProjectType; { 编制范围 } property WeaveRange: string read FWeaveRange write SetWeaveRange; { 建设单位 } property BuildUnit: string read FBuildUnit write SetBuildUnit; { 工程地点 } property ProjectSite: string read FProjectSite write SetProjectSite; { 编制日期 } property WeaveDate: string read FWeaveDate write SetWeaveDate; { 编制人 } property WeavePerson: string read FWeavePerson write SetWeavePerson; { 编制人证号 } property WeaveCode: string read FWeaveCode write SetWeaveCode; { 复核人 } property CheckPerson: string read FCheckPerson write SetCheckPerson; { 复核人证号 } property CheckCode: string read FCheckCode write SetCheckCode; { 投标人 } property TenderPerson: string read FTenderPerson write SetTenderPerson; { 数据文件号 } property DataFileCode: string read FDataFileCode write SetDataFileCode; { 公路等级 } property RoadLevel: string read FRoadLevel write SetRoadLevel; { 起点桩号 } property FirstPeg: string read FFirstPeg write SetFirstPeg; { 终点桩号 } property LastPeg: string read FLastPeg write SetLastPeg; { 路线长度 } property RouteLength: string read FRouteLength write SetRouteLength; { 路线宽度 } property RouteWidth: string read FRouteWidth write SetRouteWidth; property ExpressMode: Integer read FExpressMode write SetExpressMode; end; implementation uses DB; { TProjectProperty } function TProjectProperty.CheckProjProperty( const aName: string): Boolean; var sSql: string; begin sSql := Format('Select * From ProjProperty Where Name = ''%s''', [aName]); OpenSql(FDoQuery, sSql); Result := FDoQuery.RecordCount > 0; end; procedure TProjectProperty.CloseArcFile; begin if FArchiver.IsOpened then FArchiver.CloseFile; end; constructor TProjectProperty.Create; begin FQuery := TADOQuery.Create(nil); FDoQuery := TADOQuery.Create(nil); FArchiver := TScProjectFileArchiver.Create; end; destructor TProjectProperty.Destroy; begin CloseArcFile; FQuery.Free; FDoQuery.Free; FArchiver.Free; inherited; end; procedure TProjectProperty.ExecuteSql(aQuery: TADOQuery; const aSql: string); begin with aQuery do begin SQL.Clear; SQL.Add(aSql); ExecSQL; end; end; function TProjectProperty.GetMaxProjPropertyID: Integer; var sSql: string; begin sSql := 'Select Max(ID) as ID From ProjProperty'; OpenSql(FDoQuery, sSql); Result := FDoQuery.FieldByName('ID').AsInteger + 1; end; procedure TProjectProperty.GetProjectProperty; begin InitProjectProperty; ReadProjectData; ReadProjProperty; ReadProjFloatProperty; end; procedure TProjectProperty.GetProjectProperty(const aFilePath: string); begin CloseArcFile; if not OpenArcFile(aFilePath) then Exit; FConnection := FArchiver.Connection; FQuery.Connection := FConnection; FDoQuery.Connection := FConnection; GetProjectProperty; end; procedure TProjectProperty.InitProjectProperty; begin FBudgetProjectName := ''; FProjectType := ''; FWeaveRange := ''; FBuildUnit := ''; FProjectSite := ''; FWeaveDate := ''; FWeavePerson := ''; FWeaveCode := ''; FCheckPerson := ''; FCheckCode := ''; FTenderPerson := ''; FDataFileCode := ''; FRoadLevel := ''; FFirstPeg := ''; FLastPeg := ''; FRouteLength := ''; FRouteWidth := ''; FExpressMode := 1; end; procedure TProjectProperty.InsertProjProperty(aID: Integer; const aTableName, aName, aItemValue: string); var sSql: string; begin sSql := Format('Insert Into %s (ID, Name, ItemValue) Values (%d, ''%s'', ''%s'')', [aTableName, aID, aName, aItemValue]); ExecuteSql(FDoQuery, sSql); end; function TProjectProperty.OpenArcFile(const aFilePath: string): Boolean; begin FArchiver.FileName := aFilePath; Result := FArchiver.OpenFile; end; procedure TProjectProperty.OpenSql(aQuery: TADOQuery; const aSql: string); begin with aQuery do begin SQL.Clear; SQL.Add(aSql); Open; end; end; procedure TProjectProperty.ReadProjectData; begin OpenSql(FQuery, 'Select * From ProjData'); with FQuery do begin FBuildProjectName := FieldByName('BuildProjectName').AsString; FBudgetProjectName := FieldByName('BudgetProjectName').AsString; FWeaveRange := FieldByName('EditRange').AsString; FBuildUnit := FieldByName('BuildUnit').AsString; FProjectSite := FieldByName('ProjectLocation').AsString; FWeaveDate := FieldByName('EditDate').AsString; FWeavePerson := FieldByName('Author').AsString; FWeaveCode := FieldByName('AuthorCertificate').AsString; FCheckPerson := FieldByName('Auditor').AsString; FCheckCode := FieldByName('AuditorCertificate').AsString; FTenderPerson := FieldByName('Bidder').AsString; end; end; procedure TProjectProperty.ReadProjFloatProperty; begin OpenSql(FQuery, 'Select * From ProjFloatProperty Where Name = ''ROADLENGTH'''); if FQuery.RecordCount > 0 then FRouteLength := FQuery.FieldByName('ItemValue').AsString; end; procedure TProjectProperty.ReadProjProperty; begin OpenSql(FQuery, 'Select * From ProjProperty'); with FQuery do begin First; while not Eof do begin if FieldByName('Name').AsString = 'PROJTYPE' then begin if FieldByName('ItemValue').AsString = '5' then FProjectType := '三级清单预算' else FProjectType := ''; // FProjectType := '旧版本'; end else if FieldByName('Name').AsString = 'DATAFILENO' then FDataFileCode := FieldByName('ItemValue').AsString else if FieldByName('Name').AsString = 'ROADLEVEL' then FRoadLevel := FieldByName('ItemValue').AsString else if FieldByName('Name').AsString = 'STARTCODE' then FFirstPeg := FieldByName('ItemValue').AsString else if FieldByName('Name').AsString = 'ENDCODE' then FLastPeg := FieldByName('ItemValue').AsString else if FieldByName('Name').AsString = 'ROADWIDTH' then FRouteWidth := FieldByName('ItemValue').AsString else if FieldByName('Name').AsString = 'ExpressMode' then FExpressMode := FieldByName('ItemValue').AsInteger; Next; end; end; end; procedure TProjectProperty.SaveProperty; begin if FConnection = nil then Exit; WriteProjectData; WriteProjProperty; WriteProjFloatProperty; if FArchiver.IsOpened then FArchiver.Save; end; procedure TProjectProperty.SetBuildUnit(const Value: string); begin FBuildUnit := Value; end; procedure TProjectProperty.SetCheckCode(const Value: string); begin FCheckCode := Value; end; procedure TProjectProperty.SetCheckPerson(const Value: string); begin FCheckPerson := Value; end; procedure TProjectProperty.SetConnection(const Value: TADOConnection); begin FConnection := Value; FQuery.Connection := FConnection; FDoQuery.Connection := FConnection; end; procedure TProjectProperty.SetDataFileCode(const Value: string); begin FDataFileCode := Value; end; procedure TProjectProperty.SetExpressMode(const Value: Integer); begin FExpressMode := Value; end; procedure TProjectProperty.SetFirstPeg(const Value: string); begin FFirstPeg := Value; end; procedure TProjectProperty.SetLastPeg(const Value: string); begin FLastPeg := Value; end; procedure TProjectProperty.SetProjectSite(const Value: string); begin FProjectSite := Value; end; procedure TProjectProperty.SetProjectType(const Value: string); begin FProjectType := Value; // WriteProjProperty; end; procedure TProjectProperty.SetRoadLevel(const Value: string); begin FRoadLevel := Value; // WriteProjProperty; end; procedure TProjectProperty.SetRouteLength(const Value: string); begin FRouteLength := Value; // WriteProjFloatProperty; end; procedure TProjectProperty.SetRouteWidth(const Value: string); begin FRouteWidth := Value; // WriteProjProperty; end; procedure TProjectProperty.SetTenderPerson(const Value: string); begin FTenderPerson := Value; end; procedure TProjectProperty.SetWeaveCode(const Value: string); begin FWeaveCode := Value; // WriteProjectData; end; procedure TProjectProperty.SetWeaveDate(const Value: string); begin FWeaveDate := Value; // WriteProjectData; end; procedure TProjectProperty.SetWeavePerson(const Value: string); begin FWeavePerson := Value; // WriteProjectData; end; procedure TProjectProperty.SetWeaveRange(const Value: string); begin FWeaveRange := Value; // WriteProjectData; end; procedure TProjectProperty.UpdateProjProperty(const aTableName, aName, aItemValue: string); var sSql: string; begin sSql := Format('Update %s Set ItemValue = ''%s'' Where Name = ''%s''', [aTableName, aItemValue, aName]); ExecuteSql(FDoQuery, sSql); end; procedure TProjectProperty.WriteProjectData; var sSql: string; begin sSql := Format('Update ProjData Set ' + 'BuildProjectName = ''%s'', ' + 'BudgetProjectName = ''%s'', ' + 'EditRange = ''%s'', ' + 'BuildUnit = ''%s'', ' + 'ProjectLocation = ''%s'', ' + 'EditDate = ''%s'', ' + 'Author = ''%s'', ' + 'AuthorCertificate = ''%s'', ' + 'Auditor = ''%s'', ' + 'AuditorCertificate = ''%s'', ' + 'Bidder = ''%s''', [FBuildProjectName, FBudgetProjectName, FWeaveRange, FBuildUnit, FProjectSite, FWeaveDate, FWeavePerson, FWeaveCode, FCheckPerson, FCheckCode, FTenderPerson]); if not Assigned(FQuery.Connection) then FQuery.Connection := FConnection; ExecuteSql(FQuery, sSql); end; procedure TProjectProperty.WriteProjFloatProperty; var sSql: string; begin sSql := Format('Update ProjFloatProperty Set ItemValue = %0.3f Where Name = ''ROADLENGTH''', [StrToFloatDef(FRouteLength, 0)]); ExecuteSql(FQuery, sSql); end; procedure TProjectProperty.WriteProjProperty; var iMaxID: Integer; sSql: string; sProjType: string; begin iMaxID := GetMaxProjPropertyID; if SameText(FProjectType, '三级清单预算') then sProjType := '5' else sProjType := '6'; WriteProperty(iMaxID, 'ProjProperty', 'PROJTYPE', sProjType); WriteProperty(iMaxID, 'ProjProperty', 'DATAFILENO', FDataFileCode); WriteProperty(iMaxID, 'ProjProperty', 'ROADLEVEL', FRoadLevel); WriteProperty(iMaxID, 'ProjProperty', 'STARTCODE', FFirstPeg); WriteProperty(iMaxID, 'ProjProperty', 'ENDCODE', FLastPeg); WriteProperty(iMaxID, 'ProjProperty', 'ROADWIDTH', FRouteWidth); WriteProperty(iMaxID, 'ProjProperty', 'ExpressMode', IntToStr(FExpressMode)); end; procedure TProjectProperty.WriteProperty(var aMaxID: Integer; const aTableName, aName, aItemValue: string); begin if CheckProjProperty(aName) then begin UpdateProjProperty(aTableName, aName, aItemValue); end else begin InsertProjProperty(aMaxID, aTableName, aName, aItemValue); Inc(aMaxID); end; end; end.