diff options
Diffstat (limited to 'plugins/!Deprecated/MirandaNGHistoryToDB/Global.pas')
| -rw-r--r-- | plugins/!Deprecated/MirandaNGHistoryToDB/Global.pas | 1250 |
1 files changed, 0 insertions, 1250 deletions
diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/Global.pas b/plugins/!Deprecated/MirandaNGHistoryToDB/Global.pas deleted file mode 100644 index 16c1638195..0000000000 --- a/plugins/!Deprecated/MirandaNGHistoryToDB/Global.pas +++ /dev/null @@ -1,1250 +0,0 @@ -{ ############################################################################ }
-{ # # }
-{ # MirandaNG HistoryToDB Plugin v2.5 # }
-{ # # }
-{ # License: GPLv3 # }
-{ # # }
-{ # Author: Grigorev Michael (icq: 161867489, email: sleuthhound@gmail.com) # }
-{ # # }
-{ ############################################################################ }
-
-unit Global;
-
-interface
-
-uses
- Windows, SysUtils, IniFiles, Messages, XMLIntf, XMLDoc,
- FSMonitor, DCPcrypt2, DCPblockciphers, DCPsha1, DCPdes, DCPmd5, ActiveX, MapStream;
-
-type
- TCopyDataType = (cdtString = 0, cdtImage = 1, cdtRecord = 2);
- TCopyDataStruct = packed record
- dwData: DWORD;
- cbData: DWORD;
- lpData: Pointer;
- end;
- //TByteArr = Array of Byte;
- TArrayOfString = Array of String;
-
-const
- htdPluginShortName = 'MirandaNGHistoryToDB';
- htdDescription_RU = 'Хранение истории сообщений в базе данных.';
- htdDescription_EN = 'Storing the history in the database.';
- htdAuthor_EN = 'Michael Grigorev';
- htdAuthor_RU = 'Michael Grigorev';
- htdAuthorEmail = 'sleuthhound@gmail.com';
- htdCopyright_EN = '(c) 2011-2013 Michael Grigorev';
- htdCopyright_RU = '(c) 2011-2013 Michael Grigorev';
- htdHomePageURL = 'http://www.im-history.ru/';
- htdVerMajor = {MAJOR_VER}2{/MAJOR_VER};
- htdVerMinor = {MINOR_VER}5{/MINOR_VER};
- htdVerRelease = {SUB_VER}0{/SUB_VER};
- htdVerBuild = {BUILD}0{/BUILD};
- htdVersion = htdVerMajor shl 24 + htdVerMinor shl 16 + htdVerRelease shl 8 + htdVerBuild;
- {$IFDEF WIN32}
- htdPlatform = 'x86';
- {$ELSE}
- htdPlatform = 'x64';
- {$ENDIF}
- htdDBName = 'MirandaNGHistoryToDB';
- htdIMClientName = 'MirandaNG';
- {htdFLUpdateURL = 'http://addons.miranda-im.org/feed.php?dlfile=0';
- htdFLVersionURL = 'http://addons.miranda-im.org/details.php?action=viewfile&id=0';
- htdFLVersionPrefix= '<span class="fileNameHeader">'+htdPluginShortName+' ';
- htdUpdateURL = 'http://www.im-history.ru/get.php?file=MirandaNGHistoryToDB';
- htdVersionURL = 'http://www.im-history.ru/get.php?file=MirandaNGHistoryToDB-Version';
- htdVersionPrefix = htdPluginShortName+' version ';
- htdChangelogURL = 'http://www.im-history.ru/changelog/miranda.html';}
-
- // Generate your own unique id for your plugin.
- // Do not use this UUID!
- // Use Shift+Ctrl+G or uuidgen.exe to generate the uuuid
- MIID_HISTORYTODBDLL:TGUID = '{1F83C057-C59F-483B-B82E-1AE5CA6138EB}';
-
- MS_MHTD_SHOWHISTORY: PAnsiChar = 'MirandaNGHistoryToDB/ShowHistory';
- MS_MHTD_GETVERSION: PAnsiChar = 'MirandaNGHistoryToDB/GetVersion';
- MS_MHTD_SHOWCONTACTHISTORY: PAnsiChar = 'MirandaNGHistoryToDB/ShowContactHistory';
-
- DefaultDBAddres = 'db01.im-history.ru';
- DefaultDBName = 'imhistory';
- ININame = 'HistoryToDB.ini';
- DefININame = 'DefaultUser.ini';
- MesLogName = 'HistoryToDBMes.sql';
- ErrLogName = 'HistoryToDBErr.log';
- ImportLogName = 'HistoryToDBImport.sql';
- ContactListName = 'ContactList.csv';
- ProtoListName = 'ProtoList.csv';
- DebugLogName = 'HistoryToDBDebug.log';
- MSG_LOG : WideString = 'insert into uin_%s values (null, %s, ''%s'', ''%s'', ''%s'', ''%s'', %s, ''%s'', ''%s'', ''%s'', null);';
- MSG_LOG_ORACLE : WideString = 'insert into uin_%s values (null, %s, ''%s'', ''%s'', ''%s'', ''%s'', %s, %s, ''%s'', ''%s'', null)';
- CHAT_MSG_LOG : WideString = 'insert into uin_chat_%s values (null, %s, ''%s'', ''%s'', ''%s'', ''%s'', %s, %s, %s, ''%s'', ''%s'', null);';
- CHAT_MSG_LOG_ORACLE : WideString = 'insert into uin_chat_%s values (null, %s, %s, ''%s'', ''%s'', ''%s'', %s, %s, %s, ''%s'', ''%s'', null)';
- // Начальная дата (01/01/1970) Unix Timestamp для функций конвертации
- UnixStartDate: TDateTime = 25569.0;
- // Ключ для шифрования посылок программам HistoryToDBSync и HistoryToDBViewer
- EncryptKey = 'jsU6s2msoxghsKsn7';
- // Для мультиязыковой поддержки
- WM_LANGUAGECHANGED = WM_USER + 1;
- dirLangs = 'langs\';
- defaultLangFile = 'English.xml';
- ThankYouText_Rus = 'Анна Никифорова за активное тестирование плагина.' + #13#10 +
- 'Кирилл Уксусов (UksusoFF) за активное тестирование плагина и новые идеи.' + #13#10 +
- 'Игорь Гурьянов за активное тестирование плагина.' + #13#10 +
- 'Вячеслав С. (HDHMETRO) за активное тестирование плагина.' + #13#10 +
- 'Providence за активное тестирование плагина и новые идеи.' + #13#10 +
- 'Cy6 за помощь в реализации импорта истории RnQ.';
- ThankYouText_Eng = 'Anna Nikiforova for active testing of plug-in.' + #13#10 +
- 'Kirill Uksusov (UksusoFF) for active testing of plug-in and new ideas.' + #13#10 +
- 'Igor Guryanov for active testing of plug-in.' + #13#10 +
- 'Vyacheslav S. (HDHMETRO) for active testing of plug-in.' + #13#10 +
- 'Providence for active testing of plug-in and new ideas.' + #13#10 +
- 'Cy6 for help in implementing the import history RnQ.';
-
-var
- hppCodepage: Cardinal;
- hppVersionStr: AnsiString;
- MetaContactsEnabled: Boolean;
- MetaContactsProto: AnsiString;
- WriteErrLog, AniEvents, EnableHistoryEncryption, ShowPluginButton, AddSpecialContact, BlockSpamMsg: Boolean;
- EnableDebug, EnableCallBackDebug, ExPrivateChatName, GetContactList: Boolean;
- SyncMethod, SyncInterval, SyncMessageCount, MaxErrLogSize: Integer;
- DBType, DBName, DBUserName, DefaultLanguage: String;
- //Global_AccountUIN: WideString;
- //Global_AccountName: WideString;
- //Global_CurrentAccountUIN: WideString;
- //Global_CurrentAccountName: WideString;
- Global_CurrentAccountProtoID: Integer;
- Global_CurrentAccountProtoName, Global_CurrentAccountProtoAccount: WideString;
- Glogal_History_Type: Integer;
- //Global_ChatName: WideString;
- Global_AboutForm_Showing: Boolean;
- DllPath, DllName, ProfilePath, MyAccount: String;
- MessageCount: Integer;
- // Для мультиязыковой поддержки
- CoreLanguage: String;
- AboutFormHandle: HWND;
- ExportFormHandle: HWND;
- LangDoc: IXMLDocument;
- PluginPath: String = '';
- // Шифрование
- Cipher: TDCP_3des;
- Digest: Array[0..19] of Byte;
- Hash: TDCP_sha1;
- // Лог-файлы
- TFMsgLog: TextFile;
- MsgLogOpened: Boolean;
- TFErrLog: TextFile;
- ErrLogOpened: Boolean;
- TFDebugLog: TextFile;
- DebugLogOpened: Boolean;
- TFContactListLog: TextFile;
- ContactListLogOpened: Boolean;
- TFProtoListLog: TextFile;
- ProtoListLogOpened: Boolean;
- TFImportLog: TextFile;
- ImportLogOpened: Boolean;
- ExportFormDestroy: Boolean;
- // MMF
- FMap: TMapStream;
-
-function BoolToIntStr(Bool: Boolean): String;
-function UnixToDateTime(USec: Longint): TDateTime;
-function PrepareString(const Source : PWideChar) : WideString;
-function MatchStrings(Source, Pattern: String): Boolean;
-function ReadCustomINI(INIPath, CustomParams, DefaultParamsStr: String): String;
-function EncryptMD5(Str: String): String;
-function EncryptStr(const Str: String): String;
-function SearchMainWindow(MainWindowName: pWideChar): Boolean;
-function OpenLogFile(LogPath: String; LogType: Integer): Boolean;
-function GetMyFileSize(const Path: String): Integer;
-function ExtractFileNameEx(FileName: String; ShowExtension: Boolean): String;
-function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
-function AnsiToWideString(const S: AnsiString; CodePage: Cardinal; InLength: Integer = -1): WideString;
-function WideToAnsiString(const WS: WideString; CodePage: Cardinal; InLength: Integer = -1): AnsiString;
-function Utf8ToWideChar(Dest: PWideChar; MaxDestChars: Integer; Source: PAnsiChar; SourceBytes: Integer; CodePage: Cardinal = CP_ACP): Integer;
-function StrContactProtoToInt(Proto: AnsiString): Integer;
-function UnixToLocalTime(tUnix :Longint): TDateTime;
-function GetUserTempPath: WideString;
-procedure IMDelay(Value: Cardinal);
-procedure EncryptInit;
-procedure EncryptFree;
-procedure WriteInLog(LogPath: String; TextString: String; LogType: Integer);
-procedure CloseLogFile(LogType: Integer);
-procedure LoadINI(INIPath: String);
-procedure OnSendMessageToAllComponent(Msg: String);
-procedure OnSendMessageToOneComponent(WinName, Msg: String);
-procedure WriteCustomINI(INIPath, CustomParams, ParamsStr: String);
-procedure ProfileDirChangeCallBack(pInfo: TInfoCallBack);
-// Для мультиязыковой поддержки
-procedure CoreLanguageChanged;
-procedure MsgDie(Caption, Msg: WideString);
-procedure MsgInf(Caption, Msg: WideString);
-function GetLangStr(StrID: String): WideString;
-
-implementation
-
-uses Menu;
-
-function BoolToIntStr(Bool: Boolean): String;
-begin
- if Bool then
- Result := '1'
- else
- Result := '0'
-end;
-
-// Функция конвертации Unix Timestamp в DateTime
-function UnixToDateTime(USec: Longint): TDateTime;
-begin
- Result := (Usec / 86400) + UnixStartDate;
-end;
-
-// Функция для экранирования спецсимволов в строке
-function PrepareString(const Source : PWideChar) : WideString;
-var
- SLen,i : Cardinal;
- WSTmp : WideString;
- WChar : WideChar;
-begin
- Result := '';
- SLen := Length(WideString(Source));
- if (SLen>0) then
- begin
- for i:=1 to SLen do
- begin
- WChar:=WideString(Source)[i];
- case WChar of
- #$09 :{tab} WSTmp:=WSTmp+'\t';
- #$0A :{line feed} WSTmp:=WSTmp+'\n';
- #$0D :{carriage return} WSTmp:=WSTmp+'\r';
- #$27 :{single quote mark aka apostrophe?} WSTmp:=WSTmp+WChar+WChar;
- #$22, {double quote mark aka inch sign?}
- #$5C, {backslash itself}
- #$60 :{another single quote mark} WSTmp:=WSTmp+'\'+WChar;
- else WSTmp := WSTmp + WChar;
- end;
- end;
- Result := WSTmp;
- end;
-end;
-
-// LogType = 0 - сообщения добавляются в файл MesLogName
-// LogType = 1 - ошибки добавляются в файл ErrLogName
-// LogType = 2 - сообщения добавляются в файл DebugLogName
-// LogType = 3 - сообщения добавляются в файл ContactListName
-// LogType = 4 - сообщения добавляются в файл ProtoListName
-// LogType = 5 - сообщения добавляются в файл ImportLogName
-function OpenLogFile(LogPath: String; LogType: Integer): Boolean;
-var
- Path: WideString;
-begin
- if LogType = 0 then
- Path := LogPath + MesLogName
- else if LogType = 1 then
- begin
- Path := LogPath + ErrLogName;
- if (LogType > 0) and (GetMyFileSize(Path) > MaxErrLogSize*1024) then
- DeleteFile(Path);
- end
- else if LogType = 2 then
- Path := LogPath + DebugLogName
- else if LogType = 3 then
- begin
- Path := LogPath + ContactListName;
- if FileExists(Path) then
- begin
- try
- DeleteFile(Path);
- except
- end;
- end;
- end
- else if LogType = 4 then
- begin
- Path := LogPath + ProtoListName;
- if FileExists(Path) then
- begin
- try
- DeleteFile(Path);
- except
- end;
- end;
- end
- else
- Path := LogPath + ImportLogName;
- {$I-}
- try
- if LogType = 0 then
- Assign(TFMsgLog, Path)
- else if LogType = 1 then
- Assign(TFErrLog, Path)
- else if LogType = 2 then
- Assign(TFDebugLog, Path)
- else if LogType = 3 then
- Assign(TFContactListLog, Path)
- else if LogType = 4 then
- Assign(TFProtoListLog, Path)
- else
- Assign(TFImportLog, Path);
- if FileExists(Path) then
- begin
- if LogType = 0 then
- Append(TFMsgLog)
- else if LogType = 1 then
- Append(TFErrLog)
- else if LogType = 2 then
- Append(TFDebugLog)
- else if LogType = 3 then
- Append(TFContactListLog)
- else if LogType = 4 then
- Append(TFProtoListLog)
- else
- Append(TFImportLog);
- end
- else
- begin
- if LogType = 0 then
- Rewrite(TFMsgLog)
- else if LogType = 1 then
- Rewrite(TFErrLog)
- else if LogType = 2 then
- Rewrite(TFDebugLog)
- else if LogType = 3 then
- Rewrite(TFContactListLog)
- else if LogType = 4 then
- Rewrite(TFProtoListLog)
- else
- Rewrite(TFImportLog);
- end;
- Result := True;
- except
- on e :
- Exception do
- begin
- CloseLogFile(LogType);
- Result := False;
- Exit;
- end;
- end;
- {$I+}
-end;
-
-// LogType = 0 - сообщения добавляются в файл MesLogName
-// LogType = 1 - ошибки добавляются в файл ErrLogName
-// LogType = 2 - сообщения добавляются в файл DebugLogName
-// LogType = 3 - сообщения добавляются в файл ContactListName
-// LogType = 4 - сообщения добавляются в файл ProtoListName
-procedure WriteInLog(LogPath: String; TextString: String; LogType: Integer);
-var
- Path: WideString;
-begin
- if LogType = 0 then
- begin
- if not MsgLogOpened then
- MsgLogOpened := OpenLogFile(LogPath, 0);
- Path := LogPath + MesLogName
- end
- else if LogType = 1 then
- begin
- if not ErrLogOpened then
- ErrLogOpened := OpenLogFile(LogPath, 1);
- Path := LogPath + ErrLogName;
- if (LogType > 0) and (GetMyFileSize(Path) > MaxErrLogSize*1024) then
- begin
- CloseLogFile(LogType);
- DeleteFile(Path);
- if not OpenLogFile(LogPath, LogType) then
- Exit;
- end;
- end
- else if LogType = 2 then
- begin
- if not DebugLogOpened then
- DebugLogOpened := OpenLogFile(LogPath, 2);
- Path := LogPath + DebugLogName;
- end
- else if LogType = 3 then
- begin
- if not ContactListLogOpened then
- ContactListLogOpened := OpenLogFile(LogPath, 3);
- Path := LogPath + ContactListName;
- end
- else if LogType = 4 then
- begin
- if not ProtoListLogOpened then
- ProtoListLogOpened := OpenLogFile(LogPath, 4);
- Path := LogPath + ProtoListName;
- end
- else
- begin
- if not ImportLogOpened then
- ImportLogOpened := OpenLogFile(LogPath, 5);
- Path := LogPath + ImportLogName;
- end;
- {$I-}
- try
- if LogType = 0 then
- WriteLn(TFMsgLog, TextString)
- else if LogType = 1 then
- WriteLn(TFErrLog, TextString)
- else if LogType = 2 then
- WriteLn(TFDebugLog, TextString)
- else if LogType = 3 then
- WriteLn(TFContactListLog, TextString)
- else if LogType = 4 then
- WriteLn(TFProtoListLog, TextString)
- else
- WriteLn(TFImportLog, TextString);
- except
- on e :
- Exception do
- begin
- CloseLogFile(LogType);
- Exit;
- end;
- end;
- if MsgLogOpened then
- CloseLogFile(0);
- {$I+}
-end;
-
-procedure CloseLogFile(LogType: Integer);
-begin
- {$I-}
- if LogType = 0 then
- begin
- CloseFile(TFMsgLog);
- MsgLogOpened := False;
- end
- else if LogType = 1 then
- begin
- CloseFile(TFErrLog);
- ErrLogOpened := False;
- end
- else if LogType = 2 then
- begin
- CloseFile(TFDebugLog);
- DebugLogOpened := False;
- end
- else if LogType = 3 then
- begin
- CloseFile(TFContactListLog);
- ContactListLogOpened := False;
- end
- else if LogType = 4 then
- begin
- CloseFile(TFProtoListLog);
- ProtoListLogOpened := False;
- end
- else
- begin
- CloseFile(TFImportLog);
- ImportLogOpened := False;
- end;
- {$I+}
-end;
-
-// Если файл не существует, то вместо размера файла функция вернёт -1
-function GetMyFileSize(const Path: String): Integer;
-var
- FD: TWin32FindData;
- FH: THandle;
-begin
- FH := FindFirstFile(PChar(Path), FD);
- Result := 0;
- if FH = INVALID_HANDLE_VALUE then
- Exit;
- Result := FD.nFileSizeLow;
- if ((FD.nFileSizeLow and $80000000) <> 0) or
- (FD.nFileSizeHigh <> 0) then
- Result := -1;
- //FindClose(FH);
-end;
-
-// Загружаем настройки
-procedure LoadINI(INIPath: String);
-var
- Path: WideString;
- Temp: String;
- INI: TIniFile;
-begin
- // Проверяем наличие каталога
- if not DirectoryExists(INIPath) then
- CreateDir(INIPath);
- Path := INIPath + ININame;
- if FileExists(Path) then
- begin
- Ini := TIniFile.Create(Path);
- DBType := INI.ReadString('Main', 'DBType', 'mysql'); // mysql или postgresql
- DBUserName := INI.ReadString('Main', 'DBUserName', 'username');
- SyncMethod := INI.ReadInteger('Main', 'SyncMethod', 1);
- SyncInterval := INI.ReadInteger('Main', 'SyncInterval', 0);
-
- Temp := INI.ReadString('Main', 'WriteErrLog', '1');
- if Temp = '1' then WriteErrLog := True
- else WriteErrLog := False;
-
- Temp := INI.ReadString('Main', 'ShowAnimation', '1');
- if Temp = '1' then AniEvents := True
- else AniEvents := False;
-
- Temp := INI.ReadString('Main', 'EnableHistoryEncryption', '0');
- if Temp = '1' then EnableHistoryEncryption := True
- else EnableHistoryEncryption := False;
-
- Temp := INI.ReadString('Main', 'AddSpecialContact', '1');
- if Temp = '1' then AddSpecialContact := True
- else AddSpecialContact := False;
-
- DefaultLanguage := INI.ReadString('Main', 'DefaultLanguage', 'Russian');
- SyncMessageCount := INI.ReadInteger('Main', 'SyncMessageCount', 50);
-
- Temp := INI.ReadString('Main', 'ShowPluginButton', '1');
- if Temp = '1' then ShowPluginButton := True
- else ShowPluginButton := False;
-
- Temp := INI.ReadString('Main', 'BlockSpamMsg', '0');
- if Temp = '1' then BlockSpamMsg := True
- else BlockSpamMsg := False;
-
- Temp := INI.ReadString('Main', 'EnableExPrivateChatName', '0');
- if Temp = '1' then ExPrivateChatName := True
- else ExPrivateChatName := False;
-
- Temp := INI.ReadString('Main', 'EnableDebug', '0');
- if Temp = '1' then EnableDebug := True
- else EnableDebug := False;
-
- Temp := INI.ReadString('Main', 'EnableCallBackDebug', '0');
- if Temp = '1' then EnableCallBackDebug := True
- else EnableCallBackDebug := False;
-
- MaxErrLogSize := INI.ReadInteger('Main', 'MaxErrLogSize', 20);
- end
- else
- begin
- INI := TIniFile.Create(path);
- // Значения по-умолчанию
- DBType := 'mysql';
- DBName := DefaultDBName;
- DBUserName := 'username';
- SyncMethod := 1;
- SyncInterval := 0;
- SyncMessageCount := 50;
- WriteErrLog := True;
- AniEvents := True;
- ShowPluginButton := True;
- EnableHistoryEncryption := False;
- AddSpecialContact := True;
- BlockSpamMsg := False;
- EnableDebug := False;
- EnableCallBackDebug := False;
- MaxErrLogSize := 20;
- // Сохраняем настройки
- INI.WriteString('Main', 'DBType', DBType);
- INI.WriteString('Main', 'DBAddress', DefaultDBAddres);
- INI.WriteString('Main', 'DBSchema', 'username');
- INI.WriteString('Main', 'DBPort', '3306');
- INI.WriteString('Main', 'DBName', DefaultDBName);
- INI.WriteString('Main', 'DBUserName', DBUserName);
- INI.WriteString('Main', 'DBPasswd', 'skGvQNyWUHcHohJS2+2r4A==');
- INI.WriteInteger('Main', 'SyncMethod', SyncMethod);
- INI.WriteInteger('Main', 'SyncInterval', SyncInterval);
- INI.WriteInteger('Main', 'SyncTimeCount', 40);
- INI.WriteInteger('Main', 'SyncMessageCount', SyncMessageCount);
- INI.WriteInteger('Main', 'NumLastHistoryMsg', 6);
- INI.WriteString('Main', 'WriteErrLog', BoolToIntStr(WriteErrLog));
- INI.WriteString('Main', 'ShowAnimation', BoolToIntStr(AniEvents));
- INI.WriteString('Main', 'EnableHistoryEncryption', BoolToIntStr(EnableHistoryEncryption));
- INI.WriteString('Main', 'DefaultLanguage', CoreLanguage);
- INI.WriteString('Main', 'HideHistorySyncIcon', '0');
- INI.WriteString('Main', 'ShowPluginButton', BoolToIntStr(ShowPluginButton));
- INI.WriteString('Main', 'AddSpecialContact', BoolToIntStr(AddSpecialContact));
- INI.WriteString('Main', 'BlockSpamMsg', BoolToIntStr(BlockSpamMsg));
- INI.WriteInteger('Main', 'MaxErrLogSize', MaxErrLogSize);
- INI.WriteString('Main', 'AlphaBlend', '0');
- INI.WriteString('Main', 'AlphaBlendValue', '255');
- INI.WriteString('Main', 'EnableDebug', '0');
- INI.WriteString('Main', 'EnableCallBackDebug', '0');
- INI.WriteString('Fonts', 'FontInTitle', '183|-11|Verdana|0|96|8|Y|N|N|N|');
- INI.WriteString('Fonts', 'FontOutTitle', '8404992|-11|Verdana|0|96|8|Y|N|N|N|');
- INI.WriteString('Fonts', 'FontInBody', '-16777208|-11|Verdana|0|96|8|N|N|N|N|');
- INI.WriteString('Fonts', 'FontOutBody', '-16777208|-11|Verdana|0|96|8|N|N|N|N|');
- INI.WriteString('Fonts', 'FontService', '16711680|-11|Verdana|0|96|8|Y|N|N|N|');
- INI.WriteString('Fonts', 'TitleParagraph', '4|4|');
- INI.WriteString('Fonts', 'MessagesParagraph', '2|2|');
- INI.WriteString('HotKey', 'GlobalHotKey', '0');
- INI.WriteString('HotKey', 'SyncHotKey', 'Ctrl+Alt+F12');
- INI.WriteString('HotKey', 'ExSearchHotKey', 'Ctrl+F3');
- INI.WriteString('HotKey', 'ExSearchNextHotKey', 'F3');
- end;
- INI.Free;
-end;
-
-{ Процедура записи значения параметра в файл настроек }
-procedure WriteCustomINI(INIPath, CustomParams, ParamsStr: String);
-var
- Path: String;
- INI: TIniFile;
-begin
- Path := INIPath + ININame;
- if FileExists(Path) then
- begin
- INI := TIniFile.Create(Path);
- try
- INI.WriteString('Main', CustomParams, ParamsStr);
- finally
- INI.Free;
- end;
- end
- else
- begin
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура WriteCustomINI: ' + GetLangStr('SettingsErrSave'), 2);
- MsgDie(htdPluginShortName, GetLangStr('SettingsErrSave'));
- end;
-end;
-
-{ Функция чтения значения параметра из файла настроек }
-function ReadCustomINI(INIPath, CustomParams, DefaultParamsStr: String): String;
-var
- Path: String;
- INI: TIniFile;
-begin
- Path := INIPath + ININame;
- if FileExists(Path) then
- begin
- INI := TIniFile.Create(Path);
- try
- Result := INI.ReadString('Main', CustomParams, DefaultParamsStr);
- finally
- INI.Free;
- end;
- end
- else
- begin
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура ReadCustomINI: ' + GetLangStr('SettingsErrRead'), 2);
- MsgDie(htdPluginShortName, GetLangStr('SettingsErrRead'));
- end;
-end;
-
-{ Процедура для отправки сообщений программе }
-{ Стандартные команды:
- 001 - Перечитать настройки из файла HistoryToDB.ini
- 002 - Синхронизация истории
- 003 - Закрыть все компоненты плагина
- 0040 - Показать все окна плагина (Режим AntiBoss)
- 0041 - Скрыть все окна плагина (Режим AntiBoss)
- 005 - Показать окно настроек
- 0050 - Запустить перерасчет MD5-хешей
- 0051 - Запустить перерасчет MD5-хешей и удаления дубликатов
- 0060 - Запущен импорт истории
- 0061 - Импорт истории завершен
- 007 - Обновить контакт-лист в БД
- 008 - Показать историю контакта/чата
- Формат команды:
- для истории контакта:
- 008|0|UserID|UserName|ProtocolType
- для истории чата:
- 008|2|ChatName
- 009 - Экстренно закрыть все компоненты плагина.
- 010 - Строка SQL-insert передана в память
-}
-procedure OnSendMessageToAllComponent(Msg: String);
-var
- HToDB: HWND;
- copyDataStruct : TCopyDataStruct;
- EncryptMsg, WinName: String;
-begin
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToAllComponent: Отправка запроса "' + Msg + '" всем компонентам плагина.', 2);
- EncryptMsg := EncryptStr(Msg);
- // Ищем окно HistoryToDBViewer и посылаем ему команду
- WinName := 'HistoryToDBViewer for ' + htdIMClientName + ' ('+MyAccount+')';
- HToDB := FindWindow(nil, pWideChar(WinName));
- if HToDB <> 0 then
- begin
- copyDataStruct.dwData := {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(cdtString);
- copyDataStruct.cbData := Length(EncryptMsg) * SizeOf(Char);
- copyDataStruct.lpData := PChar(EncryptMsg);
- SendMessage(HToDB, WM_COPYDATA, 0, {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(@copyDataStruct));
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToAllComponent: Отправка запроса "' + Msg + '" окну ' + WinName, 2);
- end;
- // Ищем окно HistoryToDBSync и посылаем ему команду
- WinName := 'HistoryToDBSync for ' + htdIMClientName + ' ('+MyAccount+')';
- HToDB := FindWindow(nil, pWideChar(WinName));
- if HToDB <> 0 then
- begin
- copyDataStruct.dwData := {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(cdtString);
- copyDataStruct.cbData := Length(EncryptMsg) * SizeOf(Char);
- copyDataStruct.lpData := PChar(EncryptMsg);
- SendMessage(HToDB, WM_COPYDATA, 0, {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(@copyDataStruct));
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToAllComponent: Отправка запроса "' + Msg + '" окну ' + WinName, 2);
- end;
- // Ищем окно HistoryToDBImport и посылаем ему команду
- WinName := 'HistoryToDBImport for ' + htdIMClientName + ' ('+MyAccount+')';
- HToDB := FindWindow(nil, pWideChar(WinName));
- if HToDB <> 0 then
- begin
- copyDataStruct.dwData := {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(cdtString);
- copyDataStruct.cbData := Length(EncryptMsg) * SizeOf(Char);
- copyDataStruct.lpData := PChar(EncryptMsg);
- SendMessage(HToDB, WM_COPYDATA, 0, {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(@copyDataStruct));
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToAllComponent: Отправка запроса "' + Msg + '" окну ' + WinName, 2);
- end;
- // Ищем окно HistoryToDBUpdater и посылаем ему команду
- WinName := 'HistoryToDBUpdater for ' + htdIMClientName + ' ('+MyAccount+')';
- HToDB := FindWindow(nil, pWideChar(WinName));
- if HToDB <> 0 then
- begin
- copyDataStruct.dwData := {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(cdtString);
- copyDataStruct.cbData := Length(EncryptMsg) * SizeOf(Char);
- copyDataStruct.lpData := PChar(EncryptMsg);
- SendMessage(HToDB, WM_COPYDATA, 0, {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(@copyDataStruct));
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToAllComponent: Отправка запроса "' + Msg + '" окну ' + WinName, 2);
- end;
-end;
-
-procedure OnSendMessageToOneComponent(WinName, Msg: String);
-var
- HToDB: HWND;
- copyDataStruct : TCopyDataStruct;
- AppNameStr, EncryptMsg: String;
-begin
- // Ищем окно WinName и посылаем ему команду
- HToDB := FindWindow(nil, pWideChar(WinName));
- if HToDB <> 0 then
- begin
- EncryptMsg := EncryptStr(Msg);
- copyDataStruct.dwData := {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(cdtString);
- copyDataStruct.cbData := Length(EncryptMsg) * SizeOf(Char);
- copyDataStruct.lpData := PChar(EncryptMsg);
- SendMessage(HToDB, WM_COPYDATA, 0, {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF}(@copyDataStruct));
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnSendMessageToOneComponent: Отправка запроса "' + Msg + '" окну ' + WinName, 2);
- end;
-end;
-
-{ Поиск окна программы }
-function SearchMainWindow(MainWindowName: pWideChar): Boolean;
-var
- HToDB: HWND;
-begin
- // Ищем окно
- HToDB := FindWindow(nil, MainWindowName);
- if HToDB <> 0 then
- Result := True
- else
- Result := False
-end;
-
-{Функция осуществляет сравнение двух строк. Первая строка
-может быть любой, но она не должна содержать символов соответствия (* и ?).
-Строка поиска (искомый образ) может содержать абсолютно любые символы.
-Для примера: MatchStrings('David Stidolph','*St*') возвратит True.
-Автор оригинального C-кода Sean Stanley
-Автор портации на Delphi David Stidolph}
-function MatchStrings(Source, Pattern: String): Boolean;
-var
- pSource: array[0..255] of Char;
- pPattern: array[0..255] of Char;
-
- function MatchPattern(element, pattern: PChar): Boolean;
-
- function IsPatternWild(pattern: PChar): Boolean;
- begin
- Result := StrScan(pattern, '*') <> nil;
- if not Result then
- Result := StrScan(pattern, '?') <> nil;
- end;
-
- begin
- if 0 = StrComp(pattern, '*') then
- Result := True
- else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
- Result := False
- else if element^ = Chr(0) then
- Result := True
- else
- begin
- case pattern^ of
- '*': if MatchPattern(element, @pattern[1]) then
- Result := True
- else
- Result := MatchPattern(@element[1], pattern);
- '?': Result := MatchPattern(@element[1], @pattern[1]);
- else
- if element^ = pattern^ then
- Result := MatchPattern(@element[1], @pattern[1])
- else
- Result := False;
- end;
- end;
- end;
-begin
- StrPCopy(pSource, source);
- StrPCopy(pPattern, pattern);
- Result := MatchPattern(pSource, pPattern);
-end;
-
-// Для мультиязыковой поддержки
-procedure MsgDie(Caption, Msg: WideString);
-begin
- //{$IFDEF UNICODE}
- //MessageBoxW(GetForegroundWindow, PWideChar(Msg), PWideChar(Caption), MB_ICONERROR);
- //{$ELSE}
- //MessageBoxA(GetForegroundWindow, PAnsiChar(Msg), PAnsiChar(Caption), MB_ICONERROR);
- //{$ENDIF}
- MessageBox(GetForegroundWindow, PWideChar(Msg), PWideChar(Caption), MB_ICONERROR);
-end;
-
-// Для мультиязыковой поддержки
-procedure MsgInf(Caption, Msg: WideString);
-begin
- //{$IFDEF UNICODE}
- //MessageBoxW(GetForegroundWindow, PWideChar(Msg), PWideChar(Caption), MB_ICONINFORMATION);
- //{$ELSE}
- //MessageBoxA(GetForegroundWindow, PAnsiChar(Msg), PAnsiChar(Caption), MB_ICONINFORMATION);
- //{$ENDIF}
- MessageBox(GetForegroundWindow, PWideChar(Msg), PWideChar(Caption), MB_ICONINFORMATION);
-end;
-
-// Для мультиязыковой поддержки
-function GetLangStr(StrID: String): WideString;
-begin
- if (not Assigned(LangDoc)) or (not LangDoc.Active) then
- begin
- Result := '';
- Exit;
- end;
- if LangDoc.ChildNodes['strings'].ChildNodes.FindNode(StrID) <> nil then
- Result := LangDoc.ChildNodes['strings'].ChildNodes[StrID].Text
- else
- Result := 'String not found.';
-end;
-
-{ Обработчик изменений файлов в каталоге профиля }
-procedure ProfileDirChangeCallBack(pInfo: TInfoCallBack);
-var
- SettingsFormRequest: String;
-begin
- SettingsFormRequest := ReadCustomINI(ProfilePath, 'SettingsFormRequestSend', '0');
- if EnableCallBackDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура ProfileDirChangeCallBack: Параметр SettingsFormRequestSend = ' + SettingsFormRequest + ' | FAction = ' + IntToStr(pInfo.FAction) + ' | FOldFileName = ' + pInfo.FOldFileName + ' | FNewFileName = ' + Trim(pInfo.FNewFileName), 2);
- if (pInfo.FAction = 3) and (Trim(pInfo.FNewFileName) = 'HistoryToDB.ini') and (SettingsFormRequest = '0') then
- begin
- IMDelay(500);
- LoadINI(ProfilePath);
- CoreLanguage := DefaultLanguage;
- if EnableCallBackDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура ProfileDirChangeCallBack: Настройки HistoryToDB.ini перечитаны. | Новый язык программы = ' + CoreLanguage, 2);
- // Инициализация COM с поддержкой многопоточности
- // ХЗ зачем это нужно, но если этого не делать, то при вызове CoreLanguageChanged
- // вылазит ошибка "Не был произведен вызов CoInitialize"
- // CoInitialize объявлен в модуле ActiveX
- CoInitializeEx(nil, COINIT_MULTITHREADED);
- // Перезагружяем языковой файл
- CoreLanguageChanged;
- // Освобождение COM (дважды)
- CoUninitialize();
- CoUninitialize();
- // Перестраиваем меню
- RebuildMainMenu;
- // MMF
- if SyncMethod = 0 then
- begin
- if not Assigned(FMap) then
- begin
- if EnableCallBackDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура ProfileDirChangeCallBack: Создаем TMapStream', 2);
- FMap := TMapStream.CreateEx('HistoryToDB for QIP ('+MyAccount+')',MAXDWORD,2000);
- end;
- end
- else
- begin
- if Assigned(FMap) then
- begin
- FMap.Free;
- FMap := nil;
- end;
- end;
- end;
-end;
-
-// Подсчет MD5 строки
-function EncryptMD5(Str: String): String;
-var
- Hash: TDCP_md5;
- Digest: Array[0..15] of Byte;
- I: Integer;
- P: String;
-begin
- if Str <> '' then
- begin
- Hash:= TDCP_md5.Create(nil);
- try
- Hash.HashSize := 128;
- Hash.Init;
- Hash.UpdateStr(Str);
- Hash.Final(Digest);
- P := '';
- for I:= 0 to 15 do
- P:= P + IntToHex(Digest[I], 2);
- finally
- Hash.Free;
- end;
- Result := P;
- end
- else
- Result := 'MD5';
-end;
-
-// Инициируем криптование
-procedure EncryptInit;
-begin
- Hash:= TDCP_sha1.Create(nil);
- try
- Hash.Init;
- Hash.UpdateStr(EncryptKey);
- Hash.Final(Digest);
- finally
- Hash.Free;
- end;
- Cipher := TDCP_3des.Create(nil);
- try
- Cipher.Init(Digest,Sizeof(Digest)*8,nil);
- except
- on E: Exception do
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Процедура EncryptInit: ' + E.Message, 2);
- end;
-end;
-
-// Освобождаем ресурсы
-procedure EncryptFree;
-begin
- if Assigned(Cipher) then
- begin
- Cipher.Burn;
- Cipher.Free;
- end;
-end;
-
-// Зашифровываем строку
-function EncryptStr(const Str: String): String;
-begin
- Result := '';
- if Str <> '' then
- begin
- Cipher.Reset;
- Result := Cipher.EncryptString(Str);
- end;
-end;
-
-{ Функция для получения имени файла из пути без или с его расширением.
- Возвращает имя файла, без или с его расширением.
- Входные параметры:
- FileName - имя файла, которое надо обработать
- ShowExtension - если TRUE, то функция возвратит короткое имя файла
- (без полного пути доступа к нему), с расширением этого файла, иначе, возвратит
- короткое имя файла, без расширения этого файла. }
-function ExtractFileNameEx(FileName: String; ShowExtension: Boolean): String;
-var
- I: Integer;
- S, S1: string;
-begin
- I := Length(FileName);
- if I <> 0 then
- begin
- while (FileName[i] <> '\') and (i > 0) do
- i := i - 1;
- S := Copy(FileName, i + 1, Length(FileName) - i);
- i := Length(S);
- if i = 0 then
- begin
- Result := '';
- Exit;
- end;
- while (S[i] <> '.') and (i > 0) do
- i := i - 1;
- S1 := Copy(S, 1, i - 1);
- if s1 = '' then
- s1 := s;
- if ShowExtension = True then
- Result := s
- else
- Result := s1;
- end
- else
- Result := '';
-end;
-
-function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
-var
- l: integer;
-begin
- if ws = '' then
- Result := ''
- else
- begin
- l := WideCharToMultiByte(codePage,
- WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
- @ws[1], -1, nil, 0, nil, nil);
- SetLength(Result, l - 1);
- if l > 1 then
- WideCharToMultiByte(codePage,
- WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
- @ws[1], -1, @Result[1], l - 1, nil, nil);
- end;
-end;
-
-function AnsiToWideString(const S: AnsiString; CodePage: Cardinal; InLength: Integer = -1): WideString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- Result := '';
- if S = '' then
- exit;
- if Codepage = CP_UTF8 then
- begin
- Result := UTF8ToWideString(S); // CP_UTF8 not supported on Windows 95
- end
- else
- begin
- if InLength < 0 then
- InputLength := Length(S)
- else
- InputLength := InLength;
- OutputLength := MultiByteToWideChar(Codepage, 0, PAnsiChar(S), InputLength, nil, 0);
- SetLength(Result, OutputLength);
- MultiByteToWideChar(Codepage, MB_PRECOMPOSED, PAnsiChar(S), InputLength, PWideChar(Result),
- OutputLength);
- end;
-end;
-
-function WideToAnsiString(const WS: WideString; CodePage: Cardinal; InLength: Integer = -1): AnsiString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- Result := '';
- if WS = '' then
- exit;
- if Codepage = CP_UTF8 then
- Result := UTF8Encode(WS) // CP_UTF8 not supported on Windows 95
- else
- begin
- if InLength < 0 then
- InputLength := Length(WS)
- else
- InputLength := InLength;
- OutputLength := WideCharToMultiByte(Codepage, 0, PWideChar(WS), InputLength, nil, 0,
- nil, nil);
- SetLength(Result, OutputLength);
- WideCharToMultiByte(Codepage, 0, PWideChar(WS), InputLength, PAnsiChar(Result),
- OutputLength, nil, nil);
- end;
-end;
-
-function StrContactProtoToInt(Proto: AnsiString): Integer;
-var
- ProtoType: Integer;
-begin
- { Протоколы
- 0 - ICQ
- 1 - Google Talk
- 2 - MRA
- 3 - Jabber
- 4 - QIP.Ru
- 5 - Facebook
- 6 - VKontacte
- 7 - Twitter
- 8 - Social (LiveJournal)
- 9 - AIM
- 10 - IRC
- 11 - MSN
- 12 - YAHOO
- 13 - GADU
- 14 - SKYPE
- 15 - MetaContacts
- 16 - Unknown
- }
- if MatchStrings(LowerCase(Proto), 'icq*') then
- ProtoType := 0
- else if MatchStrings(LowerCase(Proto), 'google talk*') then
- ProtoType := 1
- else if MatchStrings(LowerCase(Proto), 'mrad*') then
- ProtoType := 15
- else if MatchStrings(LowerCase(Proto), 'mra*') then
- ProtoType := 2
- else if MatchStrings(LowerCase(Proto), 'jabber*') then
- ProtoType := 3
- else if (LowerCase(Proto) = 'qip.ru') then
- ProtoType := 4
- else if MatchStrings(LowerCase(Proto), 'facebook*') then
- ProtoType := 5
- else if MatchStrings(LowerCase(Proto), 'vkontakte*') then
- ProtoType := 6
- else if MatchStrings(LowerCase(Proto), 'вконтакте*') then
- ProtoType := 6
- else if MatchStrings(LowerCase(Proto), 'twitter*') then
- ProtoType := 7
- else if MatchStrings(LowerCase(Proto), 'livejournal*') then
- ProtoType := 8
- else if MatchStrings(LowerCase(Proto), 'aim*') then
- ProtoType := 9
- else if MatchStrings(LowerCase(Proto), 'irc*') then
- ProtoType := 10
- else if MatchStrings(LowerCase(Proto), 'msn*') then
- ProtoType := 11
- else if MatchStrings(LowerCase(Proto), 'yahoo*') then
- ProtoType := 12
- else if MatchStrings(LowerCase(Proto), 'gadu*') then
- ProtoType := 13
- else if MatchStrings(LowerCase(Proto), 'skype*') then
- ProtoType := 14
- else if MatchStrings(LowerCase(Proto), 'metacontacts*') then
- ProtoType := 15
- else
- ProtoType := 16;
- Result := ProtoType;
-end;
-
-{ Задержка не грузящая процессор }
-procedure IMDelay(Value: Cardinal);
-var
- F, N: Cardinal;
-begin
- N := 0;
- while N <= (Value div 10) do
- begin
- SleepEx(1, True);
- //Application.ProcessMessages;
- Inc(N);
- end;
- F := GetTickCount;
- repeat
- //Application.ProcessMessages;
- N := GetTickCount;
- until (N - F >= (Value mod 10)) or (N < F);
-end;
-
-function Utf8ToWideChar(Dest: PWideChar; MaxDestChars: Integer; Source: PAnsiChar; SourceBytes: Integer; CodePage: Cardinal = CP_ACP): Integer;
-const
- MB_ERR_INVALID_CHARS = 8;
-var
- Src,SrcEnd: PAnsiChar;
- Dst,DstEnd: PWideChar;
-begin
- if (Source = nil) or (SourceBytes <= 0) then
- begin
- Result := 0;
- end
- else if (Dest = nil) or (MaxDestChars <= 0) then
- begin
- Result := -1;
- end
- else
- begin
- Src := Source;
- SrcEnd := Source + SourceBytes;
- Dst := Dest;
- DstEnd := Dst + MaxDestChars;
- while (PAnsiChar(Src) < PAnsiChar(SrcEnd)) and (Dst < DstEnd) do
- begin
- if (Byte(Src[0]) and $80) = 0 then
- begin
- Dst[0] := WideChar(Src[0]);
- Inc(Src);
- end
- else if (Byte(Src[0]) and $E0) = $E0 then
- begin
- if Src + 2 >= SrcEnd then
- break;
- if (Src[1] = #0) or ((Byte(Src[1]) and $C0) <> $80) then
- break;
- if (Src[2] = #0) or ((Byte(Src[2]) and $C0) <> $80) then
- break;
- Dst[0] := WideChar(((Byte(Src[0]) and $0F) shl 12) + ((Byte(Src[1]) and $3F) shl 6) +
- ((Byte(Src[2]) and $3F)));
- Inc(Src, 3);
- end
- else if (Byte(Src[0]) and $E0) = $C0 then
- begin
- if Src + 1 >= SrcEnd then
- break;
- if (Src[1] = #0) or ((Byte(Src[1]) and $C0) <> $80) then
- break;
- Dst[0] := WideChar(((Byte(Src[0]) and $1F) shl 6) + ((Byte(Src[1]) and $3F)));
- Inc(Src, 2);
- end
- else
- begin
- if MultiByteToWideChar(CodePage, MB_ERR_INVALID_CHARS, Src, 1, Dst, 1) = 0 then
- Dst[0] := '?';
- Inc(Src);
- end;
- Inc(Dst);
- end;
- Dst[0] := #0;
- Inc(Dst);
- Result := Dst - Dest;
- end;
-end;
-
-// Конвертация Unix Timestamp в Локальное время с учетом пояса и Перехода на летнее время
-function UnixToLocalTime(tUnix :Longint): TDateTime;
-var
- TimeZone :TTimeZoneInformation;
- Bias :Integer;
-begin
- if (GetTimeZoneInformation(TimeZone) = TIME_ZONE_ID_DAYLIGHT) then
- Bias := TimeZone.Bias + TimeZone.DaylightBias
- else
- Bias := TimeZone.Bias + TimeZone.StandardBias;
- Result := EncodeDate(1970,1,1) - Bias / 1440 + tUnix / 86400;
-end;
-
-{ Функция для мультиязыковой поддержки }
-procedure CoreLanguageChanged;
-var
- LangFile: String;
-begin
- if CoreLanguage = '' then
- Exit;
- try
- LangFile := PluginPath + dirLangs + CoreLanguage + '.xml';
- if FileExists(LangFile) then
- LangDoc.LoadFromFile(LangFile)
- else
- begin
- if FileExists(PluginPath + dirLangs + defaultLangFile) then
- LangDoc.LoadFromFile(PluginPath + dirLangs + defaultLangFile)
- else
- begin
- MsgDie(htdPluginShortName, 'Not found any language file!');
- Exit;
- end;
- end;
- SendMessage(AboutFormHandle, WM_LANGUAGECHANGED, 0, 0);
- SendMessage(ExportFormHandle, WM_LANGUAGECHANGED, 0, 0);
- except
- on E: Exception do
- begin
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Error on CoreLanguageChanged: ' + Trim(E.Message) + ' | CoreLanguage: ' + CoreLanguage, 2);
- MsgDie(htdPluginShortName, 'Error on CoreLanguageChanged: ' + E.Message + sLineBreak +
- 'CoreLanguage: ' + CoreLanguage);
- end;
- end;
-end;
-
-{ Функция возвращает путь до пользовательской временной папки }
-function GetUserTempPath: WideString;
-var
- UserPath: WideString;
-begin
- Result := '';
- SetLength(UserPath, MAX_PATH);
- GetTempPath(MAX_PATH, PChar(UserPath));
- GetLongPathName(PChar(UserPath), PChar(UserPath), MAX_PATH);
- SetLength(UserPath, StrLen(PChar(UserPath)));
- Result := UserPath;
-end;
-
-begin
- hppVersionStr := AnsiString(Format('%d.%d.%d.%d',[htdVerMajor,htdVerMinor,htdVerRelease,htdVerBuild]));
-end.
|