mr_E
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.
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.
In group policy there is a section called SOFTWARE RESTRICTION which lets you restrict a defined software from running.Why not use it ?
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
(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:
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.
--dfm-- (D2010)
it uses a quatumgrid of devexpress
but you could easily modify to display in a stringgrid
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
ASKER
@Geert_Gruwez
Thanks, I'll try to re-create the project, I tell how it goes.
Regards
Thanks, I'll try to re-create the project, I tell how it goes.
Regards
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
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(aIt em: TCleanupItem);
var r: Integer;
begin
r := FindTask(aItem.Task);
if r < 0 then
r := viewCleanup.DataController .AppendRec ord;
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.ActionDetailsDe scr;
Values[r, colTimeStart.Index] := aItem.Task.StartTime;
Values[r, colTimeInterval.Index] := aItem.Task.StartIntervalDa ys;
if aItem.fLastStartTime > 1 then
Values[r, colProgressLastRun.Index] := aItem.fLastStartTime
else
Values[r, colProgressLastRun.Index] := Null;
Values[r, colProgressPercentDone.Ind ex] := 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 ...
function TfrmCleanup.FindTask(aTask
var
I: Integer;
begin
Result := -1;
with viewCleanup.DataController
for I := 0 to RecordCount - 1 do
if SameText(VarToStr(Values[I
SameText(VarToStr(Values[I
begin
Result := I;
Break;
end;
end;
procedure TfrmCleanup.UpdateTask(aIt
var r: Integer;
begin
r := FindTask(aItem.Task);
if r < 0 then
r := viewCleanup.DataController
with viewCleanup.DataController
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.ActionDetailsDe
Values[r, colTimeStart.Index] := aItem.Task.StartTime;
Values[r, colTimeInterval.Index] := aItem.Task.StartIntervalDa
if aItem.fLastStartTime > 1 then
Values[r, colProgressLastRun.Index] := aItem.fLastStartTime
else
Values[r, colProgressLastRun.Index] := Null;
Values[r, colProgressPercentDone.Ind
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
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 ...
ASKER
@Geert_Gruwez
Again sorry, This month has been a nightmare at work.
I will check the code in this life (promise)
Regards.
Again sorry, This month has been a nightmare at work.
I will check the code in this life (promise)
Regards.
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.
I accept the solution before my points for this month vanish.
Thanks.