Koden virker ikke som den er, der er en del ukendte variabler. Bla. skal du manuelt oprette din TADOQuery i trådens constructor (Create) og alle andre ukendte variabler skal også defineres i tråden.
unit Unit1;
interface
uses
ActiveX, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, DB, ADODB;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure DelTreeOnTerminate(Sender: TObject);
public
{ Public declarations }
end;
TDelTreeThread = class(TThread)
private
{ Private declarations }
ADOConnection: TADOConnection;
ADOQuery1: TADOQuery;
Function DelTree(DirName : string): Boolean;
procedure DeleteTempRAW(S1: String);
procedure DeleteDirectory;
protected
procedure Execute; override;
public
ErrorTekst : string;
constructor Create;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TDelTreeThread }
constructor TDelTreeThread.Create;
begin
inherited Create(False);
FreeOnTerminate:=true;
ErrorTekst:='';
ADOConnection:=TADOConnection.Create(nil);
ADOConnection.LoginPrompt:=false;
ADOConnection.ConnectionString:='din connection string';
ADOConnection.CursorLocation:=clUseServer;
ADOQuery1:=TADOQuery.Create(nil);
ADOQuery1.AutoCalcFields:=false;
ADOQuery1.CursorLocation:=clUseServer;
ADOQuery1.Connection:=ADOConnection;
ADOQuery1.CursorType:=ctOpenForwardOnly;
ADOQuery1.EnableBCD:=false;
ADOQuery1.ParamCheck:=false;
end;
procedure TDelTreeThread.DeleteTempRAW(S1: String);
var
SearchRec: TSearchRec;
X: Integer;
Path: String;
ListToDelete: TStringList;
begin
ListToDelete := TStringList.Create;
Path := ExtractFilePath(S1);
X := FindFirst(S1, faAnyFile - faDirectory - faVolumeID, SearchRec);
if X = 0 then
begin
while X = 0 do
begin
ListToDelete.Add(Path + SearchRec.Name);
X := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
for X := 0 to ListToDelete.Count - 1 do
begin
FileSetAttr(ListToDelete[X], 0);
DeleteFile(ListToDelete[X]);
end;
ListToDelete.Free;
end;
Function TDelTreeThread.DelTree(DirName : string): Boolean;
var
SHFileOpStruct : TSHFileOpStruct;
DirBuf : array [0..1024] of char;
begin
try
Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0) ;
FillChar(DirBuf, Sizeof(DirBuf), 0 ) ;
StrPCopy(DirBuf, DirName) ;
with SHFileOpStruct do begin
Wnd := 0;
pFrom := @DirBuf;
wFunc := FO_DELETE;
fFlags := FOF_ALLOWUNDO;
fFlags := fFlags or FOF_NOCONFIRMATION;
fFlags := fFlags or FOF_SILENT;
end;
Result := (SHFileOperation(SHFileOpStruct) = 0) ;
except
Result := False;
end;
end;
procedure TDelTreeThread.DeleteDirectory;
var i : integer; SearchRec: TSearchRec;
OwnerList, LogFile, LineList : TStringList;
begin
try
LogFile := TStringList.Create;
for I := 0 to list.Count -1 do
begin
LineList := TStringList.Create;
LineList.Delimiter := ',';
try
LineList.DelimitedText := StringReplace(List.Strings[i],' ','_',[rfReplaceAll]);
sSiteOU := LineList[0] + ',' + LineList[1];
sUsername := LineList[2];
sDataFolder := LineList[3];
sSiteHomePath := LineList[4];
sMail := LineList[5];
sManagedBy := StringReplace(LineList[6] + ',' + LineList[7] + ',' + LineList[8] + ',' + LineList[9] + ',' + LineList[10] + ',' + LineList[11] + ',' + LineList[12] + ',' + LineList[13],'_',' ',[rfReplaceAll]);
finally
LineList.Free;
end;
try
OwnerList := TStringList.Create;
try
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Text := 'SELECT CN FROM ' + Quotedstr('
LDAP://OU=COMPUTERS,' + sSiteOU + ',OU=company,DC=AD,DC=company,DC=ORG') + ' WHERE ObjectClass=' + Quotedstr('computer') + ' AND managedby=' + Quotedstr(sManagedBy);
ADOQuery1.Open;
ADOQuery1.First;
ADOQuery1.RecordCount;
while not ADOQuery1.Eof do
begin
OwnerList.Add(ADOQuery1.FieldByName('CN').AsString);
ADOQuery1.Next;
Application.ProcessMessages;
end;
finally
ADOQuery1.Close;
end;
if OwnerList.Count <> 0 then
begin
if FindFirst(IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + sDataFolder + '\*', faDirectory, SearchRec) = 0 then
try
begin
repeat
if ((SearchRec.Attr and faDirectory) <> faDirectory) or (SearchRec.Name = '.') or (SearchRec.Name = '..') then
continue;
if pos(searchRec.Name,OwnerList.Text) = 0 then //
begin
if (pos(uppercase(copy(sSiteOU,10,2)+copy(sSiteOU,4,2))+'LT',SearchRec.Name) <> 0) or (pos(uppercase(copy(sSiteOU,10,2)+copy(sSiteOU,4,2))+'DT',SearchRec.Name) <> 0) then
begin
if monthsbetween(date,FileDateToDateTime(SearchRec.Time)) > iVal then
begin
if sDatafolder = '' then
begin
if DelTree(IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + SearchRec.Name) then
Logfile.Add(DateTimeToStr(Now) + ': Delete: ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + SearchRec.Name)
else
Logfile.Add(DateTimeToStr(Now) + ': Failed To Delete: ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + SearchRec.Name);
DeleteTempRAW(IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter('Log') + SearchRec.Name '*.*'); end
else
begin
if DelTree(IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter(sDataFolder) + SearchRec.Name) then
Logfile.Add(DateTimeToStr(Now) + ': Delete: ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter(sDataFolder) + SearchRec.Name)
else
Logfile.Add(DateTimeToStr(Now) + ': Failed To Delete: ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter(sDataFolder) + SearchRec.Name);
DeleteTempRAW(IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter(sDataFolder) + IncludeTrailingPathDelimiter('Log') + SearchRec.Name + '*.*');
end;
end
else
Logfile.Add(DateTimeToStr(Now) + ': Nothing to do: ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername) + IncludeTrailingPathDelimiter(sDataFolder) + SearchRec.Name);
end;
end
else
Logfile.Add(DateTimeToStr(Now) + ': Everthing is ok ' + IncludeTrailingPathDelimiter(sSiteHomePath) + IncludeTrailingPathDelimiter(sUsername));
Application.ProcessMessages;
until findNext(SearchRec) <> 0;
end;
finally
FindClose(SearchRec);
end;
end
else
begin
Logfile.Add(DateTimeToStr(Now) + ': No owner: ' + sManagedBy);
end;
finally
FreeAndNil(OwnerList);
end;
Application.ProcessMessages;
end;
finally
LogFile.SaveToFile(IncludeTrailingPathDelimiter(getcurrentdir)+datetostr(now)+'.log');
FreeAndNil(LogFile);
end;
end;
procedure TDelTreeThread.Execute;
begin
CoInitializeEx(nil,COINIT_MULTITHREADED);
try
DeleteDirectory;
except
on E:Exception do
begin
ErrorTekst:=E.Message;
end;
end;
CoUninitialize;
end;
procedure TForm1.DelTreeOnTerminate(Sender: TObject);
begin
if (Sender as TDelTreeThread).ErrorTekst<>'' then
begin
ShowMessage((Sender as TDelTreeThread).ErrorTekst);
end;
end;
{ TDelTreeThread SLUT }
procedure TForm1.Button1Click(Sender: TObject);
begin
TDelTreeThread.Create.OnTerminate:=DelTreeOnTerminate;
end;
end.
