Статьи Королевства Дельфи

         

procedure Init; procedure Free; end;


Type MyRec = Record A, B : Real; Q, X : Integer; End; MyRecPtr = ^MyRec; VMayRec = object VAddr : VirtualPtr; {- Virtual heap Address -} function Addr : MyRecPtr; procedure Init; procedure Free; end; function VMyRec.Addr : MyRecPtr; begin RESULT := VirtualToPtr( VAddr ); End; Procedure VMyRec.Init; Begin VAddr := GetVMem( SizeOf( MyRec ) ); End; Procedure VmayRec.Free; Begin FreeVMem( Vaddr ); End; ... Var MR : VMayRec; Begin // InitVHeap( имя файла, оставить после выполнения программы) InitVHeap( 'F.vhp', True ); if VHeapStatus = OldVHeap then MR.VAddr := VHBases[ User01 ] else MR.Init; ... With MR.Addr^ do begin Q := Pi; ... ...
Чтобы сохранить виртуальный адрес до следующего запуска программы его нужно записать в один из базовых адресов перед завершением : VHBases[ User01 ] := MR.VAddr; Для строковых переменных свои отдельные функции по образу Turbo/Object Professional : StringToVHeap( S : String ) : VPtr и StringFromVHeap( VP : VPtr ) : String;

Первая записывает строка в виртуальную память и возвращает виртуальный адрес, вторая по виртуальному адресу возвращает строку.

Модуль еще не полностью переделан под среду Delphi. В нем исправлены лишь явные ошибки, мешающие компилятору. Реализовать все можно абсолютно по-другому и на более высоком уровне. Я, хотел лишь осветить саму идею. Могу добавить, что под ДОС все работало. Была даже программа для разработки структур данных виртуальной памяти. Результатом ее работы был исходный текст модуля с описанием типов объектов и реализацией их методов. К сожалению, программа и ее исходный текст были потеряны вместе с HDD…

{$A-} unit VHEAPLow; {*********************************************************} {* VHEAPLOW.PAS 7.0 *} {* Writen by HNV 1991,92. *} {* Low level support for virtual heap. *} {*********************************************************} interface uses Classes, Dialogs, OpStrDev, SysUtils; const MaxFree = 256; {- size of free list -} type VirtualPtr = Real; VirtualPtrRec = record Len : LongWord; Addr : LongWord; end; Base = array[ 0..11 ] of VirtualPtr; UserBasesType = ( User01, User02, User03, User04, User05, User06, User07, User08, User09, User10 ); VHeapStatus = { Virtual Heap Status } ( NewVHeap, OldVHeap ); const UseKeyAccess : Boolean = false; { True if use key access } ShowHeapStatus : Boolean = false; { True if need show statistics } MaxHeapSpace : LongWord = 0; { Disk Free } } SaveVHeap : Boolean = False; { true if need saving v-heap } VHeapOk : Boolean = true; { VHeap Error flag } BaseAddr : Base = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ); VHeapCacheProc : Pointer = nil; { Addres of function VirtualToPtr } VHeapErrorProc : Pointer = nil; { Addres of VHeap error routine } {- Virtual Heap File Caching -} MaxCacheSize : LongWord = 0; {- Maximum size of cache -} CacheHeapRatio : Real = 0.5; {- CacheSize / HeapSize -} BytesInCache : LongWord = 0; {- Cache use -} MinCacheLevel : Byte = 8; {- Min number of caching records -} CacheLevel : LongWord = 0; {- Current number of caching records -} CacheRead : LongWord = 0; {- Number of reading records -} CacheWrite : LongWord = 0; {- Number of swaping records -} CacheHits : LongWord = 0; {- Number of cache hits -} CacheEff : Real = 0; {- Caching effect -} CacheSearch : LongWord = 0; {- Cache routine calls -} var VHBases : array[ UserBasesType ] of VirtualPtr Absolute BaseAddr; VHStatus : VHeapStatus; {- Virtual Heap status -} type StringPtr = ^string; VString = object VAddr : VirtualPtr; {- Virtual heap Address -} function Addr : StringPtr; procedure Init; procedure Free; end; procedure InitVHeap( FName : string; Save : Boolean ); {- Initiator of Virtual Heap -} function GetVMem( L : Word ) : VirtualPtr; {- Allocate virtual space -} procedure FreeVMem( V : VirtualPtr ); {- Deallocate virtual space -} function VirtualToPtr( V : VirtualPtr ) : Pointer; {- Converted a virtual pointer to real pointer -} function StrVPtr( V : VirtualPtr ) : StringPtr; {- Converted a virtual pointer to real pointer -} procedure SetCaching( TF : Boolean ); {- Turn Caching OFF if TF is false. -} function StructToVHeap( var S; L : Word ) : VirtualPtr; {- Allocate space for S and return virtual pointer -} procedure StructFromVHeap( var S; V : VirtualPtr ); {- Return S at virtual pointer V -} function StringToVHeap( S : string ) : VirtualPtr; {- Allocate space for S and return virtual pointer -} function StringFromVHeap( V : VirtualPtr ) : string; {- Return S at virtual pointer V -} procedure Statistics( ST : TStrings ); {- Show virtual heap staistics on the screen. -} implementation type FreeListA = array[ 1..MaxFree ] of VirtualPtrRec; FreeListV = array[ 1..MaxFree ] of VirtualPtr; FreeListVHeap = record NFree : LongWord; case Byte of 1 : ( FreeL : FreeListA ); 2 : ( FreeV : FreeListV ); end; FreeListPtrV = ^FreeListVHeap; type CacheAddr = ^CacheRec; CacheRec = record Next : CacheAddr; RecA : Pointer; case byte of 1 : ( HAddr : VirtualPtr ); 2 : ( VRec : VirtualPtrRec ); end; const MaxHeapAddr : LongWord = $7FFFFFFF; MaxHeapBlock : LongWord = $7FFFFFFF; MinHeapBlock : LongWord = 1; HeaderVHeap : string = 'HNV(C)VIRTUAL HEAP FILE V 1.0'; HeaderVFree : string = 'FREE BLOCKS LIST'; Init : Boolean = False; StructRPtr : Pointer = nil; StructVPtr : VirtualPtr = 0; UseFactor : LongWord = 0; DelFreeArea : LongWord = 0; VHeapOrg : LongWord = 0; {- begin of virtual heap -} VHeapPtr : LongWord = 0; {- end of heap -} Caching : Boolean = True; Cache : CacheAddr = nil; var OldExit : Pointer; FreeListArea : FreeListPtrV; F : file; FileName : string; function VString.Addr : StringPtr; begin if VAddr <> 0 then Addr := VirtualToPtr( VAddr ) else begin VAddr := GetVMem( Succ( SizeOf( string ) ) ); Addr := VirtualToPtr( VAddr ); end; end; procedure VString.Init; begin VAddr := 0; end; procedure VString.Free; begin FreeVMem( VAddr ); end; procedure VHeapError( S : string ); begin ShowMessage( S ); Halt( 1 ); end; procedure Abort( S : string ); begin {Inline( $FF/$1E/>VHeapErrorProc );} VHeapError( S ) end; function AllocateFreeList : Pointer; var i : Word; P : Pointer; begin GetMem( P, SizeOf( FreeListVHeap ) ); with FreeListPtrV( P )^ do begin NFree := 0; for i := 1 to MaxFree do begin FreeL[ i ].Len := 0; FreeL[ i ].Addr := 0; end; end; AllocateFreeList := P; end; procedure Store( var S; V : VirtualPtr ); var i : LongWord; VR : VirtualPtrRec Absolute V; begin Inc( CacheWrite ); VHeapOk := True; Seek( F, VR.Addr ); BlockWrite( F, S, VR.Len, i ); VHeapOk := i = VR.Len; end; procedure Load( var S; V : VirtualPtr ); var i : LongWord; VR : VirtualPtrRec Absolute V; begin Inc( CacheRead ); VHeapOk := True; Seek( F, VR.Addr ); BlockRead( F, S, VR.Len, i ); VHeapOk := i = VR.Len; end; procedure LoSwapProc( var P : Pointer; V1, V2 : VirtualPtr ); var VR1 : VirtualPtrRec Absolute V1; VR2 : VirtualPtrRec Absolute V2; begin if P <> nil then begin Store( P^, V1 ); FreeMem( P, VR1.Len ); end; if not VHeapOk then exit; GetMem( P, VR2.Len ); Load( P^, V2 ); end; function LoCacheProc( V : VirtualPtr ) : Pointer; begin VHeapOk := True; if StructVPtr <> V then begin LoSwapProc( StructRPtr, StructVPtr, V ); LoCacheProc := StructRPtr; end else LoCacheProc := StructRPtr; end; procedure CacheNormalizing( L : LongWord ); {--------------------------------------} { Normalizing of Cache size to L value } {--------------------------------------} var P, T : CacheAddr; Done : Boolean; begin repeat P := Cache; T := P; Done := True; while ( BytesInCache + L > MaxCacheSize ) and ( P <> nil ) do with P^ do if Next = nil then begin Store( RecA^, HAddr ); Dec( BytesInCache, VRec.Len ); { Decrement Cache length } if CacheLevel 'INSSUFICIENT MEMORY FOR CACHING.' ); WriteLn( 'PROGRAM TERMINATED.' ); Abort( '$16 CRITICAL ERROR.' ); end; Dec( CacheLevel ); { Decrement Cache level } FreeMem( RecA, VRec.Len ); { Dispose structure } if T <> P then T^.Next := nil { goto next Cache record } else Cache := nil; FreeMem( P, SizeOf( CacheRec ) ); { dispose Cache record } P := nil; Done := False; end else begin T := P; P := Next; end; until Done; end; function AddRecToCache( V : VirtualPtr ) : Pointer; { addition new Cache record to Cache structure } var P : CacheAddr; VR : VirtualPtrRec Absolute V; begin GetMem( P, SizeOf( CacheRec ) ); with P^ do begin Next := Cache; Cache := P; GetMem( RecA, VR.Len ); Inc( CacheLevel ); {- -} Load( RecA^, V ); Inc( BytesInCache, VR.Len ); HAddr := V; AddRecToCache := RecA; end; end; procedure DelCacheRec( V : VirtualPtr ); { deleting Cache record from Cache structure. uses in FreeVmem } var P, T : CacheAddr; begin if not Caching then { exit if Caching is not active } exit; { search a virtual heap pointer in Cache structure } P := Cache; T := P; while P <> nil do with P^ do if HAddr = V then begin Dec( BytesInCache, VRec.Len ); { Decrement Cache length } FreeMem( RecA, VRec.Len ); { Dispose this structure } if T <> P then T^.Next := P^.Next { go to next Cache record } else Cache := P^.Next; { go to next Cache record } FreeMem( P, SizeOf( CacheRec ) ); { dispose Cache record } exit; end else begin T := P; P := Next; end; end; {-------------------------------------------------------} { Center function of VHeapLow unit } { converted a virtual heap pointer to real heap pointer } {-------------------------------------------------------} function VirtualToPtr( V : VirtualPtr ) : Pointer; var P, T : CacheAddr; VR : VirtualPtrRec Absolute V; begin Inc( CacheSearch ); if ( VR.Addr < VHeapOrg ) or ( VR.Addr + VR.Len > VHeapPtr ) then Abort( '$46 Invalid virtual pointer.' ); P := Cache; T := P; while P <> nil do if P^.HAddr = V then begin {- Set top of cache -} if T <> P then begin T^.Next := P^.Next; P^.Next := Cache; Cache := P; end; VirtualToPtr := P^.RecA; Inc( CacheHits ); exit; end else begin T := P; P := P^.Next; end; CacheNormalizing( VR.Len ); VirtualToPtr := AddRecToCache( V ); end; function StrVPtr( V : VirtualPtr ) : StringPtr; {- Converted a virtual pointer to string pointer -} begin StrVptr := VirtualToPtr( V ); end; procedure FlushOldRec; begin if StructRPtr <> nil then Store( StructRPtr^, StructVPtr ); end; procedure SetCaching( TF : Boolean ); {- turn Caching OFF if TF is false -} begin end; function ReadLongWord( var F : file ) : LongWord; var L : LongWord; i : LongWord; begin VHeapOk := True; BlockRead( F, L, SizeOf( LongWord ), i ); if i <> SizeOf( LongWord ) then Abort( '$0B initialization error.' ); ReadLongWord := L; end; function ReadString( var F : file ) : string; var i : LongWord; S : string; begin VHeapOK := True; ReadString := ''; i := ReadLongWord( F ); ShowMessage( intToStr( i ) ); SetLength( S, i ); BlockRead( F, S[ 1 ], i, i ); if i <> Length( S ) then Abort( '$0A Initialization Error.' ); ReadString := S; end; function ReadVirtualPtr( var F : file ) : VirtualPtr; var L : VirtualPtr; i : LongWord; begin VHeapOk := True; BlockRead( F, L, SizeOf( VirtualPtr ), i ); if i <> SizeOf( VirtualPtr ) then Abort( '$13 initialization error.' ); ReadVirtualPtr := L; end; function ReadBoolean( var F : file ) : Boolean; var L : Boolean; i : LongWord; begin VHeapOk := True; BlockRead( F, L, SizeOf( Boolean ), i ); if i <> SizeOf( Boolean ) then Abort( '$0D initialization error.' ); ReadBoolean := L; end; procedure WriteLongWord( var F : file; L : LongWord ); var i : LongWord; begin VHeapOk := True; BlockWrite( F, L, SizeOf( LongWord ), i ); if i <> SizeOf( LongWord ) then Abort( '$10 initialization error.' ); end; procedure WriteString( var F : file; S : string ); var i : LongWord; begin VHeapOK := True; WriteLongWord( F, Length( S ) ); BlockWrite( F, S[ 1 ], Length( S ), i ); if i <> Length( S ) then Abort( '$0F Initialization Error.' ); end; procedure WriteVirtualPtr( var F : file; L : VirtualPtr ); var i : LongWord; begin VHeapOk := True; BlockWrite( F, L, SizeOf( VirtualPtr ), i ); if i <> SizeOf( VirtualPtr ) then Abort( '$12 initialization error.' ); end; procedure WriteBoolean( var F : file; L : Boolean ); var i : LongWord; begin VHeapOk := True; BlockWrite( F, L, SizeOf( Boolean ), i ); if i <> SizeOf( Boolean ) then Abort( '$11 initialization error.' ); end; procedure StoreHeader; begin Seek( F, 0 ); WriteString( F, HeaderVHeap ); WriteLongWord( F, UseFactor ); WriteLongWord( F, DelFreeArea ); WriteLongWord( F, VHeapOrg ); WriteLongWord( F, VHeapPtr ); end; procedure StoreBase; var i : Word; begin for i := 0 to 11 do WriteVirtualPtr( F, BaseAddr[ i ] ); end; procedure StoreFreeList; var i : Word; begin WriteString( F, HeaderVFree ); WriteLongWord( F, FreeListArea^.NFree ); for i := 1 to MaxFree do WriteVirtualPtr( F, FreeListArea^.FreeV[ i ] ); end; procedure LoadHeader; begin Seek( F, 0 ); HeaderVHeap := ReadString( F ); UseFactor := ReadLongWord( F ); DelFreeArea := ReadLongWord( F ); VHeapOrg := ReadLongWord( F ); VHeapPtr := ReadLongWord( F ); end; procedure LoadBase; var i : Word; begin for i := 0 to 11 do BaseAddr[ i ] := ReadVirtualPtr( F ); end; procedure LoadFreeList; var i : Word; begin if ReadString( F ) <> HeaderVFree then Abort( '$32 file is not Virtual Heap' ); FreeListArea^.NFree := ReadLongWord( F ); for i := 1 to MaxFree do FreeListArea^.FreeV[ i ] := ReadVirtualPtr( F ); end; function HasExtension( Name : string; var DotPos : Word ) : Boolean; {-Return whether and position of extension separator dot in a pathname} var I : Word; begin DotPos := 0; for I := Length( Name ) downto 1 do if ( Name[ I ] = '.' ) and ( DotPos = 0 ) then DotPos := I; HasExtension := ( DotPos > 0 ) and ( Pos( '\', Copy( Name, Succ( DotPos ), 64 ) ) = 0 ); end; function ForceExtension( Name, Ext : string ) : string; {-Return a pathname with the specified extension attached} var DotPos : Word; begin if HasExtension( Name, DotPos ) then ForceExtension := Copy( Name, 1, DotPos ) + Ext else ForceExtension := Name + '.' + Ext; end; procedure MakeNewVHeap; var i : Word; begin StoreHeader; for i := 0 to 11 do begin BaseAddr[ i ] := 0; end; StoreBase; FreeListArea^.NFree := 0; StoreFreeList; VHeapOrg := FilePos( F ); VHeapPtr := VHeapOrg; StoreHeader; end; procedure VHeapExit; begin if SaveVHeap then begin if Caching then begin CacheNormalizing( MaxCacheSize ); if Cache <> nil then WriteLn( ' Cache ERROR.' ); end else FlushOldRec; StoreHeader; StoreBase; StoreFreeList; Seek( F, VHeapPtr ); Truncate( F ); Close( F ); end else begin Close( F ); Erase( F ); end; end; { --------------------------- GetVmem --------------------------------} function GetVmemPrim( L : Word ) : VirtualPtr; var V : VirtualPtr; VR : VirtualPtrRec Absolute V; j : Word; K : LongWord; procedure SetVHeapPtr; begin VR.Len := L; VR.Addr := VHeapPtr; Inc( VHeapPtr, L ); end; function Hole : Word; var i : Word; begin Hole := 0; with FreeListArea^ do begin K := MaxHeapBlock; for i := 1 to NFree do if ( FreeL[ i ].Len >= L ) and ( ( FreeL[ i ].Len - L ) < K ) then begin K := FreeL[ i ].Len - L; Hole := i; end; end; end; begin with FreeListArea^ do if NFree = 0 then begin SetVHeapPtr; GetVmemPrim := V; exit; end else begin { Search of Minimum Heap Hole } j := Hole; if j <> 0 then begin VR.Len := L; VR.Addr := FreeL[ j ].Addr; Dec( FreeL[ j ].Len, L ); Inc( FreeL[ j ].Addr, L ); if FreeL[ j ].Len = 0 then begin FreeV[ j ] := FreeV[ NFree ]; Dec( NFree ); end; GetVmemPrim := V; exit; end; SetVHeapPtr; GetVmemPrim := V; end; end; function GetVmem( L : Word ) : VirtualPtr; var V : VirtualPtr; P : ^Byte; begin VHeapOk := True; V := GetVmemPrim( L ); GetMem( P, L ); Store( P^, V ); Freemem( P ); if not VHeapOk then GetVmem := VHeapPtr else GetVmem := V; Dec( MaxHeapSpace, L ); end; { --------------------------- GetVmem --------------------------------} { --------------------------- FreeVmem --------------------------------} procedure SortFreeListByAddress; procedure Sort( l, r : Word ); var i, j : Word; x : LongWord; y : VirtualPtr; begin with FreeListArea^ do begin i := l; j := r; x := FreeL[ ( l + r ) div 2 ].Addr; repeat while FreeL[ i ].Addr < x do i := i + 1; while x < FreeL[ j ].Addr do j := j - 1; if i j; if l < j then sort( l, j ); if i < r then sort( i, r ); end; end; begin {quicksort} ; sort( 1, FreeListArea^.NFree ); end; function ReorgFreeList : Boolean; var Q : LongWord; i : Word; begin ReorgFreeList := False; with FreeListArea^ do begin if NFree MaxHeapBlock then exit; Inc( FreeL[ i ].Len, FreeL[ i + 1 ].Len ); FreeV[ i + 1 ] := FreeV[ NFree ]; Dec( NFree ); ReorgFreeList := True; exit; end; end; end; procedure FreeVmem( V : VirtualPtr ); { Erased a virtual heap pointer } var VR : VirtualPtrRec Absolute V; i : Word; K, j : Word; begin DelCacheRec( V ); { free real heap space if Caching is active } with FreeListArea^ do begin if ( VR.Addr + VR.Len ) <> VHeapPtr then begin if ( NFree + 1 ) > MaxFree then begin K := MaxHeapBlock; j := 1; for i := 1 to MaxFree do if FreeL[ i ].Len < K then begin K := FreeL[ i ].Len; j := i; end; FreeV[ j ] := V; end else begin Inc( NFree ); FreeV[ NFree ] := V; end; end else Dec( VHeapPtr, VR.Len ); repeat if NFree > 1 then SortFreeListByAddress; until not ReorgFreeList; end; end; function StructToVHeap( var S; L : Word ) : VirtualPtr; var V : VirtualPtr; begin StructToVHeap := 0; VHeapOk := True; V := GetVMemPrim( L ); if not VHeapOk then exit; Store( S, V ); StructToVHeap := V; end; procedure StructFromVHeap( var S; V : VirtualPtr ); begin VHeapOk := True; Load( S, V ); end; function StringToVHeap( S : string ) : VirtualPtr; var V : VirtualPtr; begin StringToVHeap := 0; VHeapOk := True; V := GetVMemPrim( Length( S ) ); if not VHeapOk then exit; Store( S, V ); StringToVHeap := V; end; function StringFromVHeap( V : VirtualPtr ) : string; begin VHeapOk := True; StringFromVHeap := StringPtr( VirtualToPtr( V ) )^; end; procedure Statistics( ST : TStrings ); var i : Word; begin with FreeListArea^ do begin UseFactor := 0; if NFree > 0 then for i := 1 to NFree do UseFactor := UseFactor + FreeL[ i ].Len; end; Write( TPStr, '------------ VIRTUAL HEAP STATISTICS ---------------' ); ST.Add( ReturnStr ); Write( TPStr, 'і --- Heap --- і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Bytes in Heap......................: ', VHeapPtr - VHeapOrg : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Start Virtual Heap Address.........: ', VHeapOrg : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Bytes available to Virtual Heap....: ', MaxHeapSpace : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і і' ); ST.Add( ReturnStr ); Write( TPStr, '----------------------------------------------------' ); ST.Add( ReturnStr ); Write( TPStr, 'і --- Holes --- і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Number of Heap Holes...............: ', FreeListArea^.NFree : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Bytes in accessible Heap Holes.....: ', UseFactor : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Bytes in not accessible Heap Holes.: ', DelFreeArea : 10, ' і' ); ST.Add( ReturnStr ); if ( VHeapPtr - VHeapOrg ) <> 0 then Write( TPStr, 'і Percent Holes in Heap..............: ', ( UseFactor + DelFreeArea ) / ( VHeapPtr - VHeapOrg + UseFactor ) * 100 : 8 : 4, ' % і' ); ST.Add( ReturnStr ); Write( TPStr, 'і --- Cache --- і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Bytes in Cache.....................: ', BytesInCache : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і General Cache Space................: ', MaxCacheSize : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Cache Level........................: ', CacheLevel : 10, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і Disk Input : ', CacheRead : 10, '; Output : ', CacheWrite : 10, ' і' ); ST.Add( ReturnStr ); if CacheSearch <> 0 then Write( TPStr, 'і Cache Hits : ', CacheHits : 10, '; Eff [%] : ', CacheHits / CacheSearch * 100 : 10 : 3, ' і' ); ST.Add( ReturnStr ); Write( TPStr, 'і і' ); ST.Add( ReturnStr ); Write( TPStr, '----------------------------------------------------' ); ST.Add( ReturnStr ); end; procedure CalcDiskSize( FName : string ); begin if Pos( ':', FName ) <> 0 then MaxHeapSpace := DiskFree( Pos( UpCase( FName[ 1 ] ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ) ) else MaxHeapSpace := DiskFree( 0 ); end; procedure InitVHeap( FName : string; Save : Boolean ); begin if Init then Abort( '$25 Double Initialization.' ); FileName := FName; SaveVHeap := Save; FreeListArea := AllocateFreeList; if CacheHeapRatio > 0.8 then CacheHeapRatio := 0.8; MaxCacheSize := Trunc( MaxHeapAddr * CacheHeapRatio ); Assign( F, FName ); if not FileExists( FName ) then begin Rewrite( F, 1 ); MakeNewVHeap; VHStatus := NewVHeap; CalcDiskSize( FName ); end else begin Reset( F, 1 ); VHStatus := OldVHeap; if ReadString( F ) <> HeaderVHeap then Abort( 'file is not Virtual Heap.' ); LoadHeader; LoadBase; LoadFreeList; Init := True; CalcDiskSize( FName ); end; end; initialization finalization VHeapExit; end.
Для данного материала нет комментариев.



Содержание  Назад  Вперед