From 0c1b97a6027e2341a2d68711e147d87be08ca411 Mon Sep 17 00:00:00 2001 From: George Hazan Date: Wed, 29 Aug 2018 13:49:40 +0300 Subject: ImportTXT moved to deprecated --- plugins/ImportTXT/ImportThrd.pas | 643 --------------------------------------- 1 file changed, 643 deletions(-) delete mode 100644 plugins/ImportTXT/ImportThrd.pas (limited to 'plugins/ImportTXT/ImportThrd.pas') diff --git a/plugins/ImportTXT/ImportThrd.pas b/plugins/ImportTXT/ImportThrd.pas deleted file mode 100644 index 4315977a0a..0000000000 --- a/plugins/ImportTXT/ImportThrd.pas +++ /dev/null @@ -1,643 +0,0 @@ -unit ImportThrd; - -interface - -uses - Classes, - Windows, - SysUtils, - StrUtils, - PerlRegEx, - m_api, - general, - ImportT, - ImportTU, - KOLEdb {ADODB if want to use ADO}; - -const - ITXT_THREAD_BASE = $8000 + $2000; // WM_APP + $2000 - ITXT_THREAD_START = ITXT_THREAD_BASE + 1; // Поток запустился (0,0) - ITXT_THREAD_MAXPROGRESS = ITXT_THREAD_BASE + 2; - // Мах прогресс (0, MaxProgress) - ITXT_THREAD_PROGRESS = ITXT_THREAD_BASE + 3; // Прогресс (Current, 0) - ITXT_THREAD_ERROR = ITXT_THREAD_BASE + 4; - // Возникла ошибка (PWideChar(ErrorString),0) - ITXT_THREAD_FINISH = ITXT_THREAD_BASE + 5; - // Завершение файла, подведение результатов (Added, Duplicates) - ITXT_THREAD_START_FILE = ITXT_THREAD_BASE + 6; - // Начали работать с файлом(PWideChar(FileName),0); - ITXT_THREAD_DEST_CONTACT = ITXT_THREAD_BASE + 7; - // Определили контакт (hContact,0) - ITXT_THREAD_ALLSTARTED = ITXT_THREAD_BASE + 8; // Началось - ITXT_THREAD_ALLFINISHED = ITXT_THREAD_BASE + 9; // Всё закончено :) - -type - TSendMethod = (smSend, smPost); - -type - TImportThrd = class(TThread) - private - { Private declarations } - RegExpr: TPerlRegEx; - hMapedFile: THandle; - hFile: THandle; - pFileText: Pointer; - FolderName: WideString; - FileName: WideString; - FileLen: Cardinal; - fContact: TDestContact; // Contact recognised by filename - AddedMessages: integer; - Duplicates: integer; - function DoMessage(Message: Longword; wParam: WPARAM; lParam: LPARAM; - Method: TSendMethod = smSend): Boolean; - function DoMapFile: Boolean; - procedure DoUnMapFile; - Procedure PreMessageSP(var src: AnsiString; CSP: integer); - procedure AddMsgToDB(hContact: THandle; Direction: integer; - MsgTimeStamp: Longword; const Text: AnsiString; var AddMsg, Dupy: integer); - procedure TextImportProcedure; - procedure BinImportProcedure; - protected - procedure Execute; override; - public - FileNames: WideString; // File Names - OffsetFileName: integer; // offset name of file in FileNames - WorkPattern: RTxtPattern; // Pattern for work - DContact: TDestContact; // Recognised or defined contact - Destination: TDestProto; // destination protocol - ParentHWND: Longword; // HWND of parent window - end; - -function IsDuplicateEvent(hContact: THandle; dbei: TDBEVENTINFO): Boolean; - -function PassMessage(Handle: THandle; Message: Longword; wParam: wParam; - lParam: lParam; Method: TSendMethod = smSend): Boolean; - -implementation - -// Returns TRUE if event already is in base -function IsDuplicateEvent(hContact: THandle; dbei: TDBEVENTINFO): Boolean; -var - hExistingDbEvent: THandle; - dbeiExisting: TDBEVENTINFO; - dwFirstEventTimeStamp: Longword; - dwLastEventTimeStamp: Longword; - dwPreviousTimeStamp: Longword; -begin - result := FALSE; - if not CheckForDuplicates then - exit; - hExistingDbEvent := db_event_first(hContact); - if hExistingDbEvent = 0 then - begin - result := FALSE; - exit; - end; - - FillChar(dbeiExisting, SizeOf(dbeiExisting), Byte(0)); - dbeiExisting.cbBlob := 0; - db_event_get(hExistingDbEvent, @dbeiExisting); - dwFirstEventTimeStamp := dbeiExisting.timestamp; - - hExistingDbEvent := db_event_last(hContact); - if hExistingDbEvent = 0 then - begin - result := FALSE; - exit; - end; - - FillChar(dbeiExisting, SizeOf(dbeiExisting), Byte(0)); - dbeiExisting.cbBlob := 0; - db_event_get(hExistingDbEvent, @dbeiExisting); - dwLastEventTimeStamp := dbeiExisting.timestamp; - - // If before the first - if (dbei.timestamp < dwFirstEventTimeStamp) then - begin - result := FALSE; - exit; - end; - - // If after the last - if (dbei.timestamp > dwLastEventTimeStamp) then - begin - result := FALSE; - exit; - end; - - dwPreviousTimeStamp := dwLastEventTimeStamp; - - if (dbei.timestamp <= dwPreviousTimeStamp) then // search from the end - begin - while (hExistingDbEvent <> 0) do - begin - FillChar(dbeiExisting, SizeOf(dbeiExisting), Byte(0)); - dbeiExisting.cbBlob := 0; - db_event_get(hExistingDbEvent, @dbeiExisting); - // compare event - if (dbei.timestamp = dbeiExisting.timestamp) and - ((dbei.flags) = (dbeiExisting.flags)) and - // fix for first event - (dbei.eventType = dbeiExisting.eventType) and - (dbei.cbBlob = dbeiExisting.cbBlob) then - begin - result := true; - exit; - end; - - if (dbei.timestamp > dbeiExisting.timestamp) then - begin - result := FALSE; - exit; - end; - // get the previous - hExistingDbEvent := db_event_prev(hContact,hExistingDbEvent); - end; - end; -end; - -Procedure TImportThrd.PreMessageSP(var src: AnsiString; CSP: integer); -var - i: integer; - ls: integer; - PSP, ASP: integer; -begin - ls := -1; - repeat - i := ls + 2; - PSP := 0; - while (src[i + PSP] = ' ') do - inc(PSP); - if PSP > 0 then - case WorkPattern.PreMsg.PreSP of - 0: PSP := 0; - -1: ; - -2: if PSP > CSP then - PSP := CSP; - else - if PSP > WorkPattern.PreMsg.PreSP then - PSP := WorkPattern.PreMsg.PreSP; - end; // case - Delete(src, i, PSP); - ls := PosEx(#$0D#$0A, src, i); - ASP := 0; - while (ls > 1) and (src[ls - ASP - 1] = ' ') do - inc(ASP); - if ASP > 0 then - case WorkPattern.PreMsg.AfterSP of - 0: ASP := 0; - -1: ; - -2: if ASP > CSP then - ASP := CSP; - else - if ASP > WorkPattern.PreMsg.AfterSP then - ASP := WorkPattern.PreMsg.AfterSP; - end; // case - Delete(src, ls - ASP - 1, ASP); - Until ls <= 0 -end; - -Procedure TImportThrd.AddMsgToDB(hContact: THandle; Direction: integer; - MsgTimeStamp: Longword; const Text: AnsiString; var AddMsg, Dupy: integer); -var - dbei: TDBEVENTINFO; - proto: AnsiString; - s: WideString; -begin - FillChar(dbei, SizeOf(dbei), Byte(0)); - dbei.eventType := EVENTTYPE_MESSAGE; - dbei.flags := Direction; - proto := GetContactProto(hContact); - dbei.szModule := PAnsiChar(proto); - dbei.timestamp := MsgTimeStamp; - dbei.cbBlob := Length(Text) + 1; - dbei.pBlob := PByte(AllocMem(dbei.cbBlob)); - try - Move(Text[1], dbei.pBlob^, dbei.cbBlob); - if not IsDuplicateEvent(hContact, dbei) then - if db_event_add(hContact, @dbei) <> 0 then - inc(AddMsg) - else - begin - s := 'Error adding message to database'; - DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0); - end - else - begin - if ShowDuplicates then - begin - if (dbei.flags and DBEF_SENT) > 0 then - s := '>' - else - s := '<'; - s := TranslateWideString('Duplicate:') + ' ' + s + ' ' + - TimeStampToWStr(dbei.timestamp); - DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0, smSend); - end; - inc(Dupy); - end; - finally - FreeMem(dbei.pBlob); - end; -end; - -function PassMessage(Handle: THandle; Message: Longword; wParam: wParam; - lParam: lParam; Method: TSendMethod = smSend): Boolean; -var - Tries: integer; -begin - result := true; - case Method of - smSend: - SendMessage(Handle, Message, wParam, lParam); - smPost: begin - Tries := 5; - while (Tries > 0) and not PostMessage(Handle, Message, wParam, - lParam) do - begin - Dec(Tries); - Sleep(5); - end; - result := (Tries > 0); - end; - end; -end; - -function TImportThrd.DoMessage(Message: Longword; wParam: wParam; - lParam: lParam; Method: TSendMethod = smSend): Boolean; -begin - result := PassMessage(ParentHWND, Message, wParam, lParam, Method); -end; - -function TImportThrd.DoMapFile: Boolean; -var - s: pWideChar; -begin - result := true; - hFile := CreateFileW(PWideChar(FileName), GENERIC_READ, 0, nil, - OPEN_EXISTING, 0, 0); - if hFile = INVALID_HANDLE_VALUE then - begin - result := FALSE; - s := 'Error opening file'; - DoMessage(ITXT_THREAD_ERROR, wparam(s), 0); - exit; - end; - FileLen := GetFileSize(hFile, nil); - hMapedFile := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, 'ImportTXTmapfile'); - if hMapedFile = 0 then - begin - result := FALSE; - s := 'Error mapping file'; - DoMessage(ITXT_THREAD_ERROR, wparam(s), 0); - exit; - end; - pFileText := MapViewOfFile(hMapedFile, FILE_MAP_READ, 0, 0, 0); - if pFileText = nil then - begin - result := FALSE; - s := 'Error mapping'; - DoMessage(ITXT_THREAD_ERROR, wparam(s), 0); - exit; - end; -end; - -procedure TImportThrd.DoUnMapFile; -begin - UnmapViewOfFile(pFileText); - pFileText := nil; - CloseHandle(hMapedFile); - CloseHandle(hFile); -end; - -procedure TryDetermContact(var DContact: TDestContact); -begin - if DContact.ProtoName <> '' then - begin - if DContact.ContactUID <> '' then - begin - DContact.hContact := GetContactByUID(DContact.ProtoName, DContact.ContactUID) - end - else if DContact.ContactNick <> '' then - begin - DContact.hContact := GetContactByNick(DContact.ProtoName, DContact.ContactNick); - end - else - DContact.hContact := INVALID_HANDLE_VALUE; - end - else - DContact.hContact := INVALID_HANDLE_VALUE; -end; - -procedure TImportThrd.TextImportProcedure; -var - PosCur, LenCur, PosNext: integer; - TextLength, h1, h2: integer; - PRN, ARN, j: DWORD; - msg_flag: integer; - DT: Longword; - TxtMsg: AnsiString; - s: WideString; - tempstr: PAnsiChar; - tempwstr: PWideChar; -begin - AddedMessages := 0; - Duplicates := 0; - Case WorkPattern.Charset of - inANSI: - begin - if WorkPattern.Codepage <> 0 then - tempstr := ANSIToUTF8(PAnsiChar(pFileText), tempstr, WorkPattern.Codepage) - else - tempstr := ANSIToUTF8(PAnsiChar(pFileText), tempstr, cp); - RegExpr.Subject := tempstr; - FreeMem(tempstr); - end; - inUTF8: - RegExpr.Subject := PAnsiChar(pFileText) + 3; - inUCS2: - begin - GetMem(tempwstr, FileLen + 2); - lstrcpynW(tempwstr, PWideChar(pFileText), FileLen); - tempwstr[FileLen div SizeOf(WideChar)] := #$0000; - // file is not ended dy #0000 - tempstr := WidetoUTF8(ChangeUnicode(tempwstr), tempstr); - RegExpr.Subject := tempstr; - FreeMem(tempstr); - FreeMem(tempwstr); - end; - end; // case - if (WorkPattern.UseHeader and 1) = 0 then - // If the information on a direction is not present that we will transform a line - begin - tempstr := ANSIToUTF8(PAnsiChar(WorkPattern.Msg.Incoming), tempstr, cp); - WorkPattern.Msg.Incoming := tempstr; - FreeMem(tempstr); - tempstr := ANSIToUTF8(PAnsiChar(WorkPattern.Msg.Outgoing), tempstr, cp); - WorkPattern.Msg.Outgoing := tempstr; - FreeMem(tempstr); - end; - if (WorkPattern.UseHeader > 0) then - begin - tempstr := ANSIToUTF8(PAnsiChar(WorkPattern.Header.Pattern), tempstr, cp); - RegExpr.RegEx := tempstr; - RegExpr.Options := [preMultiLine, preUTF8]; - FreeMem(tempstr); - if not RegExpr.Match then - begin - s := TranslateWideString('Header not found'); - DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0); - exit; - end - else - begin - if (WorkPattern.UseHeader and 1) = 1 then - begin - WorkPattern.Msg.Incoming := RegExpr.SubExpressions[WorkPattern.Header.Incoming]; - WorkPattern.Msg.Outgoing := RegExpr.SubExpressions[WorkPattern.Header.Outgoing]; - end; - if (WorkPattern.UseHeader and 2) = 2 then - if (DContact.hContact = 0) or - (DContact.hContact = INVALID_HANDLE_VALUE) then - begin - if WorkPattern.Header.InUID <> 0 then - DContact.ContactUID := RegExpr.SubExpressions[WorkPattern.Header.InUID] - else - DContact.ContactUID := ''; - if WorkPattern.Header.InNick <> 0 then - DContact.ContactNick := RegExpr.SubExpressions[WorkPattern.Header.InNick] - else - DContact.ContactNick := ''; - TryDetermContact(DContact); - end; - end; - end; - // Whether if it has not turned out to define in header then we look it was defined in a file - if (DContact.hContact = 0) or (DContact.hContact = INVALID_HANDLE_VALUE) then - if (fContact.hContact <> 0) and (fContact.hContact <> INVALID_HANDLE_VALUE) then - DContact := fContact; - if (DContact.hContact <> 0) and (DContact.hContact <> INVALID_HANDLE_VALUE) then - begin - DoMessage(ITXT_THREAD_DEST_CONTACT, DContact.hContact, 0); - DoMessage(ITXT_THREAD_START, 0, 0); - tempstr := ANSIToUTF8(PAnsiChar(WorkPattern.Msg.Pattern), tempstr, cp); - RegExpr.RegEx := tempstr; - RegExpr.Options := [preMultiLine, preUTF8]; - FreeMem(tempstr); - - TextLength := Length(RegExpr.Subject) - 1; // Position of last symbol - DoMessage(ITXT_THREAD_MAXPROGRESS, 0, TextLength); - RegExpr.State := [preNotEmpty]; - // search for regular expression - if not RegExpr.Match then - begin - s := TranslateWideString('No messages in this file'); - DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0); - end - else - begin - PosCur := RegExpr.MatchedExpressionOffset; - // get the position of RegExpression - repeat - LenCur := RegExpr.MatchedExpressionLength; - // get the length of RegExpression - // Further we define a message direction (incoming or outgoing) - if RegExpr.SubExpressions[WorkPattern.Msg.Direction] = WorkPattern.Msg.Incoming then - msg_flag := DBEF_READ - else - msg_flag := DBEF_READ or DBEF_SENT; - msg_flag := msg_flag or DBEF_UTF; - // make timestamp - if WorkPattern.Msg.Seconds <> 0 then - DT := timestamp - (StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Year]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Month]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Day]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Hours]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Minutes]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Seconds])) - else - DT := timestamp - (StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Year]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Month]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Day]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Hours]), - StrToInt(RegExpr.SubExpressions[WorkPattern.Msg.Minutes]), 0); - - if RegExpr.MatchAgain then - PosNext := RegExpr.MatchedExpressionOffset - // search for next regexpr - else - PosNext := TextLength; // if not then end of file - h1 := PosCur + LenCur; // The message text beginning presumably - h2 := PosNext - PosCur - LenCur - 2; // its presumably message length - // working with message text - if WorkPattern.UsePreMsg then - PRN := DWORD(WorkPattern.PreMsg.PreRN) - else - PRN := DWORD(-1); - if PRN <> 0 then - begin - j := 1; - while ((RegExpr.Subject[h1] = Char($0D)) and - (RegExpr.Subject[h1 + 1] = Char($0A))) and (j <= PRN) do - begin - inc(h1, 2); - Dec(h2, 2); - inc(j); - end; // remove carriage return in the beginning - end; - if WorkPattern.UsePreMsg then - ARN := DWORD(WorkPattern.PreMsg.AfterRN) - else - ARN := DWORD(-1); - if ARN <> 0 then - begin - j := 1; - while ((RegExpr.Subject[h1 + h2] = Char($0D)) and - (RegExpr.Subject[h1 + h2 + 1] = Char($0A))) and (j <= ARN) do - begin - Dec(h2, 2); - inc(j) - end; // remove carriage return in the end - end; - // get the message text - TxtMsg := Copy(RegExpr.Subject, h1, h2 + 2); - // remove spaces if needs - if WorkPattern.UsePreMsg and - ((WorkPattern.PreMsg.PreSP <> 0) or - (WorkPattern.PreMsg.AfterSP <> 0)) then - PreMessageSP(TxtMsg, UTF8Len(PAnsiChar(RegExpr.MatchedExpression))); - AddMsgToDB(DContact.hContact, msg_flag, DT, TxtMsg, AddedMessages, - Duplicates); // adding in base - PosCur := PosNext; - DoMessage(ITXT_THREAD_PROGRESS, PosCur, 0); - until (PosNext = TextLength) or Terminated; - end; // RegExpr.Exec - end - else - begin - s := TranslateWideString('Can''t determine destination contact'); - DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0); - end; -end; - -procedure TImportThrd.BinImportProcedure; -var - i: integer; - s: WideString; - tempstr: PAnsiChar; -var - dbei: TDBEVENTINFO; - evSize: integer; - proto: AnsiString; - pt: int_ptr; - fsz: cardinal; -{$DEFINE BIN_IMPORT_} -{$I BmContactIP.inc} -{$I BqhfIP.inc} -{$I BICQ6IP.inc} -{$I BICQ5IP.inc} -{$I BRMSIP.inc} -{$I BbayanIP.inc} -{$UNDEF BIN_IMPORT_} -begin - AddedMessages := 0; - Duplicates := 0; - case WorkPattern.BinProc of - 1: // mContactImport - {$I BmContactIP.inc} - 2: // QHF - {$I BqhfIP.inc} - 3: // ICQ6 - {$I BICQ6IP.inc} - 4: // ICQ5 - {$I BICQ5IP.inc} - 5: // Nokia midp-rms - {$I BRMSIP.inc} - 6: // BayanICQ - {$I BbayanIP.inc} - end; -end; - -procedure TImportThrd.Execute; -var - i: integer; - s1: WideString; - tempstr: PAnsiChar; -begin - DoMessage(ITXT_THREAD_ALLSTARTED, 0, 0); - FolderName := Copy(FileNames, 1, OffsetFileName - 1); - i := OffsetFileName; - while (FileNames[i + 1] <> #0) and not Terminated do - begin // начало цикла по файлам - s1 := ''; - inc(i); - while FileNames[i] <> #0 do - begin - s1 := s1 + FileNames[i]; - inc(i); - end; - if (s1 <> '') and (s1 <> #0) then - begin // Начинаем работать с файлом - FileName := FolderName + '\' + s1; - DoMessage(ITXT_THREAD_START_FILE, wparam(PWideChar(FileName)),0, smSend); - pFileText := nil; - hFile := INVALID_HANDLE_VALUE; - DContact.ProtoName := Destination.ProtoName; - fContact.hContact := INVALID_HANDLE_VALUE; - RegExpr := TPerlRegEx.Create; - // Создаём объект для работы с рег. выражениями - try - // Поработаем с именем файла - if WorkPattern.UseFileName then - if (DContact.hContact = 0) or - (DContact.hContact = INVALID_HANDLE_VALUE) then - begin - tempstr := WidetoUTF8(PWideChar(FileName), tempstr); - RegExpr.Subject := tempstr; - FreeMem(tempstr); - tempstr := ANSIToUTF8(PAnsiChar(WorkPattern.FName.Pattern),tempstr, cp); - RegExpr.RegEx := tempstr; - FreeMem(tempstr); - RegExpr.Options := [preUTF8]; - - if RegExpr.Match then - begin - fContact.ProtoName := Destination.ProtoName; - if WorkPattern.FName.InUID <> 0 then - fContact.ContactUID := RegExpr.SubExpressions[WorkPattern.FName.InUID] - else - fContact.ContactUID := ''; - if WorkPattern.FName.InNick <> 0 then - fContact.ContactNick := RegExpr.SubExpressions[WorkPattern.FName.InNick] - else - fContact.ContactNick := ''; - TryDetermContact(fContact); - end; - end; - - // Загружаем сам файл - // [preMultiLine] модификатор для восприятия многострочного текста - if DoMapFile then // Загружаем файл - begin - db_set_safety_mode(0); - case WorkPattern.IType of - 1: TextImportProcedure; - 2: BinImportProcedure; - end; // case - end; // DoMapFile - finally - db_set_safety_mode(1); - DoMessage(ITXT_THREAD_FINISH, AddedMessages, Duplicates); - DoUnMapFile; - RegExpr.Free; - end; - DContact.hContact := INVALID_HANDLE_VALUE; - Sleep(10); // чтобы все сообщения дошли до окна - end; // закончили работать с файлом - end; // цикла по файлам - DoMessage(ITXT_THREAD_ALLFINISHED, 0, 0); -end; - -end. -- cgit v1.2.3