home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / ATVSRC.RAR / HISTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  6KB  |  229 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {       Virtual Pascal v2.1                             }
  10. {       Copyright (C) 1996-2000 vpascal.com             }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit HistList;
  15.  
  16. {$X+,I-,S-,Cdecl-,Use32+}
  17.  
  18. {****************************************************************************
  19.    History buffer structure:
  20.  
  21.      Longint  String        StrLen Longint String        StrLen
  22.     +----------------------------+----------------------------+--...--+
  23.     |  Id   | History string | L |  Id   | History string | L |
  24.     +----------------------------+----------------------------+--...--+
  25.  
  26.  ***************************************************************************}
  27.  
  28. interface
  29.  
  30. uses Objects;
  31.  
  32. const
  33.   HistoryBlock: Pointer = nil;
  34.   HistorySize: Word = 2*1024;
  35.   HistoryUsed: Word = 0;
  36.  
  37. procedure HistoryAdd(Id: Longint; const Str: String);
  38. function HistoryCount(Id: Longint): Word;
  39. function HistoryStr(Id: Longint; Index: Integer): String;
  40. procedure ClearHistory;
  41.  
  42. procedure InitHistory;
  43. procedure DoneHistory;
  44.  
  45. procedure StoreHistory(var S: TStream);
  46. procedure LoadHistory(var S: TStream);
  47.  
  48. implementation
  49.  
  50. var
  51.   CurId: Longint;
  52.   CurString: PString;
  53.  
  54. { Advance CurString to next string with an ID of CurId }
  55.  
  56. procedure AdvanceStringPointer; assembler; {$USES esi} {$FRAME-}
  57. asm
  58.                 mov     ecx,HistoryUsed
  59.                 mov     edx,CurId
  60.                 mov     esi,CurString
  61.                 test    esi,esi
  62.                 jz      @@4
  63.                 cld
  64.                 cmp     esi,HistoryBlock
  65.                 jne     @@2
  66.                 cmp     esi,ecx
  67.                 je      @@3
  68.               @@1:
  69.                 lodsd                   { History Id  }
  70.                 cmp     eax,edx         { edx = CurId }
  71.                 je      @@4
  72.               @@2:
  73.                 movzx   eax,Byte Ptr [esi]
  74.                 lea     esi,[esi+eax+2]
  75.                 cmp     esi,ecx         { ecx = HistoryUsed }
  76.                 jb      @@1
  77.               @@3:
  78.                 xor     esi,esi
  79.               @@4:
  80.                 mov     CurString,esi
  81. end;
  82.  
  83. { Deletes the current string from the table }
  84.  
  85. procedure DeleteString; assembler; {$USES esi,edi} {$FRAME-}
  86. asm
  87.                 cld
  88.                 mov     ecx,HistoryUsed
  89.                 mov     esi,CurString
  90.                 lea     edi,[esi-TYPE Longint]
  91.                 movzx   eax,Byte Ptr [esi]
  92.                 lea     esi,[esi+eax+2]
  93.                 sub     ecx,esi
  94.                 rep     movsb
  95.                 mov     HistoryUsed,edi
  96. end;
  97.  
  98. { Insert a string into the table }
  99.  
  100. procedure InsertString(Id: Longint; const Str: String); assembler; {$USES ebx,esi,edi} {$FRAME-}
  101. asm
  102. { Position edi to the end the buffer  }
  103. {          edx to beginning of buffer }
  104.                 mov     edx,HistoryBlock
  105.                 mov     edi,HistoryUsed
  106.                 mov     esi,Str
  107.                 movzx   ebx,Byte Ptr [esi]
  108.                 add     ebx,TYPE Longint + TYPE Byte + TYPE Byte
  109.               @@1:
  110.                 mov     eax,edi
  111.                 add     eax,ebx
  112.                 sub     eax,edx         { edx = HistoryBlock }
  113.                 cmp     eax,HistorySize
  114.                 jb      @@2
  115. { Drop the last string off the end of the list }
  116.                 movzx   eax,Byte Ptr [edi-1] { Last string length }
  117.                 sub     edi,eax
  118.                 sub     edi,TYPE Longint + TYPE Byte + TYPE Byte
  119.                 jmp     @@1
  120. { Move the table down the size of the string }
  121.               @@2:
  122.                 std
  123.                 mov     esi,edi
  124.                 add     edi,ebx
  125.                 mov     HistoryUsed,edi
  126.                 mov     ecx,esi
  127.                 sub     ecx,edx         { edx = HistoryBlock }
  128.                 dec     esi
  129.                 dec     edi
  130.                 rep     movsb
  131. { Copy the string into the position }
  132.                 cld
  133.                 mov     edi,edx         { edx = HistoryBlock }
  134.                 mov     eax,Id
  135.                 stosd                   { Id     }
  136.                 mov     esi,Str
  137.                 xor     eax,eax
  138.                 lodsb
  139.                 stosb                   { StrLen }
  140.                 mov     ecx,eax
  141.                 rep     movsb           { String }
  142.                 stosb                   { StrLen }
  143. end;
  144.  
  145. procedure StartId(Id: Longint);
  146. begin
  147.   CurId := Id;
  148.   CurString := HistoryBlock;
  149. end;
  150.  
  151. function HistoryCount(Id: Longint): Word;
  152. var
  153.   Count: Word;
  154. begin
  155.   StartId(Id);
  156.   Count := 0;
  157.   AdvanceStringPointer;
  158.   while CurString <> nil do
  159.   begin
  160.     Inc(Count);
  161.     AdvanceStringPointer;
  162.   end;
  163.   HistoryCount := Count;
  164. end;
  165.  
  166. procedure HistoryAdd(Id: Longint; const Str: String);
  167. begin
  168.   if Str = '' then Exit;
  169.  
  170.   StartId(Id);
  171.  
  172.   { Delete duplicates }
  173.   AdvanceStringPointer;
  174.   while CurString <> nil do
  175.   begin
  176.     if Str = CurString^ then DeleteString;
  177.     AdvanceStringPointer;
  178.   end;
  179.  
  180.   InsertString(Id, Str);
  181. end;
  182.  
  183. function HistoryStr(Id: Longint; Index: Integer): String;
  184. var
  185.   I: Integer;
  186. begin
  187.   StartId(Id);
  188.   for I := 0 to Index do AdvanceStringPointer;
  189.   if CurString <> nil then
  190.     HistoryStr := CurString^ else
  191.     HistoryStr := '';
  192. end;
  193.  
  194. procedure ClearHistory;
  195. begin
  196.   HistoryUsed := Longint(HistoryBlock);
  197. end;
  198.  
  199. procedure StoreHistory(var S: TStream);
  200. var
  201.   Size: Word;
  202. begin
  203.   Size := HistoryUsed - Longint(HistoryBlock);
  204.   S.Write(Size, SizeOf(Word));
  205.   S.Write(HistoryBlock^, Size);
  206. end;
  207.  
  208. procedure LoadHistory(var S: TStream);
  209. var
  210.   Size: Word;
  211. begin
  212.   S.Read(Size, SizeOf(Word));
  213.   S.Read(HistoryBlock^, Size);
  214.   HistoryUsed := Longint(HistoryBlock) + Size;
  215. end;
  216.  
  217. procedure InitHistory;
  218. begin
  219.   GetMem(HistoryBlock, HistorySize);
  220.   ClearHistory;
  221. end;
  222.  
  223. procedure DoneHistory;
  224. begin
  225.   FreeMem(HistoryBlock, HistorySize);
  226. end;
  227.  
  228. end.
  229.