Форум: "Начинающим";
Текущий архив: 2009.05.03;
Скачать: [xml.tar.bz2];

Вниз

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

← →
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("Изменено")

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

---

← →
Slym ©   (2009-03-18 05:57) [20]

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

---

← →
Slym ©   (2009-03-18 06:34) [21]

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

---

← →
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 не появляются нужные ссылки. А появляются они только после того как начнёш чегой то в ентой секции менять. Во пипец.


---

← →
Slym ©   (2009-03-18 08:35) [23]

это ты тупиЩъ...
вот так должно выглядеть и никаких 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

---

← →
Slym ©   (2009-03-18 08:35) [24]

       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.


---

← →
Slym ©   (2009-03-18 11:48) [26]

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;
Это на самом деле проблема!
У тебя глаз висит? печень наруже или мозг вскрыт? Пациент умрет

---

← →
Slym ©   (2009-03-18 11:52) [27]

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

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2009.05.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.59 MB
Время: 0.018 c