转大富翁笔记 作者: hellbeast
unit BHMapFileStream;
interface
uses Classes,Forms,Windows,SysUtils;
const
sErrorOpenFileFailue ='打开文件: %s 出错!';
sErrorMapFileFailue ='创建映象失败!';
sErrorViewFileFailue ='创建映象视图失败!';
type
TBHMapFileStream=class(TStream)
private
FMapFile:THandle;
FViewFile:Pointer;
FSize,FPosition,FCurViewOffset:Longint;
FInMemory:Boolean;
FFileName:String;
procedure CreateInFile(FileName:String;AutoCreate:Boolean=True;FileSize:LongInt=0;ForceCreate:Boolean=False);
function GetMapSize:LongInt;
function GetCurViewPos:LongInt;
procedure Reset(DeleteTempFile:Boolean=True);
protected
function ReSetView(ViewOffSet:LongInt):Boolean;
function PrePareSize(NewSize:LongInt):Boolean;virtual;
function GetSize: Int64;override;
public
constructor Create;overload;
constructor Create(FileName:String;ForceCreate:Boolean=False);overload;
destructor Destroy; override;
procedure Clear;
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
function CopyFromStream(Stream:TBHMapFileStream):Int64;overload;
function CopyFromStream(Stream:TStream;Count:Int64):Int64;overload;
procedure SaveToStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(NewSize: Longint); override;
procedure SaveData;
function Write(const Buffer; Count: Longint): Longint; override;
property Memory: Pointer read FViewFile;
end;
var
DefaultAllocBlockSize:LongInt; //默认缓冲大小，等于系统的内存分配颗粒大小
DefaultMapFileSize:LongInt; //默认映象的内存大小，等于$4MB
implementation
function GetSysAllocBlockSize:LongInt;
var
SystemInfoGet:TSystemInfo;
begin
GetSystemInfo(SystemInfoGet);
Result:=SystemInfoGet.dwAllocationGranularity;
end;
function GetPhysicalMemory:LongInt;
var
MemoryStatusGet:TMemoryStatus;
begin
GlobalMemoryStatus( MemoryStatusGet);
Result:=MemoryStatusGet.dwTotalPhys;
end;
procedure BatchMove(Source, Destination: Pointer;
Count: Integer);
var
BufSize, N: Integer;
OffSet:Integer;
Buffer: PChar;
begin
if Count > DefaultAllocBlockSize then BufSize := DefaultAllocBlockSize else BufSize := Count;
GetMem(Buffer, BufSize);
try
offset:=0;
while Count <> 0 do
begin
if Count > BufSize then N := BufSize else N := Count;
Move(Pointer(LongInt(Source)+Offset)^,Buffer^,N);
Move(Buffer^,Pointer(LongInt(Destination)+Offset)^,N);
Dec(Count, N);
Inc(OffSet,N);
Application.ProcessMessages;
end;
finally
FreeMem(Buffer, BufSize);
end;
end;
function GetTempFile:string;
var
pPath,pFile:PAnsiChar;
begin
GetMem(pPath,255);
GetTempPath(255,pPath);
GetMem(pFile,255);
GetTempFileName(pPath,'mfs',0,pFile);
Result:=pFile;
FreeMem(pPath,255);
FreeMem(pFile,255);
end;
{ TBHMapFileStream }
procedure TBHMapFileStream.Clear;
begin
SetSize(0);
end;
constructor TBHMapFileStream.Create;
begin
inherited Create;
FFileName:=GetTempFile;
FInMemory:=True;
CreateInFile(FFileName);
end;
function TBHMapFileStream.CopyFromStream(Stream: TBHMapFileStream):Int64;
var
iMapCount,iRest,iCurOffset:Integer;
cntI:Integer;
begin
Stream.Position := 0;
Result:=Stream.Size;
// SetSize(Size+Result);
iMapCount:=Result div DefaultMapFileSize;
iRest:=Result mod DefaultMapFileSize;
for cntI:=0 to iMapCount-1 do
begin
iCurOffset:=cntI*DefaultMapFileSize;
Stream.ReSetView(iCurOffset);
WriteBuffer(Stream.FViewFile^,DefaultMapFileSize);
end;
if iRest>0 then begin
if iMapCount<>0 then
Stream.ReSetView(FCurViewOffset+DefaultMapFileSize);
WriteBuffer(Stream.FViewFile^,iRest);
end;
end;
constructor TBHMapFileStream.Create(FileName: String;ForceCreate:Boolean);
begin
inherited Create;
FFileName:=FileName;
FInMemory:=False;
CreateInFile(FileName,True,0,ForceCreate);
end;
procedure TBHMapFileStream.CreateInFile(FileName: String;AutoCreate:Boolean;FileSize:LongInt;ForceCreate:Boolean);
var
iSize:Longint;
FOpenFile:THandle;
begin
if ForceCreate then
FOpenFile:=CreateFile(PAnsiChar(FileName),GENERIC_WRITE or GENERIC_READ,FILE_SHARE_READ,nil,CREATE_ALWAYS,FILE_FLAG_SEQUENTIAL_SCAN,0)
else if FileExists(FileName) then
FOpenFile:=CreateFile(PAnsiChar(FileName),GENERIC_WRITE or GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,0)
else if AutoCreate then
FOpenFile:=CreateFile(PAnsiChar(FileName),GENERIC_WRITE or GENERIC_READ,FILE_SHARE_READ,nil,CREATE_ALWAYS,FILE_FLAG_SEQUENTIAL_SCAN,0)
else raise Exception.CreateFmt(sErrorOpenFileFailue,[FileName]);
if FileSize=0 then
FSize:=GetFileSize(FOpenFile,nil)
else
FSize:=FileSize;
iSize:=GetMapSize;
FMapFile:=CreateFileMapping(FOpenFile,nil,PAGE_READWRITE,0,iSize,nil);
if FMapFile=0 then begin
CloseHandle(FOpenFile);
raise Exception.Create(sErrorMapFileFailue );
end;
CloseHandle(FOpenFile);
FViewFile:=MapViewOfFile(FMapFile,FILE_MAP_ALL_ACCESS,0,0,DefaultMapFileSize);
if FViewFile=nil then begin
CloseHandle(FMapFile);
raise Exception.Create(sErrorViewFileFailue);
end;
FCurViewOffset:=0;
FPosition:=0;
end;
destructor TBHMapFileStream.Destroy;
begin
Reset(True);
inherited;
end;
function TBHMapFileStream.GetCurViewPos: LongInt;
begin
Result:=FPosition-FCurViewOffset;
end;
function TBHMapFileStream.GetMapSize: LongInt;
begin
if ((FSize mod DefaultMapFileSize)=0) and ((FSize div DefaultMapFileSize )>0) then
Result:=(FSize div DefaultMapFileSize) *DefaultMapFileSize
else
Result:=((FSize div DefaultMapFileSize)+1) *DefaultMapFileSize
end;
function TBHMapFileStream.GetSize: Int64;
begin
Result:=FSize;
end;
procedure TBHMapFileStream.LoadFromFile(const FileName: string);
var
hFile,hMapFile:THandle;
pViewFile:Pointer;
iSize:LongInt;
iMapCount,iRest:Integer;
cntI:Integer;
begin
hFile:=CreateFile(PAnsiChar(FileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,0);
if hFile=INVALID_HANDLE_VALUE then raise Exception.CreateFmt(sErrorOpenFileFailue,[FileName]);
hMapFile:=CreateFileMapping(hFile,nil,PAGE_READONLY,0,0,nil);
if hMapFile=0 then begin
CloseHandle(hFile);
raise Exception.Create(sErrorMapFileFailue );
end;
iSize:=GetFileSize(hFile,nil);
Clear;
SetSize(iSize);
iMapCount:=iSize div DefaultMapFileSize;
iRest:=iSize mod DefaultMapFileSize;
pViewFile:=nil;
Position:=0;
for cntI:=0 to iMapCount-1 do
begin
FCurViewOffset:=cntI*DefaultMapFileSize;
ReSetView(FCurViewOffset);
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
pViewFile:=MapViewOfFile(hMapFile,FILE_MAP_READ,0,FCurViewOffset,DefaultMapFileSize);
if pViewFile=nil then begin
CloseHandle(hMapFile);
CloseHandle(hFile);
raise Exception.Create(sErrorViewFileFailue);
end;
BatchMove(pViewFile,FViewFile,DefaultMapFileSize);
end;
if iRest>0 then begin
if iMapCount<>0 then
ReSetView(FCurViewOffset+DefaultMapFileSize);
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
pViewFile:=MapViewOfFile(hMapFile,FILE_MAP_READ,0,FCurViewOffset,iRest);
if pViewFile=nil then begin
CloseHandle(hMapFile);
CloseHandle(hFile);
raise Exception.Create(sErrorViewFileFailue);
end;
BatchMove(pViewFile,FViewFile,iRest);
end;
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
CloseHandle(hMapFile);
CloseHandle(hFile);
Position:=Size;
end;
procedure TBHMapFileStream.LoadFromStream(Stream: TStream);
var
Count: Longint;
iMapCount,iRest:Integer;
cntI:Integer;
Buffer:PChar;
begin
Stream.Position := 0;
Count := Stream.Size;
SetSize(Count);
iMapCount:=Count div DefaultMapFileSize;
iRest:=Count mod DefaultMapFileSize;
GetMem(Buffer,DefaultMapFileSize);
try
for cntI:=0 to iMapCount-1 do
begin
FCurViewOffset:=cntI*DefaultMapFileSize;
ReSetView(FCurViewOffset);
Stream.ReadBuffer(Buffer^,DefaultMapFileSize);
BatchMove(Buffer,FViewFile,DefaultMapFileSize);
end;
if iRest>0 then begin
if iMapCount<>0 then
ReSetView(FCurViewOffset+DefaultMapFileSize);
Stream.ReadBuffer(Buffer^,iRest);
BatchMove(Buffer,FViewFile,iRest);
end;
finally
FreeMem(Buffer,DefaultMapFileSize);
end;
end;
function TBHMapFileStream.PrePareSize(NewSize: Integer): Boolean;
begin
Result:=True;
if (NewSize div DefaultAllocBlockSize+1)<=(FSize div DefaultMapFileSize +1) then begin
FSize:=NewSize;
end;
try
Reset(False);
CreateInFile(FFileName,False,NewSize,False);
except
Result:=False;
end;
end;
function TBHMapFileStream.Read(var Buffer; Count: Integer): Longint;
var
iMapCount,iRest,iLast,iCurOffset:Integer;
cntI:Integer;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
iRest:=FCurViewOffset+DefaultMapFileSize-FPosition;
iCurOffset:=0;
if iRest>=Result then begin
BatchMove(Pointer(Longint(FViewFile) + GetCurViewPos), @Buffer, Result);
end
else begin
BatchMove(Pointer(Longint(FViewFile) + GetCurViewPos), @Buffer, iRest);
Inc(iCurOffset,iRest);
iMapCount:=(Result-iRest) div DefaultMapFileSize;
iLast:=Result-(iMapCount*DefaultMapFileSize+iRest);
for cntI:=0 to iMapCount-1 do
begin
ReSetView(FCurViewOffset+DefaultMapFileSize);
BatchMove(FViewFile, Pointer(Integer(@Buffer)+iCurOffset), DefaultMapFileSize);
Inc(iCurOffset,DefaultMapFileSize);
end;
if iLast>0 then begin
ReSetView(FCurViewOffset+DefaultMapFileSize);
BatchMove(FViewFile, Pointer(Integer(@Buffer)+iCurOffset), iLast);
end;
end;
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
procedure TBHMapFileStream.Reset(DeleteTempFile:Boolean);
var
FOpenFile:THandle;
begin
if Assigned(FViewFile) then begin
UnmapViewOfFile(FViewFile);
CloseHandle(FMapFile);
FOpenFile:=CreateFile(PAnsiChar(FFileName),GENERIC_WRITE or GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,0);
if FInMemory and DeleteTempFile then
SetFilePointer(FOpenFile,1,nil,FILE_BEGIN)
else
SetFilePointer(FOpenFile,FSize,nil,FILE_BEGIN);
SetEndOfFile(FOpenFile);
CloseHandle(FOpenFile);
if FInMemory and DeleteTempFile then DeleteFile(FFileName);
end;
end;
function TBHMapFileStream.ReSetView(ViewOffSet: Integer):Boolean;
begin
Result:=False;
if ViewOffSet>GetMapSize then Exit;
if Assigned(FViewFile) then begin
try
if ViewOffSet<>FCurViewOffset then begin
UnmapViewOfFile(FViewFile);
FViewFile:=MapViewOfFile(FMapFile,FILE_MAP_ALL_ACCESS,0,ViewOffSet,DefaultMapFileSize);
FCurViewOffset:=ViewOffSet;
end;
Result:=True;
except
Result:=False;
end;
end
else
Result:=False;
end;
procedure TBHMapFileStream.SaveData;
begin
if FViewFile<>nil then FlushViewOfFile(FViewFile,0);
end;
procedure TBHMapFileStream.SaveToFile(const FileName: string);
var
hFile,hMapFile:THandle;
pViewFile:Pointer;
oldPos,iMapCount,iRest:Integer;
cntI:Integer;
begin
hFile:=CreateFile(PAnsiChar(FileName),GENERIC_WRITE or GENERIC_READ,FILE_SHARE_READ,nil,CREATE_ALWAYS,FILE_FLAG_SEQUENTIAL_SCAN,0);
if hFile=INVALID_HANDLE_VALUE then raise Exception.CreateFmt(sErrorOpenFileFailue,[FileName]);
hMapFile:=CreateFileMapping(hFile,nil,PAGE_READWRITE,0,Size,nil);
if hMapFile=0 then begin
CloseHandle(hFile);
raise Exception.Create(sErrorMapFileFailue );
end;
CloseHandle(hFile);
iMapCount:=Size div DefaultMapFileSize;
iRest:=Size mod DefaultMapFileSize;
pViewFile:=nil;
oldPos:=FPosition;
Position:=0;
for cntI:=0 to iMapCount-1 do
begin
FCurViewOffset:=cntI*DefaultMapFileSize;
ReSetView(FCurViewOffset);
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
pViewFile:=MapViewOfFile(hMapFile,FILE_MAP_ALL_ACCESS,0,FCurViewOffset,DefaultMapFileSize);
if pViewFile=nil then begin
CloseHandle(hMapFile);
Position:=oldPos;
raise Exception.Create(sErrorViewFileFailue);
end;
BatchMove(FViewFile,pViewFile,DefaultMapFileSize);
end;
if iRest>0 then begin
if iMapCount<>0 then
ReSetView(FCurViewOffset+DefaultMapFileSize);
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
pViewFile:=MapViewOfFile(hMapFile,FILE_MAP_ALL_ACCESS,0,FCurViewOffset,iRest);
if pViewFile=nil then begin
CloseHandle(hMapFile);
Position:=oldPos;
raise Exception.Create(sErrorViewFileFailue);
end;
BatchMove(FViewFile,pViewFile,iRest);
end;
if Assigned(pViewFile) then UnmapViewOfFile(pViewFile);
CloseHandle(hMapFile);
Position:=oldPos;
end;
procedure TBHMapFileStream.SaveToStream(Stream: TStream);
var
iMapCount,iRest:Integer;
cntI:Integer;
Buffer:PChar;
begin
if FSize=0 then Exit;
iMapCount:=FSize div DefaultMapFileSize;
iRest:=FSize mod DefaultMapFileSize;
GetMem(Buffer,DefaultMapFileSize);
try
Stream.Size:=FSize;
Stream.Position:=0;
for cntI:=0 to iMapCount-1 do
begin
FCurViewOffset:=cntI*DefaultMapFileSize;
ReSetView(FCurViewOffset);
BatchMove(FViewFile,Buffer,DefaultMapFileSize);
Stream.WriteBuffer(Buffer^,DefaultMapFileSize);
end;
if iRest>0 then begin
if iMapCount<>0 then
ReSetView(FCurViewOffset+DefaultMapFileSize);
BatchMove(FViewFile,Buffer,iRest);
Stream.WriteBuffer(Buffer^,iRest);
end;
finally
FreeMem(Buffer,DefaultMapFileSize);
end;
end;
function TBHMapFileStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
case Origin of
soFromBeginning: FPosition := Offset;
soFromCurrent: Inc(FPosition, Offset);
soFromEnd: FPosition := FSize + Offset;
end;
ReSetView((FPosition div DefaultMapFileSize)*DefaultMapFileSize);
Result := FPosition;
end;
procedure TBHMapFileStream.SetSize(NewSize: Integer);
var
oldPos:LongInt;
begin
oldPos:=FPosition;
if PrePareSize(NewSize) then
if oldPos>NewSize then
Seek(0,soFromEnd)
else
Seek(oldPos,soFromBeginning);
end;
function TBHMapFileStream.Write(const Buffer; Count: Integer): Longint;
var
iMapCount,iRest,iLast,iCurOffset:Integer;
cntI:Integer;
Pos: Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Pos := FPosition + Count;
if Pos > 0 then
begin
if Pos > FSize then
SetSize(Pos);
iRest:=FCurViewOffset+DefaultMapFileSize-FPosition;
iCurOffset:=0;
if iRest>=Count then begin
BatchMove(@Buffer,Pointer(Longint(FViewFile) + GetCurViewPos), Count);
end
else begin
BatchMove(@Buffer,Pointer(Longint(FViewFile) + GetCurViewPos), iRest);
Inc(iCurOffset,iRest);
iMapCount:=(Count-iRest) div DefaultMapFileSize;
iLast:=Count-(iMapCount*DefaultMapFileSize+iRest);
for cntI:=0 to iMapCount-1 do
begin
ReSetView(FCurViewOffset+DefaultMapFileSize);
BatchMove(Pointer(Integer(@Buffer)+iCurOffset),FViewFile, DefaultMapFileSize);
Inc(iCurOffset,DefaultMapFileSize);
end;
if iLast>0 then begin
ReSetView(FCurViewOffset+DefaultMapFileSize);
BatchMove(Pointer(Integer(@Buffer)+iCurOffset),FViewFile, iLast);
end;
end;
FPosition := Pos;
Result := Count;
Exit;
end;
end;
Result := 0;
end;
function TBHMapFileStream.CopyFromStream(Stream: TStream;Count:Int64): Int64;
var
BufSize, N: Integer;
Buffer: PChar;
begin
if Count = 0 then
begin
Stream.Position := 0;
Count := Stream.Size;
end;
Result := Count;
// SetSize(Size+Result);
if Count > DefaultAllocBlockSize then BufSize := DefaultAllocBlockSize else BufSize := Count;
GetMem(Buffer, DefaultAllocBlockSize);
try
while Count <> 0 do
begin
if Count > BufSize then N := BufSize else N := Count;
Stream.ReadBuffer(Buffer^, N);
WriteBuffer(Buffer^, N);
Dec(Count, N);
end;
finally
FreeMem(Buffer, DefaultAllocBlockSize);
end;
end;
initialization
DefaultAllocBlockSize:=GetSysAllocBlockSize;
DefaultMapFileSize:=$00100000;
finalization
end.