Author Archives: Stanislav_Panteleev

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
    { Private declarations }
    procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE;
  public
    { Public declarations }
  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

{ Private declarations }

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

public

{ Public declarations }

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);
    { Private declarations }
  public
    property MainHandle: Hwnd read FMainHandle write SetMainHandle;
  protected
    procedure Execute; override;
  end;

implementation

{
  Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TApiTestThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end;

    or

    Synchronize(
      procedure
      begin
        Form1.Caption := 'Updated in thread via an anonymous method'
      end
      )
    );

  where an anonymous method is passed.

  Similarly, the developer can call the Queue method with similar parameters as
  above, instead passing another TThread class as the first parameter, putting
  the calling thread in a queue with the other thread.

}

{ 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
  { Place thread code here }
  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);

{ Private declarations }

public

property MainHandle: Hwnd read FMainHandle write SetMainHandle;

protected

procedure Execute; override;

end;

implementation

{

Important: Methods and properties of objects in visual components can only be

used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TApiTestThread.UpdateCaption;

begin

Form1.Caption := 'Updated in a thread';

end;

Synchronize(

procedure

begin

Form1.Caption := 'Updated in thread via an anonymous method'

end

)

);

where an anonymous method is passed.

Similarly, the developer can call the Queue method with similar parameters as

above, instead passing another TThread class as the first parameter, putting

the calling thread in a queue with the other thread.

}

{ 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

{ Place thread code here }

Test;

end;

end.

Posted in Delphi | Leave a comment

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 | Leave a comment

Delphi. SuperObject для json формата

Posted on 26.05.2018 by Stanislav_Panteleev

Перешел superobject библиотеку с System.Json и ощутил массу удобств. Работать с ней показалось на порядок проще! Чуть позже напишу развернутый пост, но пока зафиксирую ссылки, которые мне помогли с ней разобраться. https://github.com/hgourvest/superobject https://stackoverflow.com/questions/16790006/how-to-create-json-file-in-delphi-using-superobject-lib

Posted in Delphi | Leave a comment

Духовность. Фильмы

Posted on 14.05.2018 by Stanislav_Panteleev

ДУХОВНЫЕ ФИЛЬМЫ Более 100 духовных и вдохновляющих фильмов смотреть онлайн: ФИЛЬМЫ Весь список фильмов: 1+1 https://www.kinopoisk.ru/film/1-plus-1-2011-535341/ “Моя левая нога” https://www.kinopoisk.ru/film/moya-levaya-noga-1989-18784/ “Окно” https://www.kinopoisk.ru/film/okno-2015-888118/ «О мой Бог» http://wejournal.com.ua/video/filmy-dlya-razvitiya/film-o-moj-bog/ «Иерей-сан. Исповедь самурая» (2015) http://wejournal.com.ua/video/ierej-san-ispoved-samuraya-2015/ «Придел Ангела» http://wejournal.com.ua/video/pridel-angela/ «Православные притчи» http://wejournal.com.ua/video/pravoslavnye-pritchi/ «Спасайся, брат» http://wejournal.com.ua/video/spasajsya-brat/ «Полианна» … Continue reading →

Posted in Без рубрики | Leave a comment

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 | Leave a comment

Get или POST ?

Posted on 08.05.2018 by Stanislav_Panteleev

Понравилась схемка…

Posted in Без рубрики | Leave a comment

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 | Leave a comment

Delphi. Несколько способов засечь время выполнения кода

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 | Leave a comment

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 | Leave a comment

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 | Leave a comment

Author Archives: Stanislav_Panteleev

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

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

Delphi. SuperObject для json формата

Духовность. Фильмы

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

Get или POST ?

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

Delphi. Несколько способов засечь время выполнения кода

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

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

C# WORLD

MySQL WORLD

DELPHI WORLD

JS WORLD

PHP World

IIS World

Recent Posts

Categories