From 273b10c5ce28a955e6b7a6b384cba736f1762d77 Mon Sep 17 00:00:00 2001 From: Mikhail Grigoryev Date: Wed, 22 May 2013 09:48:12 +0000 Subject: Added plugin MirandaNGHistoryToDB (www.im-history.ru) git-svn-id: http://svn.miranda-ng.org/main/trunk@4793 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../HistoryToDBUpdater/Global.pas | 1583 ++++++++++++++++++++ 1 file changed, 1583 insertions(+) create mode 100644 plugins/MirandaNGHistoryToDB/HistoryToDBUpdater/Global.pas (limited to 'plugins/MirandaNGHistoryToDB/HistoryToDBUpdater/Global.pas') diff --git a/plugins/MirandaNGHistoryToDB/HistoryToDBUpdater/Global.pas b/plugins/MirandaNGHistoryToDB/HistoryToDBUpdater/Global.pas new file mode 100644 index 0000000000..6747ee346d --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/HistoryToDBUpdater/Global.pas @@ -0,0 +1,1583 @@ +{ ################################################################################ } +{ # # } +{ # Обновление и установка набора программ IM-History - HistoryToDBUpdater v1.0 # } +{ # # } +{ # License: GPLv3 # } +{ # # } +{ # Author: Grigorev Michael (icq: 161867489, email: sleuthhound@gmail.com) # } +{ # # } +{ ################################################################################ } + +unit Global; + +{$I jedi.inc} + +interface + +uses + Windows, Forms, Classes, SysUtils, IniFiles, DCPcrypt2, DCPblockciphers, DCPsha1, + DCPdes, DCPmd5, TypInfo, Messages, XMLIntf, XMLDoc, StrUtils, Types, TLHELP32, PsAPI, NTNative; + +type + TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP,wv2003,wvVista,wv7,wv2008,wv8); + TCopyDataType = (cdtString = 0, cdtImage = 1, cdtRecord = 2); + TDelim = set of Char; + TArrayOfString = Array of String; + TArrayOfCardinal = Array of Cardinal; + TProcessInfo = packed record + ProcessName: String; + PID: DWord; + ProcessFullCmd: String; + ProcessPath: String; + ProcessParamCmd: String; + end; + TProcessInfoArray = Array of TProcessInfo; + +const + ProgramsName = 'HistoryToDBUpdater'; + ProgramsVer : WideString = '2.5.0.0'; + DefaultDBAddres = 'db01.im-history.ru'; + DefaultDBName = 'imhistory'; + ININame = 'HistoryToDB.ini'; + ErrLogName = 'HistoryToDBUpdaterErr.log'; + DebugLogName = 'HistoryToDBUpdaterDebug.log'; + // Начальная дата (01/01/1970) Unix Timestamp для функций конвертации + UnixStartDate: TDateTime = 25569.0; + // Ключь для расшифровки параметра DBPasswd из конфига + EncryptKey = 'jsU6s2msoxghsKsn7'; + // Для мультиязыковой поддержки + WM_LANGUAGECHANGED = WM_USER + 1; + dirLangs = 'langs\'; + dirSQLUpdate = 'update\'; + defaultLangFile = 'English.xml'; + // End + WM_MSGBOX = WM_USER + 2; + uURL = 'http://im-history.ru/update/get.php?file=HistoryToDB-Update'; + {$IFDEF WIN32} + PlatformType = 'x86'; + {$ELSE} + PlatformType = 'x64'; + {$ENDIF} +var + WriteErrLog: Boolean; + EnableDebug, AlphaBlendEnable: Boolean; + MaxErrLogSize, AlphaBlendEnableValue: Integer; + DBType, DefaultLanguage, IMClientType: String; + PluginPath, ProfilePath: WideString; + Global_MainForm_Showing, Global_AboutForm_Showing: Boolean; + Global_IMProcessPID: DWORD; + // Прокси + IMUseProxy, IMProxyAuth: Boolean; + IMProxyAddress, IMProxyPort, IMProxyUser, IMProxyUserPagsswd: String; + DBUserName, MyAccount: String; + IMClientPlatformType: String; + UpdateServer: String; + // Шифрование + Cipher: TDCP_3des; + Digest: Array[0..19] of Byte; + Hash: TDCP_sha1; + // Для мультиязыковой поддержки + CoreLanguage: String; + MainFormHandle: HWND; + AboutFormHandle: HWND; + LangDoc: IXMLDocument; + +function BoolToIntStr(Bool: Boolean): String; +function IsNumber(const S: String): Boolean; +function DateTimeToUnix(ConvDate: TDateTime): Longint; +function UnixToDateTime(USec: Longint): TDateTime; +function PrepareString(const Source : PWideChar) : AnsiString; +function EncryptStr(const Str: String): String; +function DecryptStr(const Str: String): String; +function EncryptMD5(Str: String): String; +function MatchStrings(source, pattern: String): Boolean; +function ExtractFileNameEx(FileName: String; ShowExtension: Boolean): String; +function ReadCustomINI(INIPath, CustomSection, CustomParams, DefaultParamsStr: String): String; +function GetSystemDefaultUILanguage: UINT; stdcall; external kernel32 name 'GetSystemDefaultUILanguage'; +function GetSysLang: AnsiString; +function Tok(Sep: String; var S: String): String; +function GetMyFileSize(const Path: String): Integer; +function SearchMainWindow(MainWindowName: pWideChar): Boolean; +function StrContactProtoToInt(Proto: AnsiString): Integer; +function IsProcessRun(ProcessName: String): Boolean; overload; +function IsProcessRun(ProcessName, WinCaption: String): Boolean; overload; +function GetProcessID(ExeFileName: String): Cardinal; +//function GetProcessIDMulti(ExeFileName: String): TArrayOfString; +function GetProcessIDMulti2(ExeFileName: String): TArrayOfCardinal; +function GetThreadsOfProcess(APID: Cardinal): TIntegerDynArray; +function KillTask(ExeFileName: String): Integer; overload; +function KillTask(ExeFileName, WinCaption: String): Integer; overload; +function ProcessTerminate(dwPID: Cardinal): Boolean; +function ProcCloseEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +function ProcQuitEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +function GetProcessFileName(PID: DWord; FullPath: Boolean=True): String; +function GetProcessCmdLine(dwProcessId : DWORD): String; +function SetProcessDebugPrivelege: Boolean; +function EndProcess(IMClientExeName: String; EndType: Integer; EndProcess: Boolean): TProcessInfoArray; +function GetUserTempPath: WideString; +//function ProcGetCaptionForHandleEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +function EnumThreadWndProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall; +function StringToParts(sString:String; tdDelim:TDelim): TArrayOfString; +function ExtractWord(const AString: string; const ADelimiter: Char; const ANumber: integer): string; +procedure EncryptInit; +procedure EncryptFree; +procedure WriteInLog(LogPath: String; TextString: String; LogType: Integer); +procedure LoadINI(INIPath: String; NotSettingsForm: Boolean); +procedure WriteCustomINI(INIPath, CustomSection, CustomParams, ParamsStr: String); +procedure MakeTransp(winHWND: HWND); +procedure OnSendMessageToAllComponent(Msg: String); +procedure IMDelay(Value: Cardinal); +procedure OnSendMessageToOneComponent(WinName, Msg: String); +function DetectWinVersion: TWinVersion; +function DetectWinVersionStr: String; +// Для мультиязыковой поддержки +procedure MsgDie(Caption, Msg: WideString); +procedure MsgInf(Caption, Msg: WideString); +function GetLangStr(StrID: String): WideString; + +implementation + +function BoolToIntStr(Bool: Boolean): String; +begin + if Bool then + Result := '1' + else + Result := '0' +end; + +function IsNumber(const S: string): Boolean; +begin + Result := True; + try + StrToInt(S); + except + Result := False; + end; +end; + +// Функция конвертации DateTime в Unix Timestamp +function DateTimeToUnix(ConvDate: TDateTime): Longint; +begin + Result := Round((ConvDate - UnixStartDate) * 86400); +end; + +// Функция конвертации Unix Timestamp в DateTime +function UnixToDateTime(USec: Longint): TDateTime; +begin + Result := (Usec / 86400) + UnixStartDate; +end; + +// Функция для экранирования спецсимволов в строке +function PrepareString(const Source : PWideChar) : AnsiString; +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 := AnsiString(WSTmp); + end; +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); + Cipher.Init(Digest,Sizeof(Digest)*8,nil); +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; + +// Расшифровываем строку +function DecryptStr(const Str: String): String; +begin + Result := ''; + if Str <> '' then + begin + Cipher.Reset; + Result := Cipher.DecryptString(Str);; + 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; + +// LogType = 0 - ошибки добавляются в файл ErrLogName +// LogType = 1 - сообщения добавляются в файл DebugLogName +procedure WriteInLog(LogPath: String; TextString: String; LogType: Integer); +var + Path: WideString; + TF: TextFile; +begin + if LogType = 0 then + begin + Path := LogPath + ErrLogName; + if (GetMyFileSize(Path) > MaxErrLogSize*1024) then + DeleteFile(Path); + end + else + Path := LogPath + DebugLogName; + {$I-} + try + Assign(TF,Path); + if FileExists(Path) then + Append(TF) + else + Rewrite(TF); + Writeln(TF,TextString); + CloseFile(TF); + except + on e : + Exception do + begin + CloseFile(TF); + Exit; + end; + end; + {$I+} +end; + +// Загружаем настройки +procedure LoadINI(INIPath: String; NotSettingsForm: Boolean); +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); + try + DBType := INI.ReadString('Main', 'DBType', 'Unknown'); + DBUserName := INI.ReadString('Main', 'DBUserName', 'username'); + DefaultLanguage := INI.ReadString('Main', 'DefaultLanguage', 'English'); + IMClientType := INI.ReadString('Main', 'IMClientType', 'Unknown'); + MyAccount := INI.ReadString('Main', 'MyAccount', DBUserName); + + Temp := INI.ReadString('Main', 'WriteErrLog', '0'); + if Temp = '1' then WriteErrLog := True + else WriteErrLog := False; + + MaxErrLogSize := INI.ReadInteger('Main', 'MaxErrLogSize', 20); + + Temp := INI.ReadString('Main', 'EnableDebug', '0'); + if Temp = '1' then EnableDebug := True + else EnableDebug := False; + + Temp := INI.ReadString('Main', 'AlphaBlend', '0'); + if Temp = '1' then AlphaBlendEnable := True + else AlphaBlendEnable := False; + AlphaBlendEnableValue := INI.ReadInteger('Main', 'AlphaBlendValue', 255); + + Temp := INI.ReadString('Proxy', 'UseProxy', '0'); + if Temp = '1' then IMUseProxy := True + else IMUseProxy := False; + + IMProxyAddress := INI.ReadString('Proxy', 'ProxyAddress', '127.0.0.1'); + IMProxyPort := INI.ReadString('Proxy', 'ProxyPort', '3128'); + + Temp := INI.ReadString('Proxy', 'ProxyAuth', '0'); + if Temp = '1' then IMProxyAuth := True + else IMProxyAuth := False; + + IMProxyUser := INI.ReadString('Proxy', 'ProxyUser', ''); + IMProxyUserPagsswd := INI.ReadString('Proxy', 'ProxyUserPasswd', ''); + if IMProxyUserPagsswd <> '' then + IMProxyUserPagsswd := DecryptStr(IMProxyUserPagsswd); + + IMClientPlatformType := INI.ReadString('Main', 'IMClientPlatformType', PlatformType); + UpdateServer := INI.ReadString('Updater', 'UpdateServer', uURL); + finally + INI.Free; + end; + end + else + begin + INI := TIniFile.Create(path); + try + // Значения по-умолчанию + DBType := 'Unknown'; + DefaultLanguage := 'English'; + IMClientType := 'Unknown'; + WriteErrLog := True; + MaxErrLogSize := 20; + EnableDebug := False; + AlphaBlendEnable := False; + AlphaBlendEnableValue := 255; + IMUseProxy := False; + IMProxyAddress := '127.0.0.1'; + IMProxyPort := '3128'; + IMProxyAuth := False; + IMProxyUser := ''; + IMProxyUserPagsswd := ''; + // Сохраняем настройки + INI.WriteString('Main', 'DBType', DBType); + INI.WriteString('Main', 'DefaultLanguage', DefaultLanguage); + INI.WriteString('Main', 'IMClientType', IMClientType); + INI.WriteString('Main', 'WriteErrLog', BoolToIntStr(WriteErrLog)); + INI.WriteInteger('Main', 'MaxErrLogSize', MaxErrLogSize); + INI.WriteString('Main', 'EnableDebug', BoolToIntStr(EnableDebug)); + INI.WriteString('Main', 'AlphaBlend', BoolToIntStr(AlphaBlendEnable)); + INI.WriteInteger('Main', 'AlphaBlendValue', AlphaBlendEnableValue); + INI.WriteString('Proxy', 'UseProxy', BoolToIntStr(IMUseProxy)); + INI.WriteString('Proxy', 'ProxyAddress', IMProxyAddress); + INI.WriteString('Proxy', 'ProxyPort', IMProxyPort); + INI.WriteString('Proxy', 'ProxyAuth', BoolToIntStr(IMProxyAuth)); + INI.WriteString('Proxy', 'ProxyUser', IMProxyUser); + INI.WriteString('Proxy', 'ProxyUserPasswd', IMProxyUserPagsswd); + INI.WriteString('Updater', 'UpdateServer', uURL); + finally + INI.Free; + end; + end; +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; + +{ Функция для получения имени файла из пути без или с его расширением. + Возвращает имя файла, без или с его расширением. + Входные параметры: + 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; + +{ Прозрачность окна MessageBox } +procedure MakeTransp(winHWND: HWND); +var + exStyle: Longint; +begin + exStyle := GetWindowLong(winHWND, GWL_EXSTYLE); + if (exStyle and WS_EX_LAYERED = 0) then + begin + exStyle := exStyle or WS_EX_LAYERED; + SetwindowLong(winHWND, GWL_EXSTYLE, exStyle); + end; + SetLayeredWindowAttributes(winHWND, 0, AlphaBlendEnableValue, LWA_ALPHA); +end; + +// Для мультиязыковой поддержки +procedure MsgDie(Caption, Msg: WideString); +begin + if AlphaBlendEnable then + PostMessage(GetForegroundWindow, WM_USER + 2, 0, 0); + MessageBoxW(GetForegroundWindow, PWideChar(Msg), PWideChar(Caption), MB_ICONERROR); +end; + +// Для мультиязыковой поддержки +procedure MsgInf(Caption, Msg: WideString); +begin + if AlphaBlendEnable then + PostMessage(GetForegroundWindow, WM_USER + 2, 0, 0); + MessageBoxW(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; + +function GetSysLang: AnsiString; +var + WinLanguage: Array [0..50] of Char; +begin + //Result := Lo(GetSystemDefaultUILanguage); + VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50); + Result := StrPas(WinLanguage); +end; + +{ Функция разбивает строку S на слова, разделенные символами-разделителями, +указанными в строке Sep. Функция возвращает первое найденное слово, при +этом из строки S удаляется начальная часть до следующего слова } +function Tok(Sep: String; var S: String): String; + + function isoneof(c, s: string): Boolean; + var + iTmp: integer; + begin + Result := False; + for iTmp := 1 to Length(s) do + begin + if c = Copy(s, iTmp, 1) then + begin + Result := True; + Exit; + end; + end; + end; + +var + c, t: String; +begin + if s = '' then + begin + Result := s; + Exit; + end; + c := Copy(s, 1, 1); + while isoneof(c, sep) do + begin + s := Copy(s, 2, Length(s) - 1); + c := Copy(s, 1, 1); + end; + t := ''; + while (not isoneof(c, sep)) and (s <> '') do + begin + t := t + c; + s := Copy(s, 2, length(s) - 1); + c := Copy(s, 1, 1); + end; + Result := t; +end; + +{ Процедура записи значения параметра в файл настроек } +procedure WriteCustomINI(INIPath, CustomSection, CustomParams, ParamsStr: String); +var + Path: String; + IsFileClosed: Boolean; + sFile: DWORD; + INI: TIniFile; +begin + Path := INIPath + ININame; + if FileExists(Path) then + begin + // Ждем пока файл освободит антивирь или еще какая-нибудь гадость + IsFileClosed := False; + repeat + sFile := CreateFile(PChar(Path),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0); + if (sFile <> INVALID_HANDLE_VALUE) then + begin + CloseHandle(sFile); + IsFileClosed := True; + end; + until IsFileClosed; + // End + INI := TIniFile.Create(Path); + try + INI.WriteString(CustomSection, CustomParams, ParamsStr); + finally + INI.Free; + end; + end + else + MsgDie(ProgramsName, GetLangStr('SettingsErrSave')); +end; + +{ Функция чтения значения параметра из файла настроек } +function ReadCustomINI(INIPath, CustomSection, CustomParams, DefaultParamsStr: String): String; +var + Path: String; + INI: TIniFile; +begin + Path := INIPath + ININame; + INI := TIniFile.Create(Path); + if FileExists(Path) then + begin + try + Result := INI.ReadString(CustomSection, CustomParams, DefaultParamsStr); + finally + INI.Free; + end; + end + else + MsgDie(ProgramsName, GetLangStr('SettingsErrRead')); +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; + +{ Поиск окна программы } +function SearchMainWindow(MainWindowName: pWideChar): Boolean; +var + HToDB: HWND; +begin + // Ищем окно + HToDB := FindWindow(nil, MainWindowName); + if HToDB <> 0 then + Result := True + else + Result := False +end; + +{ Процедура для отправки сообщений программе } +{ Стандартные команды: + 001 - Перечитать настройки из файла HistoryToDB.ini + 002 - Синхронизация истории + 003 - Закрыть все компоненты плагина + 0040 - Показать все окна плагина (Режим AntiBoss) + 0041 - Скрыть все окна плагина (Режим AntiBoss) + 0050 - Запустить перерасчет MD5-хешей + 0051 - Запустить перерасчет MD5-хешей и удаления дубликатов + 0060 - Запущен импорт истории + 0061 - Импорт истории завершен + 007 - Обновить контакт-лист в БД + 008 - Показать историю контакта/чата + Формат команды: + для истории контакта: + 008|0|UserID|UserName|ProtocolType + для истории чата: + 008|2|ChatName + 009 - Экстренно закрыть все компоненты плагина. +} +procedure OnSendMessageToAllComponent(Msg: String); +var + HToDB: HWND; + copyDataStruct : TCopyDataStruct; + EncryptMsg, WinName: String; +begin + EncryptMsg := EncryptStr(Msg); + WinName := 'HistoryToDBViewer for ' + IMClientType; + // Ищем окно HistoryToDBViewer и посылаем ему команду + HToDB := FindWindow(nil, pChar(WinName)); + if HToDB <> 0 then + begin + copyDataStruct.dwData := Integer(cdtString); + copyDataStruct.cbData := 2*Length(EncryptMsg); + copyDataStruct.lpData := PChar(EncryptMsg); + SendMessage(HToDB, WM_COPYDATA, 0, Integer(@copyDataStruct)); + end; + WinName := 'HistoryToDBSync for ' + IMClientType; + // Ищем окно HistoryToDBSync и посылаем ему команду + HToDB := FindWindow(nil, pChar(WinName)); + if HToDB <> 0 then + begin + copyDataStruct.dwData := Integer(cdtString); + copyDataStruct.cbData := 2*Length(EncryptMsg); + copyDataStruct.lpData := PChar(EncryptMsg); + SendMessage(HToDB, WM_COPYDATA, 0, Integer(@copyDataStruct)); + end; + WinName := 'HistoryToDBImport for ' + IMClientType; + // Ищем окно HistoryToDBImport и посылаем ему команду + HToDB := FindWindow(nil, pChar(WinName)); + if HToDB <> 0 then + begin + copyDataStruct.dwData := Integer(cdtString); + copyDataStruct.cbData := 2*Length(EncryptMsg); + copyDataStruct.lpData := PChar(EncryptMsg); + SendMessage(HToDB, WM_COPYDATA, 0, Integer(@copyDataStruct)); + end; +end; + +procedure OnSendMessageToOneComponent(WinName, Msg: String); +var + HToDB: HWND; + copyDataStruct : TCopyDataStruct; + EncryptMsg: String; +begin + EncryptMsg := EncryptStr(Msg); + // Ищем окно HistoryToDBViewer и посылаем ему команду + HToDB := FindWindow(nil, pChar(WinName)); + if HToDB <> 0 then + begin + copyDataStruct.dwData := Integer(cdtString); + copyDataStruct.cbData := 2*Length(EncryptMsg); + copyDataStruct.lpData := PChar(EncryptMsg); + SendMessage(HToDB, WM_COPYDATA, 0, Integer(@copyDataStruct)); + 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 - Unknown + } + if MatchStrings(LowerCase(Proto), 'icq*') then + ProtoType := 0 + else if MatchStrings(LowerCase(Proto), 'google talk*') then + ProtoType := 1 + 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(Proto, 'ВКонтакте*') then + ProtoType := 6 + else if MatchStrings(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 + ProtoType := 15; + 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; + +{ Закрытие программы через WM_CLOSE по её PID } +function ProcCloseEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +var + Pid: DWORD; +begin + Result := True; + GetWindowThreadProcessId(hwnd, pid); + if Pid = DWORD(data) then + begin + PostMessage(hwnd, WM_CLOSE, 0, 0); + end; +end; + +{ Закрытие программы через WM_QUIT по её PID } +function ProcQuitEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +var + Pid: DWORD; +begin + Result := True; + GetWindowThreadProcessId(hwnd, pid); + if Pid = DWORD(data) then + begin + PostMessage(hwnd, WM_QUIT, 0, 0); + end; +end; + +{function ProcGetCaptionForHandleEnum(hwnd: THandle; data: Pointer):BOOL;stdcall; +var + Pid: DWORD; + WinCaption: Array [0 .. 255] of Char; +begin + Result := True; + GetWindowThreadProcessId(hwnd, pid); + if Pid = DWORD(data) then + begin + //PostMessage(hwnd, WM_QUIT, 0, 0); + GetWindowText(hwnd, WinCaption, SizeOf(WinCaption)); + if WinCaption <> '' then + MsgInf('ProcGetCaptionForHandleEnum', WinCaption); + end; +end;} + +{ Функция отправляет WM_QUIT процессу + и возвращает TArrayOfString со списком полных путей + параметры запуска + этих процессов + EndType = 0 - WM_CLOSE + EndType = 1 - WM_QUIT + } +function EndProcess(IMClientExeName: String; EndType: Integer; EndProcess: Boolean): TProcessInfoArray; +var + I: Integer; + ProcessPIDListArray: TArrayOfCardinal; + MyFullCMD, MyCMD, ProcessCmdLine: String; +begin + SetLength(Result, 0); + SetLength(ProcessPIDListArray, 0); + ProcessPIDListArray := GetProcessIDMulti2(IMClientExeName); + for I := 0 to High(ProcessPIDListArray) do + begin + SetLength(Result, Length(Result)+1); + Result[Length(Result)-1].ProcessName := IMClientExeName; + Result[Length(Result)-1].PID := ProcessPIDListArray[I]; + ProcessCmdLine := GetProcessCmdLine(ProcessPIDListArray[I]); + if ProcessCmdLine = '' then + begin + + if (IMClientExeName = 'qip.exe') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\QIP 2012\qip.exe"' + else if (IMClientExeName = 'qip.exe') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files (x86)\QIP 2012\qip.exe"' + + else if (IMClientExeName = 'miranda32.exe') and (IMClientType = 'Miranda') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda IM\miranda32.exe"' + else if (IMClientExeName = 'miranda32.exe') and (IMClientType = 'Miranda') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files (x86)\Miranda IM\miranda32.exe"' + else if (IMClientExeName = 'miranda64.exe') and (IMClientType = 'Miranda') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda IM\miranda32.exe"' + else if (IMClientExeName = 'miranda64.exe') and (IMClientType = 'Miranda') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda IM\miranda32.exe"' + + else if (IMClientExeName = 'miranda32.exe') and (IMClientType = 'MirandaNG') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda NG\miranda32.exe"' + else if (IMClientExeName = 'miranda32.exe') and (IMClientType = 'MirandaNG') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files (x86)\Miranda NG\miranda32.exe"' + else if (IMClientExeName = 'miranda64.exe') and (IMClientType = 'MirandaNG') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda NG\miranda32.exe"' + else if (IMClientExeName = 'miranda64.exe') and (IMClientType = 'MirandaNG') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Miranda NG\miranda32.exe"' + + else if (IMClientExeName = 'skype.exe') and (DetectWinVersionStr = 'Windows 7') then + ProcessCmdLine := '"C:\Program Files (x86)\Skype\Phone\skype.exe"' + else if (IMClientExeName = 'skype.exe') and (DetectWinVersionStr <> 'Windows 7') then + ProcessCmdLine := '"C:\Program Files\Skype\Phone\skype.exe"' + else + ProcessCmdLine := IMClientExeName; + end; + Result[Length(Result)-1].ProcessFullCmd := ProcessCmdLine; + //MsgInf('EndProcess', 'ProcessName: ' + Result[Length(Result)-1].ProcessName + #13 + 'PID: ' + IntToStr(Result[Length(Result)-1].PID) + #13 + 'ProcessFullCmd: ' + Result[Length(Result)-1].ProcessFullCmd); + //Result[Length(Result)-1] := GetProcessFileName(StrToInt(ProcessListArray[I]), True); + // Если в полном CMD вида + // "C:/Program Files/PostgreSQL/9.1/bin/postgres.exe" "--forklog" "244" "248" + // или + // "C:\Program Files\Microsoft Firewall Client 2004\FwcAgent.exe" + if Result[Length(Result)-1].ProcessFullCmd[1] = '"' then + begin + MyFullCMD := Result[Length(Result)-1].ProcessFullCmd; + Delete(MyFullCMD, 1, 1); + MyCMD := Copy(MyFullCMD, 1, Pos('"', MyFullCMD)-1); + Delete(MyFullCMD, 1, Pos('"', MyFullCMD)+1); + Result[Length(Result)-1].ProcessPath := MyCMD; + Result[Length(Result)-1].ProcessParamCmd := MyFullCMD; + end + else + begin + MyFullCMD := Result[Length(Result)-1].ProcessFullCmd; + // Если в полном CMD вида + // C:\WINDOWS\system32\svchost -k DcomLaunch + if Pos(' ', MyFullCMD) > 0 then + begin + MyCMD := Copy(MyFullCMD, 1, Pos(' ', MyFullCMD)-1); + Delete(MyFullCMD, 1, Pos(' ', MyFullCMD)); + Result[Length(Result)-1].ProcessPath := MyCMD; + Result[Length(Result)-1].ProcessParamCmd := MyFullCMD; + end + // Если в полном CMD вида + // C:\WINDOWS\system32\lsass.exe + else + begin + Result[Length(Result)-1].ProcessPath := MyFullCMD; + Result[Length(Result)-1].ProcessParamCmd := ''; + end; + end; + // Завершение процесса + if EndProcess then + begin + if EndType = 0 then //WM_CLOSE + EnumWindows(@ProcCloseEnum, ProcessPIDListArray[I]) + else //WM_QUIT + EnumWindows(@ProcQuitEnum, ProcessPIDListArray[I]); + end; + end; +end; + +function EnumThreadWndProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall; +var + WindowClassName: String; + WindowClassNameLength: Integer; + WinCaption: Array [0 .. 255] of Char; + ThreadProcessWinCaption: String; + PID: DWORD; +begin + Result := True; + ThreadProcessWinCaption := String(LPARAM); + GetWindowThreadProcessId(hwnd, pid); + SetLength(WindowClassName, MAX_PATH); + WindowClassNameLength := GetClassName(hwnd, PChar(WindowClassName), MAX_PATH); + GetWindowText(hwnd, WinCaption, SizeOf(WinCaption)); + if MatchStrings(LeftStr(WindowClassName, WindowClassNameLength), 'TMain*') and (WinCaption = ThreadProcessWinCaption) then + begin + Global_IMProcessPID := PID; + //MsgInf('EnumThreadWndProc', 'PID процесса родителя: ' + IntToStr(PID) + #10#13 + 'Класс: ' + LeftStr(WindowClassName, WindowClassNameLength) + #10#13 + 'Заголовок окна: ' + WinCaption); + end; + // Получим дочерние окна. + //EnumChildWindows(hwnd, @EnumThreadWndProc, lParam); +end; + +{ Получение ID всех потоков указанного процесса } +function GetThreadsOfProcess(APID: Cardinal): TIntegerDynArray; +var + lSnap: DWord; + lThread: TThreadEntry32; +begin + Result := nil; + if APID <> INVALID_HANDLE_VALUE then + begin + lSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); + if (lSnap <> INVALID_HANDLE_VALUE) then + begin + lThread.dwSize := SizeOf(TThreadEntry32); + if Thread32First(lSnap, lThread) then + repeat + if lThread.th32OwnerProcessID = APID then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := lThread.th32ThreadID; + end; + until not Thread32Next(lSnap, lThread); + CloseHandle(lSnap); + end; + end; +end; + +{ Проверка процесса на наличие в памяти по его имени } +function IsProcessRun(ProcessName: String): Boolean; overload; +var + Snapshot: THandle; + Proc: TProcessEntry32; +begin + Result := False; + Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if Snapshot = INVALID_HANDLE_VALUE then + Exit; + Proc.dwSize := SizeOf(TProcessEntry32); + if Process32First(Snapshot, Proc) then + repeat + if Proc.szExeFile = ProcessName then + begin + Result := True; + Break; + end; + until not Process32Next(Snapshot, Proc); + CloseHandle(Snapshot); +end; + +function IsProcessRun(ProcessName, WinCaption: String): Boolean; overload; +var + Snapshot: THandle; + Proc: TProcessEntry32; + lThreads: TIntegerDynArray; + J: Integer; +begin + Result := False; + Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if Snapshot = INVALID_HANDLE_VALUE then + Exit; + Proc.dwSize := SizeOf(TProcessEntry32); + if Process32First(Snapshot, Proc) then + repeat + if ((UpperCase(ExtractFileName(Proc.szExeFile)) = UpperCase(ProcessName)) + or (UpperCase(Proc.szExeFile) = UpperCase(ProcessName))) then + begin + // Получение Заголовков окон процесса + //EnumWindows(@ProcGetCaptionForHandleEnum, FProcessEntry32.th32ProcessID); + // Получение ClassName и Заголовков окон всех потоков процесса + Global_IMProcessPID := 0; + lThreads := GetThreadsOfProcess(Proc.th32ProcessID); + for J := Low(lThreads) to High(lThreads) do + EnumThreadWindows(lThreads[J], @EnumThreadWndProc, LPARAM(WinCaption)); + if Global_IMProcessPID = Proc.th32ProcessID then + //MsgInf('IsProcessRun', 'Найден нужный процесс'); + Result := True; + // Ends + end; + until not Process32Next(Snapshot, Proc); + CloseHandle(Snapshot); +end; + +{ Завершение процесса по имени } +function KillTask(ExeFileName: String): Integer; +const + PROCESS_TERMINATE=$0001; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + Result := 0; + FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := Sizeof(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) + or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then + Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), + FProcessEntry32.th32ProcessID), 0)); + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + CloseHandle(FSnapshotHandle); +end; + +{ Завершение процесса по имени и заголовку окна } +function KillTask(ExeFileName, WinCaption: String): Integer; overload; +const + PROCESS_TERMINATE=$0001; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; + lThreads: TIntegerDynArray; + J: Integer; +begin + Result := 0; + FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := Sizeof(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) + or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then + begin + // Получение Заголовков окон процесса + //EnumWindows(@ProcGetCaptionForHandleEnum, FProcessEntry32.th32ProcessID); + // Получение ClassName и Заголовков окон всех потоков процесса + Global_IMProcessPID := 0; + lThreads := GetThreadsOfProcess(FProcessEntry32.th32ProcessID); + for J := Low(lThreads) to High(lThreads) do + EnumThreadWindows(lThreads[J], @EnumThreadWndProc, LPARAM(WinCaption)); + if Global_IMProcessPID = FProcessEntry32.th32ProcessID then + //MsgInf('KillTask', 'Найден нужный процесс'); + Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0)); + // Ends + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + CloseHandle(FSnapshotHandle); +end; + +{ Получение PID программы в памяти } +function GetProcessID(ExeFileName: String): Cardinal; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + Result := 0; + FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := Sizeof(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + repeat + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) + or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then + begin + Result := FProcessEntry32.th32ProcessID; + Break; + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + until not ContinueLoop; + CloseHandle(FSnapshotHandle); +end; + +{ Получение PID для нескольких процессов с одинаковым именем } +{function GetProcessIDMulti(ExeFileName: String): TArrayOfString; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + SetLength(Result, 0); + //Result := 0; + FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := Sizeof(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + repeat + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) + or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then + begin + SetLength(Result, Length(Result)+1); + Result[Length(Result)-1] := IntToStr(FProcessEntry32.th32ProcessID); + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + until not ContinueLoop; + CloseHandle(FSnapshotHandle); +end;} + +{ Получение PID для нескольких процессов с одинаковым именем } +function GetProcessIDMulti2(ExeFileName: String): TArrayOfCardinal; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + SetLength(Result, 0); + //Result := 0; + FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := Sizeof(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + repeat + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) + or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then + begin + SetLength(Result, Length(Result)+1); + Result[Length(Result)-1] := FProcessEntry32.th32ProcessID; + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + until not ContinueLoop; + CloseHandle(FSnapshotHandle); +end; + +{ Получаем полный путь до приложения по его PID } +function GetProcessFileName(PID: DWord; FullPath: Boolean=True): String; +var + Handle: THandle; +begin + Result := ''; + Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID); + try + if Handle <> 0 then + begin + SetLength(Result, MAX_PATH); + if FullPath then + begin + if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then + SetLength(Result, StrLen(PChar(Result))) + else + Result := ''; + end + else + begin + if GetModuleBaseNameA(Handle, 0, PAnsiChar(Result), MAX_PATH) > 0 then + SetLength(Result, StrLen(PChar(Result))) + else + Result := ''; + end; + end; + finally + CloseHandle(Handle); + end; +end; + +{ Получаем команду запуска программы с полным путем по её PID } +function GetProcessCmdLine(dwProcessId : DWORD): String; +const + STATUS_SUCCESS = $00000000; + SE_DEBUG_NAME = 'SeDebugPrivilege'; + ProcessWow64Information = 26; +var + ProcessHandle : THandle; + ProcessBasicInfo : PROCESS_BASIC_INFORMATION; + ReturnLength : DWORD; + lpNumberOfBytesRead : ULONG_PTR; + TokenHandle : THandle; + lpLuid : TOKEN_PRIVILEGES; + OldlpLuid : TOKEN_PRIVILEGES; + Rtl : RTL_USER_PROCESS_PARAMETERS; + Peb : _PEB; + IsProcessx64 : Boolean; + {$IFDEF CPUX64} + PEBBaseAddress32 : Pointer; + Peb32 : _PEB32; + Rtl32 : RTL_USER_PROCESS_PARAMETERS32; + {$ENDIF} + Ws: WideString; +begin + Result:=''; + if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then + begin + try + if not LookupPrivilegeValue(nil, SE_DEBUG_NAME, lpLuid.Privileges[0].Luid) then + RaiseLastOSError + else + begin + lpLuid.PrivilegeCount := 1; + lpLuid.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; + ReturnLength := 0; + OldlpLuid := lpLuid; + // Включаем себе SeDebugPrivilege + if not AdjustTokenPrivileges(TokenHandle, False, lpLuid, SizeOf(OldlpLuid), OldlpLuid, ReturnLength) then RaiseLastOSError; + end; + + ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, dwProcessId); + if ProcessHandle = 0 then RaiseLastOSError + else + try + IsProcessx64 := ProcessIsX64(ProcessHandle); + + {$IFNDEF CPUX64} + if IsProcessx64 then + raise Exception.Create('Only 32 bits processes are supported'); + {$ENDIF} + + {$IFDEF CPUX64} + if IsProcessx64 then + begin + {$ENDIF} + // Получаем доступ к PROCESS_BASIC_INFORMATION по адресу PEB + if (NtQueryInformationProcess(ProcessHandle,0{=>ProcessBasicInformation},@ProcessBasicInfo, SizeOf(ProcessBasicInfo), @ReturnLength)=STATUS_SUCCESS) and (ReturnLength=SizeOf(ProcessBasicInfo)) then + begin + // Читаем PEB структуру + if not ReadProcessMemory(ProcessHandle, ProcessBasicInfo.PEBBaseAddress, @Peb, sizeof(Peb), lpNumberOfBytesRead) then + RaiseLastOSError + else + begin + // Читаем RTL_USER_PROCESS_PARAMETERS структуру + if not ReadProcessMemory(ProcessHandle, Peb.ProcessParameters, @Rtl, SizeOf(Rtl), lpNumberOfBytesRead) then + RaiseLastOSError + else + begin + SetLength(ws,(Rtl.CommandLine.Length div 2)); + if not ReadProcessMemory(ProcessHandle,Rtl.CommandLine.Buffer,PWideChar(ws),Rtl.CommandLine.Length,lpNumberOfBytesRead) then + RaiseLastOSError + else + Result := String(ws); + end; + end; + end + else + RaiseLastOSError; + {$IFDEF CPUX64} + end + else + begin + // Получаем PEB адрес + if NtQueryInformationProcess(ProcessHandle, ProcessWow64Information, @PEBBaseAddress32, SizeOf(PEBBaseAddress32), nil)=STATUS_SUCCESS then + begin + // Читаем PEB структуру + if not ReadProcessMemory(ProcessHandle, PEBBaseAddress32, @Peb32, sizeof(Peb32), lpNumberOfBytesRead) then + RaiseLastOSError + else + begin + // Читаем RTL_USER_PROCESS_PARAMETERS структуру + if not ReadProcessMemory(ProcessHandle, Pointer(Peb32.ProcessParameters), @Rtl32, SizeOf(Rtl32), lpNumberOfBytesRead) then + RaiseLastOSError + else + begin + SetLength(ws,(Rtl32.CommandLine.Length div 2)); + if not ReadProcessMemory(ProcessHandle, Pointer(Rtl32.CommandLine.Buffer), PWideChar(ws), Rtl32.CommandLine.Length, lpNumberOfBytesRead) then + RaiseLastOSError + else + Result := String(Ws); + end; + end; + end + else + RaiseLastOSError; + end; + {$ENDIF} + finally + CloseHandle(ProcessHandle); + end; + finally + CloseHandle(TokenHandle); + end; + end + else + RaiseLastOSError; +end; + +{ Включаем себе SeDebugPrivilege } +function SetProcessDebugPrivelege: Boolean; +var + hToken: THandle; + tp: TTokenPrivileges; + rl: Cardinal; +begin + Result := False; + if not OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES,hToken) then + Exit; + try + if not LookupPrivilegeValue(nil,'SeDebugPrivilege', tp.Privileges[0].Luid) then + Exit; + tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; + tp.PrivilegeCount := 1; + Result := AdjustTokenPrivileges(hToken,false,tp,0,nil,rl) and (GetLastError=0); + finally + CloseHandle(hToken); + end +end; + +// Завершение любых процессов в том числе системных. +// Включение, приминение и отключения привилегии. +// Для примера возьмем привилегию отладки приложений 'SeDebugPrivilege' +// необходимую для завершения ЛЮБЫХ процессов в системе (завершение процесов +// созданных текущим пользователем привилегия не нужна. +// Название добавление/удаление привилгии немного неправильные. Привилегия или +// есть в токене процесса или ее нет. Если привилегия есть, то она может быть в +// двух состояниях - или включеная или отключеная. И в этом примере мы только +// включаем или выключаем необходимую привилегию, а не добавляем ее. +function ProcessTerminate(dwPID: Cardinal): Boolean; +var + hToken:THandle; + SeDebugNameValue:Int64; + tkp:TOKEN_PRIVILEGES; + ReturnLength:Cardinal; + hProcess:THandle; +begin + Result := False; + // Включаем привилегию SeDebugPrivilege + // Для начала получаем токен нашего процесса + if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken ) then + Exit; + // Получаем LUID привилегии + if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', SeDebugNameValue) then + begin + CloseHandle(hToken); + Exit; + end; + tkp.PrivilegeCount := 1; + tkp.Privileges[0].Luid := SeDebugNameValue; + tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; + // Добавляем привилегию к нашему процессу + AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ReturnLength); + if GetLastError() <> ERROR_SUCCESS then + Exit; + // Завершаем процесс. Если у нас есть SeDebugPrivilege, то мы можем + // завершить и системный процесс + // Получаем дескриптор процесса для его завершения + hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, dwPID); + if hProcess = 0 then + Exit; + // Завершаем процесс + if not TerminateProcess(hProcess, DWORD(-1)) then + Exit; + CloseHandle( hProcess ); + // Отключаем привилегию + tkp.Privileges[0].Attributes := 0; + AdjustTokenPrivileges(hToken, FALSE, tkp, SizeOf(tkp), tkp, ReturnLength); + if GetLastError() <> ERROR_SUCCESS then + Exit; + Result := True; +end; + +function StringToParts(sString: String; tdDelim: TDelim): TArrayOfString; +var + iCounter,iBegin:Integer; +begin + if length(sString)>0 then + begin + include(tdDelim, #0); + iBegin:=1; + SetLength(Result, 0); + for iCounter:=1 to Length(sString)+1 do + begin + if(sString[iCounter] in tdDelim) then + begin + SetLength(Result, Length(Result)+1); + Result[Length(Result)-1] := Copy(sString, iBegin, iCounter-iBegin); + iBegin := iCounter+1; + end; + end; + end; +end; + +{ Edit1.Text := ExtractWord(ExtractWord('admin:login:password', ':', 3)); //'password' } +function ExtractWord(const AString: string; const ADelimiter: Char; const ANumber: integer): string; +var + i, j, k: integer; +begin + i := 1; + k := 1; + while k <> ANumber do + begin + if AString[i] = ADelimiter then + begin + Inc(k); + end; + Inc(i); + end; + j := i + 1; + while (j <= Length(AString)) and (AString[j] <> ADelimiter) do + Inc(j); + Result := Copy(AString, i, j - i); +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; + +{ +DwMajorVersion:DWORD - старшая цифра версии Windows + + Windows 95 - 4 + Windows 98 - 4 + Windows Me - 4 + Windows NT 3.51 - 3 + Windows NT 4.0 - 4 + Windows 2000 - 5 + Windows XP - 5 + +DwMinorVersion: DWORD - младшая цифра версии + + Windows 95 - 0 + Windows 98 - 10 + Windows Me - 90 + Windows NT 3.51 - 51 + Windows NT 4.0 - 0 + Windows 2000 - 0 + Windows XP - 1 + + +DwBuildNumber: DWORD + Win NT 4 - номер билда + Win 9x - старший байт - старшая и младшая цифры версии / младший - номер +билда + +dwPlatformId: DWORD + + VER_PLATFORM_WIN32s Win32s on Windows 3.1. + VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 9x + VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000 + + +SzCSDVersion:DWORD + NT - содержит PСhar с инфо о установленном ServicePack + 9x - доп. инфо, может и не быть +} +function DetectWinVersion: TWinVersion; +var + OSVersionInfo : TOSVersionInfo; +begin + Result := wvUnknown; // Неизвестная версия ОС + OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo); + if GetVersionEx(OSVersionInfo) + then + begin + case OSVersionInfo.DwMajorVersion of + 3: Result := wvNT3; // Windows NT 3 + 4: case OSVersionInfo.DwMinorVersion of + 0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT + then Result := wvNT4 // Windows NT 4 + else Result := wv95; // Windows 95 + 10: Result := wv98; // Windows 98 + 90: Result := wvME; // Windows ME + end; + 5: case OSVersionInfo.DwMinorVersion of + 0: Result := wvW2K; // Windows 2000 + 1: Result := wvXP; // Windows XP + 2: Result := wv2003; // Windows 2003 + 3: Result := wvVista; // Windows Vista + end; + 6: case OSVersionInfo.DwMinorVersion of + 0: Result := wv2008; // Windows 2008 + 1: Result := wv7; // Windows 7 + end; + 7: case OSVersionInfo.DwMinorVersion of + 1: Result := wv8; // Windows 8 + end; + end; + end; +end; + +function DetectWinVersionStr: String; +const + VersStr : Array[TWinVersion] of String = ( + 'Unknown OS', + 'Windows 95', + 'Windows 98', + 'Windows ME', + 'Windows NT 3', + 'Windows NT 4', + 'Windows 2000', + 'Windows XP', + 'Windows Server 2003', + 'Windows Vista', + 'Windows 7', + 'Windows Server 2008', + 'Windows 8'); +begin + Result := VersStr[DetectWinVersion]; +end; + +begin +end. -- cgit v1.2.3