Перейти к содержанию
Fire Monkey от А до Я

Евгений Корепов

Пользователи
  • Постов

    738
  • Зарегистрирован

  • Посещение

  • Победитель дней

    100

Весь контент Евгений Корепов

  1. Добавлю - если у вас цель экономия трафика через мобильные сети, то вы можете использовать https://docwiki.embarcadero.com/Libraries/Sydney/en/System.ZLib.TZCompressionStream для сжатия данных перед передачей.
  2. Вы ошибаетесь. TZipFile отлично работает с TStream и остальными TMemoryStream, TFileStream и т.д. Вот пример: uses System.Zip; .... procedure TForm1.Test(); var FZip : TZipFile; AArchiveStream : TStream; AFileStreamSource : TStream; ADecompressionStream, AFileStreamDest : TStream; ALocalHeader : TZipHeader; AArchivePath, AFileSourcePath, AFileName : String; begin AArchivePath := 'D:\0\005\test.zip'; AFileSourcePath := 'D:\0\005\test.txt'; AFileName := TPath.GetFileName(AFileSourcePath); // Добавляем в архив AFileStreamSource := TFileStream.Create('D:\0\005\test.txt', fmOpenRead); AArchiveStream := TFileStream.Create(AArchivePath, fmCreate); FZip := TZipFile.Create; FZip.Open(AArchiveStream, TZipMode.zmWrite); FZip.Add(AFileStreamSource, AFileName, TZipCompression.zcDeflate); FZip.Close; FZip.Free; AArchiveStream.Free; // распаковываем из архива FZip := TZipFile.Create; AArchiveStream := TFileStream.Create(AArchivePath, fmOpenRead or fmShareDenyNone); FZip.Open(AArchiveStream, TZipMode.zmRead); FZip.Read(AFileName, ADecompressionStream, ALocalHeader); AFileStreamDest := TFileStream.Create('D:\0\005\test_dest.txt', fmCreate); AFileStreamDest.CopyFrom(ADecompressionStream, ADecompressionStream.Size); AFileStreamDest.Free; ADecompressionStream.Free; FZip.Close; FZip.Free; AArchiveStream.Free; end; В примере берем файл D:\0\005\test.txt и архивируем его в архив 'D:\0\005\test.zip. Потом достаем из этого архива файл test.txt и сохраняем как D:\0\005\test_dest.txt. Все через потоки. Код написан на коленке, при использовании в реальной задаче вам нужно добавить критические секции и обработчики try finally. Кстати вы можете использовать и сжатие BZIP2. В данном примере замените TZipCompression.zcDeflate на TZipCompression.zcBZIP2, ну и самое интересное для разработчика - напишите свою реализацию алгоритма архивирования и зарегистрируйте ее с помощью FZip.RegisterCompressionHandler(TZipCompression.zcBZIP2, .....); Да, это будет не просто, но опыта наберетесь с лихвой.
  3. Разобрался с помощью коллег из https://t.me/fmx_flood, спасибо kami! Определение: nvmlDeviceGetHandleByPciBusId_v2 : function (const pciBusId : PAnsiChar; pHandle: p_nvmlDevice_t) : nvmlReturn_t; stdcall; Импорт: function ProcNV(var Fun: Pointer; const FunName: WideString) : boolean; begin Fun := nil; Fun := GetProcAddress(LibHandleNV, PWideChar(FunName)); Result := Assigned(Fun); end; ... ProcNV(@nvmlDeviceGetHandleByPciBusId_v2, 'nvmlDeviceGetHandleByPciBusId_v2'); Использование: В функцию GPUusageNVIDIA надо вместо GPU ID передавать PCI BUS ID. PCI BUS ID получаем так clStatus := clGetDeviceInfo(PlatformDevices[DevN], CL_DEVICE_PCI_BUS_ID_NV, SizeOf(AValueCardinal), @AValueCardinal, @Returned_Size); if (clStatus = CL_SUCCESS) and (Returned_Size = 4) then ADevicesOpenCL[NumDevicesOpenCL].DevicePCIBusID := AValueCardinal; Ну и получение GPU_Handle : var ABusIDText : String; ... ABusIDText := '00000000:' + PCIBusID.ToString.PadLeft(2, '0') + ':00.0'; AnvmlReturn := nvmlDeviceGetHandleByPciBusId_v2(PAnsiChar(AnsiString(ABusIDText)), @GPU_Handle); If AnvmlReturn <> 0 then raise EAbort.Create(''); В nvmlDeviceGetHandleByPciBusId_v2 передается pciBusId, параметр должен быть вида domain:bus:device.function, к примеру '00000000:08:00.0'
  4. Владимир огромное спасибо! Ваш код очень помог мне в одном проекте. А есть ли путь для решения проблемы не совпадения нумерации GPU? У меня на разных стендах абсолютно разные результаты, каждый раз создавать SlotGPU.txt с соответствиями очень не хочется. Бывает что нумерации совсем безумные, типа 4 5 2 3 1 0 И определить их можно только нагружая один из GPU и наблюдая результат выдаваемый nvmlDeviceGetMemoryInfo Я пытаюсь определить соответствие получая CL_DEVICE_PCI_BUS_ID_NV и CL_DEVICE_PCI_SLOT_ID_NV PlatformID 0 | DeviceID 0 | DeviceNum 0 | PCI Bus 5 Slot 0 | NVIDIA GeForce RTX 3070 | GPU_usage 11 % | Temperature 51 | FanSpeed 40 % | Power 41 PlatformID 0 | DeviceID 1 | DeviceNum 1 | PCI Bus 7 Slot 0 | NVIDIA GeForce RTX 3070 | GPU_usage 100 % | Temperature 76 | FanSpeed 82 % | Power 239 PlatformID 0 | DeviceID 2 | DeviceNum 2 | PCI Bus 3 Slot 0 | NVIDIA GeForce RTX 2070 SUPER | GPU_usage 100 % | Temperature 62 | FanSpeed 71 % | Power 148 PlatformID 0 | DeviceID 3 | DeviceNum 3 | PCI Bus 2 Slot 0 | NVIDIA GeForce GTX 960 | GPU_usage 100 % | Temperature 63 | FanSpeed 72 % | Power 148 Но у меня не хватает мозгов правильно импортировать функцию nvmlDeviceGetHandleByPciBusId_v2 ( const char* pciBusId, nvmlDevice_t* device )(https://docs.nvidia.com/deploy/nvml-api/group__nvmlDeviceQueries.html#group__nvmlDeviceQueries) То ли я параметры не правильно перевожу в pascal, то ли еще что - при вызове получаю только NVML_ERROR_INVALID_ARGUMENT Буду безмерно благодарен за помощь! )
  5. Светить портом базы данных в интернет - худшая идея.
  6. Этот текст гугль находит по многим ресурсам с апреля 2020, думаю они или нашли уже себе разработчика, или забили на проект )
  7. Не совсем понял ваш вопрос, что именно вам требуется получить? Скажите, тогда смогу посоветовать как или в какой реализации браузера это доступно.
  8. FireDAC, он из коробки, бесплатно и покрывает 99% всех нужд. И отлично работает.
  9. Если проект был сохранен в редакции не имеющей лицензии Linux, то вы никак не сможете добавить платформу Linux. Сам работаю дома на профе и у заказчика на энтерпрайзе и бесит эта хрень. Выход - удалите в проекте .dproj файл и откройте его в энтерпрайзе, добавьте платформу, сохраните и скопируйте файл .dproj в отдельную папку. Если проект был изменен и сохранен в профе, заменяйте .dproj на сохраненный.
  10. Ширина задана в исходных кодах константой.
  11. Да, используйте поиск по этому форуму по Admob. Вот к примеру один из результатов поиска
  12. Не используйте первую попавшуюся, используйте нормальные дистрибутивы. Но если даже у вас настолько странная ОС, то всегда можете анализировать dmesg
  13. Выполняете любимую консольную команду выводящую сведения о железе (к примеру lspci -v) и парсите вывод.
  14. https://unix.stackexchange.com/questions/58846/viewing-linux-library-executable-version-info
  15. В Линуксе просто нет никаких стандартов для размещения версии внутри бинарника. Ембаркадера об этом не в курсе, но по привычке воткнула пустую заглушку ))) Забейте, и просто делайте свою константу с версией.
  16. Тут все просто - нужно ждать. Ваш код работает корректно только в идеальных условиях. Но если вторая сторона не ответила мгновенно, то вы уже ничего не получите. Перед отправкой/получением вам надо проверить наличие соединения функцией FTCPClient.IOHandler.CheckForDisconnect() - при отсутствии соединения она сгенерит исключение: try FTCPClient.IOHandler.CheckForDisconnect(); except on E: EIdException do begin LogError('TUTM5StreamProtocol.Run CheckForDisconnect ERROR ' + E.Message); Reconnect(); end; end; Читать с ожиданием данных можно несколькими способами: 1. Задавать FTCPClient.IOHandler.ReadTimeout в надежде что в отведенное время что то придет. 2. Использовать FTCPClient.IOHandler.ReadLnWait() для чтения строки. 3. Или обрабатывать проверять наличие данных и читать по мере их поступления: if FTCPClient.IOHandler.CheckForDataOnSource(FConnectParams.Timeouts.TCPReadTimeout) then читаем....
  17. Запоминайте в php последний номер добавленной записи (id), добавьте в api метод вроде GetLastRecordsIDs, который будет возвращать все ID нужных таблиц. Клиент пусть долбится в этот метод раз в N секунд и сверяет свои последние ID с ID сервера, при не совпадении - запрос новых данных. В php хранить последние идешники можно как угодно - файл, сессия, ну или memcache чтоб уж совсем быстро было. Я бы хранил в сессии, и сессию сделал в memcached.
  18. Use jsPDF https://github.com/MrRio/jsPDF Example https://www.codexworld.com/convert-html-to-pdf-using-javascript-jspdf/
  19. Как верно подметил Дмитрий - знание SQL наше все. Вот к примеру я создал тестовую таблицу и наполнил ее тестовыми данными: CREATE TABLE `test001` ( `id` int(11) NOT NULL AUTO_INCREMENT, `TimeFrom` datetime DEFAULT NULL, `InA` int(11) DEFAULT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB AUTO_INCREMENT=21 DEFAULT CHARSET=utf8; INSERT INTO `test001` VALUES ('1', '2020-05-17 16:14:36', '1'); INSERT INTO `test001` VALUES ('2', '2020-05-17 16:12:56', '2'); INSERT INTO `test001` VALUES ('3', '2020-05-17 16:12:56', '3'); INSERT INTO `test001` VALUES ('4', '2020-05-17 17:12:56', '4'); INSERT INTO `test001` VALUES ('5', '2020-05-17 17:12:56', '5'); INSERT INTO `test001` VALUES ('6', '2020-05-17 17:12:56', '6'); INSERT INTO `test001` VALUES ('7', '2020-05-17 18:12:56', '7'); INSERT INTO `test001` VALUES ('8', '2020-05-17 18:12:56', '8'); INSERT INTO `test001` VALUES ('9', '2020-05-17 18:12:56', '9'); INSERT INTO `test001` VALUES ('10', '2020-05-17 19:12:56', '10'); INSERT INTO `test001` VALUES ('11', '2020-05-17 19:12:56', '11'); INSERT INTO `test001` VALUES ('12', '2020-05-17 19:12:56', '12'); INSERT INTO `test001` VALUES ('13', '2020-05-17 20:12:56', '13'); INSERT INTO `test001` VALUES ('14', '2020-05-17 20:12:56', '14'); INSERT INTO `test001` VALUES ('15', '2020-05-17 20:12:56', '15'); INSERT INTO `test001` VALUES ('16', '2020-05-17 21:12:56', '16'); INSERT INTO `test001` VALUES ('17', '2020-05-17 21:12:56', '17'); INSERT INTO `test001` VALUES ('18', '2020-05-17 21:12:56', '18'); Для получения почасовых сумм по полю InA мне достаточно очень простого запроса: SELECT FROM_UNIXTIME(FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600), SUM(test001.InA) as SumInA FROM test001 GROUP BY FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600 Результат запроса будет выглядеть вот так: 2020-05-17 16:00:00 6 2020-05-17 17:00:00 15 2020-05-17 18:00:00 24 2020-05-17 19:00:00 33 2020-05-17 20:00:00 42 2020-05-17 21:00:00 51 Скорость выдачи результата будет большой - при миллионах записей в исходной таблице дело нескольких секунд или десятков секунд (зависит от железа сервера). Но это все равно медленно, потому что на каждую запись таблицы будет производится вычисление "FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600" - деление, округление и умножение. Если это разовая выборка - проблем нет. Но если вам нужно регулярно дергать из таблицы данные, то лучше добавить в таблицу поле TimeFromHour, в которое сразу записывать значение FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600. Это можно сделать руками или триггером при вставке. Добавить Индекс по полю TimeFromHour и в запросе тоже группировать (GROUP BY) по этому полю: ALTER TABLE `test001` ADD INDEX `Index-TimeFromHour` (`TimeFromHour`) USING BTREE ; Тогда вы получите максимально возможное быстродействие. Если нужно результат вставить в другую таблицу, то используйте запрос вроде такого: INSERT INTO test_sum (TimeFrom, SumInA) ( SELECT FROM_UNIXTIME(FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600), SUM(test001.InA) as SumInA FROM test001 GROUP BY FLOOR(UNIX_TIMESTAMP(test001.TimeFrom) / 3600) * 3600 )
  20. По умолчанию в TThread классовая функция GetTickCount имеет тип Cardinal, соответственно если приложение рассчитано на долговременную работу, то через 40 дней результат этой функции или уложит приложение (если отключена защита от переполнения) или превратит приложение в тыкву (если на этом завязана какая то логика). Для своего проекта написал хелпер для класса TThread, вдруг кому пригодится. Тестил на win10 x64 и linux x64. unit UnitTThreadHelper; interface uses {$IFDEF MSWINDOWS} Winapi.Windows, {$ENDIF MSWINDOWS} {$IFDEF POSIX} Posix.SysTypes, {$IFDEF MACOS} Macapi.CoreServices, {$ENDIF MACOS} {$IFDEF ANDROID} Posix.Fcntl, {$ENDIF ANDROID} {$IFDEF LINUX} Posix.Time, {$ENDIF LINUX} {$ENDIF POSIX} System.Classes; type TThreadHelper = class helper for TThread class function GetTickCount64 : Int64; static; end; implementation class function TThreadHelper.GetTickCount64 : Int64; {$IF Defined(MSWINDOWS)} begin Result := Winapi.Windows.GetTickCount64; end; {$ELSEIF Defined(MACOS)} begin Result := AbsoluteToNanoseconds(mach_absolute_time) div 1000000; end; {$ELSEIF Defined(POSIX)} var res: timespec; begin clock_gettime(CLOCK_MONOTONIC, @res); Result := (Int64(1000000000) * res.tv_sec + res.tv_nsec) div 1000000; end; {$ELSE OTHERPLATFORM} {$MESSAGE Fatal 'Method not implemented for Platform'} {$ENDIF OTHERPLATFORM} end. При попытке запуска на win x32 упадет - не используйте или проверяйте битность: if CheckWin32Version(6, 0) then begin GetTickCount64; end else begin GetTickCount; end;
  21. Класс для работы с FastCGI серверами, такими как php-fpm. Для тех кто не в теме : веб-сервер, к примеру nginx, получает запросы и отправляет их на исполнение FastCGI серверу, к примеру php-fpm, php-fpm получает имя скрипта, параметры, выполняет все и возвращает результат в nginx, который в свою очередь возвращает этот результат запросившему клиенту. С помощью класса вы можете так же, выполнять php скрипты на локальном или удаленном сервере. Исходники https://github.com/EvgeniyKorepov/FastCGIClient Пример delphi var FFastCGI : TFastCGI; ... procedure TFormMain.FormCreate(Sender: TObject); var AHost : String; APort : Word; AScriptFileName, ARequest, AContent : String; begin AHost := '10.0.0.4'; APort := 9000; FFastCGI := TFastCGI.Create(AHost, APort); FFastCGI.KeepAlive := True; AScriptFileName := '/opt/xxx.php'; ARequest := 'request=1234567890'; if FFastCGI.Get(AScriptFileName, ARequest, AContent) then Memo.Text := AContent else Memo.Text := FFastCGI.StatusCode.ToString + ' ' + FFastCGI.StatusText; end; пример php <?php header('Content-Type: text/html; charset=utf-8'); if (isset($_REQUEST["request"])) if ($_REQUEST["request"] == "1234567890") { header("Status: 200"); echo 'OK'; } else { http_response_code(400); echo "ERROR"; }
  22. В прошлой теме я показал как делать демонов старой школы - серьезных и самодостаточных. Но это все в прошлом. Теперь существуют системы управления процессами, где все намного, намного проще. Исходники тут https://github.com/EvgeniyKorepov/LinuxDaemonNewStyle Заметьте, теперь никаких потоков, все элементарно, systemd сделает всю работу за нас. Половина кода - разбор параметров командной строки. Вторая половина - бесконечный цикл, ожидающий сигналов от экземпляра класса демона нового стиля . Код самого класса сократился на треть. Если запустите приложения в консоли - будет самое обычное приложение, которые умрет при закрытии консоли. Запуск в качестве бессмертного демона - через systemd, причем он сможет автоматически перезапускать вашего демона при крахе. Эти параметры задаются в текстовом файле /etc/systemd/system/DaemonNewStyleTest.service program DaemonNewStyleTest; {$APPTYPE CONSOLE} uses System.SysUtils, System.IOUtils, System.SyncObjs, Posix.Stdlib, Posix.SysStat, Posix.SysTypes, Posix.Unistd, Posix.Signal, Posix.Fcntl, Posix.Syslog in 'Posix.Syslog.pas', UnitDaemonNewStyle in 'UnitDaemonNewStyle.pas'; var AEvent : TEventType; begin if ParamCount = 0 then begin syslog(LOG_ERR, 'No parameters'); ExitCode := EXIT_FAILURE; exit; end; if ParamStr(1).ToLower.Equals('stop') then begin if Daemon.Stop(30) then ExitCode := EXIT_SUCCESS else ExitCode := EXIT_FAILURE; exit; end; if ParamStr(1).ToLower.Equals('reload') then begin if Daemon.Reload() then ExitCode := EXIT_SUCCESS else ExitCode := EXIT_FAILURE; exit; end; if not ParamStr(1).ToLower.Equals('start') then begin syslog(LOG_ERR, 'Unknow parameters'); ExitCode := EXIT_FAILURE; exit; end; syslog(LOG_NOTICE, 'main START'); while Daemon.IsRunning do begin syslog(LOG_NOTICE, 'main LOOP'); Daemon.Execute(AEvent); if AEvent <> TEventType.None then syslog(LOG_NOTICE, 'main Daemon receive signal'); case AEvent of TEventType.Start : begin syslog(LOG_NOTICE, 'main Event START'); end; TEventType.Reload : begin // Reload config syslog(LOG_NOTICE, 'main Event RELOAD'); end; TEventType.Stop : begin syslog(LOG_NOTICE, 'main Event STOP'); ExitCode := EXIT_SUCCESS; Sleep(10); // simulate destroy delay break; end; end; Sleep(1000); end; end. systemctl start DaemonNewStyleTest.service systemctl reload DaemonNewStyleTest.service systemctl stop DaemonNewStyleTest.service
  23. У меня в досягаемости только CentOS 7, ну еще Дебиан есть на паре старых серваков. Под ними все работает превосходно. Тут надо под отладкой запускать и смотреть что происходит. Ну и логи системы смотреть
  24. Сначала пишем серверную часть - загрузка сохранения файла на любимом языке. Потом тестируем серверную часть - бросаем на сервер страничку с формой загрузки. Убеждаемся что все работает в браузере. И только после этого пишем клиента...
  25. Вам проще адаптировать сайт https://gector-spb.ru/ для мобильных браузеров. Наймите верстальшика за доширак - обойдется дешевле и по времени гораздо быстрее.
×
×
  • Создать...