CentrED/MulProvider/UMulProvider.pas

379 lines
11 KiB
Plaintext

(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UMulProvider;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UBufferedStreams, UMulBlock, UGenericIndex;
type
TOnProgressEvent = procedure(Total, Current: Integer) of object;
TMulEventHandler = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FEvents: TList;
public
procedure RegisterEvent(AEvent: TMulBlockChanged);
procedure UnregisterEvent(AEvent: TMulBlockChanged);
procedure FireEvents(ABlock: TMulBlock);
end;
TMulProvider = class(TObject)
constructor Create; overload; virtual;
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual;
destructor Destroy; override;
protected
FData: TStream;
FOwnsData: Boolean;
FReadOnly: Boolean;
FChangeEvents: TMulEventHandler;
FFinishedEvents: TMulEventHandler;
function CalculateOffset(AID: Integer): Integer; virtual; abstract;
function GetData(AID, AOffset: Integer): TMulBlock; virtual; abstract;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); virtual;
procedure OnChanged(ABlock: TMulBlock);
procedure OnFinished(ABlock: TMulBlock);
public
function GetBlock(AID: Integer): TMulBlock; virtual;
procedure SetBlock(AID: Integer; ABlock: TMulBlock); virtual;
procedure RegisterOnChangeEvent(AEvent: TMulBlockChanged);
procedure UnregisterOnChangeEvent(AEvent: TMulBlockChanged);
procedure RegisterOnFinishedEvent(AEvent: TMulBlockChanged);
procedure UnregisterOnFinishedEvent(AEvent: TMulBlockChanged);
property Block[ID: Integer]: TMulBlock read GetBlock write SetBlock;
property Data: TStream read FData;
end;
TIndexedMulProvider = class(TMulProvider)
constructor Create(AData, AIndex: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData, AIndex: string; AReadOnly: Boolean = False); overload; virtual;
destructor Destroy; override;
protected
FIndex: TBufferedReader;
function CalculateIndexOffset(AID: Integer): Integer; virtual;
function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; reintroduce; virtual; abstract;
procedure SetData(AID: Integer; AIndex: TGenericIndex; ABlock: TMulBlock); reintroduce; virtual;
function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; virtual;
public
function GetBlock(AID: Integer): TMulBlock; override;
procedure GetBlockEx(AID: Integer; var ABlock: TMulBlock; var AIndex: TGenericIndex); virtual;
procedure SetBlock(AID: Integer; ABlock: TMulBlock); override;
function Exists(AID: Integer): Boolean; virtual;
procedure Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); virtual;
property Index: TBufferedReader read FIndex;
end;
implementation
type
PMethod = ^TMethod;
{ TMulEventHandler }
constructor TMulEventHandler.Create;
begin
inherited;
FEvents := TList.Create;
end;
destructor TMulEventHandler.Destroy;
var
i: Integer;
begin
if Assigned(FEvents) then
begin
for i := 0 to FEvents.Count - 1 do
Dispose(PMethod(FEvents.Items[i]));
FreeAndNil(FEvents);
end;
inherited;
end;
procedure TMulEventHandler.FireEvents(ABlock: TMulBlock);
var
i: Integer;
begin
for i := 0 to FEvents.Count - 1 do
TMulBlockChanged(FEvents.Items[i]^)(ABlock);
end;
procedure TMulEventHandler.RegisterEvent(AEvent: TMulBlockChanged);
var
eventInfo: PMethod;
begin
UnregisterEvent(AEvent);
New(eventInfo);
eventInfo^.Code := TMethod(AEvent).Code;
eventInfo^.Data := TMethod(AEvent).Data;
FEvents.Add(eventInfo);
end;
procedure TMulEventHandler.UnregisterEvent(AEvent: TMulBlockChanged);
var
i: Integer;
function RemoveEntry: Boolean;
begin
Dispose(PMethod(FEvents.Items[i]));
FEvents.Delete(i);
Result := True;
end;
begin
i := 0;
while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do
Inc(i);
end;
{ TMulProvider }
constructor TMulProvider.Create(AData: TStream; AReadOnly: Boolean = False);
begin
Create;
FData := AData;
FOwnsData := False;
FReadOnly := AReadOnly;
end;
constructor TMulProvider.Create(AData: string; AReadOnly: Boolean = False);
var
mode: Word;
begin
Create;
if AReadOnly then
mode := fmOpenRead or fmShareDenyWrite
else
mode := fmOpenReadWrite or fmShareDenyWrite;
FData := TFileStream.Create(AData, mode);
FOwnsData := True;
FReadOnly := AReadOnly;
end;
constructor TMulProvider.Create;
begin
inherited;
FChangeEvents := TMulEventHandler.Create;
FFinishedEvents := TMulEventHandler.Create;
end;
destructor TMulProvider.Destroy;
begin
if FOwnsData and Assigned(FData) then FreeAndNil(FData);
if Assigned(FChangeEvents) then FreeAndNil(FChangeEvents);
if Assigned(FFinishedEvents) then FreeAndNil(FFinishedEvents);
inherited;
end;
function TMulProvider.GetBlock(AID: Integer): TMulBlock;
begin
Result := GetData(AID, CalculateOffset(AID));
Result.OnChanged := @OnChanged;
Result.OnFinished := @OnFinished;
end;
procedure TMulProvider.OnChanged(ABlock: TMulBlock);
begin
SetBlock(ABlock.ID, ABlock);
FChangeEvents.FireEvents(ABlock);
end;
procedure TMulProvider.OnFinished(ABlock: TMulBlock);
begin
FFinishedEvents.FireEvents(ABlock);
ABlock.Free;
end;
procedure TMulProvider.RegisterOnChangeEvent(AEvent: TMulBlockChanged);
begin
FChangeEvents.RegisterEvent(AEvent);
end;
procedure TMulProvider.RegisterOnFinishedEvent(AEvent: TMulBlockChanged);
begin
FFinishedEvents.RegisterEvent(AEvent);
end;
procedure TMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock);
begin
if FReadOnly then Exit;
SetData(AID, CalculateOffset(AID), ABlock);
end;
procedure TMulProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock);
begin
if FReadOnly then Exit;
FData.Position := AOffset;
ABlock.Write(FData);
end;
procedure TMulProvider.UnregisterOnChangeEvent(AEvent: TMulBlockChanged);
begin
FChangeEvents.UnregisterEvent(AEvent);
end;
procedure TMulProvider.UnregisterOnFinishedEvent(AEvent: TMulBlockChanged);
begin
FFinishedEvents.UnregisterEvent(AEvent);
end;
{ TIndexedMulProvider }
function TIndexedMulProvider.CalculateIndexOffset(AID: Integer): Integer;
begin
Result := 12 * AID;
end;
constructor TIndexedMulProvider.Create(AData, AIndex: TStream; AReadOnly: Boolean = False);
begin
inherited Create(AData, AReadOnly);
FIndex := TBufferedReader.Create(AIndex);
end;
constructor TIndexedMulProvider.Create(AData, AIndex: string; AReadOnly: Boolean = False);
var
mode: Word;
begin
inherited Create(AData, AReadOnly);
if AReadOnly then
mode := fmOpenRead or fmShareDenyWrite
else
mode := fmOpenReadWrite or fmShareDenyWrite;
FIndex := TBufferedReader.Create(TFileStream.Create(AIndex, mode), True);
end;
procedure TIndexedMulProvider.Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil);
var
genericIndex: TGenericIndex;
begin
if FReadOnly then Exit;
ATempStream.Size := FData.Size;
ATempStream.Position := 0;
FIndex.Position := 0;
while FIndex.Position < FIndex.Size do
begin
genericIndex := TGenericIndex.Create(FIndex);
if genericIndex.Lookup <> LongInt($FFFFFFFF) then
begin
FData.Position := genericIndex.Lookup;
genericIndex.Lookup := ATempStream.Position;
ATempStream.CopyFrom(FData, genericIndex.Size);
FIndex.Seek(-12, soFromCurrent);
genericIndex.Write(FIndex);
end;
genericIndex.Free;
if Assigned(AOnProgress) and (FIndex.Position mod 1200 = 0) then
AOnProgress(FIndex.Size, FIndex.Position);
end;
FData.Size := ATempStream.Position;
FData.Position := 0;
ATempStream.Position := 0;
FData.CopyFrom(ATempStream, FData.Size);
end;
destructor TIndexedMulProvider.Destroy;
begin
if Assigned(FIndex) then FreeAndNil(FIndex);
inherited;
end;
function TIndexedMulProvider.Exists(AID: Integer): Boolean;
var
genericIndex: TGenericIndex;
begin
FIndex.Position := CalculateIndexOffset(AID);
genericIndex := TGenericIndex.Create(FIndex);
Result := genericIndex.Lookup <> LongInt($FFFFFFFF);
genericIndex.Free;
end;
function TIndexedMulProvider.GetBlock(AID: Integer): TMulBlock;
var
genericIndex: TGenericIndex;
begin
GetBlockEx(AID, Result, genericIndex);
genericIndex.Free;
end;
procedure TIndexedMulProvider.GetBlockEx(AID: Integer;
var ABlock: TMulBlock; var AIndex: TGenericIndex);
begin
FIndex.Position := CalculateIndexOffset(AID);
AIndex := TGenericIndex.Create(FIndex);
ABlock := GetData(AID, AIndex);
ABlock.OnChanged := @OnChanged;
ABlock.OnFinished := @OnFinished;
end;
function TIndexedMulProvider.GetVarious(AID: Integer; ABlock: TMulBlock;
ADefault: Integer): Integer;
begin
Result := ADefault;
end;
procedure TIndexedMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock);
var
genericIndex: TGenericIndex;
begin
if FReadOnly then Exit;
FIndex.Position := CalculateIndexOffset(AID);
genericIndex := TGenericIndex.Create(FIndex);
SetData(AID, genericIndex, ABlock);
FIndex.Position := CalculateIndexOffset(AID);
genericIndex.Various := GetVarious(AID, ABlock, genericIndex.Various);
genericIndex.Write(FIndex);
genericIndex.Free;
end;
procedure TIndexedMulProvider.SetData(AID: Integer; AIndex: TGenericIndex;
ABlock: TMulBlock);
var
size: Integer;
begin
if FReadOnly then Exit;
size := ABlock.GetSize;
if size = 0 then
begin
AIndex.Lookup := LongInt($FFFFFFFF);
AIndex.Various := LongInt($FFFFFFFF);
end else if (size > AIndex.Size) or (AIndex.Lookup = LongInt($FFFFFFFF)) then
begin
FData.Position := FData.Size;
AIndex.Lookup := FData.Position;
ABlock.Write(FData);
end else
begin
FData.Position := AIndex.Lookup;
ABlock.Write(FData);
end;
AIndex.Size := size;
end;
end.