Вопрос по потокам

← →
petvv (2009-03-17 07:52) [0]

Вот есть код:
constructor TMonDirThread.Create(aPath: String); begin inherited Create(True); FreeOnTerminate := True; FPath := aPath; Self.Priority := tpHighest; Resume; end; procedure TMonDirThread.UpdateLog; var s: string; f: TextFile; i: Integer; begin Result:=1; KolStr:=0; Full:= WideCharToString(Path)+"\"+WideCharToString(FileName); CreateDBF(); AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); if Result=2 then begin // Сдесь получаем № и дату накладной GetNom(s,12,20); GetDat(s,21,31); end; Inc(Result,1); end; CloseFile(f); //************************************* // Получаем количество строк в файле //************************************* AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); Inc(KolStr,1); end; KolStr:=KolStr-4; CloseFile(f); //******************* Result:=1; AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); if Result>=5 then begin Form1.Table1.Append; Form1.Table1.FieldByName("DATEN").AsDateTime:=StrToDateTime(ResultDat); Form1.Table1.FieldByName("NOMN").AsString:=ResultNom; //Отсюда начинается сама накладная //Получим количество полей GetFields(s, Length(s)); end; Inc(Result,1); end; CloseFile(f); DeleteFile(Full); Form1.Table1.Active:=False; end; procedure TMonDirThread.Execute; Type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:WideChar; end; var hDir,cbReturn:dword; lpBuf:pointer; Ptr:PFileNotifyInformation; begin //Path:="D:\Накладные"; hDir:=CreateFile(Path,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir=INVALID_HANDLE_VALUE then begin ShowMessage(SysErrorMessage(GetLastError));exit;end; GetMem(lpBuf,BUF_SIZE); //repeat while not Terminated do begin ZeroMemory(lpBuf,BUF_SIZE); if(not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE,@cbReturn,nil,nil))or(cbReturn=0)then Break; // пользователь не сможет прервать ожидание, если захочет. Это нужно либо вынести в отдельный // поток, либо использовать синхронный ввод/вывод Ptr:=lpBuf;OldName:=""; // repeat while not Terminated do begin GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); case Ptr.Action of FILE_ACTION_ADDED:Synchronize(UpdateLog); end; FreeMem(FileName); if Ptr^.NextEntryOffset=0 then break; Inc(integer(Ptr),Ptr^.NextEntryOffset); // until false; //until false; end; end; FreeMem(lpBuf); // этот код ни разу не вызывается - программа останется в цикле до первой ошибки CloseHandle(hDir); end;

После выполнения FILE_ACTION_ADDED:Synchronize(UpdateLog);
не возвращается в цикл. Почему однако ???

← →
petvv (2009-03-17 08:01) [1]

Т.е. получается, что это одноразовая операция и на следующие поступающие файлы уже не реагирует :(

← →
Anatoly Podgoretsky © (2009-03-17 09:04) [2]

> petvv (17.03.2009 7:52:00) [0]

Обращение к VCL должно проходить через метод Synchonize

← →
petvv (2009-03-17 09:10) [3]

т.е. не

CreateDBF();
а
Synchonize(CreateDBF);

и т.д.

← →
petvv (2009-03-17 09:21) [4]

Сделал следующее:

procedure TMonDirThread.UpdateLog;
begin
Synchronize(TxtToDbf);
end;
а в
procedure TMonDirThread.Execute;
...
case Ptr.Action of
FILE_ACTION_ADDED:Synchronize(UpdateLog);

end;
end;

Результат тотже :(

Или я чего не так делаю (понимаю) ?

← →
petvv (2009-03-17 10:05) [5]

Направьте на путь истинный

← →
Anatoly Podgoretsky © (2009-03-17 10:10) [6]

> petvv (17.03.2009 9:21:04) [4]

Тебе же сказано, что обращение к VCL должно идти через Synchronize, а ты не приводишь измененого кода. Пока это не сделаешь - говорить о другом нет смысла.

← →
petvv (2009-03-17 10:16) [7]

Вот:

constructor TMonDirThread.Create(aPath: String); begin inherited Create(True); FreeOnTerminate := True; FPath := aPath; Self.Priority := tpHighest; Resume; end; procedure TMonDirThread.UpdateLog; begin Synchronize(TxtToDbf); end; procedure TMonDirThread.Execute; Type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:WideChar; end; var hDir,cbReturn:dword; lpBuf:pointer; Ptr:PFileNotifyInformation; begin //Path:="D:\Накладные"; hDir:=CreateFile(Path,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir=INVALID_HANDLE_VALUE then begin ShowMessage(SysErrorMessage(GetLastError));exit;end; GetMem(lpBuf,BUF_SIZE); //repeat while not Terminated do begin ZeroMemory(lpBuf,BUF_SIZE); if(not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE,@cbReturn,nil,nil))or(cbReturn=0)then Break; // пользователь не сможет прервать ожидание, если захочет. Это нужно либо вынести в отдельный // поток, либо использовать синхронный ввод/вывод Ptr:=lpBuf;OldName:=""; // repeat while not Terminated do begin GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); case Ptr.Action of FILE_ACTION_ADDED:Synchronize(UpdateLog); end; FreeMem(FileName); if Ptr^.NextEntryOffset=0 then break; Inc(integer(Ptr),Ptr^.NextEntryOffset); // until false; //until false; end; end; FreeMem(lpBuf); // этот код ни разу не вызывается - программа останется в цикле до первой ошибки CloseHandle(hDir); end;

← →
petvv (2009-03-17 10:25) [8]

Вот код основной формы:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, DB, DBTables, Menus, uMonThread; const BUF_SIZE=256; type TForm1 = class(TForm) TrayIcon1: TTrayIcon; Table1: TTable; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; Table1: TTable; Path:PWideChar; Full, ResultNom, ResultDat, Path1,fName, nName, Pole: String; Fields: Variant; FileName:PWideChar; OldName:widestring; Result, KolStr, KolFields:Integer; procedure TxtToDbf; procedure GetFields(InpString: string; fieldpos: Integer); procedure CreateDBF(); function GetDat(InpString: string; nashpos: Integer; fieldpos: Integer): string; function GetNom(InpString: string; nashpos: Integer; fieldpos: Integer): string; implementation uses ShellApi, shlobj, registry; //************************************** procedure CreateDBF(); begin //************************************** path1:=ExtractFileDir(Full); fName:=ExtractFileName(Full); nName:=ChangeFileExt(fName, ".dbf"); //***** Form1.Table1.Active:=False; Form1.Table1.TableType:=ttDBase; Form1.Table1.DataBaseName:=Path1; Form1.Table1.TableName:=nName; Form1.Table1.FieldDefs.Clear; Form1.Table1.FieldDefs.Add("DATEN",ftDate); Form1.Table1.FieldDefs.Add("NOMN",ftString,12,False); Form1.Table1.FieldDefs.Add("KOD",ftFloat,0,False); Form1.Table1.FieldDefs.Add("NAME",ftString,200,False); Form1.Table1.FieldDefs.Add("KOL",ftFloat,0,False); Form1.Table1.FieldDefs.Add("PROIZV",ftString,50,False); Form1.Table1.FieldDefs.Add("COUNTRY",ftString,15,False); Form1.Table1.FieldDefs.Add("GTD",ftString,30,False); Form1.Table1.FieldDefs.Add("CENA_OTP",ftFloat,0,False); Form1.Table1.FieldDefs.Add("CENA",ftFloat,0,False); Form1.Table1.FieldDefs.Add("NDS",ftFloat,0,False); Form1.Table1.FieldDefs.Add("SUM_NDS",ftFloat,0,False); Form1.Table1.FieldDefs.Add("CENA_SNDS",ftFloat,0,False); Form1.Table1.FieldDefs.Add("SUM_BNDS",ftFloat,0,False); Form1.Table1.FieldDefs.Add("CENA_REES",ftFloat,0,False); Form1.Table1.FieldDefs.Add("CENA_PR",ftFloat,0,False); Form1.Table1.FieldDefs.Add("TORG_NADB",ftFloat,0,False); Form1.Table1.FieldDefs.Add("SERIA",ftString,20,False); Form1.Table1.FieldDefs.Add("GODN",ftDate); Form1.Table1.FieldDefs.Add("NOM_SERT",ftString,30,False); Form1.Table1.FieldDefs.Add("SROK_DEIST",ftString,10,False); Form1.Table1.FieldDefs.Add("ORGAN",ftString,50,False); Form1.Table1.FieldDefs.Add("NOM_GLK",ftString,30,False); Form1.Table1.FieldDefs.Add("DATA_VID",ftString,10,False); Form1.Table1.CreateTable; Form1.Table1.Active:=True; Form1.Table1.Edit; Form1.Table1.First; end; //******************************** procedure GetFields(InpString: string; fieldpos: Integer); var c: Char; curpos, i: Integer; begin //************************************** curpos := 1; KolFields:=0; Fields:=""; for i := 1 to fieldpos do begin case KolFields of 1: Pole:="KOD"; 2: Pole:="NAME"; 3: Pole:="KOL"; 4: Pole:="PROIZV"; 5: Pole:="COUNTRY"; 6: Pole:="GTD"; 7: Pole:="CENA_OTP"; 8: Pole:="CENA"; 9: Pole:="NDS"; 10: Pole:="SUM_NDS"; 11: Pole:="CENA_SNDS"; 12: Pole:="SUM_BNDS"; 13: Pole:="CENA_REES"; 14: Pole:="CENA_PR"; 15: Pole:="TORG_NADB"; 16: Pole:="SERIA"; 17: Pole:="GODN"; 18: Pole:="NOM_SERT"; 19: Pole:="SROK_DEIST"; 20: Pole:="ORGAN"; 21: Pole:="NOM_GLK"; 22: Pole:="DATA_VID"; end; case KolFields of 1,3,7,8,9,10,11,12,13,14,15: Form1.Table1.FieldByName(Pole).AsFloat:=StrToFloat(Fields); 2,4,5,6,16,18,19,20,21,22: Form1.Table1.FieldByName(Pole).AsString:=Fields; end; Fields:=""; KolFields := KolFields+1; if curpos > Length(InpString) then Break; repeat c := InpString[curpos]; Inc(curpos, 1); if (c = #13) or (c = #10) then c := " "; if (KolFields<>19) and (c=".") then c:=","; if c="%" then c:=" "; if c <> ";" then Fields := Fields + c; until (c = ";") or (curpos > Length(InpString)) end; if (curpos > Length(InpString)) and (i < fieldpos) then end; //******************************** function GetDat(InpString: string; nashpos: Integer; fieldpos: Integer): string; var c: Char; curpos, i: Integer; begin curpos := nashpos; resultDat := ""; for i := nashpos to fieldpos do begin if curpos > fieldpos then Break; repeat c := InpString[curpos]; Inc(curpos, 1); if (c="о") or (c="т") or (c = #13) or (c = #10) then c := " "; if c <> "," then resultDat := resultDat + c; until (c = ",") or (curpos > fieldpos) end; resultDat := Trim(resultDat); end; //******************************** function GetNom(InpString: string; nashpos: Integer; fieldpos: Integer): string; var c: Char; curpos, i: Integer; begin curpos := nashpos; resultNom := ""; for i := nashpos to fieldpos do begin if curpos > fieldpos then Break; repeat c := InpString[curpos]; Inc(curpos, 1); if (c="о") or (c="т") or (c = #13) or (c = #10) then c := " "; if c <> "," then resultNom := resultNom + c; until (c = ",") or (curpos > fieldpos) end; if (curpos > Length(InpString)) and (i < fieldpos) then result := ""; resultNom := Trim(resultNom); end; //************************************ {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin Path:="D:\Накладные"; Form1.Tag := Integer(TMonDirThread.Create(Path)); end; procedure TxtToDbf; var s: string; f: TextFile; // i: Integer; begin Result:=1; KolStr:=0; Full:= WideCharToString(Path)+"\"+WideCharToString(FileName); CreateDBF(); AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); if Result=2 then begin // Сдесь получаем № и дату накладной GetNom(s,12,20); GetDat(s,21,31); end; Inc(Result,1); end; CloseFile(f); //************************************* // Получаем количество строк в файле //************************************* AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); Inc(KolStr,1); end; KolStr:=KolStr-4; CloseFile(f); //******************* Result:=1; AssignFile(f, Full); Reset(f); while not EOF(f) do begin ReadLn(f, s); if Result>=5 then begin Form1.Table1.Append; Form1.Table1.FieldByName("DATEN").AsDateTime:=StrToDateTime(ResultDat); Form1.Table1.FieldByName("NOMN").AsString:=ResultNom; //Отсюда начинается сама накладная //Получим количество полей GetFields(s, Length(s)); end; Inc(Result,1); end; CloseFile(f); DeleteFile(Full); Form1.Table1.Active:=False; end; end.

← →
petvv (2009-03-17 11:17) [9]

Вот код потока:
unit uMonThread; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, DB, DBTables, Menus; const BUF_SIZE=256; type TMonDirThread = class(TThread) private FPath: String; protected procedure Execute; override; procedure UpdateLog; public constructor Create(aPath: String); end; implementation uses Unit1; constructor TMonDirThread.Create(aPath: String); begin inherited Create(True); FreeOnTerminate := True; FPath := aPath; Self.Priority := tpHighest; Resume; end; procedure TMonDirThread.UpdateLog; begin //Synchronize(TxtToDbf); Form1.Memo1.SetSelText("Изменено"); end; procedure TMonDirThread.Execute; Type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:WideChar; end; var hDir,cbReturn:dword; lpBuf:pointer; Ptr:PFileNotifyInformation; begin //Path:="D:\Накладные"; hDir:=CreateFile(Path,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir=INVALID_HANDLE_VALUE then begin ShowMessage(SysErrorMessage(GetLastError));exit;end; GetMem(lpBuf,BUF_SIZE); //repeat while not Terminated do begin ZeroMemory(lpBuf,BUF_SIZE); if(not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE,@cbReturn,nil,nil))or(cbReturn=0)then Break; // пользователь не сможет прервать ожидание, если захочет. Это нужно либо вынести в отдельный // поток, либо использовать синхронный ввод/вывод Ptr:=lpBuf;OldName:=""; // repeat while not Terminated do begin GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); case Ptr.Action of FILE_ACTION_ADDED:Synchronize(UpdateLog); end; FreeMem(FileName); if Ptr^.NextEntryOffset=0 then break; Inc(integer(Ptr),Ptr^.NextEntryOffset); // until false; //until false; end; end; FreeMem(lpBuf); // этот код ни разу не вызывается - программа останется в цикле до первой ошибки CloseHandle(hDir); end; end.

← →
Юрий Зотов © (2009-03-17 11:36) [10]

> petvv (17.03.09 11:17) [9]

Как Вы считаете, если бы Вы выделили и привели только тот код, который относится к проблеме непосредственно, то Ваши шансы получить конкретный толковый ответ увеличились бы, или уменьшились?

← →
petvv (2009-03-17 11:39) [11]

непосредственно по проблеме был выше, и вопрос конкретный

← →
petvv (2009-03-17 11:45) [12]

Если не понятно то ещё раз:

while not Terminated do begin GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); case Ptr.Action of FILE_ACTION_ADDED:Synchronize(UpdateLog); //Уходит на синхронизацию end; FreeMem(FileName); if Ptr^.NextEntryOffset=0 then break; Inc(integer(Ptr),Ptr^.NextEntryOffset); // until false; //until false; end;

procedure TMonDirThread.UpdateLog;
begin
//Synchronize(TxtToDbf);
Form1.Memo1.SetSelText("Изменено");
end;

В Мемо1 OnChange = Form1.TxtToDbf - выполняется обработка файла

и после Form1.Memo1.SetSelText("Изменено");
выполнение останавливается (не возвращается в основной цикл опроса)

← →
Сергей М. © (2009-03-17 11:57) [13]

> выполнение останавливается (не возвращается в основной цикл
> опроса)

Как ты это узнал ?
Ставил брейкпойнт на вызове SetSelText и делал шаг (F7) ?

← →
petvv (2009-03-17 12:01) [14]

Ставил. Когда кидаеш 1-й файл в директорию отрабатыват нормально (создаёт dbf) и после Form1.Memo1.SetSelText("Изменено");
выполнение останавливается (не возвращается в основной цикл опроса). Т.е. кидаеш следующий файл в директорию, а реакции 0.

← →
Сергей М. © (2009-03-17 12:47) [15]

> выполнение останавливается

Шаг (F7) после останова выполняется успешно ?

← →
petvv (2009-03-17 13:01) [16]

Да. Нажимаеш F7 попадаем в TxtToDbf она выполняется, попадаем в

procedure TMonDirThread.UpdateLog;
begin
//Synchronize(TxtToDbf);
Form1.Memo1.SetSelText("Изменено");
end; // вот сюда
Дальше хоть обнажимайся F7, F8, F9 никуда не возвращается

← →
Сергей М. © (2009-03-17 13:22) [17]

> Нажимаеш F7 попадаем в TxtToDbf

Что ты несешь, какой еще TxtToDbf ?
Процедура Updatelog у тебя состоит из одной-единственной исполняемой строчки :

procedure TMonDirThread.UpdateLog; begin //Synchronize(TxtToDbf); // <-- эта закомментарена Form1.Memo1.SetSelText("Изменено"); <-- вот здесть ты встал по брейкпойнту, сделал шаг по F7 end; <-- сюда попал ? толкнул F9 дальше ?

← →
petvv (2009-03-17 13:29) [18]

Form1.Memo1.SetSelText("Изменено"); <-- вот здесть ты встал по брейкпойнту, сделал шаг по F7

Memo1 в OnChange стоит TxtToDbf();

← →
Сергей М. © (2009-03-17 13:35) [19]

А что, напрямую никак нелься вызвать TxtToDbf() ? Обязательно в обработчике ее вызывать ?

TxtToDbf; Form1.Memo1.SetSelText("Изменено")

Чем этот вариант плох ?

я не вижу привязки Table1 к гриду или другой визуализации...
1. Тогда зачем его держать на форме?
2. Нет обращения к форме, нет нужды в синхронизе...
3. Код на троечку с - (куча глобальных переменных)... на рефакторинг...

Какой формат файла? Намудрено сильно...

← →
petvv (2009-03-18 07:53) [22]

ё мля люди походу енто у меня дельфя чегойто глючит.
Пишу:

Type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:WideChar; end; var hDir,cbReturn:dword; lpBuf:pointer; Ptr:PFileNotifyInformation; begin //Path:="D:\Накладные"; hDir:=CreateFile(Path,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir=INVALID_HANDLE_VALUE then begin ShowMessage(SysErrorMessage(GetLastError));exit;end; GetMem(lpBuf,BUF_SIZE); repeat //while not Terminated do //begin ZeroMemory(lpBuf,BUF_SIZE); if(not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE,@cbReturn,nil,nil))or(cbReturn=0)then Terminate; // пользователь не сможет прервать ожидание, если захочет. Это нужно либо вынести в отдельный // поток, либо использовать синхронный ввод/вывод Ptr:=lpBuf;OldName:=""; repeat //while not Terminated do //begin GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); case Ptr.Action of FILE_ACTION_ADDED:Form1.TxtToDbf(Form1); на выделенное жирным говорит Undiclared identificator ... Опупеть. И ещё заметил, что при добавлении на форму любого компонента в секции Uses не появляются нужные ссылки. А появляются они только после того как начнёш чегой то в ентой секции менять. Во пипец.

это ты тупиЩъ...
вот так должно выглядеть и никаких Undiclared identificator не будет

unit uDataProcessor; interface uses Windows, SysUtils, Classes, DB, DBTables; type TDataProcessor=class private Table:TTable; protected procedure InitTable(const FileName:string); procedure ProcessLine(const Line:string); public constructor Create; destructor Destroy;override; procedure ProcessFile(const FileName:string); end; implementation function GetDat(InpString: string; nashpos: Integer; fieldpos: Integer): string; var curpos, i: Integer; c: Char; begin curpos:= nashpos; result:= ""; for i := nashpos to fieldpos do begin if curpos > fieldpos then Break; repeat c := InpString[curpos]; Inc(curpos, 1); if (c="о") or (c="т")then c := " "; if c <> "," then result:= result + c; until (c = ",") or (curpos > fieldpos) end; result := Trim(result); end; function GetNom(InpString: string; nashpos: Integer; fieldpos: Integer): string; var c: Char; curpos, i: Integer; begin curpos := nashpos; result := ""; for i := nashpos to fieldpos do begin if curpos > fieldpos then Break; repeat c := InpString[curpos]; Inc(curpos, 1); if (c="о") or (c="т") or (c = #13) or (c = #10) then c := " "; if c <> "," then result := result + c; until (c = ",") or (curpos > fieldpos) end; if (curpos > Length(InpString)) and (i < fieldpos) then result := ""; result := Trim(result); end; { TDataProcessor } constructor TDataProcessor.Create; begin inherited Create; Table:=TTable.Create(nil); end; destructor TDataProcessor.Destroy; begin Table.Free; inherited; end; procedure TDataProcessor.InitTable(const FileName: string); begin with Table do begin Active:=False; TableType:=ttDBase; DataBaseName:=ExtractFileDir(FileName); TableName:=ExtractFileName(FileName); with FieldDefs do begin Clear; Add("DATEN",ftDate); Add("NOMN",ftString,12,False); Add("KOD",ftFloat,0,False); Add("NAME",ftString,200,False); Add("KOL",ftFloat,0,False); Add("PROIZV",ftString,50,False); Add("COUNTRY",ftString,15,False); Add("GTD",ftString,30,False); Add("CENA_OTP",ftFloat,0,False); Add("CENA",ftFloat,0,False); Add("NDS",ftFloat,0,False); Add("SUM_NDS",ftFloat,0,False); Add("CENA_SNDS",ftFloat,0,False); Add("SUM_BNDS",ftFloat,0,False); Add("CENA_REES",ftFloat,0,False); Add("CENA_PR",ftFloat,0,False); Add("TORG_NADB",ftFloat,0,False); Add("SERIA",ftString,20,False); Add("GODN",ftDate); Add("NOM_SERT",ftString,30,False); Add("SROK_DEIST",ftString,10,False); Add("ORGAN",ftString,50,False); Add("NOM_GLK",ftString,30,False); Add("DATA_VID",ftString,10,False); end; CreateTable; Exclusive:=true; Active:=True; end; end; procedure TDataProcessor.ProcessLine(const Line: string); const FieldNames:array[1..22] of string=("KOD","NAME","KOL","PROIZV","COUNTRY","GTD", "CENA_OTP","CENA","NDS","SUM_NDS","CENA_SNDS","SUM_BNDS","CENA_REES","CENA_PR", "TORG_NADB","SERIA","GODN","NOM_SERT","SROK_DEIST","ORGAN","NOM_GLK","DATA_VID") ; var LineData:TStringList; i:Integer; Field:TField; FieldValue:string; begin LineData:=TStringList.Create; try LineData.Delimiter:=";"; LineData.DelimitedText:=Line; for i:= Low(FieldNames) to High(FieldNames) do begin Field:=Table.FindField(FieldNames[i]); if not assigned(Field) then continue; FieldValue:=LineData[i]; FieldValue:=StringReplace(FieldValue,"%"," ",[rfReplaceAll]); if Field.DataType<>ftDate then FieldValue:=StringReplace(FieldValue,".",",",[rfReplaceAll]); Field.Value:=FieldValue; end; finally LineData.Free; end; end; procedure TDataProcessor.ProcessFile(const FileName: string); var FileData:TStringList; Dat:TDateTime; Nom:string; i:integer; begin InitTable(ChangeFileExt(FileName,".dbf")); try FileData:=TStringList.Create; try FileData.LoadFromFile(FileName); Dat:=StrToDateTime(GetNom(FileData[1],12,20)); Nom:=GetDat(FileData[1],21,31); for i:=4 to FileData.Count-1 do begin Table.Append; ProcessLine(FileData[i]); Table.FieldByName("DATEN").AsDateTime:=Dat; Table.FieldByName("NOMN").AsString:=Nom; Table.Post; end; finally FileData.Free; end; finally Table.Close; end; end; end. unit uMonThread; interface uses Windows, Messages, SysUtils, Classes,uDataProcessor; type TMonDirThread = class(TThread) private FPath: String; DataProcessor:TDataProcessor; protected procedure Execute; override; public constructor Create(const Path: String); destructor Destroy;override; end; implementation type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:WideChar; end; const BUF_SIZE=4096; constructor TMonDirThread.Create(const Path: String); begin inherited Create(True); DataProcessor:=TDataProcessor.Create; FreeOnTerminate:=True; FPath:=IncludeTrailingPathDelimiter(Path); Priority:=tpHighest; Resume; end; destructor TMonDirThread.Destroy; begin DataProcessor.Free; inherited; end; procedure TMonDirThread.Execute; var hDir,cbReturn:dword; lpBuf:pointer; Ptr:PFileNotifyInformation; FileName:string; begin try hDir:=CreateFile(PChar(FPath),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir=INVALID_HANDLE_VALUE then RaiseLastOSError; try GetMem(lpBuf,BUF_SIZE); try

while not Terminated do begin ZeroMemory(lpBuf,BUF_SIZE); if(not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE,@cbReturn,nil,nil))or(cbReturn=0) then Break; Ptr:=lpBuf; repeat FileName:=WideCharLenToString(@(Ptr^.FileName),Ptr.FileNameLength div 2); case Ptr.Action of FILE_ACTION_ADDED: DataProcessor.ProcessFile(FPath+FileName); end; if Ptr^.NextEntryOffset=0 then break; Inc(integer(Ptr),Ptr^.NextEntryOffset); until false; end; finally FreeMem(lpBuf); end; finally CloseHandle(hDir); end; except if Assigned(ApplicationHandleException) then ApplicationHandleException(Self); end; end; end. TMonDirThread.Create("c:\");

← →
petvv (2009-03-18 11:38) [25]

Slym"у огромный респект, буду разбираться с твоим кодом. А решил всё так:
unit TxtToDbf; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables, ComCtrls, StdCtrls; const BUF_SIZE=1024; type TForm1 = class(TForm) Table1: TTable; LV: TListBox; procedure FormCreate(Sender: TObject); procedure CreateDBF(); procedure GetFields(InpString: string; fieldpos: Integer); function GetDat(InpString: string; nashpos: Integer; fieldpos: Integer): string; function GetNom(InpString: string; nashpos: Integer; fieldpos: Integer): string; private { Private declarations } public { Public declarations } end; var Form1: TForm1; Path, Full, ResultNom, ResultDat, Path1,fName, nName, Pole: String; Fields: Variant; nFileName:PWideChar; OldName:widestring; Result, KolStr, KolFields:Integer; procedure TxtToDbf1; implementation {$R *.dfm} procedure WorkThread(LV : TListView);stdcall; Type PFileNotifyInformation=^TFileNotifyInformation; TFileNotifyInformation=packed record NextEntryOffset:dword; Action:dword; FileNameLength:dword; FileName:PWideChar; end; var hDir : THandle; lpBuf : Pointer; cbReturn : Cardinal; FileName : PWideChar; Ptr:PFileNotifyInformation; begin hDir := CreateFile ("d:\Накладные",GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0); if hDir = INVALID_HANDLE_VALUE then begin ShowMessage(SysErrorMessage(GetLastError)); exit; end; GetMem(lpBuf,BUF_SIZE); repeat // очищаем память перед записью в нее (на всякий случай) ZeroMemory(lpBuf,BUF_SIZE); if not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true, FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE, @cbReturn,nil,nil) then Break; Ptr:=lpBuf; repeat GetMem(FileName,Ptr^.FileNameLength+2); ZeroMemory(FileName,Ptr^.FileNameLength+2); lstrcpynW(FileName,addr(Ptr^.FileName),Ptr.FileNameLength div 2+1); Full:= Path+"\"+FileName; FreeMem(FileName); case PFileNotifyInformation(Ptr).Action of FILE_ACTION_ADDED : if ExtractFileExt(Full)<>".dbf" Then TxtToDbf1(); end; if PFileNotifyInformation(Ptr).NextEntryOffset=0 then Break else begin Inc(Cardinal(Ptr),PFileNotifyInformation(Ptr).NextEntryOffset); end; until false; until false; FreeMem(lpBuf); end; procedure TForm1.FormCreate(Sender: TObject); var ThID, hThread : Cardinal; begin Path:="d:\Накладные"; hThread:=CreateThread(nil,0,@WorkThread,LV,0,ThID); // В случае неудачи выводим сообщение if hThread=0 then ShowMessage(SysErrorMessage(GetLastError)); end; ..... end.

petvv (18.03.09 11:38) [25]
Path, Full, ResultNom, ResultDat, Path1,fName, nName, Pole: String;
Fields: Variant;
nFileName:PWideChar;
OldName:widestring;
Result, KolStr, KolFields:Integer;
procedure TxtToDbf1;
Это на самом деле проблема!
У тебя глаз висит? печень наруже или мозг вскрыт? Пациент умрет

petvv (18.03.09 11:38) [25]
hThread:=CreateThread(nil,0,@WorkThread,LV,0,ThID);
Думаешь проблема только с дельфевыми потоками? сирано графика у тебя съедет в один прекрасный момент...
если хочешь логов то Post/SendMessage пользуй но не напрямую VCL

Вопрос по потокам Найти похожие ветки