home *** CD-ROM | disk | FTP | other *** search
/ Windoware / WINDOWARE_1_6.iso / winutil / dsiz10 / dsize.pas < prev    next >
Pascal/Delphi Source File  |  1991-06-23  |  19KB  |  692 lines
  1. {DSize - 1.0 Program Copyright (C) Doug Overmyer 6/22/91}
  2. program DSize;
  3.  
  4. {$S-}{$I-}
  5. {$R DSIZE.RES}
  6. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  7.  
  8. const
  9.   id_But1    = 201;
  10.   id_But2    = 202;
  11.   id_But3    = 203;
  12.   id_But4    = 204;
  13.   id_Lb1     = 301;
  14.   id_lb2     = 302;
  15.   id_St1     = 401;
  16.   id_St2     = 402;
  17.   id_St3     = 403;
  18.   id_St4     = 404;
  19.   id_st5     = 405;
  20.  
  21. {******************************************************************}
  22. { Types                                                            }
  23. {******************************************************************}
  24. type
  25.     TDSApplication = object(TApplication)
  26.        procedure InitMainWindow;virtual;
  27.     end;
  28.  
  29. type
  30.     PStackItem = ^TStackItem;
  31.    TStackItem = object(TObject)
  32.        StackItem:PChar;
  33.       constructor Init(NewItem:PChar);
  34.       destructor Done;virtual;
  35.     end;
  36.  
  37. type
  38.     PStack = ^TStack;
  39.     TStack = object(TCollection)
  40.        procedure Push(Item:Pointer);virtual;
  41.       function Pop:Pointer;virtual;
  42.    end;
  43.  
  44.  
  45. PDSDialog = ^TDSDialog;
  46. TDSDialog = object(TDialog)
  47.     TheDrive: Array[0..3] of Char;
  48.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  49.    procedure IDLb1(var Msg:TMessage);virtual id_First+id_Lb1;
  50.     end;
  51.  
  52. {TTextStream}
  53. type
  54. PTextStream = ^TTextStream ;
  55. TTextStream = object(TBufStream)
  56.    CharsToRead : LongInt;
  57.    CharsRead : LongInt;
  58.    ARecord :PChar;
  59.    constructor Init(FileName:PChar;Mode,Size:Word);
  60.    destructor Done;virtual;
  61.    function GetNext:PChar;virtual;
  62.    function WriteNext(szARecord:PChar):integer;virtual;
  63.    function WriteEOF:integer;virtual;
  64.    function IsEOF:Boolean;virtual;
  65.    function GetPctDone:Integer;
  66. end;
  67.  
  68. type
  69. PDirRec = ^TDirRec;
  70. TDirRec = object(TObject)
  71.     PathName:PChar;
  72.    DirSize:PChar;
  73.    constructor Init(NewPathName:PChar;NewDirSize:PChar);
  74.    destructor Done;virtual;
  75. end;
  76.  
  77. PDSCollection = ^TDSCollection;
  78. TDSCollection = object(TSortedCollection)
  79.     Maxpath:Integer;
  80.    constructor Init(ALimit,ADelta:Integer);
  81.     function KeyOf(Item:Pointer):Pointer;virtual;
  82.    function Compare(Key1,Key2:Pointer):Integer;virtual;
  83. end;
  84.  
  85. {DSWindow}
  86. PDSWindow = ^TDSWindow;
  87. TDSWindow = object(TWindow)
  88.     Editor:PEdit;
  89.    Editor1:PListBox;
  90.    TheIcon:HIcon;
  91.    TheButton,TheLogo:HBitmap;{About}
  92.    TheCollection:PDSCollection;
  93.    Bn1,Bn2,Bn3,Bn4 : PButton;
  94.    Dlg1 : PDSDialog;
  95.    St1,St2,St3,St4:PStatic;
  96.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  97.    destructor  Done;virtual;
  98.    procedure     SetupWindow;virtual;
  99.    procedure     Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  100.    procedure     FindFiles(Drive:PChar);
  101.    procedure     SetStaticText(Drive:PChar);
  102.    procedure    SetDriveInfo;
  103.    procedure     WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
  104.    procedure     WMSetFocus(var Msg:TMessage);virtual wm_First+wm_SetFocus;
  105.    procedure     IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Drive}
  106.     procedure     IDBut2(var Msg:TMessage);virtual id_First+id_But2; {Clipboard}
  107.    procedure     IDBut3(var Msg:TMessage);virtual id_First+id_But3; {File}
  108.    procedure     IDBut4(var Msg:TMessage);virtual id_First+id_But4; {Exit}
  109.    procedure    IDLB2(var Msg:TMessage);virtual  id_First+id_lb2;
  110.    procedure     WMLButtonUp(var Msg:TMessage);virtual wm_First+wm_LButtonUp;
  111. end;
  112.  
  113.  
  114. {********************************************************************}
  115. {M E T H O D S                                                       }
  116. {********************************************************************}
  117.  
  118. procedure TDSApplication.InitMainWindow;
  119. begin
  120.     MainWindow := New(PDSWindow,Init(nil,'DSize'));
  121. end;
  122.  
  123. {********************************************************************}
  124. {Init}
  125. constructor TDSWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  126. begin
  127.     TWindow.Init(AParent,ATitle);
  128.    Attr.Menu := 0;
  129.    Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
  130.    Editor := New(PEdit,Init(@Self,200,nil,-0,0,0,0,0,True));
  131.    with Editor^.Attr do
  132.        Style := Style or es_NoHideSel ;
  133.    Editor1 := New(PListBox,Init(@Self,id_lb2,0,0,0,0));
  134.    with Editor1^.Attr do
  135.        begin
  136.        Style := Style and not lbs_Sort  ;
  137.       end;
  138.    Bn1 := New(PButton,Init(@Self,id_But1,'Drive',0,0,0,0,False));
  139.    Bn2 := New(PButton,Init(@Self,id_But2,'ClpBd',0,0,0,0,False));
  140.    Bn3 := New(PButton,Init(@Self,id_But3,'File',0,0,0,0,False));
  141.    Bn4 := New(PButton,Init(@Self,id_But4,'Exit',0,0,0,0,False));
  142.    St1 := New(PStatic,Init(@Self,id_St1,'',315,5,240,18,75));
  143.    St2 := New(PStatic,Init(@Self,id_St2,'',315,26,240,18,75));
  144.    St3 := New(PStatic,Init(@Self,id_ST3,'',310,3,250,44,75));
  145.    TheButton := LoadBitmap(HInstance,'DS_BUTTON');
  146.    TheLogo   := LoadBitmap(HInstance,'DS_BMP1');
  147.    St2^.Attr.Style := St2^.Attr.Style or ss_LeftNoWordWrap;
  148.    St3^.Attr.Style := St3^.Attr.Style or ss_BlackFrame;
  149.    TheCollection := New(PDSCollection,Init(1000,100));
  150. end;
  151.  
  152. {SetupWindow}
  153. procedure TDSWindow.SetupWindow;
  154. var
  155.     TheFont:HFont;
  156. begin
  157.     TWindow.SetupWindow;
  158.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'DS_Icon'));
  159.     TheFont := GetStockObject(OEM_Fixed_Font);
  160.     SendMessage(Editor^.HWindow,wm_Setfont,TheFont,longint(1));
  161.     SendMessage(Editor1^.HWindow,wm_Setfont,TheFont,longint(1));
  162.    SetDriveInfo;
  163. end;
  164.  
  165. {Paint}
  166. procedure TDSWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  167. var
  168.     ThePen:HPen;
  169.    TheBrush :HBrush;
  170.    OldBrush :HBrush;
  171.    OldPen:HPen;
  172.    OldBitMap:HBitMap;
  173.    MemDC :HDC;
  174.    CR:TRect;
  175.    W,H:Integer;
  176. begin
  177.     TheBrush := GetStockObject(LtGray_Brush);
  178.     ThePen := CreatePen(ps_Solid,1,$00000000);
  179.    OldPen := SelectObject(PaintDC,ThePen);
  180.    OldBrush := SelectObject(PaintDC,TheBrush);
  181.    Rectangle(PaintDC,0,0,1024,50);
  182.    SelectObject(PaintDC,OldBrush);
  183.    SelectObject(PaintDC,OldPen);
  184.    DeleteObject(ThePen);
  185.    MemDC := CreateCompatibleDC(PaintDC);
  186.    OldBitMap := SelectObject(MemDC,TheButton);
  187.    BitBlt(PaintDC,0,0,50,50,MemDC,0,0,SrcCopy);
  188.    SelectObject(MemDC,OldBitMap);
  189.    DeleteDC(MemDC);
  190.  
  191.    GetClientRect(HWindow,CR);
  192.    W := CR.Right-CR.Left;H := CR.Bottom-CR.Top;
  193.    MemDC := CreateCompatibleDC(PaintDC);
  194.    OldBitMap := SelectObject(MemDC,TheLogo);
  195.    BitBlt(PaintDC,((W div 3) - 100) div 2,             {the .bmp is 100x100}
  196.        50+ ((H -50) div 2)+(((H -50) div 2)-100)div 2 ,
  197.        W div 3,H div 2,
  198.       MemDC,0,0,SrcCopy);
  199.    SelectObject(MemDC,OldBitMap);
  200.    DeleteDC(MemDC);
  201. end;
  202.  
  203. {Done}
  204. destructor TDSWindow.Done;
  205. begin
  206.     DeleteObject(TheButton);
  207.    DeleteObject(TheLogo);
  208.     Dispose(TheCollection,Done);
  209.     TWindow.Done;
  210. end;
  211.  
  212. {WMSize}
  213. procedure TDSWindow.WMSize(var Msg:TMessage);
  214. begin
  215.     SetWindowPos(Editor1^.HWindow,0,-1,50,(Msg.LParamLo div 3)+1,
  216.        ((Msg.LParamHi-50) div 2 - 0),swp_NoZOrder);
  217.     SetWindowPos(Editor^.HWindow,0,(Msg.LParamLo  div 3)-1,50,
  218.        (Msg.LParamLo * 2 div 3),(Msg.LParamHi-48),swp_NoZOrder);
  219.    SetWindowPos(Bn1^.HWindow,0,50,0,100,50,swp_NoZOrder);
  220.    SetWindowPos(Bn2^.HWindow,0,150,0,50,50,swp_NoZOrder);
  221.    SetWindowPos(Bn3^.HWindow,0,200,0,50,50,swp_NoZOrder);
  222.    SetWindowPos(Bn4^.HWindow,0,250,0,50,50,swp_NoZOrder);
  223. end;
  224.  
  225. {WMSetFocus}
  226. procedure TDSWindow.WMSetFocus(var Msg:TMessage);
  227. begin
  228.     SetFocus(Editor^.HWindow);
  229. end;
  230.  
  231. {IDBut1}
  232. procedure TDSWindow.IDBut1(var Msg:TMessage);
  233. begin
  234.     Dlg1 := new(PDSDialog,Init(@Self,'DS_Dlg1'));
  235.    Application^.ExecDialog(Dlg1);
  236.    if StrLen(Dlg1^.TheDrive) <> 0 then
  237.        FindFiles(Dlg1^.TheDrive);
  238. end;
  239.  
  240. {IDBut2}
  241. procedure TDSWindow.IDBut2(var Msg:TMessage);
  242. var
  243.     TotChars:Integer;
  244. begin
  245.     TotChars := Editor^.GetLineIndex(9999);
  246.    Editor^.SetSelection(0,TotChars);
  247.     Editor^.Copy;
  248.    Editor^.SetSelection(0,0);
  249. end;
  250.  
  251. {IdBut3}
  252. procedure TDSWindow.IDBut3(var Msg:TMessage);
  253. const
  254.    CRLF : Array[0..2] of Char = #13#10;
  255.    EOF : Array[0..1] of Char = #26;
  256. var
  257.     FName : Array[0..fsPathName] of Char;
  258.     Dlg :PFileDialog;
  259.     AStream: PTextStream;
  260.      ABuffer: Array[0..120] of Char;
  261.     Indx,OutCtr : Integer;
  262.    MaxPathS:Array[0..2] of Char;
  263.    wvsString:Array[0..12] of Char;
  264.    PDir :PDirRec;
  265. begin
  266.    StrCopy(FName,'*.*');
  267.    Dlg :=  (New(PFileDialog,Init(@Self,PChar(sd_FileSave),FName)));
  268.    if Application^.ExecDialog(Dlg) = id_OK then
  269.        begin
  270.       if TheCollection^.MaxPath < 9 then
  271.                   Str(TheCollection^.MaxPath:1,MaxPathS)
  272.           else
  273.                   Str(TheCollection^.MaxPath:2,MaxPathS);
  274.           StrCat(StrCat(StrCopy(wvsString,'%-'),MaxPathS),'s');
  275.       AStream := New(PTextStream, Init(FName, stCreate,1024));
  276.        for Indx := 0 to (TheCollection^.Count - 1) do
  277.              begin
  278.           PDir := TheCollection^.At(Indx);
  279.              wvsprintf(ABuffer,wvsString,PDir^.PathName);
  280.          StrCat(ABuffer,PDir^.DirSize);
  281.           AStream^.Write(ABuffer,StrLen(ABuffer));
  282.          AStream^.Write(CRLF,2);
  283.           Inc(OutCtr);
  284.              end;
  285.         AStream^.Write(EOF,1);
  286.          Dispose(AStream, Done);
  287.       end;
  288. end;
  289.  
  290. {IdBut4}
  291. procedure TDSWindow.IDBut4(var Msg:TMessage);
  292. begin
  293.    SendMessage(HWindow,wm_Close,0,0);
  294. end;
  295.  
  296. {WMLButtonDown}
  297. procedure TDSWindow.WMLButtonUp(var Msg:TMessage);
  298. var
  299.     Dlg : PDialog;
  300. begin
  301.     if (Msg.lParamLo < 50) and (Msg.lParamHi < 50) then
  302.        begin
  303.       Dlg :=New(PDialog,Init(@Self,'DS_About'));
  304.       Application^.ExecDialog(Dlg);
  305.       end;
  306. end;
  307.  
  308. {FindFiles}
  309. procedure TDSWindow.FindFiles(Drive:PChar);
  310. var
  311.   SearchRec: TSearchRec;
  312.   DirBuf: array[0..fsDirectory] of Char;
  313.   PDir : PDirRec;
  314.   EName : array[0..120] of Char;
  315.   FName : array[0..120] of Char;
  316.   FMask : array[0..fsPathName] of Char;
  317.   DStack : PStack;
  318.   Item : PStackItem;
  319.   DirSize : LongInt;
  320.   szDirSize :Array[0..80] of Char;
  321.   F:File of byte;
  322.   Indx: Integer;
  323.   Buf :PChar;
  324.   Ret:LongInt;
  325.   Cursor:HCursor;
  326.   MaxP:Integer;
  327.   MaxPathS:Array[0..2] of Char;
  328.   wvsString : Array[0..12] of Char;
  329.   Count:Integer;
  330.  
  331. begin
  332.   Cursor := loadCursor(0,Idc_Wait);
  333.   SetCursor(Cursor);
  334.   Editor^.Clear;
  335.  
  336.   if Drive[StrLen(Drive)-1] <> '\' then
  337.        StrCat(Drive,'\');
  338.   StrUpper(Drive);
  339.   SetCurDir(Drive);
  340.  
  341.   SetStaticText(Drive);
  342.  
  343.   DStack := New(PStack,Init(1000,100));
  344.   DStack^.Push(New(PStackItem,Init(Drive)));
  345.   if TheCollection^.Count > 0 then
  346.           begin
  347.       Dispose(TheCollection,Done);
  348.           TheCollection := New(PDSCollection,Init(1000,100));
  349.       end;
  350.   DirSize := 0;
  351.   MaxP := 0;
  352.   while DStack^.Count > 0 do
  353.       begin
  354.    Item := DStack^.Pop;
  355.       StrCopy(DirBuf,Item^.StackItem);
  356.       Dispose(Item,Done);
  357.       SetCurdir(Dirbuf);
  358.    if DirBuf[StrLen(DirBuf)-1] <> '\' then
  359.        StrCat(DirBuf,'\');
  360.    StrCat(StrCopy(FMask,DirBuf),'*.*');
  361.    DosError := 0;
  362.  
  363.       FindFirst(FMask, faArchive+ faReadOnly+ faDirectory, SearchRec); {.  dir}
  364.    while ((SearchRec.Name[0] = '.') and (DosError = 0))  do
  365.        FindNext(SearchRec);
  366.       while (DosError = 0)  do
  367.         begin
  368.       if SearchRec.Attr = faDirectory  then
  369.           begin
  370.          FileExpand(EName,SearchRec.Name);
  371.          if StrLen(EName) > MaxP then MaxP := StrLen(EName);
  372.           DStack^.Push(New(PStackItem,Init(EName)));
  373.          end
  374.       else {if SearchRec.Attr <> faReadOnly then }
  375.           begin
  376.          FileExpand(FName,SearchRec.Name);
  377.          Assign(F,FName);
  378.          Reset(F);
  379.          DirSize := DirSize + FileSize(F);
  380.          Close(F);
  381.       end;
  382.         Inc(Count);
  383.         FindNext(SearchRec);
  384.        end;
  385.  
  386.    Str(DirSize:8,szDirSize);
  387.    TheCollection^.Insert(New(PDirRec,Init(DirBuf,szDirSize)));
  388.    DirSize := 0;
  389.   end;
  390.  
  391.   GetMem(Buf,32000);
  392.   Buf[0] := #0;
  393.   wvsString[0] := #0;
  394.   MaxP := MaxP +2;
  395.   TheCollection^.MaxPath := MaxP;
  396.  
  397.   if MaxP < 9 then
  398.           Str(MaxP:1,MaxPathS)
  399.   else
  400.       Str(MaxP:2,MaxPathS);
  401.   StrCat(StrCat(StrCopy(wvsString,'%-'),MaxPathS),'s');
  402.   for indx := 0 to TheCollection^.Count - 1 do
  403.           begin
  404.       PDir := TheCollection^.At(Indx);
  405.        wvsprintf(szDirsize,wvsString,PDir^.PathName);
  406.        StrCat(StrCat(StrCat(Buf,szDirSize),PDir^.DirSize),#13#10);
  407.       end;
  408.   Editor^.Insert(Buf);
  409.   Editor^.Scroll(0,-9999);
  410.   FreeMem(Buf,32000);
  411.   Dispose(DStack,Done);
  412.   Cursor := loadCursor(0,Idc_Arrow);
  413.   SetCursor(Cursor);
  414. end;
  415.  
  416. procedure TDSWindow.SetStaticText(Drive:PChar);
  417. var
  418.      DTotFree,DTotSize,PctUtil:Array[0..12] of Char;
  419.       DTotSizeN,DTotFreeN,PctUtilN:LongInt;
  420.       Buffer: array[0..fsDirectory] of Char;
  421. begin
  422.   DTotFreeN := DiskFree(0);
  423.   DTotSizeN := DiskSize(0);
  424.   PctUtilN := Round(DTotFreeN / (DTotSizeN / 100)) ;
  425.   Str(DTotFreeN,DTotFree);
  426.   Str(DTotSizeN,DTotSize);
  427.   Str(PctUtilN,PctUtil);
  428.   St1^.SetText(StrCat(StrCat(StrCat(StrCopy(Buffer,'Drive '),Drive),'    % Free:'),PctUtil));
  429.   St2^.SetText(StrCat(StrCat(StrCat(StrCopy(Buffer,'Free:'),DTotFree),'  Total:'),DTotSize));
  430.  end;
  431.  
  432. procedure TDSWindow.SetDriveInfo;
  433. var
  434.     Dr:Char;
  435.    ArgList : record
  436.        StrPtr : PChar;
  437.       Free:PChar;
  438.       Size:LongInt;
  439.       PctFree:LongInt;
  440.    end;
  441.    szFree:Array[0..5] of Char;
  442.    rFree:Real;
  443.    szDr:Array[0..2] of Char;
  444.    szOutput : Array[0..80] of Char;
  445. begin
  446.     DosError := 0; StrCopy(szOutput,'');
  447.    WVSPrintf(szOutput,'Dr  MBf  MBt %%Free',ArgList);
  448.    Editor1^.InsertString(szOutput,-1);
  449.  
  450.    Dr := 'C';
  451.    szDr[0] := Dr; szDr[1] := #0;
  452.    while DosError = 0 do
  453.        begin
  454.       SetCurDir(StrCat(szDr,':'));
  455.       if DosError = 0 then
  456.           begin
  457.          rFree := (DiskFree(0) / 1024 / 1024);
  458.          Str(rFree:4:1,szFree);
  459.          ArgList.Free := @szFree;
  460.          ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
  461.          ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
  462.          ArgList.StrPtr := @szDr;
  463.          WVSPrintf(szOutput,'%s %s  %3li  %3li',ArgList);
  464.          Editor1^.InsertString(szOutput,-1);
  465.          end;
  466.       Inc(Dr);
  467.       szDr[0] := Dr;
  468.       szDr[1] := #0;
  469.       end;
  470. end;
  471.  
  472. procedure TDSWindow.IDLB2(var Msg:TMessage);
  473. var
  474.     szBuffer:Array[0..80] of Char;
  475.  
  476.    indx:Integer;
  477. begin
  478.     case Msg.lParamHi of
  479.        lbn_DblClk, lbn_SelChange:
  480.           begin
  481.           indx := Editor1^.GetSelIndex;
  482.          if indx > 0 then
  483.              begin
  484.             Editor1^.GetSelString(@szBuffer,80);
  485.             szBuffer[2] := #0;
  486.             FindFiles(szBuffer);
  487.             end;
  488.          Exit;
  489.          end;
  490.    end;
  491. end;
  492.  
  493. {***********************************************************************}
  494. procedure TDSDialog.IDLb1(var Msg:TMessage);
  495. var
  496.     Idx : Integer;
  497.    DrBuf:Array[0..5] of Char;
  498.    Ptr : PChar;
  499. begin
  500.     case Msg.lParamHi of
  501.     lbn_SelChange,lbn_DblClk:
  502.        begin
  503.       Ptr := TheDrive;
  504.       Idx := SendDlgItemMsg(id_Lb1,lb_GetCurSel,0,0);
  505.       SendDlgItemMsg(id_Lb1,lb_GetText,word(Idx),LongInt(Ptr));
  506.       EndDlg(Idx);
  507.       Exit;
  508.       end;
  509.    end;
  510. end;
  511.  
  512. procedure TDSDialog.WMInitDialog(var Msg:TMessage);
  513. var
  514.     TextItem:PChar;
  515.    Drive:Char;
  516.    DriveStr : Array[0..2] of Char;
  517.    DSN,ErrCode :Integer;
  518. begin
  519.     TDialog.WMInitDialog(Msg);
  520.    DosError := 0;
  521.    {$I-}
  522.    Drive := 'C';
  523.    DriveStr[0] :=  Drive;
  524.    DriveStr[1] := #0;
  525.    TextItem := DriveStr;
  526.    while DosError = 0 do
  527.    begin
  528.        SetCurDir(StrCat(DriveStr,':'));
  529.        if DosError = 0 then
  530.            SendDlgItemMsg(id_Lb1,lb_AddString,0,LongInt(TextItem));
  531.       Inc(Drive);
  532.       DriveStr[0] := Drive;
  533.       DriveStr[1] := #0;
  534.       TextItem := DriveStr;
  535.    end;
  536.    TheDrive[0] := #0;
  537. end;
  538.  
  539. {***********************************************************************}
  540. constructor TStackItem.Init(NewItem:PChar);
  541. begin
  542.     StackItem := StrNew(NewItem);
  543. end;
  544.  
  545. destructor TStackItem.Done;
  546. begin
  547.     StrDispose(StackItem);
  548. end;
  549.  
  550. {***********************************************************************}
  551. procedure TStack.Push(Item:Pointer);
  552. begin
  553.     AtInsert(0,Item);
  554. end;
  555.  
  556. function TStack.Pop:Pointer;
  557. begin
  558.     Pop := At(0);
  559.    AtDelete(0);
  560. end;
  561.  
  562. {***********************************************************************}
  563. constructor TDirRec.Init(NewPathName:PChar;NewDirSize:PChar);
  564. begin
  565.     PathName := StrNew(NewPathName);
  566.    DirSize := StrNew(NewDirSize);
  567. end;
  568.  
  569. destructor TDirRec.Done;
  570. begin
  571.     StrDispose(PathName);
  572.    StrDispose(DirSize);
  573. end;
  574.  
  575. {***********************************************************************}
  576. constructor TDSCollection.Init(ALimit,ADelta:Integer);
  577. begin
  578.     TCollection.Init(ALimit,ADelta);
  579.    MaxPath := 0;
  580. end;
  581.  
  582. function TDSCollection.Keyof(Item:Pointer):Pointer;
  583. begin
  584.     KeyOf := PDirRec(Item)^.PathName;
  585. end;
  586.  
  587. function TDSCollection.Compare(Key1,Key2:Pointer):Integer;
  588. begin
  589.     Compare := StrIComp(PChar(Key1), PChar(Key2));
  590. end;
  591.  
  592. {***********************************************************************}
  593. {TTextStream Methods}
  594. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  595. begin
  596.     TBufStream.Init(FileName,Mode,Size);
  597.    CharsRead := 0;
  598.    CharsToRead := TBufStream.GetSize;
  599.    ARecord := MemAlloc(32000);
  600. end;
  601.  
  602. {Done}
  603. destructor TTextStream.Done;
  604. begin
  605.     TBufStream.Done;
  606.    FreeMem(ARecord,32000);
  607. end;
  608.  
  609. {GetNext}
  610. function TTextStream.GetNext:PChar;
  611. var
  612.     Blksize:Integer;
  613.    AChar:Char;
  614.    Indx : Integer;
  615.    IsEOR : Boolean;
  616. begin
  617.    Indx := 0;
  618.    IsEOR := False;
  619.    ARecord[0] := #0;
  620.    while (CharsRead < CharsToRead) and (IsEOR = False) do
  621.    begin
  622.        TBufStream.Read(AChar,1);
  623.       Inc(CharsRead);
  624.       if (AChar = #13) then
  625.           begin
  626.          ARecord[Indx] := #0;
  627.          IsEOR := True;
  628.          end
  629.       else if (AChar = #10) then
  630.           begin
  631.          end
  632.       else if (AChar = #26) then
  633.           begin
  634.          end
  635.       else 
  636.           begin
  637.          ARecord[Indx] := AChar;
  638.          inc(Indx);
  639.          end
  640.    end;
  641.    GetNext := ARecord;
  642. end;
  643.  
  644. {WriteNext}
  645. {This method not actually used due to performance loss - instead
  646.    TStream.Write is called directly}
  647. function TTextStream.WriteNext(szARecord:PChar):Integer;
  648. const
  649.   CRLF : Array[0..2] of Char = #13#10#0;
  650.  
  651. begin
  652.       TBufStream.Write(szARecord,
  653.           StrLen(szARecord));
  654.       TBufStream.Write(CRLF,2);
  655.       WriteNext := StrLen(szARecord);
  656. end;
  657.  
  658. {WriteEOF}
  659. function TTextStream.WriteEOF:Integer;
  660. const
  661.       EOF : Array[0..1] of Char  = #26;
  662. begin
  663.     TBufStream.Write(EOF,1);
  664.    WriteEOF := 1;
  665. end;
  666.  
  667. {IsEOF}
  668. function TTextStream.IsEOF:Boolean;
  669. begin
  670.     IsEOF := False;
  671.    if CharsRead >= CharsToRead then
  672.        IsEOF := True;
  673. end;
  674.  
  675. {GetPctDone}
  676. function TTextStream.GetPctDone:Integer;
  677. begin
  678.     GetPctDone := CharsRead*100 div CharsToRead;
  679. end;
  680.  
  681. {*********************************************************************}
  682. {*** M A I N L I N E                                                  }
  683. {*********************************************************************}
  684. var
  685.     DSApp : TDSApplication;
  686. begin
  687.     DSApp.Init('DSize');
  688.     DSApp.Run;
  689.     DSApp.Done;
  690.  
  691. end.
  692.