From ffc5a3d7550528281976745279e77ac9faba551b Mon Sep 17 00:00:00 2001 From: George Hazan Date: Sat, 5 Jun 2021 15:44:37 +0300 Subject: the only valuable idea from mirevents.pas moved into history++ --- plugins/HistoryPlusPlus/hpp_events.pas | 13 +- plugins/Utils.pas/mirevents.pas | 443 --------------------------------- 2 files changed, 10 insertions(+), 446 deletions(-) delete mode 100644 plugins/Utils.pas/mirevents.pas (limited to 'plugins') diff --git a/plugins/HistoryPlusPlus/hpp_events.pas b/plugins/HistoryPlusPlus/hpp_events.pas index c4dde1817d..2f980162f0 100644 --- a/plugins/HistoryPlusPlus/hpp_events.pas +++ b/plugins/HistoryPlusPlus/hpp_events.pas @@ -385,14 +385,21 @@ begin BlobSize := db_event_getBlobSize(hDBEvent); if BlobSize > 0 then begin - EventBuffer.Allocate(BlobSize); + EventBuffer.Allocate(BlobSize+2); // cheat, for possible crash avoid Result.pBlob := EventBuffer.Buffer; end else BlobSize := 0; - Result.cbBlob := BlobSize; + if db_event_get(hDBEvent, @Result) = 0 then - Result.cbBlob := BlobSize + begin + Result.cbBlob := BlobSize; + if BlobSize > 0 then + begin + PAnsiChar(Result.pBlob)[BlobSize ]:=#0; + PAnsiChar(Result.pBlob)[BlobSize+1]:=#0; + end; + end else Result.cbBlob := 0; end; diff --git a/plugins/Utils.pas/mirevents.pas b/plugins/Utils.pas/mirevents.pas deleted file mode 100644 index 1b5f1e3573..0000000000 --- a/plugins/Utils.pas/mirevents.pas +++ /dev/null @@ -1,443 +0,0 @@ -{$Include compilers.inc} -unit mirevents; - -interface - -uses - Windows, - m_api; - -type - TBaseEventType = ( - mtUnknown, - mtMessage, mtFile, mtSystem, mtContacts, mtStatus, - mtOther); - - PMessageTypes = ^TMessageTypes; - TMessageTypes = set of TBaseEventType; - -const - BaseEventNames: array[TBaseEventType] of PAnsiChar = ( - 'Unknown', - 'Message', // SKINICON_EVENT_MESSAGE - 'Link', // SKINICON_EVENT_URL - 'File transfer', // SKINICON_EVENT_FILE - 'System message', // SKINICON_OTHER_MIRANDA, SKINICON_OTHER_MIRANDAWEB, - 'Contacts', // SKINICON_OTHER_ADDCONTACT, SKINICON_OTHER_USERDETAILS - 'Status changes', // SKINICON_OTHER_STATUS, SKINICON_STATUS_* (MS_SKIN_LOADPROTOICON) - 'Other events (unknown)' - ); - -//----- Event info ----- - -procedure GetEventInfo (hDBEvent: TMEVENT; var EventInfo: TDBEventInfo); -function GetEventTimestamp(hDBEvent: TMEVENT): DWord; -function GetEventDateTime (hDBEvent: TMEVENT): TDateTime; -function GetEventCoreText (const EventInfo: TDBEventInfo; cp: integer = CP_ACP): PWideChar; - -//----- Event check ----- - -function IsIncomingEvent(const EventInfo: TDBEventInfo):boolean; overload; -function IsIncomingEvent(hDBEvent: TMEVENT):boolean; overload; -function IsOutgoingEvent(const EventInfo: TDBEventInfo):boolean; overload; -function IsOutgoingEvent(hDBEvent: TMEVENT):boolean; overload; -function IsReadedEvent (const EventInfo: TDBEventInfo):boolean; overload; -function IsReadedEvent (hDBEvent: TMEVENT):boolean; overload; - -function GetEventBaseType(EventInfo: TDBEventInfo): TBaseEventType; overload; -function GetEventBaseType(hDBEvent : TMEVENT ): TBaseEventType; overload; - -//----- Custom events processing ----- - -//procedure ReadEvent (hDBEvent: TMEVENT; var EventInfo: TDBEventInfo; UseCP: Cardinal = CP_ACP); -//function GetEventName(const Hi: THistoryItem):PAnsiChar; - -function GetEventText(hDBEvent: TMEVENT ; custom:boolean; cp:integer=CP_ACP):PWideChar; overload; -function GetEventText(const EventInfo: TDBEventInfo; custom:boolean; cp:integer=CP_ACP):PWideChar; overload; - - -implementation - -uses - common, - datetime; - -//----- Event info ----- - -procedure GetEventInfo(hDBEvent: TMEVENT; var EventInfo: TDBEventInfo); -var - BlobSize: integer; -begin - ZeroMemory(@EventInfo, SizeOf(EventInfo)); - EventInfo.cbSize := SizeOf(EventInfo); - BlobSize := db_event_getBlobSize(hDBEvent); - if BlobSize > 0 then - begin - mGetMem(EventInfo.pBlob,BlobSize+2); // cheat, for possible crash avoid - end - else - BlobSize := 0; - EventInfo.cbBlob := BlobSize; - if db_event_get(hDBEvent, @EventInfo) = 0 then - begin - EventInfo.cbBlob := BlobSize; - if BlobSize > 0 then - begin - PAnsiChar(EventInfo.pBlob)[BlobSize ]:=#0; - PAnsiChar(EventInfo.pBlob)[BlobSize+1]:=#0; - end; - end - else - EventInfo.cbBlob := 0; -end; - -function GetEventCoreText(const EventInfo: TDBEventInfo; cp: integer = CP_ACP): PWideChar; -var - dbegt: TDBEVENTGETTEXT; - msg: PWideChar; -begin - dbegt.dbei := @EventInfo; - dbegt.datatype := DBVT_WCHAR; - dbegt.codepage := cp; - - msg := PWideChar(CallService(MS_DB_EVENT_GETTEXT,0,LPARAM(@dbegt))); - - result := AdjustLineBreaks(msg); - result := rtrimw(result); - - mir_free(msg); -end; - -//----- Info functions (no blob required) ----- -var - RecentEvent: THANDLE = 0; - RecentEventInfo: TDBEventInfo; - -procedure CheckRecent(hDBEvent: TMEVENT); -begin - if RecentEvent <> hDBEvent then - begin - ZeroMemory(@RecentEventInfo, SizeOf(RecentEventInfo)); - RecentEventInfo.cbSize := SizeOf(RecentEventInfo); - RecentEventInfo.cbBlob := 0; - db_event_get(hDBEvent, @RecentEventInfo); - RecentEvent := hDBEvent; - end; -end; - -function GetEventTimestamp(hDBEvent: TMEVENT): DWord; -begin - CheckRecent(hDBEvent); - Result := RecentEventInfo.timestamp; -end; - -function GetEventDateTime(hDBEvent: TMEVENT): TDateTime; -begin - Result := TimestampToDateTime(GetEventTimestamp(hDBEvent)); -end; - -//----- Event check ----- - -function IsIncomingEvent(const EventInfo: TDBEventInfo):boolean; - {$IFDEF AllowInline}inline;{$ENDIF} -begin - Result:=(EventInfo.flags and DBEF_SENT) = 0 -end; - -function IsIncomingEvent(hDBEvent: TMEVENT):boolean; -begin - CheckRecent(hDBEvent); - Result:=(RecentEventInfo.flags and DBEF_SENT) = 0 -end; - -function IsOutgoingEvent(const EventInfo: TDBEventInfo):boolean; - {$IFDEF AllowInline}inline;{$ENDIF} -begin - result:=(EventInfo.flags and DBEF_SENT) <> 0; -end; - -function IsOutgoingEvent(hDBEvent: TMEVENT):boolean; -begin - CheckRecent(hDBEvent); - result:=(RecentEventInfo.flags and DBEF_SENT) <> 0; -end; - -function IsReadedEvent(const EventInfo: TDBEventInfo):boolean; - {$IFDEF AllowInline}inline;{$ENDIF} -begin - result:=(EventInfo.flags and DBEF_READ) <> 0; -end; - -function IsReadedEvent(hDBEvent: TMEVENT):boolean; -begin - CheckRecent(hDBEvent); - result:=(RecentEventInfo.flags and DBEF_READ) <> 0; -end; - -//----- Not pure miranda functions ----- - -type - TEventTableItem = record - EventType : Word; - MessageType : TBaseEventType; - end; - -var - BuiltinEventTable: array[0..5] of TEventTableItem = ( - // must be the first item in array for unknown events - (EventType: MaxWord; MessageType: mtOther), - // events definitions - (EventType: EVENTTYPE_MESSAGE; MessageType: mtMessage), - (EventType: EVENTTYPE_FILE; MessageType: mtFile), - (EventType: EVENTTYPE_AUTHREQUEST; MessageType: mtSystem), - (EventType: EVENTTYPE_ADDED; MessageType: mtSystem), - (EventType: EVENTTYPE_CONTACTS; MessageType: mtContacts) - ); - -function GetEventBaseType(EventInfo: TDBEventInfo): TBaseEventType; -var - i: Integer; - EventIndex: Integer; -begin - EventIndex := 0; - - if EventInfo.szModule = nil then - begin - for i := 1 to High(BuiltinEventTable) do - if BuiltinEventTable[i].EventType = EventInfo.EventType then - begin - EventIndex := i; - break; - end; - end; - - Result := BuiltinEventTable[EventIndex].MessageType; -end; - -function GetEventBaseType(hDBEvent: TMEVENT): TBaseEventType; -begin - CheckRecent(hDBEvent); - Result := GetEventBaseType(RecentEventInfo); -end; - -//----- Custom events processing ----- - - -function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word; -begin - GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result) -end; - -function IsWideCharAlphaNumeric(WC: WideChar): Boolean; -begin - Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0; -end; - -const - UrlPrefix: array[0..1] of PWideChar = ( - 'www.', - 'ftp.'); - -const - UrlProto: array[0..12] of record - Proto: PWideChar; - Idn : Boolean; - end = ( - (Proto: 'http:/'; Idn: True;), - (Proto: 'ftp:/'; Idn: True;), - (Proto: 'file:/'; Idn: False;), - (Proto: 'mailto:/'; Idn: False;), - (Proto: 'https:/'; Idn: True;), - (Proto: 'gopher:/'; Idn: False;), - (Proto: 'nntp:/'; Idn: False;), - (Proto: 'prospero:/'; Idn: False;), - (Proto: 'telnet:/'; Idn: False;), - (Proto: 'news:/'; Idn: False;), - (Proto: 'wais:/'; Idn: False;), - (Proto: 'outlook:/'; Idn: False;), - (Proto: 'callto:/'; Idn: False;)); - -function TextHasUrls(text: PWideChar): Boolean; -var - i,len: Integer; - buf,pPos: PWideChar; -begin - Result := False; - len := StrLenW(text); - if len=0 then exit; - - // search in URL Prefixes like "www" - // make Case-insensitive?? - - for i := 0 to High(UrlPrefix) do - begin - pPos := StrPosW(text, UrlPrefix[i]); - if not Assigned(pPos) then - continue; - Result := ((uint_ptr(pPos) = uint_ptr(text)) or not IsWideCharAlphaNumeric((pPos - 1)^)) and - IsWideCharAlphaNumeric((pPos + StrLenW(UrlPrefix[i]))^); - if Result then - exit; - end; - - // search in url protos like "http:/" - - if StrPosW(text,':/') = nil then exit; - - StrDupW(buf,text); - - CharLowerBuffW(buf,len); - for i := 0 to High(UrlProto) do - begin - pPos := StrPosW(buf, UrlProto[i].proto); - if not Assigned(pPos) then - continue; - Result := ((uint_ptr(pPos) = uint_ptr(buf)) or - not IsWideCharAlphaNumeric((pPos - 1)^)); - if Result then - break; - end; - mFreeMem(buf); -end; - -type - TCustomEvent = record - Module : PAnsiChar; - EventType : Word; - MessageType : TBaseEventType; - end; -const - CustomEventTable: array [0..4] of TCustomEvent = ( - (Module:'WATrack' ; EventType:EVENTTYPE_WAT_REQUEST {; MessageType:}), - (Module:'WATrack' ; EventType:EVENTTYPE_WAT_ANSWER {; MessageType:}), - (Module:'WATrack' ; EventType:EVENTTYPE_WAT_MESSAGE {; MessageType:}), - (Module:'NewStatusNotify'; EventType:EVENTTYPE_STATUSCHANGE {; MessageType:}), - (Module:'Nudge' ; EventType:1 {; MessageType:}) - ); - -//----- Support functions ----- - -//----- Custom standard event text ----- - -function GetEventTextForUrl(const EventInfo: TDBEventInfo):PWideChar; -var - pc:PAnsiChar; - len,lend,lenf:integer; - - url,desc: PAnsiChar; - urlw: PWideChar; -// cp: Cardinal; -begin - //blob is: URL(ASCII) or URL(ASCIIZ),description(ASCIIZ) - len := StrLen(PAnsiChar(EventInfo.pBlob)); - if (integer(EventInfo.cbBlob)-len)>2 then // possible have description - begin - desc := PAnsiChar(EventInfo.pBlob) + len + 1; - lend := StrLen(desc); - end - else - begin - desc := nil; - lend := 0; - end; - - lenf := len; - if lend > 0 then - inc(lenf, lend + 2 + 1); // #13#10 + #0 - mGetMem(url, lenf); - pc := StrCopyE(url, PAnsiChar(EventInfo.pBlob)); - if lend > 0 then - begin - pc^ := #13; inc(pc); - pc^ := #10; inc(pc); - StrCopy(pc,desc); - end; - - if (EventInfo.flags and DBEF_UTF)<>0 then - UTF8ToWide(url,urlw) - else - AnsiToWide(url,urlw); // with proper codepage must be - mFreeMem(url); - result := FormatStrW('URL: %s', [urlw]); - mFreeMem(urlw); -// hi.Extended := PAnsiChar(EventInfo.pBlob); -end; - -function GetEventTextForFile(const EventInfo: TDBEventInfo):PWideChar; -var - pc,filea,fname,desc:PAnsiChar; - format, filew:PWideChar; - len:integer; -// cp: Cardinal; -begin - //blob is: sequenceid(DWORD),filename(ASCIIZ),description(ASCIIZ) - fname:=PAnsiChar(EventInfo.pBlob) + SizeOf(DWORD); - len :=StrLen(fname); - desc :=fname + len + 1; - if desc^ <> #0 then - inc(len, 2 + StrLen(desc)); // +#13#10 - mGetMem(filea, len + 1); // +#0 - pc := StrCopyE(filea, fname); - if desc^ <> #0 then - begin - pc^ := #13; inc(pc); - pc^ := #10; inc(pc); - StrCopy(pc,desc); - end; - - if (EventInfo.flags and DBEF_SENT) <> 0 then - format := 'Outgoing file transfer: %s' - else - format := 'Incoming file transfer: %s'; - - if (EventInfo.flags and DBEF_UTF)<>0 then - UTF8ToWide(filea,filew) - else - AnsiToWide(filea,filew); // with proper codepage must be - mFreeMem(filea); - result := FormatStrW(format, [filew]); - mFreeMem(filew); -// Hi.Extended := PAnsiChar(EventInfo.pBlob) + SizeOf(DWORD); -end; - - -function GetEventText(const EventInfo: TDBEventInfo; custom:boolean; cp:integer=CP_ACP):PWideChar; -begin - result:=nil; - if not custom then - begin - result:=GetEventCoreText(EventInfo); - // ok if registered with text service - // ok if have text in blob - end; - if (result = nil) or custom then - begin - end; -end; - -function GetEventText(hDBEvent: TMEVENT; custom:boolean; cp:integer=CP_ACP):PWideChar; -var - EventInfo: TDBEventInfo; -begin - GetEventInfo(hDBEvent, EventInfo); - result:=GetEventText(EventInfo, custom); -end; - -function GetStandardEventIcon(const EventInfo: TDBEventInfo):HICON; -var - idx:integer; -begin - case GetEventBaseType(EventInfo) of - mtMessage : idx:=SKINICON_EVENT_MESSAGE; - mtFile : idx:=SKINICON_EVENT_FILE; - mtStatus : begin - result:=0; - exit; - end; - else - idx:=0; - end; - result:=Skin_LoadIcon(idx,0); -end; - -end. -- cgit v1.2.3