the only valuable idea from mirevents.pas moved into history++

2 files changed, 10 insertions, 446 deletions

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.