Autor |
Beitrag |
Flamefire
Beiträge: 1207
Erhaltene Danke: 31
Win 10
Delphi 2009 Pro, C++ (Visual Studio)
|
Verfasst: 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.
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:
|
unit unFastFileStream;
interface
uses Windows, Classes, SysUtils, RTLConsts;
type TFastFileStream = class(TStream) private FPointer: Pointer; FFile, FMapping: THandle; FRealSize, FVirtualSize, FBufferPos, FBufferSize, FCurBufferSize, FAllocationGranularity, FPosInBuffer: Int64; 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
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<>0) then begin if(FReadOnly) then access:=PAGE_READONLY else access:=PAGE_READWRITE; FMapping := CreateFileMapping(FFile, nil, access, 0, 0, nil); if(GetLastError()<>0) then 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()<>0) then 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>0) then 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>=0) then 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<0) then 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 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>0) do begin iRemain:=FCurBufferSize-FPosInBuffer; if(iRemain<Count) then begin if(Position>=Size) then break; if(iRemain>0) then 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;
curPos:=Position; if(curPos+Count>Size) then begin SetSizeInternal(curPos+Count,False); end;
pSrc:=@Buffer; while(Count>0) do begin iRemain:=FCurBufferSize-FPosInBuffer; if(iRemain<Count) then begin if(iRemain>0) then 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
Beiträge: 90
Win XP, Win 7
Delphi 7 Enterprise, Delphi 2009
|
Verfasst: So 27.06.10 15:16
in wie fern ist diese jetzt schneller?
|
|
jaenicke
Beiträge: 19288
Erhaltene Danke: 1743
W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
|
Verfasst: 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
Beiträge: 90
Win XP, Win 7
Delphi 7 Enterprise, Delphi 2009
|
Verfasst: So 27.06.10 16:47
gilt das auch für's schreiben?
(in meinem Fall für einen Downloader)
|
|
jaenicke
Beiträge: 19288
Erhaltene Danke: 1743
W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
|
Verfasst: 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
Beiträge: 1207
Erhaltene Danke: 31
Win 10
Delphi 2009 Pro, C++ (Visual Studio)
|
Verfasst: So 27.06.10 20:16
jaenicke hat folgendes geschrieben : | 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
Beiträge: 306
Erhaltene Danke: 14
|
Verfasst: Mi 09.01.13 17:49
Hallo,
vielen Dank, die Klasse ist super
Für Delphi2005 musste ich folgende Änderungen vornehmen:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11:
| PCardinal(@FRealSize)^:=GetFileSize(FFile,@Int64Rec(FRealSize).Hi);
PCardinal(@FRealSize)^:=GetFileSize(FFile,Pointer(Int64Rec(FRealSize).Hi)); exit(0);
exit; |
Ich kenne mich mit Pointern nicht gut aus, bitte korrigiert mich, falls an den Änderungen etwas auszusetzen ist.
Viele Grüße
|
|
Flamefire
Beiträge: 1207
Erhaltene Danke: 31
Win 10
Delphi 2009 Pro, C++ (Visual Studio)
|
Verfasst: 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
Beiträge: 3661
Erhaltene Danke: 604
Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
|
Verfasst: 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
Flamefire hat folgendes geschrieben : | 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
|
|
|