Autor Beitrag
Flamefire
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1207
Erhaltene Danke: 31

Win 10
Delphi 2009 Pro, C++ (Visual Studio)
BeitragVerfasst: Di 15.06.10 16:20 
Ich veröffentliche hier meine TFastFileStream-Klasse.

Version 1.00

Features
  • Sehr schnelles Lesen und Schreiben von Dateien (fast) beliebiger Größe
  • Implementierung von TStream, kompatibel zu TFileStream


Die Klasse bringt besonders hohe Geschwindigkeitsgewinne beim Lesen/Schreiben vieler kleiner Blöcke. Bestehende Projekte können einfach angepasst werden, da TStream implementiert wird und die Klasse ansonsten genau wie TFileStream verwendet werden kann.

Bisher sind keine Bugs bekannt. Anregungen werden gern entgegengenommen.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
{

  ***** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  www.mozilla.org/MPL/

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the
  License.

  The Original Code is FastFileStream.

  The Initial Developer of the Original Code is Flamefire.
  Portions created by the Initial Developer are Copyright (C) 2010
  the Initial Developer. All Rights Reserved.

  Contributor(s):
    Sebastian Jänicke (2010: MMF File Reader)

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.00
}


unit unFastFileStream;

interface

uses
  Windows, Classes, SysUtils, RTLConsts;

type
  TFastFileStream = class(TStream)
  private
    FPointer: Pointer;
    FFile, FMapping: THandle;
    FRealSize,//Real size of the file
    FVirtualSize, //Current virtual size of the file (<=FRealSize)
    FBufferPos, //Pos of Buffer in fie
    FBufferSize, //Size of Buffer wanted
    FCurBufferSize, //current size of Buffer
    FAllocationGranularity, //used for efficient alignment
    FPosInBuffer: Int64; //current position in buffer (can be >=F(Cur)BufferSize)
    FReadOnly:Boolean;
    FFileName:String;
    procedure SetFileSize(const NewSize:Int64; reMap:Boolean=True);
    procedure SetBufferSize(const Value: Int64);
    procedure ReInitView;
  protected
    function GetSize: Int64; override;
    procedure SetSize(const NewSize: Int64); override;
    procedure SetSizeInternal(const NewSize: Int64; setPosition:Boolean=True);
  public
    constructor Create(const AFileName: string; Mode: Word);  overload;
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal); overload;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    property BufferSize: Int64 read FBufferSize write SetBufferSize;
    property FileName:string read FFileName;
    property Handle:THandle read FFile;
  end;

implementation

{ TFileReader }

constructor TFastFileStream.Create(const AFileName: string; Mode: Word);
var
  SysInfo: _SYSTEM_INFO;
  access:Cardinal;
begin
  if Mode = fmCreate then begin
    FFile:=FileCreate(AFileName);
    if FFile = INVALID_HANDLE_VALUE then
      raise EFCreateError.CreateResFmt(@SFCreateErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
    FReadOnly:=False;
  end else begin
    FFile:=FileOpen(AFileName, Mode);
    if FFile = INVALID_HANDLE_VALUE then
      raise EFOpenError.CreateResFmt(@SFOpenErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
    FReadOnly:=(Mode and 3)=0;
  end;
  FFileName:=AFileName;
  if FFile = INVALID_HANDLE_VALUE then
    raise Exception.Create('Es ist ein Fehler aufgetreten:' + #13#10
      + SysErrorMessage(GetLastError()))
  else
  begin
    PCardinal(@FRealSize)^:=GetFileSize(FFile,@Int64Rec(FRealSize).Hi);
    if(FRealSize<>0then begin
      if(FReadOnly) then access:=PAGE_READONLY
      else access:=PAGE_READWRITE;
      FMapping := CreateFileMapping(FFile, nil, access, 00nil);
      if(GetLastError()<>0then
        raise Exception.Create('Es ist ein Fehler aufgetreten:' + #13#10
          + SysErrorMessage(GetLastError()));
    end else FMapping:=INVALID_HANDLE_VALUE;
  end;
  GetSystemInfo(SysInfo);
  FAllocationGranularity := SysInfo.dwAllocationGranularity;
  FBufferPos := 0;
  if FRealSize >= 224 * FAllocationGranularity then
    FBufferSize := 224 * FAllocationGranularity
  else
    FBufferSize := 16 * FAllocationGranularity;
  FCurBufferSize := FBufferSize;
  FVirtualSize:=FRealSize;
  FPosInBuffer := 0;
  ReInitView;
end;

procedure TFastFileStream.SetFileSize(const NewSize: Int64; reMap:Boolean=True);
begin
  if(FReadOnly and reMap) then exit;
  if Assigned(FPointer) then begin
    if(not FReadOnly) then FlushViewOfFile(FPointer,0);
    UnmapViewOfFile(FPointer);
    FPointer:=nil;
  end;
  if(FMapping<>INVALID_HANDLE_VALUE) then begin
    CloseHandle(FMapping);
    FMapping:=INVALID_HANDLE_VALUE;
  end;
  if(FReadOnly) then exit;
  if(NewSize<FRealSize) then begin
    FileSeek(FFile,NewSize,Ord(soBeginning));
    SetEndOfFile(FFile);
  end;
  FRealSize:=NewSize;
  if(reMap) then begin
    FMapping := CreateFileMapping(FFile, nil, PAGE_READWRITE, Int64Rec(FRealSize).Hi,Int64Rec(FRealSize).Lo, nil);
    if(GetLastError()<>0then
      raise Exception.Create('Es ist ein Fehler aufgetreten:' + #13#10
        + SysErrorMessage(GetLastError()));
    ReInitView;
  end;
end;

constructor TFastFileStream.Create(const AFileName: string; Mode: Word;
  Rights: Cardinal);
begin
  Create(AFileName,Mode);
end;

destructor TFastFileStream.Destroy;
begin
  SetFileSize(FVirtualSize,false);
  CloseHandle(FFile);
  inherited;
end;

procedure TFastFileStream.ReInitView;
var nBuffSize,access:Cardinal;
begin
  if Assigned(FPointer) then begin
    if(not FReadOnly) then FlushViewOfFile(FPointer,0);
    UnmapViewOfFile(FPointer);
    FPointer:=nil;
  end;
  if FVirtualSize < FBufferPos + FBufferSize then begin
    if(FVirtualSize<FBufferPos) then FCurBufferSize:=0
    else FCurBufferSize := FVirtualSize - FBufferPos;
  end else
    FCurBufferSize := FBufferSize;
  if FRealSize < FBufferPos + FBufferSize then begin
    if(FRealSize<FBufferPos) then nBuffSize:=0
    else nBuffSize := FRealSize - FBufferPos;
  end else
    nBuffSize := FBufferSize;
  if(nBuffSize>0then begin
      if(FReadOnly) then access:=FILE_MAP_READ
      else access:=FILE_MAP_WRITE;
      FPointer := MapViewOfFile(FMapping,access , Int64Rec(FBufferPos).Hi, Int64Rec(FBufferPos).Lo, nBuffSize);
  end;
end;

function TFastFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var newPos:Int64;
begin
  case Origin of
    soBeginning: newPos := Offset;
    soCurrent: newPos:=FBufferPos + FPosInBuffer+Offset;
    soEnd: newPos := Size + Offset;
    else newPos:=-1;
  end;
  if(newPos>=0then begin
    if (newPos < FBufferPos) or (newPos >= FBufferPos + FCurBufferSize) then  begin
      FBufferPos := newPos - (newPos mod FAllocationGranularity);
      FPosInBuffer := newPos mod FAllocationGranularity;
      ReInitView;
    end else
      FPosInBuffer := newPos - FBufferPos;
  end;
  Result := FBufferPos + FPosInBuffer;
end;

procedure TFastFileStream.SetBufferSize(const Value: Int64);
begin
  if(Value<0then exit;
  FBufferSize := Succ(Value div FAllocationGranularity) * FAllocationGranularity;
  ReInitView;
end;

function TFastFileStream.GetSize: Int64;
begin
  Result:=FVirtualSize;
end;

procedure TFastFileStream.SetSize(const NewSize: Int64);
begin
  SetSizeInternal(NewSize);
end;

procedure TFastFileStream.SetSizeInternal(const NewSize: Int64;
  setPosition: Boolean);
var newSizeWanted:Int64;
begin
  //size changed?
  if(NewSize<>FVirtualSize) then begin
    if(FReadOnly) then begin
      SetLastError(ERROR_ACCESS_DENIED);
      exit;
    end;
    FVirtualSize:=NewSize;
    newSizeWanted:=FVirtualSize+FBufferSize*4;
    newSizeWanted := Succ(newSizeWanted div FAllocationGranularity) * FAllocationGranularity;
    if(FVirtualSize>FRealSize) or (newSizeWanted-FBufferSize*2>FRealSize) then
      SetFileSize(newSizeWanted);
  end;
  if(setPosition) then Seek(NewSize,soFromBeginning);
end;

function TFastFileStream.Read(var Buffer; Count: Integer): Longint;
var pTarget,pSrc:PByte;
    iRemain:Int64;
begin
  pTarget:=@Buffer;
  while(Count>0do begin
    iRemain:=FCurBufferSize-FPosInBuffer;
    if(iRemain<Count) then begin
      if(Position>=Size) then break;
      if(iRemain>0then begin
        pSrc:=Ptr(Cardinal(FPointer)+FPosInBuffer);
        Move(pSrc^,pTarget^,iRemain);
        Inc(pTarget,iRemain);
        Dec(Count,iRemain);
      end;
      Seek(iRemain,soFromCurrent);
    end else begin
      pSrc:=Ptr(Cardinal(FPointer)+FPosInBuffer);
      Move(pSrc^,pTarget^,Count);
      Seek(Count,soFromCurrent);
      Inc(pTarget,Count);
      Count:=0;
    end;
  end;
  Result:=Cardinal(pTarget)-Cardinal(@Buffer);
end;

function TFastFileStream.Write(const Buffer; Count: Integer): Longint;
var pTarget,pSrc:PByte;
    iRemain,curPos:Int64;
begin
  if(FReadOnly) then begin
    SetLastError(ERROR_ACCESS_DENIED);
    exit(0);
  end;

  //Resize if needed
  curPos:=Position;
  if(curPos+Count>Size) then begin
    SetSizeInternal(curPos+Count,False);
  end;

  pSrc:=@Buffer;
  while(Count>0do begin
    iRemain:=FCurBufferSize-FPosInBuffer;
    if(iRemain<Count) then begin
      if(iRemain>0then begin
        pTarget:=Ptr(Cardinal(FPointer)+FPosInBuffer);
        Move(pSrc^,pTarget^,iRemain);
        Inc(pSrc,iRemain);
        Dec(Count,iRemain);
      end;
      Seek(iRemain,soFromCurrent);
    end else begin
      pTarget:=Ptr(Cardinal(FPointer)+FPosInBuffer);
      Move(pSrc^,pTarget^,Count);
      Seek(Count,soFromCurrent);
      Inc(pSrc,Count);
      Count:=0;
    end;
  end;
  Result:=Cardinal(pSrc)-Cardinal(@Buffer);
end;

end.

Für diesen Beitrag haben gedankt: Boldar, DelphiShark, Dude566, glotzer, hansjf, jaenicke, rushifell, Webo
Novo
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 90

Win XP, Win 7
Delphi 7 Enterprise, Delphi 2009
BeitragVerfasst: So 27.06.10 15:16 
in wie fern ist diese jetzt schneller?
jaenicke
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 19288
Erhaltene Danke: 1743

W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
BeitragVerfasst: So 27.06.10 15:22 
Es werden dabei größere Blöcke von der Festplatte gelesen, auch wenn man z.B. nur kleine Häppchen daraus nacheinander dann ausliest. Dadurch hat man keine ständigen Zugriffe auf die Festplatte und dementsprechend eine deutlich höhere Geschwindigkeit.

Insbesondere weil Windows den Zugriff auf MMFs entsprechend der sonstigen Systemauslastung optimieren kann.

Für diesen Beitrag haben gedankt: Dude566
Novo
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 90

Win XP, Win 7
Delphi 7 Enterprise, Delphi 2009
BeitragVerfasst: So 27.06.10 16:47 
gilt das auch für's schreiben?
(in meinem Fall für einen Downloader)
jaenicke
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 19288
Erhaltene Danke: 1743

W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
BeitragVerfasst: So 27.06.10 17:10 
Grundsätzlich ja. Wichtig ist aber, dass man möglichst die Größe nur selten verändert. Heißt: Wenn 100 mal 10 KiB geschrieben werden, die Größe gleich um 1 MiB vergrößern und nicht 100 mal.

Denn ansonsten muss die Größe ständig verändert werden, was den Geschwindigkeitsvorteil zunichte macht.

Was den Verwendungszweck als Downloader angeht:
Die Internetverbindung ist deutlich langsamer als die Festplatte, insofern ist das da gar nicht so wichtig.
Flamefire Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1207
Erhaltene Danke: 31

Win 10
Delphi 2009 Pro, C++ (Visual Studio)
BeitragVerfasst: So 27.06.10 20:16 
user profile iconjaenicke hat folgendes geschrieben Zum zitierten Posting springen:
Grundsätzlich ja. Wichtig ist aber, dass man möglichst die Größe nur selten verändert. Heißt: Wenn 100 mal 10 KiB geschrieben werden, die Größe gleich um 1 MiB vergrößern und nicht 100 mal.

Denn ansonsten muss die Größe ständig verändert werden, was den Geschwindigkeitsvorteil zunichte macht.


Stimmt in diesem Fall nicht ganz. Diese Klasse kümmert sich auch um dieses Problem. Die Größe wird intelligent erhöht und erst beim Freigeben des Objektes auf die endgültige Größe gesetzt. D.h. Es kann beliebig gelesen und geschrieben werden, bei maximaler Geschwindigkeit. (Ok, etwas geht vl noch, aber das ist unwesentlich)
rushifell
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 306
Erhaltene Danke: 14



BeitragVerfasst: Mi 09.01.13 17:49 
Hallo,

vielen Dank, die Klasse ist super :zustimm:

Für Delphi2005 musste ich folgende Änderungen vornehmen:

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
//Zeile 108
PCardinal(@FRealSize)^:=GetFileSize(FFile,@Int64Rec(FRealSize).Hi);
//Fehlermeldung: E2036 Variable erforderlich

PCardinal(@FRealSize)^:=GetFileSize(FFile,Pointer(Int64Rec(FRealSize).Hi)); //geändert

//Zeile 285
exit(0);
//Fehlermeldung: E2066 Operator oder Semikolon fehlt

exit;    //geändert


Ich kenne mich mit Pointern nicht gut aus, bitte korrigiert mich, falls an den Änderungen etwas auszusetzen ist.

Viele Grüße
Flamefire Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1207
Erhaltene Danke: 31

Win 10
Delphi 2009 Pro, C++ (Visual Studio)
BeitragVerfasst: Do 14.02.13 20:34 
Beide Änderungen sind leider nicht ganz korrekt: Statt der Adresse des .Hi-Teils Castest du dessen wert auf Pointer. Folge ist u.a. ein Fehler bei den Werten als auch ein möglicher Programmabsturz.
Richtig wäre Pointer(Cardinal(@FRealSize)+4) (für 32Bit systeme!)

exit(0); --> Result:=0;exit;
Sonst fehlt der Rückgabewert.
Martok
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 3661
Erhaltene Danke: 604

Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
BeitragVerfasst: Sa 31.08.13 18:43 
Moin!

Ich hab ein paar kleine Änderungen an der Pointer-Arithmetik, damit FreePascal weniger Warnungen wirft. 64bit hab ich nicht getestet, ist aber garantiert nicht mehr oder weniger kaputt als es vorher war, da ich die Pointer-Size-Typen benutze ;)

Wichtiger: eine Änderung in TFastFileStream.Seek, die dafür sorgt, dass beim sequenziellen Schreiben nicht bei jeder Operation das MMF neu geöffnet wird, sondern nur, wenn die VirtualSize wirklich voll ist. Damit stimmt das dann auch wirklich ;)
user profile iconFlamefire hat folgendes geschrieben Zum zitierten Posting springen:
Die Größe wird intelligent erhöht und erst beim Freigeben des Objektes auf die endgültige Größe gesetzt. D.h. Es kann beliebig gelesen und geschrieben werden, bei maximaler Geschwindigkeit.


Patch im Anhang.

Grüße,
Martok
Einloggen, um Attachments anzusehen!
_________________
"The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."

Für diesen Beitrag haben gedankt: DelphiShark