/Gedemin/Common/gsMMFStream.pas

  1
  2unit gsMMFStream;
  3
  4interface
  5
  6uses
  7  Classes, Windows, SysUtils, ContNrs;
  8
  9type
 10  TgsStream64 = class(TObject)
 11  private
 12    FHandle: THandle;
 13    FFileMapping: THandle;
 14    FPointer: PAnsiChar;
 15    FOwnFile: Boolean;
 16
 17    FStreamStart, FStreamSize: Int64;
 18    FProtection, FAccessMode: DWORD;
 19
 20    FViewStart: Int64;
 21    FViewSize, FOffset: Cardinal;
 22
 23    function GetPosition: Int64;
 24    procedure SetPosition(const Value: Int64);
 25
 26    procedure InitViewSize;
 27    procedure OpenFile;
 28    procedure MapView(ANewGlobalPos: Int64);
 29
 30  public
 31    constructor Create; overload;
 32    constructor Create(AHandle: THandle; AProtection: DWORD;
 33      AStreamStart, AStreamSize: Int64); overload;
 34    destructor Destroy; override;
 35
 36    function Read(var Buffer; Count: Longint): Longint;
 37    function Write(const Buffer; Count: Longint): Longint;
 38    function Seek(Offset: Int64; Origin: Word): Int64;
 39    procedure ReadBuffer(var Buffer; Count: Longint);
 40    procedure WriteBuffer(const Buffer; Count: Longint);
 41    procedure WriteString(const S: String);
 42    function ReadString(const AStrLen: Integer = -1): String;
 43    function CopyFrom(Source: TStream; Count: LongInt): LongInt;
 44
 45    property Position: Int64 read GetPosition write SetPosition;
 46    property Size: Int64 read FStreamSize;
 47    property ViewSize: Cardinal read FViewSize;
 48  end;
 49
 50  EgsMMFStream = class(Exception);
 51
 52implementation
 53
 54uses
 55  Consts;
 56
 57{ TgsStream64 }
 58
 59constructor TgsStream64.Create;
 60begin
 61  inherited Create;
 62  InitViewSize;
 63  FProtection := PAGE_READWRITE;
 64  FAccessMode := FILE_MAP_WRITE;
 65  FOwnFile := True;
 66end;
 67
 68constructor TgsStream64.Create(AHandle: THandle; AProtection: DWORD;
 69  AStreamStart, AStreamSize: Int64);
 70begin
 71  inherited Create;
 72  InitViewSize;
 73  FHandle := AHandle;
 74  FProtection := AProtection;
 75  if (FProtection and PAGE_READWRITE) <> 0 then
 76    FAccessMode := FILE_MAP_WRITE
 77  else
 78    FAccessMode := FILE_MAP_READ;
 79  FStreamStart := AStreamStart;
 80  FStreamSize := AStreamSize;
 81  MapView(FStreamStart);
 82end;
 83
 84destructor TgsStream64.Destroy;
 85begin
 86  UnMapViewOfFile(FPointer);
 87  CloseHandle(FFileMapping);
 88  if FOwnFile then
 89    CloseHandle(FHandle);
 90  inherited;
 91end;
 92
 93function TgsStream64.CopyFrom(Source: TStream; Count: Integer): LongInt;
 94var
 95  Buff: array[0..4096 - 1] of AnsiChar;
 96  L: LongInt;
 97begin
 98  if Count = 0 then
 99    Source.Position := 0;
100  Result := 0;
101  repeat
102    L := Source.Read(Buff, SizeOf(Buff));
103    WriteBuffer(Buff, L);
104    Result := Result + L;
105  until L = 0;
106end;
107
108function TgsStream64.GetPosition: Int64;
109begin
110  Result := FViewStart + FOffset - FStreamStart;
111end;
112
113procedure TgsStream64.InitViewSize;
114var
115  SI: TSystemInfo;
116begin
117  FViewSize := 65536;
118  GetSystemInfo(SI);
119  if FViewSize mod SI.dwAllocationGranularity <> 0  then
120    FViewSize := SI.dwAllocationGranularity;
121end;
122
123procedure TgsStream64.MapView(ANewGlobalPos: Int64);
124var
125  L: ULARGE_INTEGER;
126  ANewViewStart: Int64;
127  ANewOffset: Cardinal;
128begin
129  ANewViewStart := (ANewGlobalPos div FViewSize) * FViewSize;
130  ANewOffset := ANewGlobalPos - ANewViewStart;
131
132  if (ANewViewStart <> FViewStart) or (FPointer = nil) then
133  begin
134    if FPointer <> nil then
135    begin
136      if not UnMapViewOfFile(FPointer) then
137        raise EgsMMFStream.Create('Can not unmap view of file');
138    end;
139
140    if (ANewViewStart > FViewStart) or (FFileMapping = 0) then
141    begin
142      if FFileMapping <> 0 then
143      begin
144        if not CloseHandle(FFileMapping) then
145          raise EgsMMFStream.Create('Can not close file mapping');
146      end;
147
148      if FOwnFile then
149        L.QuadPart := ANewViewStart + FViewSize
150      else
151        L.QuadPart := FStreamStart + FStreamSize;
152      FFileMapping := CreateFileMapping(FHandle,
153        nil,
154        FProtection,
155        L.HighPart,
156        L.LowPart,
157        nil);
158      if FFileMapping = 0 then
159        raise EgsMMFStream.Create('Can not create a file mapping');
160    end;
161    FViewStart := ANewViewStart;
162
163    L.QuadPart := FViewStart;
164    FPointer := MapViewOfFile(FFileMapping,
165      FAccessMode,
166      L.HighPart,
167      L.LowPart,
168      FViewSize);
169    if FPointer = nil then
170      raise EgsMMFStream.CreateFmt('Can not map view of file, error #%d', [GetLastError]);
171  end;
172
173  FOffset := ANewOffset;
174end;
175
176procedure TgsStream64.OpenFile;
177var
178  TempPath: array[0..1023] of Char;
179  TempFileName: array[0..1023] of Char;
180begin
181  if (GetTempPath(SizeOf(TempPath), TempPath) = 0) or
182    (GetTempFileName(TempPath, 'gd', 0, TempFileName) = 0) then
183      raise EgsMMFStream.Create('Can not get a name for temp file');
184
185  FHandle := CreateFile(TempFileName,
186    GENERIC_READ or GENERIC_WRITE,
187    FILE_SHARE_READ,
188    nil,
189    CREATE_ALWAYS,
190    FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE,
191    0);
192  if FHandle = INVALID_HANDLE_VALUE then
193    raise EgsMMFStream.Create('Can not create a file for gsMMFStream');
194
195  MapView(0);
196end;
197
198function TgsStream64.Read(var Buffer; Count: Integer): Longint;
199var
200  ToCopy: Cardinal;
201  Trg: Integer;
202begin
203  Trg := 0;
204  while Count > 0 do
205  begin
206    ToCopy := Count;
207    if ToCopy > FViewSize - FOffset then
208      ToCopy := FViewSize - FOffset;
209    if ToCopy > FStreamStart + FStreamSize - FViewStart - FOffset then
210    begin
211      ToCopy := FStreamStart + FStreamSize - FViewStart - FOffset;
212      if ToCopy = 0 then
213        break;
214    end;
215    Move(FPointer[FOffset], Pointer(Longint(@Buffer) + Trg)^, ToCopy);
216    Dec(Count, ToCopy);
217    Inc(Trg, ToCopy);
218    if FOffset + ToCopy = FViewSize then
219      MapView(FViewStart + FViewSize)
220    else
221      Inc(FOffset, ToCopy);
222  end;
223  Result := Trg;
224end;
225
226procedure TgsStream64.ReadBuffer(var Buffer; Count: Integer);
227begin
228  if (Count <> 0) and (Read(Buffer, Count) <> Count) then
229    raise EReadError.CreateRes(@SReadError);
230end;
231
232function TgsStream64.ReadString(const AStrLen: Integer = -1): String;
233var
234  L: Integer;
235begin
236  if AStrLen = -1 then
237    ReadBuffer(L, SizeOf(L))
238  else
239    L := AStrLen;
240  if L < 0 then
241    raise EgsMMFStream.Create('Invalid stream format');
242  SetLength(Result, L);
243  if L > 0 then
244    ReadBuffer(Result[1], L * SizeOf(Char));
245end;
246
247function TgsStream64.Seek(Offset: Int64; Origin: Word): Int64;
248var
249  NewGlobalPos: Int64;
250begin
251  case Origin of
252    soFromBeginning: NewGlobalPos := FStreamStart + Offset;
253    soFromCurrent: NewGlobalPos := FViewStart + FOffset + Offset;
254  else
255    {soFromEnd:} NewGlobalPos := FStreamSize + Offset;
256  end;
257
258  if (NewGlobalPos < FStreamStart) or (NewGlobalPos > FStreamStart + FStreamSize) then
259    raise EgsMMFStream.Create('Invalid offset');
260
261  MapView(NewGlobalPos);
262  Result := NewGlobalPos - FStreamStart;
263end;
264
265procedure TgsStream64.SetPosition(const Value: Int64);
266begin
267  if (Value < 0) or (Value > FStreamSize - FStreamStart) then
268    raise EgsMMFStream.Create('Invalid position');
269  MapView(Value + FStreamStart);
270end;
271
272function TgsStream64.Write(const Buffer; Count: Integer): Longint;
273var
274  Src, ToCopy: Integer;
275begin
276  if FHandle = 0 then
277    OpenFile;
278
279  Src := 0;
280  while Count > 0 do
281  begin
282    ToCopy := FViewSize - FOffset;
283    if ToCopy > Count then
284      ToCopy := Count;
285    if not FOwnFile then
286    begin
287      if (FViewStart + FOffset + ToCopy) >= (FStreamStart + FStreamSize) then
288        ToCopy := (FStreamStart + FStreamSize) - (FViewStart + FOffset + ToCopy);
289      if ToCopy <= 0 then
290        break;
291    end;
292    Move((PAnsiChar(@Buffer) + Src)^, (FPointer + FOffset)^, ToCopy);
293    Inc(Src, ToCopy);
294    Inc(FOffset, ToCopy);
295    if (FViewStart + FOffset) > (FStreamStart + FStreamSize) then
296      FStreamSize := FViewStart + FOffset - FStreamStart;
297    if FOffset >= FViewSize then
298    begin
299      MapView(FViewStart + FViewSize);
300    end;
301    Dec(Count, ToCopy);
302  end;
303  Result := Src;
304end;
305
306procedure TgsStream64.WriteBuffer(const Buffer; Count: Integer);
307begin
308  if (Count <> 0) and (Write(Buffer, Count) <> Count) then
309    raise EWriteError.CreateRes(@SWriteError);
310end;
311
312procedure TgsStream64.WriteString(const S: String);
313var
314  L: Integer;
315begin
316  L := Length(S);
317  WriteBuffer(L, SizeOf(L));
318  if L > 0 then
319    WriteBuffer(S[1], L * SizeOf(Char));
320end;
321
322end.