History++ sources upload (all files, no project)

git-svn-id: http://svn.miranda-ng.org/main/trunk@756 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 269 insertions, 0 deletions

diff --git a/plugins/HistoryPlusPlus/hpp_contacts.pas b/plugins/HistoryPlusPlus/hpp_contacts.pas
new file mode 100644
index 0000000000..32d938224e
--- /dev/null
+++ b/plugins/HistoryPlusPlus/hpp_contacts.pas
@@ -0,0 +1,269 @@
+(*

+  History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*

+

+  Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.

+  History+ parts (C) 2001 Christian Kastner

+

+  This program is free software; you can redistribute it and/or modify

+  it under the terms of the GNU General Public License as published by

+  the Free Software Foundation; either version 2 of the License, or

+  (at your option) any later version.

+

+  This program is distributed in the hope that it will be useful,

+  but WITHOUT ANY WARRANTY; without even the implied warranty of

+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+  GNU General Public License for more details.

+

+  You should have received a copy of the GNU General Public License

+  along with this program; if not, write to the Free Software

+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

+*)

+

+{ -----------------------------------------------------------------------------

+  hpp_contacts (historypp project)

+

+  Version:   1.0

+  Created:   31.03.2003

+  Author:    Oxygen

+

+  [ Description ]

+

+  Some helper routines for contacts

+

+  [ History ]

+  1.0 (31.03.2003) - Initial version

+

+  [ Modifications ]

+

+  [ Knows Inssues ]

+  None

+

+  Contributors: theMIROn, Art Fedorov

+  ----------------------------------------------------------------------------- }

+

+unit hpp_contacts;

+

+interface

+

+uses

+  Windows, SysUtils,

+  Forms,

+  hpp_global,

+  hpp_database;

+

+function GetContactDisplayName(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): String;

+function GetContactProto(hContact: THandle): AnsiString; overload;

+function GetContactProto(hContact: THandle; var SubContact: THandle; var SubProtocol: AnsiString): AnsiString; overload;

+function GetContactID(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): AnsiString;

+function GetContactCodePage(hContact: THandle; Proto: AnsiString = ''): Cardinal; overload;

+function GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean): Cardinal; overload;

+function WriteContactCodePage(hContact: THandle; CodePage: Cardinal; Proto: AnsiString = ''): boolean;

+function GetContactRTLMode(hContact: THandle; Proto: AnsiString = ''): boolean;

+function GetContactRTLModeTRTL(hContact: THandle; Proto: AnsiString = ''): TRTLMode;

+function WriteContactRTLMode(hContact: THandle; RTLMode: TRTLMode; Proto: AnsiString = ''): boolean;

+

+implementation

+

+uses hpp_options, m_api;

+

+function GetContactProto(hContact: THandle): AnsiString;

+begin

+  Result := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0));

+end;

+

+function GetContactProto(hContact: THandle; var SubContact: THandle; var SubProtocol: AnsiString): AnsiString;

+begin

+  Result := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0));

+  if MetaContactsEnabled and (Result = MetaContactsProto) then

+  begin

+    SubContact := CallService(MS_MC_GETMOSTONLINECONTACT, hContact, 0);

+    SubProtocol := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, SubContact, 0));

+  end

+  else

+  begin

+    SubContact := hContact;

+    SubProtocol := Result;

+  end;

+end;

+

+function GetContactDisplayName(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): String;

+var

+  ci: TContactInfo;

+  RetPWideChar, UW: PChar;

+begin

+  if (hContact = 0) and Contact then

+    Result := TranslateW('Server')

+  else

+  begin

+    if Proto = '' then

+      Proto := GetContactProto(hContact);

+    if Proto = '' then

+      Result := TranslateW('''(Unknown Contact)''' { TRANSLATE-IGNORE } )

+    else

+    begin

+      ci.cbSize := SizeOf(ci);

+      ci.hContact := hContact;

+      ci.szProto := PAnsiChar(Proto);

+      ci.dwFlag := CNF_DISPLAY + CNF_UNICODE;

+      if CallService(MS_CONTACT_GETCONTACTINFO, 0, LPARAM(@ci)) = 0 then

+      begin

+        RetPWideChar := ci.retval.szVal.w;

+        UW := TranslateW('''(Unknown Contact)''' { TRANSLATE-IGNORE } );

+        if WideCompareText(RetPWideChar, UW) = 0 then

+          Result := AnsiToWideString(GetContactID(hContact, Proto), CP_ACP)

+        else

+          Result := RetPWideChar;

+        mir_free(RetPWideChar);

+      end

+      else

+        Result := String(GetContactID(hContact, Proto));

+      if Result = '' then

+        Result := TranslateAnsiW(Proto { TRANSLATE-IGNORE } );

+    end;

+  end;

+end;

+

+function GetContactID(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): AnsiString;

+var

+  uid: PAnsiChar;

+  dbv: TDBVARIANT;

+  cgs: TDBCONTACTGETSETTING;

+  tmp: String;

+begin

+  Result := '';

+  if not((hContact = 0) and Contact) then

+  begin

+    if Proto = '' then

+      Proto := GetContactProto(hContact);

+    uid := PAnsiChar(CallProtoService(PAnsiChar(Proto), PS_GETCAPS, PFLAG_UNIQUEIDSETTING, 0));

+    if (Cardinal(uid) <> CALLSERVICE_NOTFOUND) and (uid <> nil) then

+    begin

+      cgs.szModule := PAnsiChar(Proto);

+      cgs.szSetting := uid;

+      cgs.pValue := @dbv;

+      if CallService(MS_DB_CONTACT_GETSETTING, hContact, LPARAM(@cgs)) = 0 then

+      begin

+        case dbv._type of

+          DBVT_BYTE:

+            Result := AnsiString(intToStr(dbv.bVal));

+          DBVT_WORD:

+            Result := AnsiString(intToStr(dbv.wVal));

+          DBVT_DWORD:

+            Result := AnsiString(intToStr(dbv.dVal));

+          DBVT_ASCIIZ:

+            Result := AnsiString(dbv.szVal.a);

+          DBVT_UTF8:

+            begin

+              tmp := AnsiToWideString(dbv.szVal.a, CP_UTF8);

+              Result := WideToAnsiString(tmp, hppCodepage);

+            end;

+          DBVT_WCHAR:

+            Result := WideToAnsiString(dbv.szVal.w, hppCodepage);

+        end;

+        // free variant

+        DBFreeVariant(@dbv);

+      end;

+    end;

+  end;

+end;

+

+function WriteContactCodePage(hContact: THandle; CodePage: Cardinal; Proto: AnsiString = ''): boolean;

+begin

+  Result := false;

+  if Proto = '' then

+    Proto := GetContactProto(hContact);

+  if Proto = '' then

+    exit;

+  WriteDBWord(hContact, Proto, 'AnsiCodePage', CodePage);

+  Result := True;

+end;

+

+function _GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean) : Cardinal;

+begin

+  if Proto = '' then

+    Proto := GetContactProto(hContact);

+  if Proto = '' then

+    Result := hppCodepage

+  else

+  begin

+    Result := GetDBWord(hContact, Proto, 'AnsiCodePage', $FFFF);

+    If Result = $FFFF then

+      Result := GetDBWord(0, Proto, 'AnsiCodePage', CP_ACP);

+    UsedDefault := (Result = CP_ACP);

+    if UsedDefault then

+      Result := GetACP();

+  end;

+end;

+

+function GetContactCodePage(hContact: THandle; Proto: AnsiString = ''): Cardinal;

+var

+  def: boolean;

+begin

+  Result := _GetContactCodePage(hContact, Proto, def);

+end;

+

+function GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean): Cardinal; overload;

+begin

+  Result := _GetContactCodePage(hContact, Proto, UsedDefault);

+end;

+

+// OXY: 2006-03-30

+// Changed default RTL mode from SysLocale.MiddleEast to

+// Application.UseRightToLeftScrollBar because it's more correct and

+// doesn't bug on MY SYSTEM!

+function GetContactRTLMode(hContact: THandle; Proto: AnsiString = ''): boolean;

+var

+  Temp: Byte;

+begin

+  if Proto = '' then

+    Proto := GetContactProto(hContact);

+  if Proto = '' then

+    Result := GetDBBool(hppDBName, 'RTL', Application.UseRightToLeftScrollBar)

+  else

+  begin

+    Temp := GetDBByte(hContact, Proto, 'RTL', 255);

+    // we have no per-proto rtl setup ui, use global instead

+    // if Temp = 255 then

+    // Temp := GetDBByte(0,Proto,'RTL',255);

+    if Temp = 255 then

+      Temp := GetDBByte(hppDBName, 'RTL', Byte(Application.UseRightToLeftScrollBar));

+    Result := boolean(Temp);

+  end;

+end;

+

+function WriteContactRTLMode(hContact: THandle; RTLMode: TRTLMode; Proto: AnsiString = ''): boolean;

+begin

+  Result := false;

+  if Proto = '' then

+    Proto := GetContactProto(hContact);

+  if Proto = '' then

+    exit;

+  case RTLMode of

+    hppRTLDefault: DBDeleteContactSetting(hContact, PAnsiChar(Proto), 'RTL');

+    hppRTLEnable:  WriteDBByte(hContact, Proto, 'RTL', Byte(True));

+    hppRTLDisable: WriteDBByte(hContact, Proto, 'RTL', Byte(false));

+  end;

+  Result := True;

+end;

+

+function GetContactRTLModeTRTL(hContact: THandle; Proto: AnsiString = ''): TRTLMode;

+var

+  Temp: Byte;

+begin

+  if Proto = '' then

+    Proto := GetContactProto(hContact);

+  if Proto = '' then

+    Result := hppRTLDefault

+  else

+  begin

+    Temp := GetDBByte(hContact, Proto, 'RTL', 255);

+    case Temp of

+      0: Result := hppRTLDisable;

+      1: Result := hppRTLEnable;

+    else

+      Result := hppRTLDefault;

+    end;

+  end;

+end;

+

+end.