diff options
Diffstat (limited to 'plugins/!Deprecated/MirandaNGHistoryToDB/MsgExport.pas')
| -rw-r--r-- | plugins/!Deprecated/MirandaNGHistoryToDB/MsgExport.pas | 452 |
1 files changed, 0 insertions, 452 deletions
diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/MsgExport.pas b/plugins/!Deprecated/MirandaNGHistoryToDB/MsgExport.pas deleted file mode 100644 index a409a01091..0000000000 --- a/plugins/!Deprecated/MirandaNGHistoryToDB/MsgExport.pas +++ /dev/null @@ -1,452 +0,0 @@ -{ ############################################################################ }
-{ # # }
-{ # MirandaNG HistoryToDB Plugin v2.5 # }
-{ # # }
-{ # License: GPLv3 # }
-{ # # }
-{ # Author: Grigorev Michael (icq: 161867489, email: sleuthhound@gmail.com) # }
-{ # # }
-{ ############################################################################ }
-
-unit MsgExport;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, JvWizard, JvExControls, JvWizardRouteMapNodes, ComCtrls, StdCtrls,
- JvComponentBase, JvThread, JclStringConversions, Global, Contacts, m_api;
-
-type
- TContactRecord = record
- hContact: Cardinal;
- ContactID: AnsiString;
- ContactName: AnsiString;
- ProtoName: AnsiString;
- Selected: Boolean;
- end;
- TExportForm = class(TForm)
- IMExportWizard: TJvWizard;
- Page1: TJvWizardWelcomePage;
- Page2: TJvWizardInteriorPage;
- Page3: TJvWizardInteriorPage;
- Page4: TJvWizardInteriorPage;
- LExportDesc: TLabel;
- IMExportThread: TJvThread;
- CBSelectAll: TCheckBox;
- ContactList: TListView;
- PBTotalExport: TProgressBar;
- LExportDesc2: TLabel;
- CBSyncRequest: TCheckBox;
- LExportDone: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure Page3Page(Sender: TObject);
- procedure IMExportWizardCancelButtonClick(Sender: TObject);
- procedure IMExportWizardFinishButtonClick(Sender: TObject);
- procedure IMExportThreadExecute(Sender: TObject; Params: Pointer);
- procedure CBSelectAllClick(Sender: TObject);
- procedure ContactListChanging(Sender: TObject; Item: TListItem; Change: TItemChange; var AllowChange: Boolean);
- procedure ContactListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
- procedure BringFormToFront(Form: TForm);
- function CheckStopExportAndExit: Boolean;
- private
- { Private declarations }
- StartExport: Boolean;
- // Для мультиязыковой поддержки
- procedure OnLanguageChanged(var Msg: TMessage); message WM_LANGUAGECHANGED;
- procedure LoadLanguageStrings;
- public
- { Public declarations }
- end;
-
-var
- ExportForm: TExportForm;
- ExportContactRecords: Array of TContactRecord;
-
-implementation
-
-{$R *.dfm}
-{$R icons.res}
-
-procedure TExportForm.FormCreate(Sender: TObject);
-begin
- StartExport := False;
- ExportFormDestroy := False;
- // Для мультиязыковой поддержки
- ExportFormHandle := Handle;
- SetWindowLong(Handle, GWL_HWNDPARENT, 0);
- SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
- // Загружаем язык интерфейса
- LoadLanguageStrings;
-end;
-
-procedure TExportForm.FormShow(Sender: TObject);
-var
- ListItem: TListItem;
- hContact: Cardinal;
- ContactProto, ContactID, ContactName: AnsiString;
- Count: Integer;
-begin
- IMExportWizard.ActivePage := Page1;
- StartExport := False;
- // Получаем список контактов
- hContact := db_find_first();
- ContactList.Columns[0].MaxWidth := 190;
- ContactList.Columns[1].MaxWidth := 90;
- ContactList.Columns[2].MaxWidth := 140;
- ContactList.Items.BeginUpdate;
- Count := 0;
- while hContact <> 0 do
- begin
- ContactProto := GetContactProto(hContact);
- ContactID := GetContactID(hContact, ContactProto);
- ContactName := GetContactDisplayName(hContact, '', True);
- // Доп. проверка протокола
- if ContactProto = MyAccount then
- ContactProto := 'ICQ';
- if ContactName = '' then
- ContactName := 'NoContactName';
- if ContactID = '' then
- ContactID := 'NoContactID';
- SetLength(ExportContactRecords, Count + 1);
- ExportContactRecords[Count].hContact := hContact;
- ExportContactRecords[Count].ContactID := ContactID;
- ExportContactRecords[Count].ContactName := ContactName;
- ExportContactRecords[Count].ProtoName := ContactProto;
- ExportContactRecords[Count].Selected := False;
- Inc(Count);
- ListItem := ContactList.Items.Add;
- ListItem.Caption := ContactName;
- ListItem.SubItems.Add(ContactProto);
- ListItem.SubItems.Add(ContactID);
- {if StrContactProtoToInt(ContactProto) = 15 then // 15 - Unknown Proto
- ListItem.Checked := False
- else
- ListItem.Checked := True;}
- hContact := db_find_next(hContact);
- end;
- ContactList.Items.EndUpdate;
-end;
-
-procedure TExportForm.FormClose(Sender: TObject; var Action: TCloseAction);
-begin
- ExportFormDestroy := True;
- Action := caFree;
-end;
-
-procedure TExportForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
-begin
- CanClose := CheckStopExportAndExit;
-end;
-
-procedure TExportForm.IMExportWizardCancelButtonClick(Sender: TObject);
-begin
- Close;
-end;
-
-procedure TExportForm.IMExportWizardFinishButtonClick(Sender: TObject);
-begin
- if IMExportWizard.ActivePage = Page4 then
- begin
- if CBSyncRequest.Checked then
- OnSendMessageToAllComponent('002');
- Close;
- end;
-end;
-
-procedure TExportForm.Page3Page(Sender: TObject);
-begin
- StartExport := True;
- Page3.EnabledButtons := [bkCancel];
- if not IMExportThread.Terminated then
- begin
- IMExportThread.Terminate;
- while not (IMExportThread.Terminated) do
- Sleep(1);
- end;
- IMExportThread.Execute(Self);
-end;
-
-procedure TExportForm.IMExportThreadExecute(Sender: TObject; Params: Pointer);
-var
- I, J, K, ProtoType: Integer;
- SelectedCount, BlobSize: Integer;
- hDbEvent: Cardinal;
- DBEventInfo: TDBEventInfo;
- msgA: PAnsiChar;
- msgW: PChar;
- msgLen, LenW: Cardinal;
- Msg_Date: TDateTime;
- Msg_RcvrNick, Msg_RcvrAcc, Msg_SenderNick, Msg_SenderAcc, Msg_Text, MD5String: WideString;
- Date_Str, MsgStatus: String;
- ContactProto, ContactID, ContactName: AnsiString;
- MyContactName, MyContactID: AnsiString;
-begin
- LExportDesc2.Caption := 'Export...';
- // Подсчитываем количество выделенных элементов
- SelectedCount := 0;
- for J := 0 to Length(ExportContactRecords) do
- begin
- if ExportContactRecords[J].Selected = True then
- Inc(SelectedCount);
- if IMExportThread.Terminated then // Выход из потока в случае закрытия окна
- Exit;
- end;
- LExportDesc.Caption := Format(GetLangStr('TotalSelect'), [IntToStr(SelectedCount), IntToStr(Length(ExportContactRecords))]);
- // Начинаем перебор всех элементов
- PBTotalExport.Position := 0;
- PBTotalExport.Max := SelectedCount;
- SelectedCount := 0;
- for I := 0 to Length(ExportContactRecords) do
- begin
- // Если выделен, то экспортируем его историю
- if ExportContactRecords[I].Selected = True then
- begin
- LExportDesc2.Caption := Format(GetLangStr('ContactExport'), [ExportContactRecords[I].ContactName, ExportContactRecords[I].ContactID]);
- Inc(SelectedCount);
- PBTotalExport.Position := SelectedCount;
- if IMExportThread.Terminated then // Выход из потока в случае закрытия окна
- Exit;
- hDbEvent := CallService(MS_DB_EVENT_FINDFIRST, ExportContactRecords[I].hContact, 0);
- while hDbEvent <> 0 do
- begin
- ZeroMemory(@DBEventInfo, SizeOf(DBEventInfo));
- DBEventInfo.cbSize := SizeOf(DBEventInfo);
- DBEventInfo.pBlob := nil;
- BlobSize := CallService(MS_DB_EVENT_GETBLOBSIZE, hDbEvent, 0);
- GetMem(DBEventInfo.pBlob, BlobSize);
- DBEventInfo.cbBlob := BlobSize;
- if IMExportThread.Terminated then // Выход из потока в случае закрытия окна
- begin
- if ImportLogOpened then
- CloseLogFile(5);
- Exit;
- end;
- if (CallService(MS_DB_EVENT_GET, hDbEvent, Integer(@DBEventInfo)) = 0) and (DBEventInfo.eventType = EVENTTYPE_MESSAGE and EVENTTYPE_URL) then
- begin
- // Получаем текст сообщения
- msgA := PAnsiChar(DBEventInfo.pBlob);
- msgW := nil;
- msgLen := lstrlenA(PAnsiChar(DBEventInfo.pBlob)) + 1;
- if msgLen > DBEventInfo.cbBlob then
- msgLen := DBEventInfo.cbBlob;
- if Boolean(DBEventInfo.flags and DBEF_UTF) then
- begin
- SetLength(Msg_Text, msgLen);
- LenW := Utf8ToWideChar(PChar(Msg_Text), msgLen, msgA, msgLen - 1, CP_ACP);
- if Integer(LenW) > 0 then
- SetLength(Msg_Text, LenW - 1)
- else
- Msg_Text := AnsiToWideString(msgA, CP_ACP, msgLen - 1);
- end
- else
- begin
- LenW := 0;
- if DBEventInfo.cbBlob >= msgLen * SizeOf(Char) then
- begin
- msgW := PChar(msgA + msgLen);
- for K := 0 to ((DBEventInfo.cbBlob - msgLen) div SizeOf(Char)) - 1 do
- if msgW[K] = #0 then
- begin
- LenW := K;
- Break;
- end;
- end;
- if (LenW > 0) and (LenW < msgLen) then
- SetString(Msg_Text, msgW, LenW)
- else
- Msg_Text := AnsiToWideString(msgA, CP_ACP, msgLen - 1);
- end;
- // Тип истории
- ContactProto := GetContactProto(ExportContactRecords[I].hContact);
- // Данные собеседника
- ContactID := GetContactID(ExportContactRecords[I].hContact, ContactProto);
- ContactName := GetContactDisplayName(ExportContactRecords[I].hContact, '', True);
- // Мои данные
- MyContactName := GetMyContactDisplayName(ContactProto);
- MyContactID := GetMyContactID(ContactProto);
- // Доп. проверка протокола
- if ContactProto = MyAccount then
- ContactProto := 'ICQ';
- // Тип истории
- ProtoType := StrContactProtoToInt(ContactProto);
- if ContactID = '' then
- ContactID := 'NoContactID';
- if ContactName = '' then
- ContactName := 'NoContactName';
- if MyContactID = '' then
- MyContactID := 'NoMyContactID';
- if MyContactName = '' then
- MyContactName := 'NoMyContactName';
- // Экранирование, перекодирование и т.п.
- Msg_SenderNick := PrepareString(pWideChar(AnsiToWideString(MyContactName, CP_ACP)));
- Msg_SenderAcc := PrepareString(pWideChar(AnsiToWideString(MyContactID, CP_ACP)));
- Msg_SenderNick := WideStringToUTF8(Msg_SenderNick);
- Msg_SenderAcc := WideStringToUTF8(Msg_SenderAcc);
- Msg_RcvrNick := PrepareString(pWideChar(AnsiToWideString(ContactName, CP_ACP)));
- Msg_RcvrAcc := PrepareString(pWideChar(AnsiToWideString(ContactID, CP_ACP)));
- Msg_RcvrNick := WideStringToUTF8(Msg_RcvrNick);
- Msg_RcvrAcc := WideStringToUTF8(Msg_RcvrAcc);
- Msg_Text := WideStringToUTF8(PrepareString(pWideChar(Msg_Text)));
- MD5String := Msg_RcvrAcc + FormatDateTime('YYYY-MM-DD HH:MM:SS', UnixToLocalTime(DBEventInfo.timestamp)) + Msg_Text;
- if (DBType = 'oracle') or (DBType = 'oracle-9i') then
- Date_Str := FormatDateTime('DD.MM.YYYY HH:MM:SS', UnixToLocalTime(DBEventInfo.timestamp))
- else
- Date_Str := FormatDateTime('YYYY-MM-DD HH:MM:SS', UnixToLocalTime(DBEventInfo.timestamp));
- if MatchStrings(LowerCase(ContactProto), 'skype*') then
- begin
- // Определяем направление отправки (мы отправили или нам прислали)
- if (DBEventInfo.flags and DBEF_SENT) = 0 then
- MsgStatus := '0' // Входящее
- else
- MsgStatus := '1'; // Исходящее
- // Лог отладки
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnEventAdded: ' + 'Contact ID: ' + ContactID + ' | Contact Name: ' + ContactName + ' | Proto: ' + ContactProto + ' | My Contact ID: ' + MyContactID + ' | My Contact Name: ' + MyContactName + ' | Contact Proto = ' + ContactProto + ' | MsgStatus = ' + MsgStatus + ' | DateTime = ' + FormatDateTime('DD.MM.YYYY HH:MM:SS', UnixToLocalTime(DBEventInfo.timestamp)) + ' | Message = ' + Msg_Text, 2);
- if (MatchStrings(DBType, 'oracle*')) then // Если Oracle, то пишем SQL-лог в формате CHAT_MSG_LOG_ORACLE
- WriteInLog(ProfilePath, Format(CHAT_MSG_LOG_ORACLE, [DBUserName, MsgStatus, 'to_date('''+Date_Str+''', ''dd.mm.yyyy hh24:mi:ss'')', Msg_RcvrNick, 'Skype', Msg_RcvrNick+' ('+Msg_RcvrAcc+')', BoolToIntStr(True), BoolToIntStr(False), BoolToIntStr(False), Msg_Text, EncryptMD5(MD5String)]), 5)
- else
- WriteInLog(ProfilePath, Format(CHAT_MSG_LOG, [DBUserName, MsgStatus, Date_Str, Msg_RcvrNick, 'Skype', Msg_RcvrNick+' ('+Msg_RcvrAcc+')', BoolToIntStr(True), BoolToIntStr(False), BoolToIntStr(False), Msg_Text, EncryptMD5(MD5String)]), 5);
- end
- else
- begin
- // Определяем направление отправки (мы отправили или нам прислали)
- if (DBEventInfo.flags and DBEF_SENT) = 0 then
- MsgStatus := '1' // Входящее
- else
- MsgStatus := '0'; // Исходящее
- // Лог отладки
- if EnableDebug then WriteInLog(ProfilePath, FormatDateTime('dd.mm.yy hh:mm:ss', Now) + ' - Функция OnEventAdded: ' + 'Contact ID: ' + ContactID + ' | Contact Name: ' + ContactName + ' | Proto: ' + ContactProto + ' | My Contact ID: ' + MyContactID + ' | My Contact Name: ' + MyContactName + ' | Contact Proto = ' + ContactProto + ' | MsgStatus = ' + MsgStatus + ' | DateTime = ' + FormatDateTime('DD.MM.YYYY HH:MM:SS', UnixToLocalTime(DBEventInfo.timestamp)) + ' | Message = ' + Msg_Text, 2);
- if (MatchStrings(DBType, 'oracle*')) then // Если Oracle, то пишем SQL-лог в формате MSG_LOG_ORACLE
- WriteInLog(ProfilePath, Format(MSG_LOG_ORACLE, [DBUserName, IntToStr(ProtoType), Msg_SenderNick, Msg_SenderAcc, Msg_RcvrNick, Msg_RcvrAcc, MsgStatus, 'to_date('''+Date_Str+''', ''dd.mm.yyyy hh24:mi:ss'')', Msg_Text, EncryptMD5(MD5String)]), 5)
- else
- WriteInLog(ProfilePath, Format(MSG_LOG, [DBUserName, IntToStr(ProtoType), Msg_SenderNick, Msg_SenderAcc, Msg_RcvrNick, Msg_RcvrAcc, MsgStatus, Date_Str, Msg_Text, EncryptMD5(MD5String)]), 5);
- end;
- end;
- hDbEvent := CallService(MS_DB_EVENT_FINDNEXT, hDbEvent, 0);
- end;
- end;
- if IMExportThread.Terminated then // Выход из потока в случае закрытия окна
- Exit;
- end;
- Page3.EnabledButtons := [bkCancel,bkNext];
- StartExport := False;
- if ImportLogOpened then
- CloseLogFile(5);
- LExportDesc2.Caption := GetLangStr('ExportDone');
-end;
-
-procedure TExportForm.BringFormToFront(Form: TForm);
-begin
- if Form.WindowState = wsMaximized then
- ShowWindow(Form.Handle, SW_SHOWMAXIMIZED)
- else
- ShowWindow(Form.Handle, SW_SHOWNORMAL);
- Form.BringToFront;
-end;
-
-function TExportForm.CheckStopExportAndExit: Boolean;
-begin
- if StartExport then
- begin
- case MessageBox(Handle, pWideChar(GetLangStr('ExportAbort')), pWideChar(htdPluginShortName + ' - ' +GetLangStr('ExportAbortCaption')),36) of
- 6:
- begin
- if not IMExportThread.Terminated then
- begin
- IMExportThread.Terminate;
- while not (IMExportThread.Terminated) do
- begin
- Sleep(1);
- Forms.Application.ProcessMessages;
- end;
- end;
- Result := True;
- end;
- 7:
- begin
- Result := False;
- Exit;
- end;
- end;
- end
- else
- Result := True;
-end;
-
-procedure TExportForm.ContactListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
-begin
- if Item.Checked <> ExportContactRecords[Item.Index].Selected then // Юзер изменил значение Item.Checked
- begin
- ExportContactRecords[Item.Index].Selected := Item.Checked; // Изменяем значение переменной на новое значение
- { Здесь можно делать что хотим....}
- end;
-end;
-
-procedure TExportForm.ContactListChanging(Sender: TObject; Item: TListItem; Change: TItemChange; var AllowChange: Boolean);
-begin
- ExportContactRecords[Item.Index].Selected := Item.Checked; // Запоминаем значение Item.Checked, до того как юзер на нее нажал
- AllowChange := True; // Разрешаем юзеру нажать :)
-end;
-
-procedure TExportForm.CBSelectAllClick(Sender: TObject);
-var
- I: Integer;
-begin
- for I := 0 to ContactList.Items.Count-1 do
- begin
- ContactList.Items[I].Checked := CBSelectAll.Checked;
- ExportContactRecords[I].Selected := CBSelectAll.Checked;
- end;
- //LExportDesc.Caption := IntToStr(Length(ExportContactRecords)) + ' - ' + IntToStr(ContactList.Items.Count);
-end;
-
-// Для мультиязыковой поддержки
-procedure TExportForm.OnLanguageChanged(var Msg: TMessage);
-begin
- LoadLanguageStrings;
-end;
-
-// Для мультиязыковой поддержки
-procedure TExportForm.LoadLanguageStrings;
-var
- ExportBitmap: TBitmap;
-begin
- Caption := htdPluginShortName + ' - ' + GetLangStr('ExortFormCaption');
- IMExportWizard.ButtonBack.Caption := '< ' + GetLangStr('ButtonBack');
- IMExportWizard.ButtonNext.Caption := GetLangStr('ButtonNext') + ' >';
- IMExportWizard.ButtonFinish.Caption := GetLangStr('ButtonFinish');
- IMExportWizard.ButtonCancel.Caption := GetLangStr('ButtonCancel');
- IMExportWizard.Pages.Items[0].Title.Text := GetLangStr('IMExportWizardPage0Title');
- IMExportWizard.Pages.Items[0].Subtitle.Text := Format(GetLangStr('IMExportWizardPage0SubTitle'), [htdIMClientName]);
- IMExportWizard.Pages.Items[1].Title.Text := GetLangStr('IMExportWizardPage1Title');
- IMExportWizard.Pages.Items[1].Subtitle.Text := GetLangStr('IMExportWizardPage1SubTitle');
- IMExportWizard.Pages.Items[2].Title.Text := GetLangStr('IMExportWizardPage2Title');
- IMExportWizard.Pages.Items[2].Subtitle.Text := GetLangStr('IMExportWizardPage2SubTitle');
- IMExportWizard.Pages.Items[3].Title.Text := GetLangStr('IMExportWizardPage3Title');
- IMExportWizard.Pages.Items[3].Subtitle.Text := GetLangStr('IMExportWizardPage3SubTitle');
- CBSelectAll.Caption := GetLangStr('SelectAll');
- ContactList.Columns[0].Caption := GetLangStr('NickName');
- ContactList.Columns[1].Caption := GetLangStr('Protocol');
- ContactList.Columns[2].Caption := GetLangStr('Number');
- LExportDone.Caption := GetLangStr('ExportDoneDesc');
- CBSyncRequest.Caption := GetLangStr('SendSyncRequest');
- // Грузим битовый образы из файла ресурсов
- if IMExportWizard.ActivePage = Page1 then
- begin
- ExportBitmap := TBitmap.Create;
- try
- if DefaultLanguage = 'Russian' then
- ExportBitmap.LoadFromResourceName(HInstance, 'Export_Ru')
- else
- ExportBitmap.LoadFromResourceName(HInstance, 'Export_En');
- Page1.WaterMark.Image.Picture.Assign(ExportBitmap);
- finally
- ExportBitmap.Free;
- end;
- end;
-end;
-
-end.
|