Link to home
Start Free TrialLog in
Avatar of mr_E
mr_EFlag for Mexico

asked on

Where to find free tools or delphi (source code) prj to control & prevent certain filetypes to be saved on shared folders in Windows SBS 2000 Domain?

I'm looking for Free Tools or Source Code (Delphi preferently or other) for an application to control/prevent certain files types to be saved on shared folders in a Windows Server 2000 (SBS) by the users of the domain.

I need to disable the storage of (.mp3, .jpg, .exe, .scr, .pif, .com, etc) :: dangerous or not allowed material.
Maybe just allow files like MS Office/OOo (but there is a lot more, so is more easy just to disable certain file types)

Actions like this are good in the suggested tools/material:

If the tools found "something" not allowed, the files need to be moved to another place (quarantine) in the server, just to be sure that an important file is not removed.

I only need to monitor certain folders not the whole system, so the system don't get slowed or hang by a mistaken quarantined file.

::: In another question here in E.E. I see that Windows Server 2003 have tools to prevent this but Windows Server 2000 don't.

Thanks in advance.
BTW this was the 1st question that make found E.E. some years ago, and still I haven't found the solution.
Avatar of senad
senad
Flag of Slovenia image

In group policy there is a section called SOFTWARE RESTRICTION which lets you restrict a defined software from running.Why not use it ?
Avatar of mr_E

ASKER

Thanks senad, but I don't want to restrict more software, (well maybe disable Windows -LOL-), our users can use "Windows Explorer" to copy/save files like audio (mp3, wav), games (exe,swf), and a long etc. inside the shared folder on the server.

I disable a lot of services and devices (sound card, usb storage, CD drives, messenger, etc) on every computer in the domain, but a few "less restricted" users can saturate the server copying files that aren't allowed. and every month I see the free disk space decreasing.

I do the work by hand (find and delete), with this actions I got less faulty users, but the new ones are less educated.

So my question remains the same.
ASKER CERTIFIED SOLUTION
Avatar of Geert G
Geert G
Flag of Belgium image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mr_E

ASKER

@Geert_Gruwez
(sorry for the late response, Im sorry to post a question in this holidays season)

Thanks, your app is in what language (C, Delphi, VB) ? We have SQL Server 2000.
Maybe it can be adapted.

I just wonder if your tool scan the area of interest or detect the file save/creation events?
Because this shared folder have a huge amount of files/subfolders and I'm afraid of put more stress on the server if I need to scan all the subfolders (mmmh, maybe just run the scans in the night, but even in the night the server is busy).

I gladdly see the code If you can post it.

Regards
i'm actually in the process of recreating it.
this time without a database
i'll be using it also for cleanup of old log files and moving files

this is what i got so far:

unit formMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
  cxStyles, cxCustomData, cxFilter, cxData, cxDataStorage, cxEdit,
  cxGridCustomView, cxGridCustomTableView, cxGridTableView,
  cxGridBandedTableView, ExtCtrls, cxClasses, cxGridLevel, cxGrid, StdCtrls,
  Buttons;

const
  MaxRunningThreads = 5;

type
  TCleanupTask = class(TPersistent)
  private
    fFolderName: string;
    fFileSpec: string;
    fAction: string; // Delete, Move, Zip
    fDeleteRetention: Integer; // retention in days
    fDeleteLeave: Integer; // minimum number of files to leave
    fSubFolders: boolean; // recurse in subfolders
    fStartTime: TDateTime; // Last start time
    fStartIntervalDays: double;

    procedure SaveStringToStream(aString: string; aStream: TStream);
    function LoadStringFromStream(aStream: TStream): string;
  protected
    procedure SaveToStream(aStream: TStream); virtual;
    procedure LoadFromStream(aStream: TStream); virtual;
  public
    constructor Create; virtual;
    procedure Assign(Source: TPersistent); override;
    function ActionDetailsDescr: string;

    property FolderName: string read fFolderName;
    property FileSpec: string read fFileSpec;
    property Action: string read fAction;
    property StartTime: TDateTime read fStartTime;
    property StartIntervalDays: double read fStartIntervalDays;
  end;

  TReturnMsgEvent = procedure (Sender: TObject; Msg: string) of object;

  TCleanupThread = class(TThread)
  private
    fTask: TCleanupTask;
    fMsg: string;
    fOnReturnMsg: TReturnMsgEvent;
    procedure ReturnMsg;
    procedure ProcessFiles(aPath, aSpec: string);
    procedure ProcessFile(aPath, aSpec: string; sr: TSearchRec);
  protected
    procedure Return(aMsg: string);
    procedure Execute; override;
    procedure Done(Sender: TObject);
  public
    constructor Create(aTask: TCleanupTask; aOnReturnMsg: TReturnMsgEvent; CreateSuspended: Boolean); reintroduce;
    destructor Destroy; override;
  end;

  TCleanupItem = class(TCollectionItem)
  private
    fTask: TCleanupTask;
    fThread: TCleanupThread;
    fLastStartTime: TDateTime;
    fProgress: integer;
    fStatus: string;
  protected
    procedure OnReturnMsg(Sender: TObject; aMsg: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Start;

    property Task: TCleanupTask read fTask;
  end;

  TCleanupItems = class(TCollection)
  private
    fCleanupFileName: string;
    fRunningThreads: Integer;
    fOnUpdateOwner: TReturnMsgEvent;
    function GetItems(Index: Integer): TCleanupItem;
    procedure SetItems(Index: Integer; const Value: TCleanupItem);
  protected
    procedure SaveToStream(aStream: TStream); virtual;
    procedure LoadFromStream(aStream: TStream); virtual;
    procedure UpdateOwner(Msg: string);
  public
    constructor Create(aFileName: string; aOnUpdateOwner: TReturnMsgEvent); virtual;
    procedure Save; virtual;
    procedure SaveAs(aFileName: string); virtual;
    procedure Load; virtual;
    procedure LoadFrom(aFileName: string); virtual;
    property Items[Index: Integer]: TCleanupItem read GetItems write SetItems; default;
  end;

  TfrmCleanup = class(TForm)
    lvlCleanup: TcxGridLevel;
    gridCleanup: TcxGrid;
    pnlOptions: TPanel;
    viewCleanup: TcxGridBandedTableView;
    colSourceServer: TcxGridBandedColumn;
    colSourceFolder: TcxGridBandedColumn;
    colSourceFileSpec: TcxGridBandedColumn;
    colActionType: TcxGridBandedColumn;
    colActionDetails: TcxGridBandedColumn;
    colTimeStart: TcxGridBandedColumn;
    colTimeInterval: TcxGridBandedColumn;
    colProgressLastRun: TcxGridBandedColumn;
    colProgressPercentDone: TcxGridBandedColumn;
    colProgressStatus: TcxGridBandedColumn;
    colSystem01: TcxGridBandedColumn;
    BitBtn2: TBitBtn;
    timerTasks: TTimer;
    timerUpdate: TTimer;
    memMsg: TMemo;
    procedure BitBtn2Click(Sender: TObject);
    procedure timerTasksTimer(Sender: TObject);
    procedure timerUpdateTimer(Sender: TObject);
  private
    fCleanupItems: TCleanupItems;
    fCleanupFile: string;
    procedure OnUpdateGrid(Sender: TObject; Msg: string);
    procedure LoadData;
    procedure UpdateTask(aItem: TCleanupItem);
    function FindTask(aTask: TCleanupTask): integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Items: TCleanupItems read fCleanupItems;
  end;

var
  frmCleanup: TfrmCleanup;

implementation

uses DateUtils;

{$R *.dfm}

{ TCleanupItems }

constructor TCleanupItems.Create(aFileName: string; aOnUpdateOwner: TReturnMsgEvent);
begin
  inherited Create(TCleanupItem);
  fCleanupFileName := aFileName;
  fOnUpdateOwner := aOnUpdateOwner;
end;

function TCleanupItems.GetItems(Index: Integer): TCleanupItem;
begin
  Result := TCleanupItem(inherited Items[Index]);
end;

procedure TCleanupItems.Load;
begin
  LoadFrom(fCleanupFileName);
end;

procedure TCleanupItems.LoadFrom(aFileName: string);
var aStream: TFileStream;
begin
  if FileExists(aFileName) then
  begin
    aStream := TFileStream.Create(aFileName, fmOpenRead);
    try
      LoadFromStream(aStream);
    finally
      aStream.Free;
    end;
  end;
end;

procedure TCleanupItems.LoadFromStream(aStream: TStream);
var I, n: Integer;
  item: TCleanupItem;
begin
  Clear;
  aStream.Read(n, SizeOf(n));
  for I := 0 to n-1 do
  begin
    item := TCleanupItem(Add);
    item.Task.LoadFromStream(aStream);
  end;
end;

procedure TCleanupItems.Save;
begin
  SaveAs(fCleanupFileName);
end;

procedure TCleanupItems.SaveAs(aFileName: string);
var
  aStream: TFileStream;
begin
  aStream := TFileStream.Create(aFileName, fmCreate);
  try
    SaveToStream(aStream);
  finally
    aStream.Free;
  end;
end;

procedure TCleanupItems.SaveToStream(aStream: TStream);
var I, n: Integer;
begin
  n := Count;
  aStream.Write(n, SizeOf(n));
  for I := 0 to Count - 1 do
    Items[I].Task.SaveToStream(aStream);
end;

procedure TCleanupItems.SetItems(Index: Integer; const Value: TCleanupItem);
begin
  TCleanupItem(inherited Items[Index]).Task.Assign(Value.Task);
end;

procedure TCleanupItems.UpdateOwner(Msg: string);
begin
  if Assigned(fOnUpdateOwner) then
    fOnUpdateOwner(Self, Msg);
end;

{ TCleanupTask }

function TCleanupTask.LoadStringFromStream(aStream: TStream): string;
var n: Integer;
  b: string;
begin
  b := '';
  aStream.Read(n, SizeOf(n));
  if n > 0 then
    aStream.Read(b, n);
  Result := b;
end;

function TCleanupTask.ActionDetailsDescr: string;
begin
  Result := '';
  if SameText(fAction, 'DELETE') then
    Result := Format('>%d days, min( %d )', [fDeleteRetention, fDeleteLeave]);
end;

procedure TCleanupTask.Assign(Source: TPersistent);
begin
  if Source is TCleanupTask then
  begin
    fFolderName := TCleanupTask(Source).fFolderName;
    fFileSpec := TCleanupTask(Source).fFileSpec;
    fAction := TCleanupTask(Source).fAction;
    fDeleteRetention := TCleanupTask(Source).fDeleteRetention;
    fDeleteLeave := TCleanupTask(Source).fDeleteLeave;
    fSubFolders := TCleanupTask(Source).fSubFolders;
    fStartTime := TCleanupTask(Source).fStartTime;
    fStartIntervalDays := TCleanupTask(Source).fStartIntervalDays;
  end else
    inherited Assign(Source);
end;

constructor TCleanupTask.Create;
begin
  inherited Create;
  fFolderName := '';
  fFileSpec := '';
  fAction := '';
  fDeleteRetention := 42; // 6 weeks
  fDeleteLeave := 1; // leave last file
end;

procedure TCleanupTask.LoadFromStream(aStream: TStream);
begin
  fFolderName := LoadStringFromStream(aStream);
  fFileSpec := LoadStringFromStream(aStream);
  fAction := LoadStringFromStream(aStream);
  aStream.Read(fDeleteRetention, SizeOf(fDeleteRetention));
  aStream.Read(fDeleteLeave, SizeOf(fDeleteLeave));
end;

procedure TCleanupTask.SaveStringToStream(aString: string; aStream: TStream);
var n: Integer;
begin
  n := Length(aString);
  aStream.Write(n, SizeOf(n));
  if n > 0 then
    aStream.Write(aString, n);
end;

procedure TCleanupTask.SaveToStream(aStream: TStream);
begin
  SaveStringToStream(fFolderName, aStream);
  SaveStringToStream(fFileSpec, aStream);
  SaveStringToStream(fAction, aStream);
  aStream.Write(fDeleteRetention, SizeOf(fDeleteRetention));
  aStream.Write(fDeleteLeave, SizeOf(fDeleteLeave));
end;

{ TCleanupItem }

constructor TCleanupItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fTask := TCleanupTask.Create;
  fThread := nil;
  fLastStartTime := 0;
  fProgress := 0;
  fStatus := 'not started';
end;

destructor TCleanupItem.Destroy;
begin
  FreeAndNil(fTask);
  inherited Destroy;
end;

procedure TCleanupItem.OnReturnMsg(Sender: TObject; aMsg: string);
var List: TStringList;
  temp: string;
begin
  List := TStringList.Create;
  try
    List.StrictDelimiter := True;
    List.CommaText := aMsg;
    Temp := List.Values['PROGRESS'];
    if Temp <> '' then
    begin
      fProgress := StrToInt(Temp);
      if fProgress = 0 then
      begin
        fLastStartTime := Now;
        fTask.fStartTime := fTask.fStartTime + fTask.fStartIntervalDays;
      end
      else if fProgress >= 100 then
        fStatus := 'done';
    end;
    Temp := List.Values['DONE'];
    if Temp = 'YES' then
    begin
      fThread := nil;
      Dec(TCleanupItems(Collection).fRunningThreads);
    end;
    Temp := List.Values['MSG'];
    if Temp <> '' then
      TCleanupItems(Collection).UpdateOwner(Temp);
  finally
    List.Free;
  end;
  TCleanupItems(Collection).UpdateOwner('');
end;

procedure TCleanupItem.Start;
begin
  if fThread = nil then
  begin
    fThread := TCleanupThread.Create(fTask, OnReturnMsg, False);
    Inc(TCleanupItems(Collection).fRunningThreads);
  end;
end;

{ TfrmCleanup }

procedure TfrmCleanup.BitBtn2Click(Sender: TObject);
var item: TCleanupTask;
begin
  item := TCleanupItem(Items.Add).Task;
  item.fFolderName := 'c:\temp';
  item.fFileSpec := '*.*';
  item.fAction := 'DELETE';
  item.fDeleteRetention := 10;
  item.fDeleteLeave := 1;
  item.fSubFolders := true;
  item.fStartTime := Date + 10/24;
  item.fStartIntervalDays := 1;
  timerUpdate.Enabled := True;
end;

constructor TfrmCleanup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCleanupFile := ChangeFileExt(ParamStr(0), '.cfg');
  fCleanupItems := TCleanupItems.Create(fCleanupFile, OnUpdateGrid);
end;

destructor TfrmCleanup.Destroy;
begin
  FreeAndNil(fCleanupItems);
  inherited Destroy;
end;

function TfrmCleanup.FindTask(aTask: TCleanupTask): integer;
var
  I: Integer;
begin
  Result := -1;
  with viewCleanup.DataController do
    for I := 0 to RecordCount - 1 do
      if SameText(VarToStr(Values[I, colSourceFolder.Index]), aTask.FolderName) and
        SameText(VarToStr(Values[I, colSourceFileSpec.Index]), aTask.FileSpec) then
      begin
        Result := I;
        Break;
      end;
end;

procedure TfrmCleanup.UpdateTask(aItem: TCleanupItem);
var r: Integer;
begin
  r := FindTask(aItem.Task);
  if r < 0 then
    r := viewCleanup.DataController.AppendRecord;
  with viewCleanup.DataController do
  begin
    BeginUpdate;
    try
      Values[r, colSourceFolder.Index] := aItem.Task.FolderName;
      Values[r, colSourceFileSpec.Index] := aItem.Task.FileSpec;
      Values[r, colActionType.Index] := aItem.Task.Action;
      Values[r, colActionDetails.Index] := aItem.Task.ActionDetailsDescr;
      Values[r, colTimeStart.Index] := aItem.Task.StartTime;
      Values[r, colTimeInterval.Index] := aItem.Task.StartIntervalDays;
      if aItem.fLastStartTime > 1 then
        Values[r, colProgressLastRun.Index] := aItem.fLastStartTime
      else
        Values[r, colProgressLastRun.Index] := Null;
      Values[r, colProgressPercentDone.Index] := aItem.fProgress;
      Values[r, colProgressStatus.Index] := aItem.fStatus;
      Values[r, colSystem01.Index] := 1;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmCleanup.LoadData;
var
  I: Integer;
begin
  with viewCleanup.DataController do
  begin
    BeginUpdate;
    try
      for I := 0 to RecordCount - 1 do
        Values[I, colSystem01.Index] := 0;
      for I := 0 to Items.Count - 1 do
        UpdateTask(Items.Items[I]);
      for I := RecordCount - 1 downto 0 do
        if Values[I, colSystem01.Index] = 0 then
          DeleteRecord(I);
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmCleanup.OnUpdateGrid(Sender: TObject; Msg: string);
begin
  if Msg = '' then
    LoadData
  else
    memMsg.Lines.Add(Msg);
end;

procedure TfrmCleanup.timerTasksTimer(Sender: TObject);
var I: integer;
  item: TCleanupItem;
begin
  if Items.fRunningThreads < MaxRunningThreads then
    for I := 0 to Items.Count - 1 do
    begin
      item := items.Items[I];
      if (item.fLastStartTime < item.Task.fStartTime) and
        (item.Task.fStartTime < Now) then
      begin
        item.Start;
        Break;
      end;
    end;
end;

procedure TfrmCleanup.timerUpdateTimer(Sender: TObject);
begin
  timerUpdate.Enabled := False;
  OnUpdateGrid(Self, '');
end;

{ TCleanupThread }

constructor TCleanupThread.Create(aTask: TCleanupTask; aOnReturnMsg: TReturnMsgEvent; CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  fTask := TCleanupTask.Create;
  if Assigned(aTask) then
    fTask.Assign(aTask);
  fOnReturnMsg := aOnReturnMsg;
  FreeOnTerminate := True;
  OnTerminate := Done;
end;

destructor TCleanupThread.Destroy;
begin
  FreeAndNil(fTask);
  inherited Destroy;
end;

procedure TCleanupThread.Done(Sender: TObject);
begin
  Return('DONE=YES');
end;

procedure TCleanupThread.ProcessFile(aPath, aSpec: string; sr: TSearchRec);
var dt: TDateTime;
  st: _SYSTEMTIME;
begin
  if (sr.Name <> '.') and (sr.Name <> '..') then
  begin
    if (sr.Attr and faDirectory = faDirectory) then
    begin
      if fTask.fSubFolders then
        ProcessFiles(IncludeTrailingPathDelimiter(aPath + sr.Name), aSpec);
    end
      else
    begin
      if SameText(fTask.fAction, 'DELETE') then
      begin
        if fTask.fDeleteRetention <> 0 then
        begin
          if FileTimeToSystemTime(sr.FindData.ftLastWriteTime, st) then
          begin
            dt := SystemTimeToDateTime(st);
            if dt + fTask.fDeleteRetention < Now then
              Return(Format('MSG="DELETE FILE=%s"', [aPath + sr.Name]))
            else
              Return(Format('MSG="NO DELETE FILE=%s"', [aPath + sr.Name]));
          end;
        end;
      end;
    end;
  end;
end;

procedure TCleanupThread.ProcessFiles(aPath, aSpec: string);
var sr: TSearchRec;
begin
  if FindFirst(aPath + aSpec, faAnyFile, sr) = 0 then
  try
    ProcessFile(aPath, aSpec, sr);
    while FindNext(sr) = 0 do
      ProcessFile(aPath, aSpec, sr);
  finally
    FindClose(sr);
  end;
end;

procedure TCleanupThread.Execute;
var aPath: string;
begin
  Return('PROGRESS=0');
  aPath := IncludeTrailingPathDelimiter(fTask.fFolderName);
  ProcessFiles(aPath, fTask.FileSpec);
  Return('PROGRESS=100');
end;

procedure TCleanupThread.Return(aMsg: string);
begin
  fMsg := aMsg;
  Synchronize(ReturnMsg);
end;

procedure TCleanupThread.ReturnMsg;
begin
  if Assigned(fOnReturnMsg) then
    fOnReturnMsg(Self, fMsg);
end;

end.

Open in new window

--dfm-- (D2010)

it uses a quatumgrid of devexpress
but you could easily modify to display in a stringgrid
object frmCleanup: TfrmCleanup
  Left = 0
  Top = 0
  Caption = 'Cleanup'
  ClientHeight = 550
  ClientWidth = 977
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  PixelsPerInch = 96
  TextHeight = 13
  object gridCleanup: TcxGrid
    Left = 0
    Top = 41
    Width = 977
    Height = 175
    Align = alClient
    TabOrder = 0
    object viewCleanup: TcxGridBandedTableView
      NavigatorButtons.ConfirmDelete = False
      DataController.Summary.DefaultGroupSummaryItems = <>
      DataController.Summary.FooterSummaryItems = <>
      DataController.Summary.SummaryGroups = <>
      OptionsView.NoDataToDisplayInfoText = ' '
      OptionsView.ColumnAutoWidth = True
      OptionsView.GroupByBox = False
      Bands = <
        item
          Caption = 'Source'
        end
        item
          Caption = 'Action'
        end
        item
          Caption = 'Time'
        end
        item
          Caption = 'Progress'
          Width = 169
        end>
      object colSystem01: TcxGridBandedColumn
        Caption = 'System'
        DataBinding.ValueType = 'Integer'
        Visible = False
        VisibleForCustomization = False
        Position.BandIndex = 0
        Position.ColIndex = 3
        Position.RowIndex = 0
      end
      object colSourceServer: TcxGridBandedColumn
        Caption = 'Server'
        Position.BandIndex = 0
        Position.ColIndex = 0
        Position.RowIndex = 0
      end
      object colSourceFolder: TcxGridBandedColumn
        Caption = 'Folder'
        Position.BandIndex = 0
        Position.ColIndex = 1
        Position.RowIndex = 0
      end
      object colSourceFileSpec: TcxGridBandedColumn
        Caption = 'File spec'
        Position.BandIndex = 0
        Position.ColIndex = 2
        Position.RowIndex = 0
      end
      object colActionType: TcxGridBandedColumn
        Caption = 'Action'
        Position.BandIndex = 1
        Position.ColIndex = 0
        Position.RowIndex = 0
      end
      object colActionDetails: TcxGridBandedColumn
        Caption = 'Details'
        Position.BandIndex = 1
        Position.ColIndex = 1
        Position.RowIndex = 0
      end
      object colTimeStart: TcxGridBandedColumn
        Caption = 'Start'
        DataBinding.ValueType = 'DateTime'
        Position.BandIndex = 2
        Position.ColIndex = 0
        Position.RowIndex = 0
      end
      object colTimeInterval: TcxGridBandedColumn
        Caption = 'Interval'
        Position.BandIndex = 2
        Position.ColIndex = 1
        Position.RowIndex = 0
      end
      object colProgressLastRun: TcxGridBandedColumn
        Caption = 'Last run'
        Position.BandIndex = 3
        Position.ColIndex = 0
        Position.RowIndex = 0
      end
      object colProgressPercentDone: TcxGridBandedColumn
        Caption = 'Percent done'
        Position.BandIndex = 3
        Position.ColIndex = 1
        Position.RowIndex = 0
      end
      object colProgressStatus: TcxGridBandedColumn
        Caption = 'Status'
        Position.BandIndex = 3
        Position.ColIndex = 2
        Position.RowIndex = 0
      end
    end
    object lvlCleanup: TcxGridLevel
      GridView = viewCleanup
    end
  end
  object pnlOptions: TPanel
    Left = 0
    Top = 0
    Width = 977
    Height = 41
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 1
    object BitBtn2: TBitBtn
      Left = 696
      Top = 10
      Width = 75
      Height = 25
      Caption = 'BitBtn1'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 0
      OnClick = BitBtn2Click
    end
  end
  object memMsg: TMemo
    Left = 0
    Top = 216
    Width = 977
    Height = 334
    Align = alBottom
    Lines.Strings = (
      'memMsg')
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object timerTasks: TTimer
    Interval = 5000
    OnTimer = timerTasksTimer
    Left = 144
  end
  object timerUpdate: TTimer
    Enabled = False
    OnTimer = timerUpdateTimer
    Left = 200
  end
end

Open in new window

Avatar of mr_E

ASKER

@Geert_Gruwez
Thanks, I'll try to re-create the project, I tell how it goes.

Regards
Avatar of mr_E

ASKER

@Geert_Gruwez

Sorry for the delay, I have some problems at work...
Today I put you code inside delphi 2006 but I got many errors, some units/controls that I don't have  cx{units} .
I need to read the code carefully to see how to replace those objects/units.

Regards
you would need to rewrite the 3 procedures which display data in the devexpress grid:

function TfrmCleanup.FindTask(aTask: TCleanupTask): integer;
var
  I: Integer;
begin
  Result := -1;
  with viewCleanup.DataController do
    for I := 0 to RecordCount - 1 do
      if SameText(VarToStr(Values[I, colSourceFolder.Index]), aTask.FolderName) and
        SameText(VarToStr(Values[I, colSourceFileSpec.Index]), aTask.FileSpec) then
      begin
        Result := I;
        Break;
      end;
end;

procedure TfrmCleanup.UpdateTask(aItem: TCleanupItem);
var r: Integer;
begin
  r := FindTask(aItem.Task);
  if r < 0 then
    r := viewCleanup.DataController.AppendRecord;
  with viewCleanup.DataController do
  begin
    BeginUpdate;
    try
      Values[r, colSourceFolder.Index] := aItem.Task.FolderName;
      Values[r, colSourceFileSpec.Index] := aItem.Task.FileSpec;
      Values[r, colActionType.Index] := aItem.Task.Action;
      Values[r, colActionDetails.Index] := aItem.Task.ActionDetailsDescr;
      Values[r, colTimeStart.Index] := aItem.Task.StartTime;
      Values[r, colTimeInterval.Index] := aItem.Task.StartIntervalDays;
      if aItem.fLastStartTime > 1 then
        Values[r, colProgressLastRun.Index] := aItem.fLastStartTime
      else
        Values[r, colProgressLastRun.Index] := Null;
      Values[r, colProgressPercentDone.Index] := aItem.fProgress;
      Values[r, colProgressStatus.Index] := aItem.fStatus;
      Values[r, colSystem01.Index] := 1;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmCleanup.LoadData;
var
  I: Integer;
begin
  with viewCleanup.DataController do
  begin
    BeginUpdate;
    try
      for I := 0 to RecordCount - 1 do
        Values[I, colSystem01.Index] := 0;
      for I := 0 to Items.Count - 1 do
        UpdateTask(Items.Items[I]);
      for I := RecordCount - 1 downto 0 do
        if Values[I, colSystem01.Index] = 0 then
          DeleteRecord(I);
    finally
      EndUpdate;
    end;
  end;
end;

it would off course depend on what other component you would use:
Listview, StringGrid, Memo ...

Avatar of mr_E

ASKER

@Geert_Gruwez

Again sorry, This month has been a nightmare at work.
I will check the code in this life (promise)

Regards.

Avatar of mr_E

ASKER

I need to review the code, but looks like what I need to go forward.
I accept the solution before my points for this month vanish.

Thanks.