v3k

git-svn-id: https://svn.code.sf.net/p/kolmck/code@81 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

KOL.pas

@@ -14,7 +14,7 @@
   Key Objects Library (C) 2000 by Kladov Vladimir.
 
 ****************************************************************
-* VERSION 3.00.K
+* VERSION 3.00.L
 ****************************************************************
 
   K.O.L. - is a set of objects to create small programs
@@ -1168,7 +1168,12 @@ type
     3: (
          fBaseStream: PStream;
          fFromPos: TStrmSize;
-       )
+       );
+    4: (
+         fBlkSize: Integer;
+         fBlocks: PList;
+         fJustWrittenBlkAddress: Pointer;
+       );
   end;
 
 { ---------------------------------------------------------------------
@@ -1338,6 +1343,12 @@ function WriteMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COM
 procedure CloseMemStream( Strm: PStream );
 procedure SetSizeFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
 
+function ReadMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
+function SeekMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
+function WriteMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
+procedure ResizeMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
+procedure FreeMemBlkStream( Strm: PStream );
+
 function SeekConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
 function GetSizeConcatStream( Strm: PStream ): TStrmSize;
 procedure SetSizeConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
@@ -1417,6 +1428,15 @@ function NewExMemoryStream( ExistingMem: Pointer; Size: DWORD ): PStream;
    to write out of top bound given by Size (i.e. memory can not be resized,
    or reallocated. When stream object is destroyed this memory is not freed. }
 
+function NewMemBlkStream( BlkSize: Integer ): PStream;
+{* Creates memory stream which consists from blocks of given size. Contrary to
+   a memory stream, contents of the blocks stream should not be accessed
+   directly via fMemory but therefore it is possible to access its parts by
+   portions written to blocks still those were written contigously. To do so,
+   get an address of just written portion for further usage via procedure
+   GetAddressOfWrittenBlock. It is guarantee that blocks of memory allocated
+   during write process never are relocated until destruction the stream. }
+
 function NewConcatStream( Stream1, Stream2: PStream ): PStream;
 {* Creates a stream which is a concatenation of two source stream. After
    the call, both source streams are belonging to the resulting stream and these
@@ -24517,6 +24537,10 @@ end;
 
 { TDirList }
 
+{$IFDEF SPEED_FASTER}
+        {$DEFINE DIRLIST_FASTER}
+{$ENDIF}
+
 function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList;
 begin
   New( Result, Create );
@@ -24580,8 +24604,12 @@ end;
 //+
 function TDirList.Get(Idx: Integer): PFindFileData;
 begin
+  {$IFDEF DIRLIST_FASTER}
+  Result := FListPositions.Items[ Idx ];
+  {$ELSE}
   Result := Pointer( Integer( fStoreFiles.fMemory )
       + Integer( FListPositions.Items[ Idx ] ) );
+  {$ENDIF}
 end;
 
 {$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal
@@ -24985,61 +25013,70 @@ begin
     else
       fFilters.Add( Filter );
   end;
-  if Find_First( PKOLChar( FPath + FindFilter( Filter ) ), FindData ) then
+  if  Find_First( PKOLChar( FPath + FindFilter( Filter ) ), FindData ) then
   begin // D[u]fa. fix mem leaks (FList, fFilters)
-    FListPositions := NewList;
+      FListPositions := NewList;
-  while True do
+      while True do
-  begin
+      begin
-    {$IFDEF FORCE_ALTERNATEFILENAME} //+MtsVN
+        {$IFDEF FORCE_ALTERNATEFILENAME} //+MtsVN
-            IsUnicode := FindData.cFileName;
+                IsUnicode := FindData.cFileName;
-            if (IsUnicode <> '.') and (IsUnicode <> '..') then
+                if (IsUnicode <> '.') and (IsUnicode <> '..') then
-            begin
+                begin
-             if pos('?', IsUnicode) > 0 then
+                 if pos('?', IsUnicode) > 0 then
-                 CopyMemory( @FindData.cFileName, @FindData.cAlternateFileName,
+                     CopyMemory( @FindData.cFileName, @FindData.cAlternateFileName,
-                             SizeOf(FindData.cAlternateFileName));
+                                 SizeOf(FindData.cAlternateFileName));
-            end;
+                end;
-    {$ENDIF}
+        {$ENDIF}
-    if SatisfyFilter( PKOLChar(@FindData.cFileName[0]),
+        if SatisfyFilter( PKOLChar(@FindData.cFileName[0]),
-                      FindData.dwFileAttributes, Attr ) then
+                          FindData.dwFileAttributes, Attr ) then
-    begin
-      Action := diAccept;
-      if  Assigned( OnItem ) then
-          OnItem( @Self, FindData, Action );
-      CASE Action OF
-      diSkip: ;
-      diAccept:
         begin
-          if  fStoreFiles = nil then
+          Action := diAccept;
-          begin
+          if  Assigned( OnItem ) then
-              fStoreFiles := NewMemoryStream( );
+              OnItem( @Self, FindData, Action );
-              fStoreFiles.Capacity := 128 * Sizeof( FindData );
+          CASE Action OF
-          end;
+          diSkip: ;
-          FListPositions.Add( Pointer( fStoreFiles.Position ) );
+          diAccept:
-          {$IFDEF UNICODE_CTRLS}
+            begin
-                  {$IFDEF SPEED_FASTER}
+              if  fStoreFiles = nil then
-                          {$IFDEF DIRLIST_OPTIMIZE_ASCII}
+              begin
-                          FindData.dwReserved0 := 0;
+                  {$IFDEF DIRLIST_FASTER}
-                          P := @ FindData.cFileName[0];
+                  fStoreFiles := NewMemBlkStream( 32 * Sizeof( FindData ) );
-                          while P^ <> #0 do
+                  {$ELSE}
-                          begin
+                  fStoreFiles := NewMemoryStream( );
-                              if  PWord( P )^ > 255 then
+                  fStoreFiles.Capacity := 64 * Sizeof( FindData );
-                              begin
-                                  inc( FindData.dwReserved0 );
-                                  break;
-                              end;
-                              inc( P );
-                          end;
-                          {$ENDIF}
                   {$ENDIF}
-          {$ENDIF}
+              end;
-          fStoreFiles.Write( FindData, Sizeof( FindData ) );
+              {$IFDEF DIRLIST_FASTER}{$ELSE}
+              FListPositions.Add( Pointer( fStoreFiles.Position ) );
+              {$ENDIF}
+              {$IFDEF UNICODE_CTRLS}
+                      {$IFDEF SPEED_FASTER}
+                              {$IFDEF DIRLIST_OPTIMIZE_ASCII}
+                              FindData.dwReserved0 := 0;
+                              P := @ FindData.cFileName[0];
+                              while P^ <> #0 do
+                              begin
+                                  if  PWord( P )^ > 255 then
+                                  begin
+                                      inc( FindData.dwReserved0 );
+                                      break;
+                                  end;
+                                  inc( P );
+                              end;
+                              {$ENDIF}
+                      {$ENDIF}
+              {$ENDIF}
+              fStoreFiles.Write( FindData, Sizeof( FindData ) );
+              {$IFDEF DIRLIST_FASTER}
+              FListPositions.Add( fStoreFiles.fData.fJustWrittenBlkAddress );
+              {$ENDIF}
+            end;
+          diCancel: break;
+          END;
         end;
-      diCancel: break;
+        if not Find_Next( FindData ) then break;
-      END;
+      end;
-    end;
+      Find_Close( FindData );
-    if not Find_Next( FindData ) then break;
-  end;
-  Find_Close( FindData );
   end;
   Free_And_Nil(fFilters); //D[u]fa
   {$IFnDEF SPEED_FASTER}
@@ -27627,8 +27664,7 @@ end;
 
 // by Roman Vorobets:
 procedure SetSizeFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
-var
+var P: DWORD;
-  P: DWORD;
 begin
   P:=Strm.Position;
   Strm.Position:=NewSize;
@@ -27637,6 +27673,134 @@ begin
     Strm.Position:=P;
 end;
 
+function ReadMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
+var P, bStart, bLen, C: DWORD;
+    bAddr: PByte;
+    i: Integer;
+begin
+    P := Strm.Position;
+    i := 0;
+    bStart := 0;
+    bLen := 0;
+    bAddr := nil;
+    while i < Strm.fData.fBlocks.Count do
+    begin
+        bAddr := Strm.fData.fBlocks.fItems[i];
+        bLen := Integer( Strm.fData.fBlocks.fItems[i+1] );
+        if  bStart + bLen > P then
+            break;
+        inc( i, 2 );
+        inc( bStart, bLen );
+    end;
+    if  bStart + bLen < P then
+    begin
+        Result := 0;
+        Exit;
+    end;
+    inc( bAddr, P - bStart );
+    C := Count;
+    if  C > bLen - (P - bStart) then
+        C := bLen - (P - bStart);
+    if  C > 0 then
+        Move( bAddr^, Buffer, C );
+    Result := C;
+    inc( Strm.fData.fPosition, C );
+end;
+
+function SeekMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
+var P: Integer;
+begin
+    P := MoveTo;
+    CASE MoveFrom OF
+    spCurrent: P := P + Integer( Strm.fData.fPosition );
+    spEnd:     P := P + Integer( Strm.fData.fSize );
+    END;
+    if  P < 0 then P := 0;
+    if  P > Integer( Strm.fData.fSize ) then
+        P := Strm.fData.fSize;
+    Strm.fData.fPosition := P;
+    Result := P;
+end;
+
+function WriteMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
+var LastBlkAddr: PByte;
+    LastBlkUsed, C: Integer;
+    NewBlkSz: Integer;
+begin
+    C := Strm.fData.fBlocks.Count;
+    LastBlkUsed := Strm.fData.fBlkSize;
+    LastBlkAddr := nil;
+    if  C > 1 then
+    begin
+        LastBlkAddr := Strm.fData.fBlocks.Items[C-2];
+        LastBlkUsed := Integer( Strm.fData.fBlocks.Items[C-1] );
+    end;
+    if  Strm.fData.fBlkSize - LastBlkUsed < Integer( Count ) then
+    begin
+        NewBlkSz := Strm.fData.fBlkSize;
+        if  NewBlkSz < Integer( Count ) then
+            NewBlkSz := Count;
+        GetMem( LastBlkAddr, NewBlkSz );
+        LastBlkUsed := 0;
+        Strm.fData.fBlocks.Add( LastBlkAddr );
+        Strm.fData.fBlocks.Add( nil );
+        inc( C, 2 );
+    end;
+    inc( LastBlkAddr, LastBlkUsed );
+    Strm.fData.fJustWrittenBlkAddress := LastBlkAddr;
+    Move( Buffer, LastBlkAddr^, Count );
+    inc( LastBlkUsed, Count );
+    Strm.fData.fBlocks.fItems[ C-1 ] := Pointer( LastBlkUsed );
+    inc( Strm.fData.fSize, Count );
+    Strm.fData.fPosition := Strm.fData.fSize;
+    Result := Count;
+end;
+
+procedure ResizeMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
+var i, del: Integer;
+    LastBlkAddr: PByte;
+    LastBlkUsed: Integer;
+begin
+    while Strm.fData.fSize > NewSize do
+    begin
+        i := Strm.fData.fBlocks.Count-2;
+        LastBlkAddr := Strm.fData.fBlocks.fItems[i];
+        LastBlkUsed := Integer( Strm.fData.fBlocks.fItems[i+1] );
+        del := Strm.fData.fSize - NewSize;
+        if  del >= LastBlkUsed then
+        begin
+            FreeMem( LastBlkAddr );
+            Strm.fData.fBlocks.DeleteRange( i, 2 );
+            dec( Strm.fData.fSize, LastBlkUsed );
+        end
+          else
+        begin
+            Strm.fData.fBlocks.fItems[ i+1 ] := Pointer( LastBlkUsed - del );
+            dec( Strm.fData.fSize, del );
+        end;
+    end;
+    if  Strm.fData.fSize > Strm.fData.fPosition then
+        Strm.fData.fPosition := Strm.fData.fSize;
+end;
+
+procedure FreeMemBlkStream( Strm: PStream );
+var i: Integer;
+begin
+    i := 0;
+    while i < Strm.fData.fBlocks.Count do
+    begin
+        FreeMem( Strm.fData.fBlocks.fItems[i] );
+        inc( i, 2 );
+    end;
+    {$IFDEF SAFE_CODE}
+    Free_And_Nil( Strm.fData.fBlocks );
+    Strm.fData.fPosition := 0;
+    Strm.fData.fSize := 0;
+    {$ELSE}
+    Strm.fData.fBlocks.Free;
+    {$ENDIF}
+end;
+
 function SeekConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
 var NewPos: TStrmSize;
 begin
@@ -27997,6 +28161,20 @@ begin
   Result.fMethods.fClose := DummyClose_ExMemStream;
 end;
 
+function NewMemBlkStream( BlkSize: Integer ): PStream;
+begin
+  Result := NewMemoryStream;
+  Result.fData.fBlkSize := BlkSize;
+  Result.fData.fBlocks := NewList;
+  Result.fMethods.fWrite := WriteMemBlkStream;
+  Result.fMethods.fSetSiz := DummySetSize;
+  Result.fMethods.fClose := DummyClose_ExMemStream;
+  Result.fMethods.fRead := ReadMemBlkStream;
+  Result.fMethods.fSeek := SeekMemBlkStream;
+  Result.fMethods.fSetSiz := ResizeMemBlkStream;
+  Result.Add2AutoFreeEx( TObjectMethod( MakeMethod( Result, @FreeMemBlkStream ) ) );
+end;
+
 function NewConcatStream( Stream1, Stream2: PStream ): PStream;
 begin
   Result := _NewStream( ConcatStreamMethods );
@@ -34378,6 +34556,10 @@ asm
         {$ENDIF}
         MOV      EDX, offset[ListBoxClass]
         CALL     _NewControl
+        {$IFDEF  PACK_COMMANDACTIONS}
+        MOV      EDX, [EAX].TControl.fCommandActions
+        MOV      [EDX].TCommandActionsObj.aClear, offset[ClearListbox]
+        {$ENDIF}
         ADD      [EAX].TControl.fBoundsRect.Right, 100
         ADD      [EAX].TControl.fBoundsRect.Bottom, 200-64
         MOV      [EAX].TControl.fColor, clWindow
@@ -34393,6 +34575,9 @@ begin
                          or LBS_NOTIFY or Flags, True,
                          {$IFDEF PACK_COMMANDACTIONS} ListActions_Packed
                          {$ELSE}                      @ListActions {$ENDIF} );
+  {$IFDEF PACK_COMMANDACTIONS}
+          Result.fCommandActions.aClear := ClearListbox;
+  {$ENDIF}
   {$IFDEF DEBUG_OBJKIND}
   Result.fObjKind := 'TControl:Listbox';
   {$ENDIF}