Solved

How to mimic this log\feedback behaviour?

Posted on 2006-07-01
3
213 Views
Last Modified: 2010-04-05
Hi my dear friends!

I'm creating this app which empties IE cache. Now I want this app to count files and directories and summarize this along with the amount of MB's of space it occupies, prior to emptying.
Then when emptying it should give feedback about this and afterwards give feedback whether it succeeded.

Now I saw this behaviour in a program I used for creating unattended installs. It also displayed an icon right before every line. Kinda like this:

[icon] [time] Calculating directories: 120 Done!
[icon] [time] Calculating files: 257 Done!
[icon] [time] Calculating space occupied: 200 MB Done!
[icon] [time] Deleting all files and directories....Done!

Something like this.

Regards Paul

Ps thanks in advance, working samples do the trick ofcourse :) This is my code so far. Nothing implemented yet other than the emptying of the cache.

//Code

function TForm1.UserName: String;
var  dwSize:        DWORD;
begin

  // Buffer size to use
  dwSize:=256;

  // Allocate result buffer
  SetLength(result, 256);

  // Get user name
  if GetUserName(Pointer(result), dwSize) then
     // Truncate to actual result
     SetLength(result, Pred(dwSize))
  else
     // Truncate to null string
     SetLength(result, 0);

end;

function DeleteExclude(Path: String; ExcludeFile: String): Boolean;
var  lpFileOp:      TSHFileOpStruct;
     srFind:        TSearchRec;
     dwFind:        Integer;
     szPath:        String;
     szList:        String;
begin

  // Set default delete list
  SetLength(szList, 0);

  // Make sure path is correct
  szPath:=ExcludeTrailingBackSlash(Path);

  // Init the find
  dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);

  // Check find
  if (dwFind = 0) then
  begin
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
           begin
              // Compare against exclusion
              if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
              begin
                 // Add to list
                 szList:=szList+szPath+'\'+srFind.Name+#0;
              end;
           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;

  // Check the list
  if (Length(szList) > 0) then
  begin
     // Double null terminate the list
     szList:=szList+#0;
     // Clear struct
     FillChar(lpFileOp, SizeOf(lpFileOp), 0);
     // Set params
     lpFileOp.Wnd:=Application.Handle;
     lpFileOp.wFunc:=FO_DELETE;
     lpFileOp.pFrom:=PChar(szList);
     lpFileOp.pTo:=nil;
     // Remove the FOF_ALLOWUNDO if you don't want this to go in the recycle bin
     lpFileOp.fFlags:=FOF_SILENT or FOF_NOCONFIRMATION or FOF_ALLOWUNDO;
     // Perform the delete
     if (SHFileOperation(lpFileOp) = 0) and (lpFileOp.fAnyOperationsAborted = False) then
        // Success
        result:=True
     else
        // Failure
        result:=False;
  end
  else
     // Nothing to delete
     result:=True;

end;

procedure TForm1.Btn1Click(Sender: TObject);
begin

  if DeleteExclude('c:\documents and settings\'+UserName+'\local settings\temporary internet files\content.ie5', 'index.dat') then
     ShowMessage('Success')
  else
     ShowMessage('Failure');

end;



end.

// End of code

Tnx to esoftbg, inthe and rlibby for the above piece of code!
0
Comment
Question by:PeterdeB
  • 2
3 Comments
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
Comment Utility
Paul,

Here is an example that can be tailored (message wise) to do what you like. By default, it allows you to pass in a TStrings object (like a memo's or listbox's lines property) that it fills in during the progress. Its a bit of a change from what I originally hepled you with, because it has to manually tally files/folders and perform the deletion itself. I have tested it though, and it works very nicely. Even if it fails to delete all files (eg, you have an IE session up), it will still show you the total freed up.

Regards,
Russell

----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1            = class(TForm)
     Button1:       TButton;
     Memo1:         TMemo;
     procedure      Button1Click(Sender: TObject);
  private
     // Private declarations
  public
     // Public declarations
     function       UserName: String;
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

function TForm1.UserName: String;
var  dwSize:        DWORD;
begin

  // Buffer size to use
  dwSize:=256;

  // Allocate result buffer
  SetLength(result, 256);

  // Get user name
  if GetUserName(Pointer(result), dwSize) then
     // Truncate to actual result
     SetLength(result, Pred(dwSize))
  else
     // Truncate to null string
     SetLength(result, 0);

end;

function FormatFileSize(Size: LongWord): String;
begin

  if (Size < 1048576) then
  begin
     if (Size < 1024) then
        result:=Format('%d Bytes', [Size])
     else
        result:=FormatFloat('#,##0.00', Size / 1024)+' KB'
  end
  else
     result:=FormatFloat('#,##0.00', Size / 1048576)+' MB'

end;

procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
begin

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
  List.AddObject(Path, Pointer(-1));

  // Init the find
  dwFind:=FindFirst(Path+'\*.*', faAnyFile, srFind);

  // Check find
  if (dwFind = 0) then
  begin
     // Allow updates
     Application.ProcessMessages;
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
           begin
              // Check path
              if ((srFind.Attr and faDirectory) = faDirectory) then
                 // Recurse all files in folder
                 RecursePath(Path+'\'+srFind.Name, List)
              // Add the file name
              else
                 // Add to list with file size
                 List.AddObject(Path+'\'+srFind.Name, Pointer(srFind.Size));
           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;

end;

function DeleteExclude(Path: String; ExcludeFile: String; Output: TStrings): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     szPath:        String;
     dwSize:        LongWord;
     dwFiles:       Integer;
     dwFind:        Integer;
begin

  // Clear output
  Output.Clear;

  // Make sure path is correct
  szPath:=ExcludeTrailingBackSlash(Path);

  // Init the find
  dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);

  // Create list to hold files and paths
  listFiles:=TStringList.Create;

  // Resource protection
  try
     // Add progress
     Output.Add(Format('[%s] Calculating directories and files...', [TimeToStr(Now)]));
     // Check find
     if (dwFind = 0) then
     begin
        // Resource protection
        try
           // While sucess
           while (dwFind = 0) do
           begin
              // Check name
              if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
              begin
                 // Check path
                 if ((srFind.Attr and faDirectory) = faDirectory) then
                    // Recurse all files in folder
                    RecursePath(szPath+'\'+srFind.Name, listFiles)
                 // Compare against exclusion
                 else if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
                    // Add to list with file size
                    listFiles.AddObject(szPath+'\'+srFind.Name, Pointer(srFind.Size));
              end;
              // Find next
              dwFind:=FindNext(srFind);
           end;
        finally
           // Close the find
           FindClose(srFind);
        end;
     end;
     // Set default result
     result:=True;
     // Check the list
     if (listFiles.Count > 0) then
     begin
        // Set size and file count
        dwFiles:=0;
        dwSize:=0;
        // Display file and directory count
        for dwFind:=0 to Pred(listFiles.Count) do
        begin
           // Check for file
           if (Integer(listFiles.Objects[dwFind]) >= 0) then
           begin
              // Inc file count
              Inc(dwFiles);
              // Increment the total size
              Inc(dwSize, Integer(listFiles.Objects[dwFind]));
           end;
        end;
        // Add progress
        Output.Add(Format('[%s] Calculating directories: %d Done!', [TimeToStr(Now), listFiles.Count-dwFiles]));
        Output.Add(Format('[%s] Calculating files: %d Done!', [TimeToStr(Now), dwFiles]));
        Output.Add(Format('[%s] Calculating space occupied: %s Done!', [TimeToStr(Now), FormatFileSize(dwSize)]));
        Output.Add(Format('[%s] Removing directories and files...', [TimeToStr(Now)]));
        // Allow updates
        Application.ProcessMessages;
        // Reset size again
        dwSize:=0;
        // Now delete the file / paths
        for dwFind:=Pred(listFiles.Count) downto 0 do
        begin
           // Check for path
           if (Integer(listFiles.Objects[dwFind]) = -1) then
              // Remove path
              result:=RemoveDirectory(PChar(listFiles[dwFind]))
           else
           begin
              // Set file attr
              SetFileAttributes(PChar(listFiles[dwFind]), FILE_ATTRIBUTE_ARCHIVE);
              // Attempt to remove
              result:=DeleteFile(PChar(listFiles[dwFind]));
              // Check delete
              if result then Inc(dwSize, Integer(listFiles.Objects[dwFind]));
           end;
           // Break on failure
           if not(result) then break;
        end;
        // Check result
        if not(result) then Output.Add(Format('[%s] Failed to remove all directories and files', [TimeToStr(Now)]));
        Output.Add(Format('[%s] Space freed up: %s Done!', [TimeToStr(Now), FormatFileSize(dwSize)]))
     end
     else
        // Add progress
        Output.Add(Format('[%s] Nothing to delete', [TimeToStr(Now)]));
  finally
     // Free the list
     listFiles.Free;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  DeleteExclude('c:\documents and settings\'+UserName+'\local settings\temporary internet files\content.ie5', 'index.dat', Memo1.Lines);

end;

end.

--- dfm ---

object Form1: TForm1
  Left = 296
  Top = 114
  Width = 473
  Height = 248
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 12
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 104
    Top = 12
    Width = 337
    Height = 181
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
end
0
 

Author Comment

by:PeterdeB
Comment Utility
Well ehm .....this ofcourse WORKS!! :)

Many thanks Russel!!

Regards Paul :)
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility
No problem ;-), and enjoy your weekend

Russell
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now