Category Archives: Delphi

Delphi. FireMonkey. Get IMEI

Posted on 24.06.2018 by Stanislav_Panteleev

Получение IMEI, пример работает на Delphi Berlin

function TSplashForm.GetIMEI: string;
var
  obj: JObject;
  tm: JTelephonyManager;
  identifier: String;
begin
  obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);
  if obj <> nil then
    begin
      tm := TJTelephonyManager.Wrap( (obj as ILocalObject).GetObjectID );
        if obj<>nil then
          identifier := JStringToString(tm.getDeviceId);
    end;
  if identifier = '' then
    identifier := JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver,TJSettings_Secure.JavaClass.ANDROID_ID));
  Result:=identifier;
end;

function TSplashForm.GetIMEI: string;

var

obj: JObject;

tm: JTelephonyManager;

identifier: String;

begin

obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);

if obj <> nil then

begin

tm := TJTelephonyManager.Wrap( (obj as ILocalObject).GetObjectID );

if obj<>nil then

identifier := JStringToString(tm.getDeviceId);

end;

if identifier = '' then

identifier := JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver,TJSettings_Secure.JavaClass.ANDROID_ID));

Result:=identifier;

end;

Posted in Delphi, FireMonkey | Comments Off

Delphi. FireMonkey. Настраиваем SDK, NDK, Java

Posted on 22.06.2018 by Stanislav_Panteleev

Пишу небольшое приложение на FireMonkey для Android, пару часов настраивал вкладку SDK Manager, скачивал SDK, NDK, JRE, выставлял пути сам пару часов, бился об ошибки, но Delphi оказался умнее, надо было просто нажать кнопку на Add и далее Delphi ищет … Continue reading →

Posted in Delphi, FireMonkey | Comments Off

Delphi. WInAPI. Пример отправки сообщения из одного потока в другой

Posted on 08.06.2018 by Stanislav_Panteleev

Основной поток

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.Buttons, uApiTestThread;

const
  WM_DATA_UPDATE = WM_APP + 1000;

type
  TMain = class(TForm)
    pTop: TPanel;
    bTest: TBitBtn;
    mAllTests: TMemo;
    mErrors: TMemo;
    procedure bTestClick(Sender: TObject);
  private
    procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE;
  end;

var
  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.bTestClick(Sender: TObject);
var
  t: TApiTestThread;
begin
  t := TApiTestThread.Create(true);
  t.MainHandle := Self.Handle;
  t.FreeOnTerminate := true;
  t.Start;
end;

procedure TMain.HandleProc(var aMsg: TMessage);
var
  txt: PWideChar;
begin
  txt := PWideChar(aMsg.lParam);
  mAllTests.Lines.Add(aMsg.WParam.ToString());
  mErrors.Lines.Add(txt);
end;

end.

unit uMain;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,

Vcl.Buttons, uApiTestThread;

const

WM_DATA_UPDATE = WM_APP + 1000;

type

TMain = class(TForm)

pTop: TPanel;

bTest: TBitBtn;

mAllTests: TMemo;

mErrors: TMemo;

procedure bTestClick(Sender: TObject);

private

procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE;

end;

var

Main: TMain;

implementation

{$R *.dfm}

procedure TMain.bTestClick(Sender: TObject);

var

t: TApiTestThread;

begin

t := TApiTestThread.Create(true);

t.MainHandle := Self.Handle;

t.FreeOnTerminate := true;

t.Start;

end;

procedure TMain.HandleProc(var aMsg: TMessage);

var

txt: PWideChar;

begin

txt := PWideChar(aMsg.lParam);

mAllTests.Lines.Add(aMsg.WParam.ToString());

mErrors.Lines.Add(txt);

end;

end.

Дополнительный поток

unit uApiTestThread;

interface

uses
  System.Classes, Winapi.Messages, Winapi.Windows;

const
  WM_DATA_UPDATE = WM_APP + 1000;

type
  TApiTestThread = class(TThread)
  private
    FMainHandle: Hwnd;
    procedure Test;
    procedure SetMainHandle(const Value: Hwnd);
  public
    property MainHandle: Hwnd read FMainHandle write SetMainHandle;
  protected
    procedure Execute; override;
  end;

implementation

{ TApiTestThread }

procedure TApiTestThread.SetMainHandle(const Value: Hwnd);
begin
  FMainHandle := Value;
end;

procedure TApiTestThread.Test();
var
  h: hwnd;
  s: string;
begin
  h := FMainHandle;
  s := 'Привет';
  Sendmessage(h, WM_DATA_UPDATE, 20, DWORD(PChar(s)));
end;

procedure TApiTestThread.Execute;
begin
  Test();
end;

end.

unit uApiTestThread;

interface

uses

System.Classes, Winapi.Messages, Winapi.Windows;

const

WM_DATA_UPDATE = WM_APP + 1000;

type

TApiTestThread = class(TThread)

private

FMainHandle: Hwnd;

procedure Test;

procedure SetMainHandle(const Value: Hwnd);

public

property MainHandle: Hwnd read FMainHandle write SetMainHandle;

protected

procedure Execute; override;

end;

implementation

{ TApiTestThread }

procedure TApiTestThread.SetMainHandle(const Value: Hwnd);

begin

FMainHandle := Value;

end;

procedure TApiTestThread.Test();

var

h: hwnd;

s: string;

begin

h := FMainHandle;

s := 'Привет';

Sendmessage(h, WM_DATA_UPDATE, 20, DWORD(PChar(s)));

end;

procedure TApiTestThread.Execute;

begin

Test();

end;

end.

Posted in Delphi | Comments Off

Delphi. Импорт данных в базу из Excel. Пример из проекта

Posted on 31.05.2018 by Stanislav_Panteleev

Пример из проекта – импорт данных в базу из Excel

procedure TRPAvitoImport.Execute;

  procedure parseParams(aParams: string; var aCategory: string; var aSubCategory: string);
  var
    sa, sa1, sa2: TArray<string>;
  begin
    sa := aParams.Split(['=']);
    if length(sa) > 1 then
      aCategory := stringReplace(sa[1], ', Тип услуги', '', [rfReplaceAll]);
    if length(sa) > 2 then
      aSubCategory := sa[2];
  end;

var
  e, sheet: OLEVariant;
  r: integer;
  c: integer;
  j: integer;
  i: Integer;
  rawPhone: string;
  contactName: string;
  regionName: string;
  cityName: string;
  adress: string;
  description: string;
  params: string;
  keywords: string;
  subCategoryName: string;
  categoryName: string;
  phone: string;
  idRegion: Integer;
  idCity: Integer;
  idCategory: integer;
  idUser: integer;
  currKeyWords: string;
  filePath: string;
  idSubCategory: Integer;
begin
  e := CreateOleObject('Excel.Application');
  e.DisplayAlerts := false; //отключаем запросы Excel
  e.Visible := false;
  filePath := 'avito_Orenburg_20180420.xls';
  if TFile.Exists(ExtractFilePath(Application.ExeName) + filePath) then
  begin
    e.Workbooks.Open(ExtractFilePath(Application.ExeName) + filePath);
    sheet := e.Workbooks[ExtractFileName(filePath)].WorkSheets[1];
    i := 2; // first row
    j := e.ActiveCell.SpecialCells(xlCellTypeLast).Row; // last row
    while i <> j do
    begin
      rawPhone := sheet.cells[i, 5];
      contactName := sheet.cells[i, 7];
      regionName := sheet.cells[i, 8];
      cityName := sheet.cells[i, 9];
      adress := sheet.cells[i, 12];
      description := sheet.cells[i, 13]; //users_has_categories
      keywords := sheet.cells[i, 3]; // users_has_categories
      params := sheet.cells[i, 18];
      parseParams(params, categoryName, subCategoryName);

      // ------------ INSERTION IN DB
        // --- region
      idRegion := getRegionID(regionName);
      if idRegion = -1 then
        idRegion := insertRegion(regionName);
       // --- city
      idCity := getCityID(cityName, idRegion);
      if idCity = -1 then
        idCity := insertCity(cityName, idRegion);
      // insert in users
      phone := TCommon.TryGetUserPhone(rawPhone);
      if (phone <> '') //
        then
      begin
        idUser := getUsersID(phone);
        if idUser = -1 then
        begin
          TCommon.InsertUser( //
            phone, //
            'password', //
            3, // aUserStatusCode // with status freezed
            2,  // aRoleCode
            contactName, //
            adress, //
            1, // Russia
            idRegion, //
            idCity); //
          idUser := db.GetLastID;
        end;
      end;
      // update user keyWords
      currKeyWords := GetUserKeyWords(idUser);
      if currKeyWords = '' then
        currKeyWords := keywords
      else
        currKeyWords := currKeyWords + ',' + keywords;
      UpdateUserKeyWords(idUser, currKeyWords);

      // insert in categories
      idCategory := getCategoryID(categoryName);
      if idCategory = -1 then
        idCategory := insertCategory(categoryName, '');
      //
      idSubCategory := getCategoryID(subCategoryName);
      if (subCategoryName <> '') and (idSubCategory = -1) then
        idSubCategory := insertCategory(subCategoryName, idCategory.toString);

      // insert in user_has_categories
      if GetUsersHasCategoriesID(idUser, idCategory) then
        UpdateUsersHasCategories(idUser, idCategory, description)
      else
        InsertUsersHasCategories(idUser, idCategory, description);

      inc(i);
    end;
  end;
  e.ActiveWorkBook.Close;
  e.Quit;
  e := Unassigned;
end;

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

procedure TRPAvitoImport.Execute;

procedure parseParams(aParams: string; var aCategory: string; var aSubCategory: string);

var

sa, sa1, sa2: TArray<string>;

begin

sa := aParams.Split(['=']);

if length(sa) > 1 then

aCategory := stringReplace(sa[1], ', Тип услуги', '', [rfReplaceAll]);

if length(sa) > 2 then

aSubCategory := sa[2];

end;

var

e, sheet: OLEVariant;

r: integer;

c: integer;

j: integer;

i: Integer;

rawPhone: string;

contactName: string;

regionName: string;

cityName: string;

adress: string;

description: string;

params: string;

keywords: string;

subCategoryName: string;

categoryName: string;

phone: string;

idRegion: Integer;

idCity: Integer;

idCategory: integer;

idUser: integer;

currKeyWords: string;

filePath: string;

idSubCategory: Integer;

begin

e := CreateOleObject('Excel.Application');

e.DisplayAlerts := false; //отключаем запросы Excel

e.Visible := false;

filePath := 'avito_Orenburg_20180420.xls';

if TFile.Exists(ExtractFilePath(Application.ExeName) + filePath) then

begin

e.Workbooks.Open(ExtractFilePath(Application.ExeName) + filePath);

sheet := e.Workbooks[ExtractFileName(filePath)].WorkSheets[1];

i := 2; // first row

j := e.ActiveCell.SpecialCells(xlCellTypeLast).Row; // last row

while i <> j do

begin

rawPhone := sheet.cells[i, 5];

contactName := sheet.cells[i, 7];

regionName := sheet.cells[i, 8];

cityName := sheet.cells[i, 9];

adress := sheet.cells[i, 12];

description := sheet.cells[i, 13]; //users_has_categories

keywords := sheet.cells[i, 3]; // users_has_categories

params := sheet.cells[i, 18];

parseParams(params, categoryName, subCategoryName);

// ------------ INSERTION IN DB

// --- region

idRegion := getRegionID(regionName);

if idRegion = -1 then

idRegion := insertRegion(regionName);

// --- city

idCity := getCityID(cityName, idRegion);

if idCity = -1 then

idCity := insertCity(cityName, idRegion);

// insert in users

phone := TCommon.TryGetUserPhone(rawPhone);

if (phone <> '') //

then

begin

idUser := getUsersID(phone);

if idUser = -1 then

begin

TCommon.InsertUser( //

phone, //

'password', //

3, // aUserStatusCode // with status freezed

2, // aRoleCode

contactName, //

adress, //

1, // Russia

idRegion, //

idCity); //

idUser := db.GetLastID;

end;

// update user keyWords

currKeyWords := GetUserKeyWords(idUser);

if currKeyWords = '' then

currKeyWords := keywords

else

currKeyWords := currKeyWords + ',' + keywords;

UpdateUserKeyWords(idUser, currKeyWords);

// insert in categories

idCategory := getCategoryID(categoryName);

if idCategory = -1 then

idCategory := insertCategory(categoryName, '');

idSubCategory := getCategoryID(subCategoryName);

if (subCategoryName <> '') and (idSubCategory = -1) then

idSubCategory := insertCategory(subCategoryName, idCategory.toString);

// insert in user_has_categories

if GetUsersHasCategoriesID(idUser, idCategory) then

UpdateUsersHasCategories(idUser, idCategory, description)

else

InsertUsersHasCategories(idUser, idCategory, description);

inc(i);

end;

e.ActiveWorkBook.Close;

e.Quit;

e := Unassigned;

end;

Posted in Delphi | Comments Off

Delphi. Отправить GET, POST запрос, пример

Posted on 09.05.2018 by Stanislav_Panteleev

Из проекта GET

idHTTP.Get('http://localhost:50000/sendSms?phone=79221361449&message=' + TNetEncoding.URL.Base64.Encode('Привет'))

1	idHTTP.Get('http://localhost:50000/sendSms?phone=79221361449&message=' + TNetEncoding.URL.Base64.Encode('Привет'))

POST

  idHTTP := TIdHTTP.Create(nil);
  s := TStringStream.Create;
  data := TStringList.Create;
  try
    Data.Add('phone=79221361449');
    Data.Add('message=' + TNetEncoding.URL.Base64.Encode('Привет')); // кодируем русский текст
    IdHTTP.Post('http://localhost:50000/sendSms', data, s);
    mAnswer.Lines.Add(s.DataString);
  finally
    idHTTP.Free;
  end;

idHTTP := TIdHTTP.Create(nil);

s := TStringStream.Create;

data := TStringList.Create;

try

Data.Add('phone=79221361449');

Data.Add('message=' + TNetEncoding.URL.Base64.Encode('Привет')); // кодируем русский текст

IdHTTP.Post('http://localhost:50000/sendSms', data, s);

mAnswer.Lines.Add(s.DataString);

finally

idHTTP.Free;

end;

На сервере это надо все расшифровать из Base64 обратно

Posted in Delphi | Comments Off

Delphi. idHTTPServer. Cookies. Пример

Posted on 05.05.2018 by Stanislav_Panteleev

Пример

Subject:	Re: IdHttpServer and cookies - simple example
Posted by: 	Will Olsen (wols…@igl.net)
Date:	Tue, 7 Jun 2005
Thank you for your reply.  I have tried the following:

procedure TServerForm.HTTPServerCommandGet(AThread: TIdPeerThread;
  RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
var
  ReadCookie : TIdCookieRFC2109;
  WriteCookie : TIdCookieRFC2109;
begin
  ReadCookie := RequestInfo.Cookies.Cookie['testcookie'];
  if ReadCookie = nil then
  begin
    responseinfo.ContentText := 'No Cookie';
    WriteCookie := responseinfo.Cookies.Add;
    WriteCookie.CookieName := 'testcookie';
    WriteCookie.Value := 'asfdasfdasfdasdfsdf';
    WriteCookie.Domain := 'localhost';
    WriteCookie.Expires := 'NEVER';
  end
  else
  ResponseInfo.ContentText := 'CookieFound:' + ReadCookie.CookieText;
end;

whenever I run this, the server responds with "No Cookie".  I am running the
server locally, and I am accessing it with Internet explorer using
http://localhost:8080 . Cookies are enabled in my browser.

Any thoughts on what I need to change to make this work?

Thank you,

Will

"Remy Lebeau (TeamB)" <no.spam@no.spam.com> wrote in message
news:42a5f41c$…@newsgroups.borland.com...
>
> "Will Olsen" <wols…@igl.net> wrote in message
> news:42a5ee83$…@newsgroups.borland.com...
>
> > Does anyone have a simple example of how to get/set a
> > cookie with the indy HTTP server?
>
> In the OnCommandGet event, the ARequestInfo and AResponseInfo parameter
both
> have a Cookies property, of type TIdServerCookies.  TIdServerCookies has
an
> Add() method and a Cookie[Name] property.  Have you looked at the Indy
> documentation yet for details about the TIdServerCookie and
TIdCookieRFC2109
> classes yet?
>
> Gambit

Replies
Re: IdHttpServer and cookies - simple example posted by Remy Lebeau (TeamB) on Tue, 7 Jun 2005

Subject: Re: IdHttpServer and cookies - simple example

Posted by: Will Olsen (wols…@igl.net)

Date: Tue, 7 Jun 2005

Thank you for your reply. I have tried the following:

procedure TServerForm.HTTPServerCommandGet(AThread: TIdPeerThread;

RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);

var

ReadCookie : TIdCookieRFC2109;

WriteCookie : TIdCookieRFC2109;

begin

ReadCookie := RequestInfo.Cookies.Cookie['testcookie'];

if ReadCookie = nil then

begin

responseinfo.ContentText := 'No Cookie';

WriteCookie := responseinfo.Cookies.Add;

WriteCookie.CookieName := 'testcookie';

WriteCookie.Value := 'asfdasfdasfdasdfsdf';

WriteCookie.Domain := 'localhost';

WriteCookie.Expires := 'NEVER';

end

else

ResponseInfo.ContentText := 'CookieFound:' + ReadCookie.CookieText;

end;

whenever I run this, the server responds with "No Cookie". I am running the

server locally, and I am accessing it with Internet explorer using

http://localhost:8080 . Cookies are enabled in my browser.

Any thoughts on what I need to change to make this work?

Thank you,

Will

"Remy Lebeau (TeamB)" <no.spam@no.spam.com> wrote in message

news:42a5f41c$…@newsgroups.borland.com...

> "Will Olsen" <wols…@igl.net> wrote in message

> news:42a5ee83$…@newsgroups.borland.com...

> > Does anyone have a simple example of how to get/set a

> > cookie with the indy HTTP server?

> In the OnCommandGet event, the ARequestInfo and AResponseInfo parameter

both

> have a Cookies property, of type TIdServerCookies. TIdServerCookies has

> Add() method and a Cookie[Name] property. Have you looked at the Indy

> documentation yet for details about the TIdServerCookie and

TIdCookieRFC2109

> classes yet?

> Gambit

Replies

Re: IdHttpServer and cookies - simple example posted by Remy Lebeau (TeamB) on Tue, 7 Jun 2005

Posted in Delphi | Comments Off

Как засечь время выполнения кода ?

Posted on 05.05.2018 by Stanislav_Panteleev

Самый надежный способ из всех, которые я встретил. Измеряет очень малые интервалы

var    
 iCounterPerSec: TLargeInteger;
 C1, C2: TLargeInteger;

...
  QueryPerformanceFrequency(iCounterPerSec);
  QueryPerformanceCounter(C1);

   // your code here

 QueryPerformanceCounter(C2);
 FContentSL.Add('1 Preparing temp dirs for chunks on Server and Client = '+
 FormatFloat('0.0000', (C2 - C1) / iCounterPerSec) + ' sec.');
...

var

iCounterPerSec: TLargeInteger;

C1, C2: TLargeInteger;

...

QueryPerformanceFrequency(iCounterPerSec);

QueryPerformanceCounter(C1);

// your code here

QueryPerformanceCounter(C2);

FContentSL.Add('1 Preparing temp dirs for chunks on Server and Client = '+

FormatFloat('0.0000', (C2 - C1) / iCounterPerSec) + ' sec.');

...

Источник http://www.sql.ru/forum/418874-1/izmerenie-vremeni-vypolneniya-operacii

Posted in Delphi | Comments Off

Delphi. idHTTPServer. 3 способа авторизации

Posted on 05.05.2018 by Stanislav_Panteleev

1. Через параметр в запросе На клиенте отправляем

IdHTTP.Get('http://localhost/getHeaders?AuthToken=someCode');

1	IdHTTP.Get('http://localhost/getHeaders?AuthToken=someCode');

На сервере принимаем в CommandGet

  if ARequestInfo.Params.Values['AuthToken'] = 'someCode' then
begin
    if ARequestInfo.URI = '/testConnection' then
    begin
      AResponseInfo.ResponseNo := 200;
      AResponseInfo.CacheControl := 'no-cache';
      AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');
      AResponseInfo.ContentText := 'ok';
      AResponseInfo.ResponseNo := 200;
      AResponseInfo.WriteContent;
    end;
end
else
    AResponseInfo.AuthRealm := 'not Authorized';

if ARequestInfo.Params.Values['AuthToken'] = 'someCode' then

begin

if ARequestInfo.URI = '/testConnection' then

begin

AResponseInfo.ResponseNo := 200;

AResponseInfo.CacheControl := 'no-cache';

AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');

AResponseInfo.ContentText := 'ok';

AResponseInfo.ResponseNo := 200;

AResponseInfo.WriteContent;

end;

end

else

AResponseInfo.AuthRealm := 'not Authorized';

2. Через параметр в заголовке

Posted in Delphi | Comments Off

Delphi. idHTTPServer. 2 способа загрузить контент в браузере

Posted on 05.05.2018 by Stanislav_Panteleev

Читал интересную статью про idHTTPServer , и обнаружил, что кроме того способа отдачи контента, который указан в статье, я знаю ещё один. Решил записать.

procedure TServer.IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  sl: TStringList;
begin
// это просто пример теста соединения
  if ARequestInfo.URI = '/testConnection' then
  begin
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.CacheControl := 'no-cache';
    AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');
    AResponseInfo.ContentText := 'ok';
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.WriteContent;
  end;
// 1 способ
  if ARequestInfo.URI = '/getSomeDocument' then
  begin
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.CacheControl := 'no-cache';
    AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');
    // read some document
    sl := TStringList.Create;
    try
      sl.LoadFromFile('index.html');
      AResponseInfo.ContentText := sl.Text;
    finally
      sl.Free;
    end;
    //
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.WriteContent;
  end;
// 2 способ
  try
  //отдача индексного или иного файла с диска
    if ARequestInfo.Document = '/' then
      AResponseInfo.ContentStream := TFileStream.Create('index.html', fmOpenRead)
    else
    begin
//      fileName:=www + ARequestInfo.Document;
      AResponseInfo.ContentStream := TFileStream.Create(ARequestInfo.Document, fmOpenRead);
    end;
  except
    AResponseInfo.ContentText := '<b>File not found or access denied!';
  end;
end;

procedure TServer.IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

sl: TStringList;

begin

// это просто пример теста соединения

if ARequestInfo.URI = '/testConnection' then

begin

AResponseInfo.ResponseNo := 200;

AResponseInfo.CacheControl := 'no-cache';

AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');

AResponseInfo.ContentText := 'ok';

AResponseInfo.ResponseNo := 200;

AResponseInfo.WriteContent;

end;

// 1 способ

if ARequestInfo.URI = '/getSomeDocument' then

begin

AResponseInfo.ResponseNo := 200;

AResponseInfo.CacheControl := 'no-cache';

AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');

// read some document

sl := TStringList.Create;

try

sl.LoadFromFile('index.html');

AResponseInfo.ContentText := sl.Text;

finally

sl.Free;

end;

AResponseInfo.ResponseNo := 200;

AResponseInfo.WriteContent;

end;

// 2 способ

try

//отдача индексного или иного файла с диска

if ARequestInfo.Document = '/' then

AResponseInfo.ContentStream := TFileStream.Create('index.html', fmOpenRead)

else

begin

// fileName:=www + ARequestInfo.Document;

AResponseInfo.ContentStream := TFileStream.Create(ARequestInfo.Document, fmOpenRead);

end;

except

AResponseInfo.ContentText := '<b>File not found or access denied!';

end;

Posted in Delphi | Comments Off

Delphi. UniGUI. ProgressBar. Пример использования из проекта

Posted on 28.04.2018 by Stanislav_Panteleev

Когда нужно отобразить прогресс. Пробовал разными способами и потоками и чем угодно, но получилось вот так, через Syncronize. Анализируйте код. Это работает !)

Posted in Delphi | Comments Off

Category Archives: Delphi

Delphi. FireMonkey. Get IMEI

Delphi. FireMonkey. Настраиваем SDK, NDK, Java

Delphi. WInAPI. Пример отправки сообщения из одного потока в другой

Delphi. Импорт данных в базу из Excel. Пример из проекта

Delphi. Отправить GET, POST запрос, пример

Delphi. idHTTPServer. Cookies. Пример

Как засечь время выполнения кода ?

Delphi. idHTTPServer. 3 способа авторизации

Delphi. idHTTPServer. 2 способа загрузить контент в браузере

Delphi. UniGUI. ProgressBar. Пример использования из проекта

MY PROJECTS

Recent Posts

Categories