В данном посте реализуем функцию показа контента, находящегося в редакторе TRichViewEditor в браузере.Возьмем наше VCL приложение, добавим кнопку OpenInBrowser.
И вот что мы видим в браузере
Как это сделать?
Если по простому, то нам нужно
-Сохранить контент в БД
-Запустить сервер UniGUI, если он ещё не запущен
-Открыть браузер и перейти по адресу сервера UniGUI (например localhost:8077)
Посмотрим как это будет выглядеть в коде
База данных
Для простоты сделаем следующее. Создадим в тестовой БД одну единственную таблицу
В этой таблице будет одна единственная запись. При добавлении новой – предыдущая запись будет удаляться. Это для простоты примера.
Код на стороне VCL приложения
Обработчик кнопки OpenInBrowserClick
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
procedure TMainForm.bOpenInBrowserClick(Sender: TObject); begin // Если процесс сервера не запущен if FindTask('UniGUI_mp3.exe')=0 then begin //Сохраняем в БД SaveRecordInDB; // Запускаем UniGUI сервер StartUniServer; OpenServerPageInBrowser; end else //Если сервер уже запущен begin //Сохраняем в БД SaveRecordInDB; //Запускаем браузер и показываем в нём результат OpenServerPageInBrowser; end; end; |
Вот методы, которые были использованы в обработчике
SaveRecordInDB
Здесь мы пользуемся удобной функцией сохранения в поток HTML контента компонента TRichView. Далее из потока забираем в переменную SL:TStringList через вспомогательный поток MS:TMemeoryStream и из SLуже присваиваем в качестве значения параметра запроса. После чего выполняем запрос.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
procedure TMainForm.SaveRecordInDB; var DBConnection: TDBConnection; FDQuery: TFDQuery; SL: TStringList; MS: TMemoryStream; begin //Создание DBConnection := TDBConnection.Create(Self); FDQuery := TFdQuery.Create(Self); FDQuery.Connection := DBConnection.FDConnection; //Чистим таблицу try FDQuery.SQL.Text := 'DELETE FROM `test_db`.`htmltable` WHERE `id`>=''1'';'; FDQuery.ExecSQL; except on E:Exception do raise Exception.Create(E.ClassName+' поднята ошибка, с сообщением : ' +#13#10+#13#10+E.Message); end; //Ставим запрос на запись FDQuery.SQL.Text := 'INSERT INTO `test_db`.`htmltable` (`htmlText`) VALUES (:p1);'; //Сохраняем в базу через потоки (streams) SL := TStringList.Create; MS := TMemoryStream.Create; try try MS.Seek(0, soFromBeginning); RichViewEdit1.SaveHTMLToStreamEx(MS, '', '', '', '', '', '', []); MS.Seek(0, soFromBeginning); SL.LoadFromStream(MS); FDQuery.Params.ParamValues['p1'] := SL.Text; FDQuery.ExecSQL; except on E:Exception do raise Exception.Create(E.ClassName+' поднята ошибка, с сообщением : ' +#13#10+#13#10+E.Message); end; finally FreeAndNil(SL); FreeAndNil(MS); FreeAndNil(FDQuery); end; end; |
Проверка – запущен ли процесс (для того, чтобы запустить UniGUI сервер)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
//---------Проверка запущен ли процесс function FindTask(ExeFileName: string): integer; // uses TlHelp32 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 := 1; ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; |
StartUniServer – запуск сервера UniGUI
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
//------------------------Start UniServer------------------------------------------- procedure TMainForm.StartUniServer; var UniServerPath: string; MyApplication: string; MyParams: string; MyCmdLine: string; StartupInfo : TStartupInfo; ProcessInfo : TProcessInformation; ExitCode: Cardinal; //код завершения begin // Запускаем UniGUI сервер ZeroMemory(@StartupInfo,SizeOf(StartupInfo)); StartupInfo.cb := SizeOf(StartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW; StartupInfo.wShowWindow :=SW_SHOWNORMAL;//SW_SHOWDEFAULT; // SW_MINIMIZE; UniServerPath:=ExtractFileDir(Application.ExeName)+'\UniGUI_mp3.exe'; //'C:\DELPHI\MyStudyProjects\300_UniGUI_audio\Win32\Debug\UniGUI_mp3.exe'; MyApplication :=UniServerPath; MyParams := ''; MyCmdLine := Format('"%s" %s', [MyApplication, MyParams]); SetLastError(ERROR_INVALID_PARAMETER); // Для обхода бага по совету gunsmoker //http://www.gunsmoker.ru/2014/03/createprocessfailwithsuccess.html if Win32Check(CreateProcess(Pointer(MyApplication), PChar(MyCmdLine), nil, nil, false, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo))=true then try with ProcessInfo do begin //Ждем завершения инициализации. WaitForInputIdle(hProcess, INFINITE); //Ждем завершения процесса. WaitforSingleObject(ProcessInfo.hProcess, INFINITE); //Получаем код завершения. GetExitCodeProcess(ProcessInfo.hProcess, ExitCode); //Закрываем дескриптор процесса. CloseHandle(hThread); //Закрываем дескриптор потока. CloseHandle(hProcess); end except on E:Exception do showmessage(E.ClassName+' поднята ошибка, с сообщением : '+E.Message); end; end; |
Открытие страницы веббраузера по умолчанию
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
procedure TMainForm.OpenServerPageInBrowser; var ErrorCode: Integer; begin //Code taken from http://www.gunsmoker.ru/2015/01/avoid-using-ShellExecuteEx.html //Запускаем браузер и показываем в нём результат ErrorCode:=Integer(ShellApi.ShellExecute(0, 'Open', 'http://localhost:8077/', nil, nil, SW_SHOWNORMAL)); if ErrorCode <= HINSTANCE_ERROR { = 32 } then begin case ErrorCode of 0: Application.MessageBox(PChar('The operating system is out of memory or resources.'), 'Error', MB_OK or MB_ICONERROR); ERROR_FILE_NOT_FOUND: Application.MessageBox(PChar('The specified file was not found.'), 'Error', MB_OK or MB_ICONERROR); ERROR_PATH_NOT_FOUND: Application.MessageBox(PChar('The specified path was not found.'), 'Error', MB_OK or MB_ICONERROR); ERROR_BAD_FORMAT: Application.MessageBox(PChar('The .exe file is invalid (non-Win32 .exe or error in .exe image).'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_ACCESSDENIED: Application.MessageBox(PChar('The operating system denied access to the specified file.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_ASSOCINCOMPLETE: Application.MessageBox(PChar('The file name association is incomplete or invalid.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_DDEBUSY: Application.MessageBox(PChar('The DDE transaction could not be completed because other DDE transactions were being processed.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_DDEFAIL: Application.MessageBox(PChar('The DDE transaction failed.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_DDETIMEOUT: Application.MessageBox(PChar('The DDE transaction could not be completed because the request timed out.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_DLLNOTFOUND: Application.MessageBox(PChar('The specified DLL was not found.'), 'Error', MB_OK or MB_ICONERROR); //Dublicated// SE_ERR_FNF: Application.MessageBox(PChar('The specified file was not found.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_NOASSOC: Application.MessageBox(PChar('There is no application associated with the given file name extension. This error will also be returned if you attempt to print a file that is not printable.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_OOM: Application.MessageBox(PChar('There was not enough memory to complete the operation.'), 'Error', MB_OK or MB_ICONERROR); //Dublicated// SE_ERR_PNF: Application.MessageBox(PChar('The specified path was not found.'), 'Error', MB_OK or MB_ICONERROR); SE_ERR_SHARE: Application.MessageBox(PChar('A sharing violation occurred.'), 'Error', MB_OK or MB_ICONERROR); else Application.MessageBox(PChar(Format('Unknown Error %d', [ErrorCode])), 'Error', MB_OK or MB_ICONERROR); end; Exit; end; end; |
Код на стороне UniGUI сервера
Обработка кнопки. По нажатию – читаем единственную запись из базы.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
procedure TMainForm.bOpenHTMLClick(Sender: TObject); var DBConnectionLocal:TDBConnection; FDQuery:TFDQuery; SL:TStringList; begin //Создание DBConnectionLocal:=TDBConnection.Create(Self); FDQuery:=TFDQuery.Create(Self); SL:=TStringList.Create; try //Основная работа try FDQuery.Connection:=DBConnectionLocal.FDConnection; FDQuery.SQL.Text:='SELECT * FROM test_db.htmltable;'; FDQuery.Open(); SL.Text:=FDQuery.FieldByName('htmlText').AsString; // UniHTMLFrame.HTML.Text:=SL.Text; UniHTMLMemo1.Lines.Text:=SL.Text; except on E:Exception do raise Exception.Create(E.ClassName+' поднята ошибка, с сообщением : '+E.Message); end; finally //Уничтожение FreeAndNil(DBConnectionLocal); FreeAndNil(FDQuery); FreeAndNil(SL); end; end; |
UniFormCreate
|
1 2 3 4 5 6 7 8 |
procedure TMainForm.UniFormCreate(Sender: TObject); var FilePath:string; begin bOpenHTMLClick(Self); end; |
И вот он, наш результат!