unit ScFileProviders; interface uses Windows, Classes, SysUtils, ConstMethodUnit, ADODB, ScFileArchiver, Forms; type EScFileProvider = class(Exception); TScConnection = class(TObject) private FRefCount: Integer; // FFileName: string; FConnection: TADOConnection; FFileArchiver: TScMDBArchiver; FIsNew: Boolean; FID: Integer; function GetFileName: string; public constructor Create; destructor Destroy; override; property ID: Integer read FID; property RefCount: Integer read FRefCount; property Connection: TADOConnection read FConnection; property FileName: string read GetFileName; property FileArchiver: TScMDBArchiver read FFileArchiver; property IsNew: Boolean read FIsNew; end; TScFileType = (ftProject, ftRationLib, ftFeeRate, ftUnitPrice); TScArchiverClass = class of TScMDBArchiver; TScFileProvider = class(TObject) private FConnections: TList; FFileType: TScFileType; FTemplateFileName: string; function GetArchiverClass: TScArchiverClass; function GetConnection(ID: Integer): TScConnection; function AddConnection(AFileName: string): TScConnection; function FindConnection(AFileName: string): TScConnection; procedure SetFileType(const Value: TScFileType); procedure SetTemplateFileName(const Value: string); procedure Clear; function GetNewID: Integer; public constructor Create; destructor Destroy; override; function New: Integer; function Open(AFileName: string): Integer; function Close(AFileName: string): Boolean; overload; function Close(AID: Integer): Boolean; overload; function Save(AFileName: string): Boolean; overload; function Save(AID: Integer): Boolean; overload; function SaveAs(AFileName: string; ANewFileName: string): Boolean; overload; function SaveAs(AID: Integer; ANewFileName: string): Boolean; overload; function Refresh(AID: Integer): Boolean; overload; function Refresh(AFileName: string): Boolean; overload; function IndexByName(AFileName: string): TScConnection; property Connection[ID: Integer]: TScConnection read GetConnection; property FileType: TScFileType read FFileType write SetFileType; property TemplateFileName: string read FTemplateFileName write SetTemplateFileName; end; var ProjProvider: TScFileProvider; FeeRateProvider: TScFileProvider; UnitPriceProvider: TScFileProvider; implementation uses ScConfig; { TScConnection } constructor TScConnection.Create; begin FRefCount := 0; // FFileName := ''; FConnection := nil; FFileArchiver := nil; FIsNew := False; end; destructor TScConnection.Destroy; begin inherited; end; function TScConnection.GetFileName: string; begin if FFileArchiver <> nil then Result := FFileArchiver.FileName; end; { TScFileProvider } function TScFileProvider.AddConnection(AFileName: string): TScConnection; begin Result := nil; Result := TScConnection.Create; Result.FConnection := TADOConnection.Create(nil); Result.FFileArchiver := GetArchiverClass.Create; Result.FFileArchiver.Connection := Result.FConnection; Result.FFileArchiver.FileName := AFileName; try if not Result.FFileArchiver.OpenFile then begin FreeAndNil(Result); Exit; end; except Result := nil; MessageError(0, Format('无法打开文件[%s]!', [AFilename])); end; if Result <> nil then begin FConnections.Add(Result); Result.FID := GetNewID + 1; Inc(Result.FRefCount); end; end; function TScFileProvider.Close(AFileName: string): Boolean; var Con: TScConnection; begin Result := True; Con := FindConnection(AFileName); if Con <> nil then begin if Con.RefCount > 1 then Dec(Con.FRefCount) else begin FConnections.Remove(Con); Con.FileArchiver.CloseFile; Con.Connection.Connected := False; Con.Connection.Free; Con.FileArchiver.Free; Con.Free; end; end; end; function TScFileProvider.Close(AID: Integer): Boolean; var Con: TScConnection; begin Result := True; Con := Connection[AID]; if Con <> nil then begin if Con.RefCount > 1 then Dec(Con.FRefCount) else begin FConnections.Remove(Con); Con.FileArchiver.CloseFile; Con.Connection.Connected := False; Con.Connection.Free; Con.FileArchiver.Free; Con.Free; end; end; end; constructor TScFileProvider.Create; begin FConnections := TList.Create; end; destructor TScFileProvider.Destroy; begin Clear; FConnections.Free; inherited; end; function TScFileProvider.FindConnection(AFileName: string): TScConnection; var I: Integer; begin Result := nil; for I := 0 to FConnections.Count - 1 do begin if SameText(AFileName, TScConnection(FConnections[I]).FileName) then begin Result := TScConnection(FConnections[I]); Break; end; end; end; function TScFileProvider.GetConnection(ID: Integer): TScConnection; var I: Integer; begin Result := nil; for I := 0 to FConnections.Count - 1 do begin if ID = TScConnection(FConnections[I]).FID then begin Result := TScConnection(FConnections[I]); Break; end; end; end; // 这方法不行,如果某个文件被关闭了,会从List中删除,这时会有错误。 {begin Result := nil; if (ID >= 0) and (ID < FConnections.Count) then begin Result := TScConnection(FConnections.Items[ID]); if not (Result is TScConnection) then Result := nil; end else Result := nil; end;} function TScFileProvider.Open(AFileName: string): Integer; var Con: TScConnection; begin Result := -1; Con := FindConnection(AFileName); if Con = nil then begin Con := AddConnection(AFileName); if Con = nil then begin Result := -1; Exit; end; Con.Connection.LoginPrompt := False; Con.Connection.Connected := True; end else Inc(Con.FRefCount); Result := Con.ID; end; function TScFileProvider.Save(AFileName: string): Boolean; var Con: TScConnection; begin Result := False; Con := FindConnection(AFileName); if Con <> nil then begin Result := Con.FileArchiver.Save; end; end; function TScFileProvider.Save(AID: Integer): Boolean; var Con: TScConnection; begin Result := False; Con := Connection[AID]; if Con <> nil then begin Result := Con.FileArchiver.Save; end; end; function TScFileProvider.SaveAs(AFileName: string; ANewFileName: string): Boolean; var Con: TScConnection; begin Result := False; Con := FindConnection(AFileName); if Con <> nil then begin Result := Con.FileArchiver.SaveTo(ANewFileName); end; end; function TScFileProvider.SaveAs(AID: Integer; ANewFileName: string): Boolean; var Con: TScConnection; begin Result := False; Con := Connection[AID]; if Con <> nil then begin Result := Con.FileArchiver.SaveTo(ANewFileName); end; end; procedure TScFileProvider.SetFileType(const Value: TScFileType); begin FFileType := Value; end; function TScFileProvider.GetArchiverClass: TScArchiverClass; begin Result := TScMDBArchiver; case FFileType of ftProject: Result := TScProjectFileArchiver; ftRationLib: Result := TScRationLibArchiver; ftFeeRate: Result := TScFeeRateFileArchiver; ftUnitPrice: Result := TScUnitPriceFileArchiver; end; end; function TScFileProvider.New: Integer; var Con: TScConnection; begin Result := -1; if not FileExists(FTemplateFileName) then begin raise EScFileProvider.Create('文件系统故障,无法创建新文件!'); end; Con := AddConnection(FTemplateFileName); Con.Connection.LoginPrompt := False; Con.Connection.Connected := True; Result := Con.ID; end; procedure TScFileProvider.SetTemplateFileName(const Value: string); begin FTemplateFileName := Value; end; procedure TScFileProvider.Clear; var I: Integer; Con: TScConnection; begin for I := 0 to FConnections.Count - 1 do begin Con := TScConnection(FConnections[I]); if Con <> nil then begin Con.FileArchiver.CloseFile; Con.Connection.Connected := False; Con.Connection.Free; Con.FileArchiver.Free; Con.Free; end; end; FConnections.Clear; end; function TScFileProvider.IndexByName(AFileName: string): TScConnection; begin Result := FindConnection(AFileName); end; function TScFileProvider.Refresh(AID: Integer): Boolean; var Con: TScConnection; begin Result := False; Con := Connection[AID]; if Con <> nil then begin Result := Con.FileArchiver.Refresh; end; end; function TScFileProvider.Refresh(AFileName: string): Boolean; var Con: TScConnection; begin Result := False; Con := FindConnection(AFileName); if Con <> nil then begin Result := Con.FileArchiver.Refresh; end; end; function TScFileProvider.GetNewID: Integer; var I, iMaxID: Integer; begin iMaxID := 0; for I := 0 to FConnections.Count - 1 do begin if iMaxID < TScConnection(FConnections[I]).ID then iMaxID := TScConnection(FConnections[I]).ID; end; Result := iMaxID; end; initialization ProjProvider := TScFileProvider.Create; ProjProvider.FFileType := ftProject; // 这里ConfigInfo还没有加载,不行 // ProjProvider.TemplateFileName := ConfigInfo.ProjFileTemplate;//ExtractFilePath(Application.ExeName) + 'Data\MainTemplate.dat'; FeeRateProvider := TScFileProvider.Create; FeeRateProvider.FFileType := ftFeeRate; UnitPriceProvider := TScFileProvider.Create; UnitPriceProvider.FFileType := ftUnitPrice; finalization ProjProvider.Free; FeeRateProvider.Free; UnitPriceProvider.Free; end.