SRL Archive - Delphi/FPC Help and Tutorials

It cleans up your desktop (Does Not Remove Files).

Thought i'd share it with ya. Its easy to use,

#just select the files/folders you want to keep from the first/second listbox and click KeepFile/Folder.

# Select a Folder below

# Save your Settings if you plan to clean up your desktop in the future again.

# Press the "Cleanup my desktop!" Button.

If anyone wants the sauce i'd post that too ;D…

People always want source code, otherwise, they can't trust your application.

unit DesktopCleaner;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,ActiveX, ShlObj,FileCtrl, ShellApi, IniFiles;

type
  TStringArray = array of string;

  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Edit2: TEdit;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    ListBox2: TListBox;
    Button3: TButton;
    ListBox3: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button4: TButton;
    ListBox4: TListBox;
    Label6: TLabel;
    Button5: TButton;
    procedure Edit1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function PosEx(const Substr: string; const S: string; Offset: Integer): Integer;
begin
  if Offset <= 0 then Result := 0
  else
    Result := Pos(Substr, Copy(S, Offset, Length(S)));

  if Result <> 0 then
    Result := Result + Offset - 1;
end;




function GetDesktopPath : string;
var
  shellMalloc: IMalloc;
  ppidl: PItemIdList;
  PerDir: string;
begin
  ppidl := nil;
  try
    if SHGetMalloc(shellMalloc) = NOERROR then
    begin
      SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);
      SetLength(Result, MAX_PATH);
      if not SHGetPathFromIDList(ppidl, PChar(Result)) then
        raise exception.create('SHGetPathFromIDList failed : invalid pidl');
      SetLength(Result, lStrLen(PChar(Result)));
    end;
  finally
   if ppidl <> nil then
         shellMalloc.free(ppidl);
  end;
end;


procedure GetFilenames(Path: string; Dest: TStrings);
var
  SR: TSearchRec;
begin
  if FindFirst(Path+'*.*', faAnyFile, SR) = 0 then
  repeat
    Dest.Add(SR.Name);
  until FindNext(SR) <> 0;
  FindClose(SR);
end;

function CountFiles : integer;
var
	Rec : TSearchRec;
	nFileCount : integer;
	foo : string;

  FileNames : Array Of String;
begin
	nFileCount := 0;
	if FindFirst(GetDesktopPath+'\*.*', faAnyFile, Rec) = 0 then
	begin
		repeat
			// Exclude directories from the list of files.
			if ((Rec.Attr and faDirectory) <> faDirectory) then
      begin
        SetLength(FileNames, High(FileNames)+5);
        FileNames[0] := Rec.Name;
				Inc(nFileCount);
      end;
		until FindNext(Rec) <> 0;
		FindClose(Rec);
	end;
	Result := nFileCount;
end;

function GetFiles : TStringArray;
var
	Rec : TSearchRec;
	nFileCount : integer;
	foo : string;
begin
	nFileCount := 0;
	if FindFirst(GetDesktopPath+'\*.*', faAnyFile, Rec) = 0 then
	begin
		repeat
			// Exclude directories from the list of files.
			if ((Rec.Attr and faDirectory) <> faDirectory) then
      begin
        SetLength(Result, High(Result)+2);
        Result[nFileCount] := Rec.Name;
				Inc(nFileCount);
      end;
		until FindNext(Rec) <> 0;
		FindClose(Rec);
	end;
end;

function GetFolders : TStringArray;
var
	Rec : TSearchRec;
	nFileCount : integer;
	foo : string;
begin
	nFileCount := 0;
	if FindFirst(GetDesktopPath+'\*', faDirectory, Rec) = 0 then
	begin
		repeat
			// Only directories from the list of files.
      if  not ((Rec.Attr and faDirectory) <> faDirectory) then
      begin
        If not(Rec.Name = '..') AND not(Rec.Name = '.') then
        begin
          SetLength(Result, High(Result)+2);
          Result[nFileCount] := Rec.Name;
			  	Inc(nFileCount);
        end;
      end;
	   	until FindNext(Rec) <> 0;
		FindClose(Rec);
	end;
end;

function GetFolders2(whichfolder:string) : TStringArray;
var
	Rec : TSearchRec;
	nFileCount : integer;
	foo : string;
begin
	nFileCount := 0;
	if FindFirst(whichfolder+'\*', faDirectory, Rec) = 0 then
	begin
		repeat
			// Only directories from the list of files.
      if  not ((Rec.Attr and faDirectory) <> faDirectory) then
      begin
        If not(Rec.Name = '..') AND not(Rec.Name = '.') then
        begin
          SetLength(Result, High(Result)+2);
          Result[nFileCount] := Rec.Name;
			  	Inc(nFileCount);
        end;
      end;
	   	until FindNext(Rec) <> 0;
		FindClose(Rec);
	end;
end;


procedure TForm1.Edit1Click(Sender: TObject);
var
  i, LastPos: Integer;
  test : string;
  DFiles : Tstrings;
begin

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  DFiles : TStrings;
  AllFiles : TStringArray;
  AllFolders : TStringArray;
  i : Integer;
  ini : TInifile;
  temppos : Integer;
  templist : String;
begin
  If FileExists(ExtractFilePath(ParamStr(0))+'desktopcleaner.ini') then
  begin
    ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'desktopcleaner.ini');
    //save folders and files to keep to ini
    i:=0;


   ini.ReadSectionValues('ToKeep', Listbox3.Items);

   for i:=0 to ListBox3.Items.count-1 do
   begin
     temppos := POS('=',ListBox3.Items.Strings[i]);
     templist:= ListBox3.Items.Strings[i];
     ListBox3.Items.Delete(i);

     Delete(templist,1,temppos);
  //   Label1.Caption := templist;
  //   Label2.Caption := inttostr(temppos);
     ListBox3.AddItem(templist,nil);
   end;
    Edit2.Text := Ini.ReadString('SaveTo','Folder','0');

    ini.free;
  end;
   //Quickfix
   If ListBox3.Items.Count > 0 then
   begin
    temppos := POS('=',ListBox3.Items.Strings[0]);
      templist:= ListBox3.Items.Strings[0];
        ListBox3.Items.Delete(0);

     Delete(templist,1,temppos);
          ListBox3.AddItem(templist,nil);
   end;
  //Label1.Caption := IntToStr(CountFiles);
  Allfiles := GetFiles;
  AllFolders := GetFolders;

  // Add All Files To ListBox1
  for i:=0 to high(Allfiles) do
  begin
     ListBox1.AddItem(AllFiles[i],nil);
  end;

  // Add All Folders To ListBox2
  for i:=0 to high(AllFolders) do
  begin
     ListBox2.AddItem(AllFolders[i],nil);
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  If ListBox3.Items.IndexOf(ListBox1.Items.Strings[ListBox1.ItemIndex]) < 0 then
    ListBox3.AddItem(ListBox1.Items.Strings[ListBox1.ItemIndex],nil)
  else
    Label1.Caption := 'File Already in List';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  If ListBox3.Items.IndexOf(ListBox2.Items.Strings[ListBox2.ItemIndex]) < 0 then
    ListBox3.AddItem(ListBox2.Items.Strings[ListBox2.ItemIndex],nil)
  else
    Label1.Caption := 'Folder Already in List';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
ListBox3.Items.Delete(ListBox3.ItemIndex);
end;

procedure TForm1.Edit2Click(Sender: TObject);
const
     SELDIRHELP = 1000;
var
   dir: String;
begin
   dir := 'C:';
   if SelectDirectory(
        dir,
        [sdAllowCreate,
        sdPerformCreate,
        sdPrompt],
        SELDIRHELP
      ) then
     Edit2.Text := dir;

end;

function IsNumeric(s:String):Boolean;
var i:Integer;
begin
  Result:=False;
  for i := 1 to Length(s) do
    if (s[i] > '9') or (s[i] < '0') then exit;
  Result:=True;
end;

function MoveDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;

function IsInList(Items : TStrings;check : String):Boolean;
var
  i: Integer;
begin
  Result := False;
  for i:= 0 to Items.Count-1 do
  begin
    If Items.Strings[i] = check then
    begin
      Result := TRUE;
      exit;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  AllFolders : TStringArray;
  AllFoldersN : Array Of Integer;
  r,i : Integer;
j : integer;
 help: integer;
 destdir : String;

 dircreated : Boolean;
begin
Label1.Caption := 'Cleaning Up Desktop... Please Wait';

//Getting Contents of Desktops Folder
  AllFolders := GetFolders2(Edit2.Text);
//Getting Last Index
  for i:=0 to high(AllFolders) do
  begin
    If IsNumeric(AllFolders[i]) then
    begin
      SetLength(AllFoldersN,High(AllFoldersN)+2);
      AllFoldersN[i] := StrToInt(AllFolders[i]);
    end;
  end;
  // Sort

  For i:= high(AllFoldersN) downto 1 Do
  For j:= 1 To i Do
      If (AllFoldersN[j-1] > AllFoldersN[j]) Then
      begin
       //SwapValues( j-1, j );
        help := AllFoldersN[j];
        AllFoldersN[j] := AllFoldersN[j-1];
        AllFoldersN[j-1] := help;
      end;

  //Debug
//  for i:=0 to High(AllFoldersN) do
//  begin
//    ListBox4.Additem(IntToStr(AllFoldersN[i]),nil);
//  end;

//  Label2.Caption := IntToStr(AllFoldersN[high(allfoldersn)]);
  //Debug end
  dircreated := TRUE;
  //Create Dir For Moved Files
  If Length(AllFoldersN) > 0 then
    begin
    If CreateDir(Edit2.Text+'\'+IntToStr(AllFoldersN[high(allfoldersn)]+1)) then
    destdir := Edit2.Text+'\'+IntToStr(AllFoldersN[high(allfoldersn)]+1)
    else
      dircreated := FALSE
  end else
  begin
    If CreateDir(Edit2.Text+'\0') then
      destdir := Edit2.Text+'\0'
      else
      dircreated := FALSE;
  end;

  If dircreated then
  begin
  //Move File to the Generated Folder if its not on the KeepList
  for i:=0 to ListBox1.Items.Count-1 do
  begin
    If not IsInList(ListBox3.Items, ListBox1.Items.Strings[i]) then
    begin
      If MoveFile(PChar(GetDesktopPath+'\'+ListBox1.Items.Strings[i]), PChar(destdir+'\'+ListBox1.Items.Strings[i])) then
      begin
      Label1.Caption := 'Moved '+IntToStr(i)+ 'Files';
      Label2.Caption := GetDesktopPath+'\'+ListBox1.Items.Strings[i];
      Label6.Caption := destdir;
      end;
    end;
  end;

  //Move Folder to the Generated Folder if its not on the KeepList
  for i:=0 to ListBox2.Items.Count-1 do
  begin
    If not IsInList(ListBox3.Items, ListBox2.Items.Strings[i]) then
    begin
      MoveDir(GetDesktopPath+'\'+ListBox2.Items.Strings[i], destdir);
      Label1.Caption := 'Moved '+IntToStr(i)+ 'Directories';
      Label2.Caption := GetDesktopPath+'\'+ListBox2.Items.Strings[i];
      Label6.Caption := destdir;
    end;
  end;

  label1.Caption := 'Desktop Cleaned Up';
  label2.Caption := 'Files Moved to: '+destdir;
  end else
  Label1.Caption := 'Couldnt Create Dest Dir';
  Edit2.Text := 'CLICK HERE TO SELECT A FOLDER FIRST';
  end;


procedure TForm1.Button5Click(Sender: TObject);
var ini: TIniFile;
i : integer;
begin
 //Open or Create Ini
 ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'desktopcleaner.ini');
 //save folders and files to keep to ini
 for i:= 0 to ListBox3.Items.Count-1 do
 begin
   ini.WriteString('ToKeep',IntToStr(i), ListBox3.Items.Strings[i]);
 end;
   ini.WriteString('SaveTo','Folder', Edit2.text);
     ini.free;
  end;


end.

Your code's a bit hard to read, but that might be the code tags though :p
Delphi also has PosEx (in StrUtils unit) and for IsInList you could use List.IndexOf.
Other than that it looks good :)

looks pretty good, and worked pretty well too.
just an FYI, if your guna post your script, use

 tags instead :D

From: nielsie95
Your code's a bit hard to read, but that might be the code tags though :p
Delphi also has PosEx (in StrUtils unit) and for IsInList you could use List.IndexOf.
Other than that it looks good :)

haha, yeah i changed the tags to highlight=delphi now :).

Thanks for those advices =). I thought that Delphi had PosEx, but couldnt figure out where :x..

~caused

//Thanks Bionicle, No More messy desktops anymore :D.

Now what's the use :p?
Nice code to I skimmed through it quickly ;).

From: Hermen
Now what's the use :p?
Nice code to I skimmed through it quickly ;).

It cleans up your desktop. Very good when you have the habit to always safe everything onto it ;).

I made a version for the system startup. So this way i always have a clean desktop :D..

~caused

From: caused
It cleans up your desktop. Very good when you have the habit to always safe everything onto it ;).

I made a version for the system startup. So this way i always have a clean desktop :D..

~caused

I use CCleaner :D.
It works like a charm.

From: Hermen
I use CCleaner :D.
It works like a charm.

I think CC Cleaner doesnt have such function :O.. I may be wrong though :x