I've made an application to select specific .xml
files, open them (into a TStringList
), and check for specific numbers, then move the to a folder so that I can upload to another section of our company.
Here's the problem.
After around 9728 items moved, it just stops, for no reason that I can think of.
It doesn't show any error, just keeps hanging.
Maybe it's my code that's doing it after some time, but I hope you guys can help!
I'm using Delphi 2006.
Thread Code:
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, dblookup, FileCtrl, ExtDlgs, StrUtils;
type
FThread = class(TThread)
private
{ Private declarations }
arquivo: string;
Lista3: TStringList;
protected
procedure Execute; override;
procedure UpdateMemo; overload;
end;
implementation
uses AcharArquivos3;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure FThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ FThread }
procedure FThread.UpdateMemo;
begin
Lista3.Add(Arquivo);
end;
procedure FThread.Execute;
var
SR: TSearchRec;
Lista2: TStringList;
Caminho: string;
CaminhoOriginal: string;
Origem: string;
Destino: string;
begin
inherited;
Caminho := Form3.Dir;
CaminhoOriginal := Form3.Edit1.Text;
Lista2 := TStringList.Create;
Lista3 := TStringList.Create;
if FindFirst(IncludeTrailingBackslash(Caminho) + '*.*', faAnyFile or faDirectory, SR) = 0 then
try
repeat
if (SR.Attr and faDirectory) = 0 then
begin
if (ExtractFileExt(SR.Name) = '.xml') and not (Pos(Sr.Name, Lista3.Text) > 0) then
Lista2.LoadFromFile(IncludeTrailingBackslash(Caminho) + SR.name);
if Pos(Form3.NCM, Lista2.Text) > 0 then
begin
Origem := Caminho + '\' + SR.name;
Destino := CaminhoOriginal + '\' + 'Incluir' + '\' + SR.Name;
Arquivo := ChangeFileExt(SR.name, '');
Lista3.Add(Arquivo);
MoveFile(Pchar(Origem), Pchar(Destino));
Synchronize(Self.UpdateMemo);
end;
end
else if (SR.Name <> '.') and (SR.Name <> '..') and (Sr.Name <> 'Incluir') then
begin
Caminho := (IncludeTrailingBackslash(Caminho) + SR.Name); // Recursão
end;
until (FindNext(Sr) <> 0) and (Sr.Name = 'Incluir');
finally
FindClose(SR);
ShowMessage('Pesquisa Concluida!');
Form3.Button6.Enabled := True;
Form3.Button5.Enabled := True;
Form3.Button2.Enabled := True;
Form3.Memo3.Lines.Add(Lista3.Text);
end;
end;
end.
VCL Code:
unit AcharArquivos3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, dblookup, FileCtrl, ExtDlgs, StrUtils;
type
TForm3 = class(TForm)
OpenDialog1: TOpenDialog;
Button2: TButton;
OpenPictureDialog1: TOpenPictureDialog;
SaveDialog1: TSaveDialog;
Label3: TLabel;
Memo3: TMemo;
Button5: TButton;
Label4: TLabel;
Button6: TButton;
ComboBox1: TComboBox;
Edit1: TEdit;
Label1: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Path:String;
NCM: String;
Origem: string;
Destino: string;
Dir: String;
Lista2: TStringList;
Lista: TStringList;
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
uses Unit5;
function WUserName: String;
var
nSize: DWord;
begin
nSize := 1024;
SetLength(Result, nSize);
if GetUserName(PChar(Result), nSize) then
SetLength(Result, nSize-1)
else
RaiseLastOSError;
end;
//Pegando a pasta dos XML
procedure TForm3.Button2Click(Sender: TObject);
var
chosenDirectory : string;
begin
if SelectDirectory('Select a directory', 'C:\' + WUserName + 'Documents', chosenDirectory) then
begin
Edit1.Text := chosenDirectory;
end
else
ShowMessage('Seleção de Pasta Abortada');
end;
procedure TForm3.Button5Click(Sender: TObject);
var
FileName: String;
begin
if (Memo3.GetTextLen() > 0) then
begin
SaveDialog1.FileName := 'ListaEncontrados';
SaveDialog1.DefaultExt := 'txt';
SaveDialog1.Filter := 'Text file|*.txt|Word file|*.doc';
SaveDialog1.Title := 'Salve o arquivo de Lista';
Memo3.Lines.Delete(Memo3.Lines.Count-1);
if SaveDialog1.Execute then
Memo3.Lines.SaveToFile(SaveDialog1.FileName);
SaveDialog1.Free;
Memo3.Lines.Clear;
end
else
ShowMessage('Nenhum Arquivo Excluido');
end;
procedure TForm3.Button6Click(Sender: TObject);
var
vThread : FThread;
begin
if ComboBox1.Text = '' then
begin
ShowMessage('Por Favor escolha um NCM para procura');
Exit;
end;
if Edit1.Text = '' then
begin
ShowMessage('Por Favor Selecione ou Digite um Diretório');
Exit;
end;
if ComboBox1.Text = '2402 - Cigarros' then
NCM := '<NCM>2402';
Dir := Edit1.Text;
if not DirectoryExists(Dir + '\' + 'Incluir') then
begin
CreateDir(Dir + '\' + 'Incluir.');
end;
Button6.Enabled := False;
Button5.Enabled := False;
Button2.Enabled := False;
vThread := FThread.Create(True);
vThread.FreeOnTerminate := True;
VThread.Resume;
end;
end.
Synchronize()
. What so far worked did only so by chance.if not DirectoryExists(Dir + '\' + 'Incluir') then begin CreateDir(Dir + '\' + 'Incluir.'); end;
I'm assuming the trailing.
on theCreateDir()
is a mistake? Also, this block of code can be simplified by usingForceDirectories(IncludeTrailingBackslash(Dir) + 'Incluir');
In fact, your use of\
vsIncludeTrailingBackslash()
is quite inconsistent.