123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417 |
- 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.
|