{DSize - 1.0 Program Copyright (C) Doug Overmyer 6/22/91}
program DSize;

{$S-}{$I-}
{$R DSIZE.RES}
uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;

const
  id_But1    = 201;
  id_But2    = 202;
  id_But3    = 203;
  id_But4    = 204;
  id_Lb1     = 301;
  id_lb2     = 302;
  id_St1     = 401;
  id_St2     = 402;
  id_St3     = 403;
  id_St4     = 404;
  id_st5     = 405;

{******************************************************************}
{ Types                                                            }
{******************************************************************}
type
	TDSApplication = object(TApplication)
   	procedure InitMainWindow;virtual;
	end;

type
	PStackItem = ^TStackItem;
   TStackItem = object(TObject)
   	StackItem:PChar;
      constructor Init(NewItem:PChar);
      destructor Done;virtual;
	end;

type
	PStack = ^TStack;
	TStack = object(TCollection)
   	procedure Push(Item:Pointer);virtual;
      function Pop:Pointer;virtual;
   end;


PDSDialog = ^TDSDialog;
TDSDialog = object(TDialog)
	TheDrive: Array[0..3] of Char;
	procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
   procedure IDLb1(var Msg:TMessage);virtual id_First+id_Lb1;
	end;

{TTextStream}
type
PTextStream = ^TTextStream ;
TTextStream = object(TBufStream)
   CharsToRead : LongInt;
   CharsRead : LongInt;
   ARecord :PChar;
   constructor Init(FileName:PChar;Mode,Size:Word);
   destructor Done;virtual;
   function GetNext:PChar;virtual;
   function WriteNext(szARecord:PChar):integer;virtual;
   function WriteEOF:integer;virtual;
   function IsEOF:Boolean;virtual;
   function GetPctDone:Integer;
end;

type
PDirRec = ^TDirRec;
TDirRec = object(TObject)
	PathName:PChar;
   DirSize:PChar;
   constructor Init(NewPathName:PChar;NewDirSize:PChar);
   destructor Done;virtual;
end;

PDSCollection = ^TDSCollection;
TDSCollection = object(TSortedCollection)
	Maxpath:Integer;
   constructor Init(ALimit,ADelta:Integer);
	function KeyOf(Item:Pointer):Pointer;virtual;
   function Compare(Key1,Key2:Pointer):Integer;virtual;
end;

{DSWindow}
PDSWindow = ^TDSWindow;
TDSWindow = object(TWindow)
	Editor:PEdit;
   Editor1:PListBox;
   TheIcon:HIcon;
   TheButton,TheLogo:HBitmap;{About}
   TheCollection:PDSCollection;
   Bn1,Bn2,Bn3,Bn4 : PButton;
   Dlg1 : PDSDialog;
   St1,St2,St3,St4:PStatic;
	constructor Init(AParent:PWindowsObject;ATitle:PChar);
   destructor  Done;virtual;
   procedure 	SetupWindow;virtual;
   procedure 	Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
   procedure 	FindFiles(Drive:PChar);
   procedure 	SetStaticText(Drive:PChar);
   procedure	SetDriveInfo;
   procedure 	WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
   procedure 	WMSetFocus(var Msg:TMessage);virtual wm_First+wm_SetFocus;
   procedure 	IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Drive}
	procedure 	IDBut2(var Msg:TMessage);virtual id_First+id_But2; {Clipboard}
   procedure 	IDBut3(var Msg:TMessage);virtual id_First+id_But3; {File}
   procedure 	IDBut4(var Msg:TMessage);virtual id_First+id_But4; {Exit}
   procedure	IDLB2(var Msg:TMessage);virtual  id_First+id_lb2;
   procedure 	WMLButtonUp(var Msg:TMessage);virtual wm_First+wm_LButtonUp;
end;


{********************************************************************}
{M E T H O D S                                                       }
{********************************************************************}

procedure TDSApplication.InitMainWindow;
begin
	MainWindow := New(PDSWindow,Init(nil,'DSize'));
end;

{********************************************************************}
{Init}
constructor TDSWindow.Init(AParent:PWindowsObject;ATitle:PChar);
begin
	TWindow.Init(AParent,ATitle);
   Attr.Menu := 0;
   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
   Editor := New(PEdit,Init(@Self,200,nil,-0,0,0,0,0,True));
   with Editor^.Attr do
   	Style := Style or es_NoHideSel ;
   Editor1 := New(PListBox,Init(@Self,id_lb2,0,0,0,0));
   with Editor1^.Attr do
   	begin
   	Style := Style and not lbs_Sort  ;
      end;
   Bn1 := New(PButton,Init(@Self,id_But1,'Drive',0,0,0,0,False));
   Bn2 := New(PButton,Init(@Self,id_But2,'ClpBd',0,0,0,0,False));
   Bn3 := New(PButton,Init(@Self,id_But3,'File',0,0,0,0,False));
   Bn4 := New(PButton,Init(@Self,id_But4,'Exit',0,0,0,0,False));
   St1 := New(PStatic,Init(@Self,id_St1,'',315,5,240,18,75));
   St2 := New(PStatic,Init(@Self,id_St2,'',315,26,240,18,75));
   St3 := New(PStatic,Init(@Self,id_ST3,'',310,3,250,44,75));
   TheButton := LoadBitmap(HInstance,'DS_BUTTON');
   TheLogo   := LoadBitmap(HInstance,'DS_BMP1');
   St2^.Attr.Style := St2^.Attr.Style or ss_LeftNoWordWrap;
   St3^.Attr.Style := St3^.Attr.Style or ss_BlackFrame;
   TheCollection := New(PDSCollection,Init(1000,100));
end;

{SetupWindow}
procedure TDSWindow.SetupWindow;
var
	TheFont:HFont;
begin
	TWindow.SetupWindow;
	SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'DS_Icon'));
	TheFont := GetStockObject(OEM_Fixed_Font);
	SendMessage(Editor^.HWindow,wm_Setfont,TheFont,longint(1));
	SendMessage(Editor1^.HWindow,wm_Setfont,TheFont,longint(1));
   SetDriveInfo;
end;

{Paint}
procedure TDSWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
	ThePen:HPen;
   TheBrush :HBrush;
   OldBrush :HBrush;
   OldPen:HPen;
   OldBitMap:HBitMap;
   MemDC :HDC;
   CR:TRect;
   W,H:Integer;
begin
	TheBrush := GetStockObject(LtGray_Brush);
	ThePen := CreatePen(ps_Solid,1,$00000000);
   OldPen := SelectObject(PaintDC,ThePen);
   OldBrush := SelectObject(PaintDC,TheBrush);
   Rectangle(PaintDC,0,0,1024,50);
   SelectObject(PaintDC,OldBrush);
   SelectObject(PaintDC,OldPen);
   DeleteObject(ThePen);
   MemDC := CreateCompatibleDC(PaintDC);
   OldBitMap := SelectObject(MemDC,TheButton);
   BitBlt(PaintDC,0,0,50,50,MemDC,0,0,SrcCopy);
   SelectObject(MemDC,OldBitMap);
   DeleteDC(MemDC);

   GetClientRect(HWindow,CR);
   W := CR.Right-CR.Left;H := CR.Bottom-CR.Top;
   MemDC := CreateCompatibleDC(PaintDC);
   OldBitMap := SelectObject(MemDC,TheLogo);
   BitBlt(PaintDC,((W div 3) - 100) div 2,             {the .bmp is 100x100}
   	50+ ((H -50) div 2)+(((H -50) div 2)-100)div 2 ,
   	W div 3,H div 2,
      MemDC,0,0,SrcCopy);
   SelectObject(MemDC,OldBitMap);
   DeleteDC(MemDC);
end;

{Done}
destructor TDSWindow.Done;
begin
	DeleteObject(TheButton);
   DeleteObject(TheLogo);
	Dispose(TheCollection,Done);
	TWindow.Done;
end;

{WMSize}
procedure TDSWindow.WMSize(var Msg:TMessage);
begin
	SetWindowPos(Editor1^.HWindow,0,-1,50,(Msg.LParamLo div 3)+1,
   	((Msg.LParamHi-50) div 2 - 0),swp_NoZOrder);
	SetWindowPos(Editor^.HWindow,0,(Msg.LParamLo  div 3)-1,50,
   	(Msg.LParamLo * 2 div 3),(Msg.LParamHi-48),swp_NoZOrder);
   SetWindowPos(Bn1^.HWindow,0,50,0,100,50,swp_NoZOrder);
   SetWindowPos(Bn2^.HWindow,0,150,0,50,50,swp_NoZOrder);
   SetWindowPos(Bn3^.HWindow,0,200,0,50,50,swp_NoZOrder);
   SetWindowPos(Bn4^.HWindow,0,250,0,50,50,swp_NoZOrder);
end;

{WMSetFocus}
procedure TDSWindow.WMSetFocus(var Msg:TMessage);
begin
	SetFocus(Editor^.HWindow);
end;

{IDBut1}
procedure TDSWindow.IDBut1(var Msg:TMessage);
begin
	Dlg1 := new(PDSDialog,Init(@Self,'DS_Dlg1'));
   Application^.ExecDialog(Dlg1);
   if StrLen(Dlg1^.TheDrive) <> 0 then
   	FindFiles(Dlg1^.TheDrive);
end;

{IDBut2}
procedure TDSWindow.IDBut2(var Msg:TMessage);
var
	TotChars:Integer;
begin
	TotChars := Editor^.GetLineIndex(9999);
   Editor^.SetSelection(0,TotChars);
	Editor^.Copy;
   Editor^.SetSelection(0,0);
end;

{IdBut3}
procedure TDSWindow.IDBut3(var Msg:TMessage);
const
   CRLF : Array[0..2] of Char = #13#10;
   EOF : Array[0..1] of Char = #26;
var
	FName : Array[0..fsPathName] of Char;
	Dlg :PFileDialog;
	AStream: PTextStream;
 	ABuffer: Array[0..120] of Char;
	Indx,OutCtr : Integer;
   MaxPathS:Array[0..2] of Char;
   wvsString:Array[0..12] of Char;
   PDir :PDirRec;
begin
   StrCopy(FName,'*.*');
   Dlg :=  (New(PFileDialog,Init(@Self,PChar(sd_FileSave),FName)));
   if Application^.ExecDialog(Dlg) = id_OK then
   	begin
      if TheCollection^.MaxPath < 9 then
  				Str(TheCollection^.MaxPath:1,MaxPathS)
  		else
  				Str(TheCollection^.MaxPath:2,MaxPathS);
  		StrCat(StrCat(StrCopy(wvsString,'%-'),MaxPathS),'s');
      AStream := New(PTextStream, Init(FName, stCreate,1024));
   	for Indx := 0 to (TheCollection^.Count - 1) do
     		begin
      	PDir := TheCollection^.At(Indx);
     		wvsprintf(ABuffer,wvsString,PDir^.PathName);
         StrCat(ABuffer,PDir^.DirSize);
      	AStream^.Write(ABuffer,StrLen(ABuffer));
         AStream^.Write(CRLF,2);
      	Inc(OutCtr);
     		end;
    	AStream^.Write(EOF,1);
 		Dispose(AStream, Done);
      end;
end;

{IdBut4}
procedure TDSWindow.IDBut4(var Msg:TMessage);
begin
   SendMessage(HWindow,wm_Close,0,0);
end;

{WMLButtonDown}
procedure TDSWindow.WMLButtonUp(var Msg:TMessage);
var
	Dlg : PDialog;
begin
	if (Msg.lParamLo < 50) and (Msg.lParamHi < 50) then
   	begin
      Dlg :=New(PDialog,Init(@Self,'DS_About'));
      Application^.ExecDialog(Dlg);
      end;
end;

{FindFiles}
procedure TDSWindow.FindFiles(Drive:PChar);
var
  SearchRec: TSearchRec;
  DirBuf: array[0..fsDirectory] of Char;
  PDir : PDirRec;
  EName : array[0..120] of Char;
  FName : array[0..120] of Char;
  FMask : array[0..fsPathName] of Char;
  DStack : PStack;
  Item : PStackItem;
  DirSize : LongInt;
  szDirSize :Array[0..80] of Char;
  F:File of byte;
  Indx: Integer;
  Buf :PChar;
  Ret:LongInt;
  Cursor:HCursor;
  MaxP:Integer;
  MaxPathS:Array[0..2] of Char;
  wvsString : Array[0..12] of Char;
  Count:Integer;

begin
  Cursor := loadCursor(0,Idc_Wait);
  SetCursor(Cursor);
  Editor^.Clear;

  if Drive[StrLen(Drive)-1] <> '\' then
   	StrCat(Drive,'\');
  StrUpper(Drive);
  SetCurDir(Drive);

  SetStaticText(Drive);

  DStack := New(PStack,Init(1000,100));
  DStack^.Push(New(PStackItem,Init(Drive)));
  if TheCollection^.Count > 0 then
  		begin
      Dispose(TheCollection,Done);
  		TheCollection := New(PDSCollection,Init(1000,100));
      end;
  DirSize := 0;
  MaxP := 0;
  while DStack^.Count > 0 do
  	begin
   Item := DStack^.Pop;
  	StrCopy(DirBuf,Item^.StackItem);
  	Dispose(Item,Done);
  	SetCurdir(Dirbuf);
   if DirBuf[StrLen(DirBuf)-1] <> '\' then
   	StrCat(DirBuf,'\');
   StrCat(StrCopy(FMask,DirBuf),'*.*');
   DosError := 0;

  	FindFirst(FMask, faArchive+ faReadOnly+ faDirectory, SearchRec); {.  dir}
   while ((SearchRec.Name[0] = '.') and (DosError = 0))  do
   	FindNext(SearchRec);
  	while (DosError = 0)  do
  	  begin
      if SearchRec.Attr = faDirectory  then
      	begin
         FileExpand(EName,SearchRec.Name);
         if StrLen(EName) > MaxP then MaxP := StrLen(EName);
      	DStack^.Push(New(PStackItem,Init(EName)));
         end
      else {if SearchRec.Attr <> faReadOnly then }
      	begin
         FileExpand(FName,SearchRec.Name);
         Assign(F,FName);
         Reset(F);
         DirSize := DirSize + FileSize(F);
         Close(F);
      end;
    	Inc(Count);
    	FindNext(SearchRec);
  	 end;

   Str(DirSize:8,szDirSize);
   TheCollection^.Insert(New(PDirRec,Init(DirBuf,szDirSize)));
   DirSize := 0;
  end;

  GetMem(Buf,32000);
  Buf[0] := #0;
  wvsString[0] := #0;
  MaxP := MaxP +2;
  TheCollection^.MaxPath := MaxP;

  if MaxP < 9 then
  		Str(MaxP:1,MaxPathS)
  else
  	Str(MaxP:2,MaxPathS);
  StrCat(StrCat(StrCopy(wvsString,'%-'),MaxPathS),'s');
  for indx := 0 to TheCollection^.Count - 1 do
  		begin
      PDir := TheCollection^.At(Indx);
   	wvsprintf(szDirsize,wvsString,PDir^.PathName);
   	StrCat(StrCat(StrCat(Buf,szDirSize),PDir^.DirSize),#13#10);
      end;
  Editor^.Insert(Buf);
  Editor^.Scroll(0,-9999);
  FreeMem(Buf,32000);
  Dispose(DStack,Done);
  Cursor := loadCursor(0,Idc_Arrow);
  SetCursor(Cursor);
end;

procedure TDSWindow.SetStaticText(Drive:PChar);
var
 	DTotFree,DTotSize,PctUtil:Array[0..12] of Char;
  	DTotSizeN,DTotFreeN,PctUtilN:LongInt;
  	Buffer: array[0..fsDirectory] of Char;
begin
  DTotFreeN := DiskFree(0);
  DTotSizeN := DiskSize(0);
  PctUtilN := Round(DTotFreeN / (DTotSizeN / 100)) ;
  Str(DTotFreeN,DTotFree);
  Str(DTotSizeN,DTotSize);
  Str(PctUtilN,PctUtil);
  St1^.SetText(StrCat(StrCat(StrCat(StrCopy(Buffer,'Drive '),Drive),'    % Free:'),PctUtil));
  St2^.SetText(StrCat(StrCat(StrCat(StrCopy(Buffer,'Free:'),DTotFree),'  Total:'),DTotSize));
 end;

procedure TDSWindow.SetDriveInfo;
var
	Dr:Char;
   ArgList : record
   	StrPtr : PChar;
      Free:PChar;
      Size:LongInt;
      PctFree:LongInt;
   end;
   szFree:Array[0..5] of Char;
   rFree:Real;
   szDr:Array[0..2] of Char;
   szOutput : Array[0..80] of Char;
begin
	DosError := 0; StrCopy(szOutput,'');
   WVSPrintf(szOutput,'Dr  MBf  MBt %%Free',ArgList);
   Editor1^.InsertString(szOutput,-1);

   Dr := 'C';
   szDr[0] := Dr; szDr[1] := #0;
   while DosError = 0 do
   	begin
      SetCurDir(StrCat(szDr,':'));
      if DosError = 0 then
      	begin
         rFree := (DiskFree(0) / 1024 / 1024);
         Str(rFree:4:1,szFree);
         ArgList.Free := @szFree;
         ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
         ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
         ArgList.StrPtr := @szDr;
         WVSPrintf(szOutput,'%s %s  %3li  %3li',ArgList);
         Editor1^.InsertString(szOutput,-1);
         end;
      Inc(Dr);
      szDr[0] := Dr;
      szDr[1] := #0;
      end;
end;

procedure TDSWindow.IDLB2(var Msg:TMessage);
var
	szBuffer:Array[0..80] of Char;

   indx:Integer;
begin
	case Msg.lParamHi of
   	lbn_DblClk, lbn_SelChange:
      	begin
      	indx := Editor1^.GetSelIndex;
         if indx > 0 then
         	begin
            Editor1^.GetSelString(@szBuffer,80);
            szBuffer[2] := #0;
            FindFiles(szBuffer);
            end;
         Exit;
         end;
   end;
end;

{***********************************************************************}
procedure TDSDialog.IDLb1(var Msg:TMessage);
var
	Idx : Integer;
   DrBuf:Array[0..5] of Char;
   Ptr : PChar;
begin
	case Msg.lParamHi of
    lbn_SelChange,lbn_DblClk:
   	begin
      Ptr := TheDrive;
      Idx := SendDlgItemMsg(id_Lb1,lb_GetCurSel,0,0);
      SendDlgItemMsg(id_Lb1,lb_GetText,word(Idx),LongInt(Ptr));
      EndDlg(Idx);
      Exit;
      end;
   end;
end;

procedure TDSDialog.WMInitDialog(var Msg:TMessage);
var
	TextItem:PChar;
   Drive:Char;
   DriveStr : Array[0..2] of Char;
   DSN,ErrCode :Integer;
begin
	TDialog.WMInitDialog(Msg);
   DosError := 0;
   {$I-}
   Drive := 'C';
   DriveStr[0] :=  Drive;
   DriveStr[1] := #0;
   TextItem := DriveStr;
   while DosError = 0 do
   begin
   	SetCurDir(StrCat(DriveStr,':'));
   	if DosError = 0 then
   		SendDlgItemMsg(id_Lb1,lb_AddString,0,LongInt(TextItem));
      Inc(Drive);
      DriveStr[0] := Drive;
      DriveStr[1] := #0;
      TextItem := DriveStr;
   end;
   TheDrive[0] := #0;
end;

{***********************************************************************}
constructor TStackItem.Init(NewItem:PChar);
begin
	StackItem := StrNew(NewItem);
end;

destructor TStackItem.Done;
begin
	StrDispose(StackItem);
end;

{***********************************************************************}
procedure TStack.Push(Item:Pointer);
begin
	AtInsert(0,Item);
end;

function TStack.Pop:Pointer;
begin
	Pop := At(0);
   AtDelete(0);
end;

{***********************************************************************}
constructor TDirRec.Init(NewPathName:PChar;NewDirSize:PChar);
begin
	PathName := StrNew(NewPathName);
   DirSize := StrNew(NewDirSize);
end;

destructor TDirRec.Done;
begin
	StrDispose(PathName);
   StrDispose(DirSize);
end;

{***********************************************************************}
constructor TDSCollection.Init(ALimit,ADelta:Integer);
begin
	TCollection.Init(ALimit,ADelta);
   MaxPath := 0;
end;

function TDSCollection.Keyof(Item:Pointer):Pointer;
begin
	KeyOf := PDirRec(Item)^.PathName;
end;

function TDSCollection.Compare(Key1,Key2:Pointer):Integer;
begin
	Compare := StrIComp(PChar(Key1), PChar(Key2));
end;

{***********************************************************************}
{TTextStream Methods}
constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
begin
	TBufStream.Init(FileName,Mode,Size);
   CharsRead := 0;
   CharsToRead := TBufStream.GetSize;
   ARecord := MemAlloc(32000);
end;

{Done}
destructor TTextStream.Done;
begin
	TBufStream.Done;
   FreeMem(ARecord,32000);
end;

{GetNext}
function TTextStream.GetNext:PChar;
var
	Blksize:Integer;
   AChar:Char;
   Indx : Integer;
   IsEOR : Boolean;
begin
   Indx := 0;
   IsEOR := False;
   ARecord[0] := #0;
   while (CharsRead < CharsToRead) and (IsEOR = False) do
   begin
   	TBufStream.Read(AChar,1);
      Inc(CharsRead);
      if (AChar = #13) then
      	begin
         ARecord[Indx] := #0;
         IsEOR := True;
         end
      else if (AChar = #10) then
      	begin
         end
      else if (AChar = #26) then
      	begin
         end
      else 
      	begin
         ARecord[Indx] := AChar;
         inc(Indx);
         end
   end;
   GetNext := ARecord;
end;

{WriteNext}
{This method not actually used due to performance loss - instead
   TStream.Write is called directly}
function TTextStream.WriteNext(szARecord:PChar):Integer;
const
  CRLF : Array[0..2] of Char = #13#10#0;

begin
      TBufStream.Write(szARecord,
      	StrLen(szARecord));
      TBufStream.Write(CRLF,2);
      WriteNext := StrLen(szARecord);
end;

{WriteEOF}
function TTextStream.WriteEOF:Integer;
const
	  EOF : Array[0..1] of Char  = #26;
begin
	TBufStream.Write(EOF,1);
   WriteEOF := 1;
end;

{IsEOF}
function TTextStream.IsEOF:Boolean;
begin
	IsEOF := False;
   if CharsRead >= CharsToRead then
   	IsEOF := True;
end;

{GetPctDone}
function TTextStream.GetPctDone:Integer;
begin
	GetPctDone := CharsRead*100 div CharsToRead;
end;

{*********************************************************************}
{*** M A I N L I N E                                                  }
{*********************************************************************}
var
	DSApp : TDSApplication;
begin
    DSApp.Init('DSize');
    DSApp.Run;
    DSApp.Done;

end.