#1 Re: mORMot Framework » Disable insecure SSL3 protocol? » 2021-09-28 18:11:18

Thank you for your all suggestions

I use mormot 1 for a server side webservices with Http.sys handling the ssl communication .

We have just made registry change and verified that SSL3 is not available anymore after reboot.

UInfortunatelly our client has only one virtual server and it is not an option for them to setup  another virtual server to act as a Linux proxy.

Nevertheless  we use Win-ACME Windows implementation of LETS encrypt certificates system

#2 mORMot Framework » Disable insecure SSL3 protocol? » 2021-09-28 07:25:00

EvaF
Replies: 4

When doing online SSL tests against my mORMot powered webservices I get a warning about insecure SSL3 protocol,

What is the recomended way to disable the SSL3 option?

#4 mORMot Framework » SynDB + FetchAllToJSON » 2021-04-19 13:19:55

EvaF
Replies: 3

Hello,
I don't know if my proposal  doesn't go beyond the logic of the FetchAllToJSON function, but I would welcome  if FetchAllToJSON function returns eally all records ( not only the rest of records from the CurrentRow position)
f.e.
instead of

  function TSQLDBStatement.FetchAllToJSON(JSON: TStream; Expanded: boolean): PtrInt;
  ...
  while Step do begin
      ColumnsToJSON(W);
      W.Add(',');
      inc(result);
    end;
   ...

to use:

  function TSQLDBStatement.FetchAllToJSON(JSON: TStream; Expanded: boolean): PtrInt;
  var lFirst : boolean;
  ...
    lFirst := true;
    while Step(lFirst) do begin
      lFirst := false;
      ColumnsToJSON(W);
      W.Add(',');
      inc(result);
    end;
    ...

#5 Re: PDF Engine » Muddy Image rendering in PDF » 2020-05-29 12:11:18

you are include into pdf really huge image 4916 x 1830 (approx) and moreover ( at least to seems to me) you used JPEG compression - therefore it is splitted (imho - i can be wrong of course) . ( 4916 is width of your picture rounded up and height I calculated by proportinality)
try to play with less image, without compression..
But to be true I couldn't afford such big images in my pdfs. You should invent some more efficient way how and in which form to put logo images into your pdf.

#6 Re: PDF Engine » Muddy Image rendering in PDF » 2020-05-29 06:32:04

By "directly draw the logo" I ment, that you are able to draw your logo into canvas - not like a big image but - mainly the text - as curves
there are many ways
first of all I would split your logo into three parts:

  1. text

  2. background (=blue gradient)

  3. middle rectangle

the 2nd and 3rd  items I would save into separate files (2nd with dimensions 1px x height of logo rectangle, 3rd in real dimension)

the text you can handle f.e.

  1. you can write text (as curves) from your logo using syngdiplus ( or other graphics library) and save as wmf file and render this file in your pdf

  2. you can write text directly into pdfcanvas (without or with ObjectX)

  3. you can also use mormotReport library for text


I did a small example ( by eye, without any precise - using the first sample "SynPdfFormCanvas" that i met) and f.e. b) option
the pdf result of code bellow


function getPdfImage(aPDF:TPdfDocument; aName:PDFString):TPdfImage;
var
  FS: TFileStream;
  Graphic: TGraphic;
begin
  Graphic := TPngImage.Create;
  FS := TFileStream.Create(aName, fmOpenRead);
  try
    FS.Seek(0, soFromBeginning);
    Graphic.LoadFromStream(FS);
    Result:= TPdfImage.create(aPDF,Graphic,true);
  finally
    Graphic.Free;
    FS.Free;
  end;
end;
var
  obPDF: TPdfDocument;
  obFormCanvas: TPdfFormWithCanvas;
  obFormCanvasGrad: TPdfFormWithCanvas;
  oGrad,oMiddle : TPdfImage;
begin
  obPDF := TPdfDocument.Create(false,0,false);

  obPDF.GeneratePDF15File := true;
  obPDF.DefaultPaperSize := psA4;
  obPDF.DefaultPageLandscape := false;
  obPDF.CompressionMethod := cmNone;

//------------------------------ logo-------------------------
  oGrad:= getPdfImage(obPDF,'grad.png');
  obPDF.AddXObject('imgLogoGrad', oGrad);
  oMiddle:= getPdfImage(obPDF,'middle.png');
  obPDF.AddXObject('imgLogoMiddle', oMiddle);

  obFormCanvas := TPdfFormWithCanvas.Create(obPDF,Trunc(20.828*PDFFactor),Trunc(20.828/2.7*PDFFactor));

  obPDF.AddXObject('FORMOBJECT',obFormCanvas);
  obFormCanvas.Canvas.SetTextRenderingMode(trFill);

  obFormCanvas.Canvas.SetFont('Verdana',54.0,[pfsBold]);
  obFormCanvas.Canvas.SetHorizontalScaling(90);
  obFormCanvas.Canvas.SetCMYKFillColor(65,52,0,39);
  obFormCanvas.Canvas.TextOut(0,5*PDFFactor,'Live long and prosper');
  obFormCanvas.CloseCanvas;
//------------------------------ logo-------------------------

  obPDF.AddPage;
// ----------------------------- your content ---------------------------
  obPDF.Canvas.SetTextRenderingMode(trFill);
  obPDF.Canvas.SetFont('Arial',10.0,[]);

  obPDF.Canvas.SetLineWidth(0.01*PDFFactor);

  obPDF.Canvas.Rectangle(1.0*PDFFactor,1.0*PDFFactor,19.0*PDFFactor,27.9*PDFFactor);
  obPDF.Canvas.Stroke;

  obPDF.Canvas.TextOut(2.0*PDFFactor,27.0*PDFFactor,'XObject form canvas sample');

//------------------------------ logo background (=gradient)-------------------------
  obPDF.Canvas.DrawXObject(0,23*PDFFactor,20.828*PDFFactor,Trunc(20.828/2.7*PDFFactor),'imgLogoGrad');
//------------------------------ logo middle rectangle -------------------------
  obPDF.Canvas.DrawXObject(20.828*PDFFactor/2-oMiddle.pixelWidth/3,
                          25*PDFFactor -oMiddle.pixelHeight/3,
                          2/3*oMiddle.pixelWidth,2/3*oMiddle.pixelHeight,'imgLogoMiddle');
//------------------------------ logo text -------------------------
  obPDF.Canvas.DrawXObject(0,23*PDFFactor,1,1,'FORMOBJECT');


  obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));

  FreeAndNil(obPDF);
end.

small note:
if you use TPdfFormWithCanvas for drawing of text, fix yourself a small bug in this class:

constructor TPdfFormWithCanvas.Create(aDoc: TPdfDocument; W, H: single;aXForm:PXForm);
...
// instead of   FAttributes.AddItem('BBox',TPdfArray.Create(nil,[0,0,H,W])); write
  FAttributes.AddItem('BBox',TPdfArray.Create(nil,[0,0,W,H]));
...
end;

#7 PDF Engine » Problems with generated PDF in Adobe » 2020-05-27 09:35:53

EvaF
Replies: 0

hello,
in my project I use mORMotReport + SynPdf for generate output into PDF. The resulting PDF is rather complicated - with many drawings, several fonts, images, tables etc.

Everything worked fine till the last week.

Last week my client reported  some errors that occured when  he tried to print the generated pdf in Adobe Reader; he also reported another problem of incomplete drawing.
M1.png

When I tried to print/display/analyze the generated PDF in other softwares (Edge, Mozilla, XFINIUM.PDF, Winking PDF analyzer) there was no error.

When analyzing the generated PDF in Adobe Acrobat DC - preflight module  I have found three unusual problems:

1) General File/Format error  The key /First must be present when key /Count is used
this error was caused by this part !!

1 0 obj
<</Type/Catalog/PageLayout/SinglePage/Outlines 2 0 R/Pages 4 0 R>>
endobj
2 0 obj
<</Type/Outlines/Count 0>>
endobj

To avoid this error I have set

UseOutlines := false;

2) when I checked the incomplete drawing I found out  there are at  no PDF syntax error on the page, however the list of the used fonts contains entries for Courier font ( which is not used in my PDF at all) and the texts that were reportedly using Courier were missing in the incomplete drawing
From this I have inferred that Adobe requires explicit setFont  in front of each text element now - this requires a small change in TPdfCanvas.SetPDFFont procedure
(SynPdf)

procedure TPdfCanvas.SetPDFFont(AFont: TPdfFont; ASize: Single);
begin
  // check if this font is already the current font
  //  if (AFont=nil) or ((FPage.Font=AFont) and (FPage.FontSize=ASize)) then         <-- commented
  //    Exit;                                                                        <-- commented
  // add this font to the resource array of the current page
  if FPageFontList.ValueByName(AFont.ShortCut)=nil then
    FPageFontList.AddItem(AFont.ShortCut, AFont.Data);
  // change the font
  if FContents<>nil then
    SetFontAndSize(AFont.ShortCut, ASize); // e.g. SetFontAndSize('F0',12)
  FPage.Font := AFont;
  FPage.FontSize := ASize;
end;

this change helped

3) the third reported warnings are of type Invalid content stream state (PathObject) for operator
and the mentioned operators  are:  Tf, Tw, rg and BT. I have no clue what is the problem.
For the reference I give the code which matters:

/F1 14.04 Tf
0.18 Tw
0.28 0.17 0.42 rg
BT
28.32 800.36 Td
(Project: project 1) Tj
ET

#8 Re: PDF Engine » Muddy Image rendering in PDF » 2020-05-21 07:58:53

The embeded image ( in the reasonable size) looks never well for bigger scaling.
Your logo is simple for direct drawing. I would directly draw the logo  into a pdf instead of placing image.
the advantage of this step is: the pdf will be less, the logo looks the best for all scaling

#9 Re: PDF Engine » Clipping Problem » 2019-08-23 11:19:11

HEllo,
I had to solve clipping problem too for my project (pdf + patterns).
I have extracted only my changes related on clipping into separate branch:
https://github.com/Eva-F/SynPDF/tree/Ev … lip-branch

try it, plz ...
I am appologizing I have currently  no time to test it

#10 Re: PDF Engine » PlayEnhMetaFile / Screen DC on lower resolutions » 2019-06-01 06:01:09

did you draw with

  with TGDIPages.create(self) do
  begin
    .. 
    ForceScreenResolution := true;
    ..
  end;

?

#11 Re: PDF Engine » how to make one sheet in portrait orientation and the other in landsc » 2019-05-11 06:59:27

did you try to change orientation just before "Newpage" ?
something like:

    with TGDIPages.Create(self) do
    try
      Orientation := poLandscape;
      BeginDoc;
      ...
      Orientation := poPortrait;
      newPage;
      ...
      Orientation := poLandscape;
      newPage;
      ...
      endDoc;
      ..
     finally
      free;
     end;

#12 PDF Engine » Several proposals for mORMotReport » 2019-04-04 13:42:43

EvaF
Replies: 0

At the beginning I have to apologize for directly  modifying mORMOtReport unit again
(I hoped that I solve my issue by creating own class based on  TGDIPages but i needed to expand some data structures and therefore direct modifying of mORMotReport seemed to me more convenient).

I got a PDF sample template that I need to keep exactly.

Therefore I added into TGDIpages:
- vertical align
- text styles
- linespacing into header/footer
- drawing of RoundRectangle
- extending Columns (option to use text styles, vertical aligning, word wrap of column headers)
- rendering of external metafiles directly into PDF (= skip rendering of them into GDIPages.canvas)

more at:
https://github.com/Eva-F/SynPDF/tree/Ev … Report.pas

and
https://github.com/Eva-F/SynPDF/tree/Ev … tDocuments

#13 PDF Engine » Texture brushes in PDF » 2019-03-14 19:30:54

EvaF
Replies: 1

In my project I have to generate and include into pdf many pictures (from ten to hundred - depends on customer design) and the pictures have to be very readable and illustrative and of course the smallest as possible. Therefore I use texture brush for drawing them. (f.e. brush n x 1 pixels).The drawing picture is stored as metafile (.wmf), that can be rendered into pdf. But a recognization of texture brush bitmap from metafile is difficult and time/memory consuming because rounding color leads to similiar (but not equal) bitmaps.
Therefore I decided to such step: instead of real texture brush to use dummy brush of 1x1 pixel(to minimalize wmf metafile itself) and add into GDI comments information about bitmap, that will be used as texture brush for filling shapes right in pdf
Pdf has the tools for texture/pattern brush - there are Pattern and XObject/Form
Because I need primarily to render metafiles into pdf, I have prepared the option to read info about texture brushes from metafile and write into pdf  the filling the shapes by texture brushes by efficient way.

more at:
https://github.com/Eva-F/SynPDF/tree/Ev … re-pattern

examples at
https://github.com/Eva-F/SynPDF/tree/Ev … /documents

#14 Re: PDF Engine » PDF canvas » 2019-02-11 22:47:32

I am continuing in the study of synPDF and mORMotReport and I have found out, that in some cases (when the font of pageNrs is not diffferent from the font of header (or footer))
then Adobe Acrobat notifies the error in generated PDF.

It can be fixed by swapping order of page draw and PageNr text:

procedure TGDIPages.EndDoc;
...
 for i := 0 to n-1 do begin
      Page := CreateMetaFile(fPages[i].SizePx.X,fPages[i].SizePx.Y);
      try
        fCanvas := CreateMetafileCanvas(Page);
//-     fCanvas.Draw(0,0,GetMetaFileForPage(i)); // re-draw the original page
        s := format(fPagesToFooterText,[i+1,n]); // add 'Page #/#' caption
        aX := fPagesToFooterAt.X;
        if aX<0 then
          aX := fPages[i].SizePx.X-fPages[i].MarginPx.Right;
        SavedState := fPagesToFooterState;
        if TextAlign=taRight then
          dec(aX,fCanvas.TextWidth(s));
        with fPages[i] do
          fCanvas.TextOut(aX,SizePx.Y-MarginPx.bottom-fFooterHeight+   
            fFooterGap+fPagesToFooterAt.Y,s);
        fCanvas.Draw(0,0,GetMetaFileForPage(i));                                     //+ <-- swapping an order of commands 
        FreeAndNil(fCanvas);
        SetMetaFileForPage(i,Page); // replace page content
      finally
        Page.Free;
      end;
   ...

#15 PDF Engine » PDF canvas » 2019-02-10 17:59:46

EvaF
Replies: 1

I - like many others - use  FastReport for my reports but the exported PDF files - when pictures are embedded into them - look really bad.
Therefore I have decided to rework all my reports to use SynPDF.

A short introduction:
I have two webservice applications (both based on mORMot) that communicate with each other. One of them generates the picture files (*.png) which are inserted into reports by the second application.

All this can be handled by SynPDF alone. Instead of png files I plan to  use the windows metafiles(*.emf) which the second application will render into resulting PDF pages.

I have tried to render my generated emf file and stumbled on some small issues in SynPDF that I would like to have fixed:

They are related to Canvas.SaveDC and Canvas.RestoreDC

 procedure TPdfEnum.RestoreDC;
begin
  Assert(nDC>0);
  dec(nDC);
  Canvas.GRestore;         // <---   imho this line has to be added
end;

procedure TPdfEnum.SaveDC;
begin
  Assert(nDC<high(DC));
  DC[nDC+1] := DC[nDC];
  inc(nDC);
  Canvas.GSave;               // <---  imho this line has  to be added
end;

  and to clipping - I have already read this topic from MtwStark https://synopse.info/forum/viewtopic.php?id=4276 , but I was not digging so deeply and not to such extent as he.
I was focused only on the  EMR_SELECTCLIPPATH that is a part of my generated pictures - therefore my suggested change affects only the EMR_SELECTCLIPPATH.

function EnumEMFFunc(DC: HDC; var Table: THandleTable; R: PEnhMetaRecord;
   NumObjects: DWord; E: TPdfEnum): LongBool; stdcall;
....

 EMR_SELECTCLIPPATH:begin                                  // <---   added  EMF_record EMR_SELECTCLIPPATH
    if PolyFillMode = ALTERNATE then
      E.Canvas.EOClip
    else
      E.Canvas.Clip;
    E.Canvas.NewPath;
  end;
  EMR_BEGINPATH: begin
    E.InPath := true;                                         // <--- added a path bracket flag  := true; 
    E.Canvas.NewPath;
    if not Moved then begin
      E.Canvas.MoveToI(Position.X,Position.Y);
      Moved := true;
    end;
  end;
  EMR_ENDPATH:
  begin
    E.InPath := false;                                        // <--- added a path bracket flag  := false
    E.Canvas.fNewPath := false;
  end;

When the InPath flag is true, the path defined in path brackets (EMR_BEGINPATH .. EMR_ENDPATH) should  not be Filled nor Stroked

procedure TPdfEnum.NeedBrushAndPen;
begin
  if InPath then                          // <--- added a condition  
  begin
    fStrokeColor := -1;
    fPenWidth := -1;
    fFillColor := -1;
    fPenStyle := -1;
  end
  else begin
    if fInlined then begin
      fInlined := false;
      Canvas.Stroke;
    end;
    NeedPen;
    with DC[nDC] do
    if not brush.null then
      FillColor := brush.color;
  end;
end;

procedure TPdfEnum.NeedPen;
begin
  with DC[nDC] do
  if not pen.null and not InPath then begin                  // <--- added a condition not InPath
    StrokeColor := pen.color;
    ...
  end else begin
    // pen.null need reset values
    fStrokeColor := -1;
    fPenWidth := -1;
    fPenStyle := -1;
  end;
end;

and in EnumEMFFunc procedure an PolyPoly procedure

function EnumEMFFunc(DC: HDC; var Table: THandleTable; R: PEnhMetaRecord;
   NumObjects: DWord; E: TPdfEnum): LongBool; stdcall;
   ... 
  EMR_POLYGON, EMR_POLYLINE, EMR_POLYGON16, EMR_POLYLINE16:
  if not brush.null or not pen.null and not E.InPath then begin           // <--- added a condition not InPath
  ...
end;

procedure TPdfEnum.PolyPoly(data: PEMRPolyPolygon; iType: Integer);
...
  if not InPath then                                          // <--- added a condition not InPath
  begin
     if iType in [EMR_POLYPOLYLINE, EMR_POLYPOLYLINE16] then begin // stroke
     ...
  end;
end;

With these small changes applied  my generated emf's are rendered correctly

#16 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2017-01-04 20:41:49

Hi,
I forgot to comment some debug statements - sorry. The fixed version of WPRESTAPI.pas file is on git.

#17 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2016-12-23 10:29:12

I checked only WordpressREST ( sorry - a few time). I have installed new version (Oauth 0.3.0, Wordpress 4.7 +  Mormot Nigth Build -mORMot_and_Open_Source_friends_2016-12-21_193435_df194baa76) and made a couple of the small changes in WordpressREST sources.
The adding, updating and listing Wordpress users works now.

About the Error 404: rest_no_route
Please check your Wordpress endpoint address
=[WP-REST-API-Url] - http[https]://[your-WP-server]/wp-json/ in WPRESTAPI.json
and
=[WOO-REST-API-Url] - http[https]://[your-WP-server]/wc-api/[Woocommerce API version]/ in WooRESTAPI.JSON     

f.e.

http://somewordpress.blabla.com/wc-api/v2/

#18 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2016-12-22 14:18:11

I will check all new versions and after that let you know...
E.

#19 mORMot Framework » SMS - SynCrossPlatformREST-Queue of requests » 2016-12-09 08:19:10

EvaF
Replies: 0

I use Smart Mobile Studio to communicate with mORMot server (based on RegressionTestsServer). For my project the most suitable method is to use the sicPerSession implementation with asynchronous responses. More precisely - I need to put my requests into a FIFO queue (without waiting for each response) and let the mormot client manage the queue . 
I have looked at the SynCrossPlatformREST unit,  but didn't find the option how to implement such approach (I may be wrong)

So here are my questions (for the implementation sicPerSession):
1) is it possible to ensure  that the request  is delayed until the server completes the processing of the previous request?
2) I tried to implement simple queueing in SynCrossPlatformREST unit. It works but I wonder if there is  a more efficient way to achive it?

  TCallQueue=class                                                  <---added
    Caller: TServiceClientAbstract;
    CallMethod: string;
    CallParams: string;
    onSuccess: procedure(res: array of Variant);
    onError: TSQLRestEvent;
    ReturnsCustomAnswer: boolean;
    ExpectedOutputParamsCount : integer;
  end;

  /// REST client access class
  TSQLRestClientURI = class(TSQLRest)
  protected
    fAuthentication: TSQLRestServerAuthentication;
    fOnlyJSONRequests: boolean;
    fRunningClientDriven: TStringList;
    {$ifdef ISSMS}
    fAsynchCount: integer;
    fCallsQueue:  Array of TCallQueue;                            <---added 
    fCallIsProcessed: boolean;                                     <---added

    fAsynchPendingText: array of string;
    procedure SyncCallRemoteServiceASynchQueue;                  <---added
    ...
  public
    ...
    procedure CallRemoteServiceAsynch(aCaller: TServiceClientAbstract;
      const aMethodName: string; aExpectedOutputParamsCount: integer;
      const aInputParams: array of variant; 
      onSuccess: procedure(res: array of Variant); onError: TSQLRestEvent;
      aReturnsCustomAnswer: boolean=false);
    procedure SyncCallRemoteServiceAsynch(aCaller: TServiceClientAbstract;      <---added
      const aMethodName: string; aExpectedOutputParamsCount: integer;
      const aInputParams: array of variant;
      onSuccess: procedure(res: array of Variant); onError: TSQLRestEvent;
      aReturnsCustomAnswer: boolean=false);
  ...
end;


implementation
...

procedure TSQLRestClientURI.SyncCallRemoteServiceASynch(aCaller: TServiceClientAbstract;
  const aMethodName: string; aExpectedOutputParamsCount: integer;
  const aInputParams: array of variant;
  onSuccess: procedure(res: array of Variant); onError: TSQLRestEvent;
  aReturnsCustomAnswer: boolean);
var  CallQueueItem : TCallQueue;
begin
    CallQueueItem := TCallQueue.create;
    CallQueueItem .caller := aCaller;
    CallQueueItem .callMethod := aMethodName;
    CallQueueItem .callParams := JSON.Stringify(variant(aInputParams));
    CallQueueItem .onError := onError;
    CallQueueItem .OnSuccess := onSuccess;
    CallQueueItem .ReturnsCustomAnswer := aReturnsCustomAnswer;
    CallQueueItem .ExpectedOutputParamsCount := aExpectedOutputParamsCount;

    fCallsQueue.add(CallQueueItem );                                // the length  is set in constructor Create (fCallsQueue.SetLength(0); )
    SyncCallRemoteServiceASynchQueue;
end;
 
procedure  TSQLRestClientURI.SyncCallRemoteServiceASynchQueue;
var Call: TSQLRestURIParams;
    CallQueueItem : TCallQueue;
begin
  SetAsynch(Call,
    lambda
      var i:= 0;
      fCallIsProcessed:= false;
      CallQueueItem :=  fCallsQueue[ Low(fCallsQueue)];
      for i := Low(fCallsQueue) + 1 to High(fCallsQueue) do
        fCallsQueue[i-1] := fCallsQueue[i];
      fCallsQueue.SetLength(high(fCallsQueue));
      if high(fCallsQueue)>=Low(fCallsQueue) then
         SyncCallRemoteServiceASynchQueue;
      if not assigned(CallQueueItem.onSuccess) then
        exit; // no result to handle
      if CallQueueItem.ReturnsCustomAnswer then begin
        if Call.OutStatus=HTTP_SUCCESS then begin
          var result: TVariantDynArray;
          result.Add(Call.OutBody);
          CallQueueItem.onSuccess(result);
        end else
          if Assigned(CallQueueItem.onError) then
            CallQueueItem.onError(self);
        exit;
      end;
      var outID: integer;
      var result := CallGetResult(Call,outID); // from {result:...,id:...}
      if VarIsValidRef(result) then begin
         if (CallQueueItem.Caller.fInstanceImplementation=sicClientDriven) and (outID<>0) then
           (CallQueueItem.Caller as TServiceClientAbstractClientDriven).fClientID := IntToStr(outID);
        if CallQueueItem.ExpectedOutputParamsCount=0 then
          CallQueueItem.onSuccess([]) else begin
          var res := TJSONVariantData.CreateFrom(result);
          if (res.Kind=jvArray) and (res.Count=CallQueueItem.ExpectedOutputParamsCount) then
            CallQueueItem.onSuccess(res.Values) else
            if Assigned(CallQueueItem.onError) then
              CallQueueItem.onError(self);
        end;
      end else
        if Assigned(CallQueueItem.onError) then
          CallQueueItem.onError(self);
    end,
    lambda
      if Assigned(CallQueueItem.onError) then
          CallQueueItem.onError(self);
    end,
    lambda
      result := (Call.OutStatus=HTTP_SUCCESS) and (Call.OutBody<>'');
    end);
    CallQueueItem:= fCallsQueue[Low(fCallsQueue)];
    if assigned(CallQueueItem) and not fCallIsProcessed then
    begin
       fCallIsProcessed:= true;
       CallRemoteServiceInternal(Call,CallQueueItem.Caller,CallQueueItem.CallMethod,CallQueueItem.CallParams);
    end;
end;

Eva
P.S. Thanks a lot for creating the SMS crossplatform  and I also would like to thank for warleyalex for illustrative examples and for creating videotutorials

#20 Re: mORMot Framework » Error saving Blobs to MS SQL via OleDB » 2016-02-17 10:53:36

I had to solve the saving Blobs into MSSQL  a month ago (http://synopse.info/forum/viewtopic.php?id=3106).
I used a little bit different coding, but the principle is the same:

procedure TOleDBStatement.ExecutePrepared;
...
...
  ftBlob: begin
    B^.dwPart := DBPART_VALUE or DBPART_LENGTH or DBPART_STATUS;
    B^.obValue := PAnsiChar(@P^.VBlob)-pointer(fParams);
    B^.cbMaxLen := sizeof(Pointer);
    P^.VInt64 := length(P^.VBlob);
    B^.obLength := PAnsiChar(@P^.VInt64)-pointer(fParams);
// ---------------ParamBindInfo.ulParamSize-------------------
// For parameters that use a variable-length data type
// The maximum length of the data type in characters (for DBTYPE_STR and DBTYPE_WSTR) or in bytes (for DBTYPE_BYTES and DBTYPE_VARNUMERIC),
    BI^.ulParamSize := P^.VInt64;                       // <--- added the setting of length                
  end;
  ftUTF8: begin
    B^.obValue := PAnsiChar(@P^.VText)-pointer(fParams);
    ...
  end;
  end;
end;
if BI^.ulParamSize = 0  then
  BI^.ulParamSize := B^.cbMaxLen;                   //   <--- Here is set default length  - but it is valid only
                                                    //        for parameters that use a fixed-length data type

 

Still remains the question how to insert Null value into a varbinary(MAX) (=BLOB) field

I modified procedure ExecutePrepared this way, but I cannot see whether there will be other consequences

case P^.VType of
ftNull: begin
  P^.VStatus := ord(stIsNull);
//  BI.pwszDataSourceType := 'DBTYPE_WVARCHAR';          <-- commented by me
  BI.dwFlags := BI^.dwFlags or DBPARAMFLAGS_ISNULLABLE;

#22 Re: mORMot Framework » SynOleDB and ExecutePrepared » 2016-01-13 09:59:04

Again TOleDBStatement.ExecutePrepared procedure

I ran into next problem related to Blob parameters - whenever I try to store a picture into varbinary(max) field ( using BindBlob - see code above ), in MSSQL database is stored only first 8 bytes.

0x89504E47

the reason is imho that wrong ParamBindInfo.ulParamSize is set for blob field.

procedure TOleDBStatement.ExecutePrepared;
...
...
  ftBlob: begin
    B^.dwPart := DBPART_VALUE or DBPART_LENGTH or DBPART_STATUS;
    B^.obValue := PAnsiChar(@P^.VBlob)-pointer(fParams);
    B^.cbMaxLen := sizeof(Pointer);
    P^.VInt64 := length(P^.VBlob);
    B^.obLength := PAnsiChar(@P^.VInt64)-pointer(fParams);
// ---------------ParamBindInfo.ulParamSize-------------------
// For parameters that use a variable-length data type
// The maximum length of the data type in characters (for DBTYPE_STR and DBTYPE_WSTR) or in bytes (for DBTYPE_BYTES and DBTYPE_VARNUMERIC),
    BI^.ulParamSize := P^.VInt64;                       // <--- added the setting of length                
  end;
  ftUTF8: begin
    B^.obValue := PAnsiChar(@P^.VText)-pointer(fParams);
    ...
  end;
  end;
end;
if BI^.ulParamSize = 0  then
  BI^.ulParamSize := B^.cbMaxLen;                   //   <--- Here is set default length  - but it is valid only
                                                    //        for parameters that use a fixed-length data type

#23 mORMot Framework » SynOleDB and ExecutePrepared » 2016-01-12 22:50:11

EvaF
Replies: 6

Hi,
While upgrading of my program with  the latest (unstable) version of mormot, I ran into following problem:

I need to insert/update data on server (MSSQL 2012) from client dbs (sqlite) and  for a specific reasons I need to do it in general way.

First I retrieve a table structure (field names, field types, nullable, keys,...)

the code segment looks like this:

lSQL := StringToUTf8( ' INSERT INTO ' + lTableName + '(' + lAddFields + 'changedAt,changedBy ) Values ('+  lParameters + 'getDate(), '+quotedStr(fSiteUser)+')');
// lParameters ='?,?,?,...'
// lAddFields comma delimited list of fieldnames of lTablename 
with fprops.MainConnection.NewStatementPrepared(lSql , false) do
begin
   lFieldCount := 0;
   for i := 0 to lField.count - 1 do
   begin
      lfn := lField.Names[i];
      if (lSQLTable.FieldIndex(lfn)>-1) then
      begin
         inc(lFieldCount);                                            
         lDataType := lField.objects[lfn].strings['DATA_TYPE'];
         if  not(lKey.has[lfn] ) and (lField.Objects[lfn].strings['NULLABLE']='YES') and (lSQLTable.Get(lSQLTable.stepRow,lSQLTable.FieldIndex(lfn)) = '') then
            BindNull(lFieldCount)
         else  if endsText('int',lDataType) then
            Bind(lFieldCount,lSQLTable.GetAsInt64(lSQLTable.stepRow,lSQLTable.FieldIndex(lfn)))
        ...
        else  if endsText('binary',lDataType)  then
            BindBlob(lFieldCount,lSQLTable.GetBlob(lSQLTable.stepRow,lSQLTable.FieldIndex(lfn)))
        ...
      end;
   end;
   try
     ExecutePrepared;
   except
      on E:Exception do
      begin
       ......      
      end;
   end;

   

and I receive the exception whenever I try to insert Null value into a varbinary(MAX) field

Project .. raised exception class EOleDBException with message 'TOleDBConnection:
OLEDB Error 80040E14 -   (line 1): Implicit conversion from data type nvarchar to varbinary(max) is not allowed. Use
the CONVERT function to run this query.

I debugged it and I suspect that the problem is in TOleDBStatement.ExecutePrepared procedure
First I think ( and I may be wrong) that there is a typo error in this procedure and instead of BI.pwszDataSourceType there  should be BI^.pwszDataSourceType
and the same goes for BI.dwFlags

case P^.VType of
ftNull: begin
  P^.VStatus := ord(stIsNull);
  BI.pwszDataSourceType := 'DBTYPE_WVARCHAR';    
  BI.dwFlags := BI^.dwFlags or DBPARAMFLAGS_ISNULLABLE;

but the reason  for  my exception is the following line:

 BI.pwszDataSourceType := 'DBTYPE_WVARCHAR';  

when I modify the this small part of ExecutePrepared procedure:

case P^.VType of
ftNull: begin
  P^.VStatus := ord(stIsNull);
  BI^.dwFlags := BI^.dwFlags or DBPARAMFLAGS_ISNULLABLE;

then I am able to successfully insert  null value into a varbinary field

#24 Re: mORMot Framework » Patch for "Expanded" TSQLDBStatement.FetchAllToJSON » 2016-01-10 20:42:43

hm, so nothing - it doesn't help me...
I mainly use fetchAllToJSON for the results of MSSQL queries,further I perform a little bit more complicated calculations using these JSON objects and mormotize only the result of calculation.

#25 Re: mORMot Framework » Patch for "Expanded" TSQLDBStatement.FetchAllToJSON » 2016-01-10 20:13:26

Ok, thanks a lot for tip, I will take a look at it

#26 Re: mORMot Framework » Patch for "Expanded" TSQLDBStatement.FetchAllToJSON » 2016-01-10 19:45:42

Hi,
I also  intercede for the Maciej proposal.
I have to go to new version of mormot and I have to treat the result of FetchallToJSON(true) in many places - I know it's not difficult, but it makes imho more sense to return every time the same type

for Expanded = true  i would like to expect allways Array []
for Expanded = false  i would like to expect allways Object {}

#27 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2016-01-02 12:37:25

ab wrote:

You could use a TDocVariantData to store the array and convert it to an array of const.

ok, thanks, I did it by your recommended way.

#28 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2016-01-01 15:39:34

ab wrote:

I did not understand the purpose of this function, and its use case...

I will try to explain my idea:
I have intended  to call the CallbackGet function that uses open array of TVarRec as a parameter.

function TSQLRestClientURI.CallBackGet(const aMethodName: RawUTF8;
  const aNameValueParameters: array of const; ...): integer;
 

Rather then explicitly enumerate  all  name, value pairs I would prefer to add them gradually one by one based on the actual authentication stage. Therefore  each NameValue pair is copied into a FParameters array

    fParameters: array of TVarRec;

and afterwards passed as an aNameValueParameters.

fOauthClient.CallBackGet('request', fParameters, lResponse)

I have fixed the unsatisfactory releasing of fParameters and there are no memory leaks now.

Further I have discovered a bug in OAuth1 plugin and when I have checked it on Github, I have found out that there is a new version of Oauth1 plugin available and that this new version changed the way the signature is created at the third leg of authetication. I have also added  the support for OAuth1 plugin version 0.2.1 into source code.

#29 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2015-12-31 18:32:29

Thanks for the warning, I will take look into - in this case I think that in SynCommons is a suitable subroutine for this purpose, but I could not find it

#30 Re: mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2015-12-30 21:35:55

hereby is source https://github.com/Eva-F/mormot-WP-REST-API
maybe it helps somebody

a little remark:
I am not good in the writing of commentaries neither in my native language let alone in English.
I know only a small fraction of mormot, so some part of my code could use routines of mormot better and more effectively

#31 mORMot Framework » A mORMot Wordpress REST API (and WooCommerce API) consumer » 2015-12-29 06:15:36

EvaF
Replies: 14

Hi,
for my project that uses webservice (based on mORMot) I will have to create users in Wordpress with the same account ( username,pwd,email, etc)  and maybe later to reading/writing WooCommerce data. Therefore  I created a small library to accomplish it.
I tried to use ORM classes for the work with Wordpress records.

The reading looks like this

type 
TWPRESTAPI1_0_3LEGS = class(TWPRESTAPI)       // my class for dealing with Wordpress REST API include providing authentication
...
TSQLWPClient = class(TSQLHttpClientWinHTTP)
...
TSQLRESTAPIUser = class(TSQLRecord)
  protected
    fusername: RawUTF8;
    fname: RawUTF8;
    ffirst_name: RawUTF8;
    fnickname: RawUTF8;
    fslug: RawUTF8;
...

var
     fWP: TWPRESTAPI1_0_3LEGS ;  
     fWPClient : TSQLWPClient;
     fWPUser : TSQLRESTAPIUser;

procedure ReadWPUsers;
begin    
    fWP := TWPRESTAPI1_0_3LEGS.create('WPRestAPI.json'); // WPRestAPI.json - the file containing TSQLRecord that stores Wordpress server, consumer key, secret consumer key etc. 
    fWP.Connect;

    fWPClient := TSQLWPClient(fWP.getWAPIClient('users', '{"search":"*eva*","orderby":"username}'));   //'users' is route of WP REST API and '{"search":...'  is filter
 
    fWPUser := TSQLRESTAPIUser.CreateAndFillPrepare(fWPClient,'',[]);
end;

the updating like this:

procedure UpdateWPUser;
begin
  if assigned( fWPUser) then
  begin
    fWPUser.FillRewind;
    while fWPUser.FillOne do
    begin
      if fWPUser.username=EditWPUsername.text then
      begin
        fWPUser.description := EditWPdescription.text;
        fWPClient.Update(fWPUser);
      end;
    end ;
  end;
end;

I had to only  take care of the authentication of the requests, everything else was pretty simple thanks mormot.

#32 mORMot Framework » Crypto HMAC_SHA256 procedure » 2015-12-22 09:33:03

EvaF
Replies: 1

Hi,
I am not expert for Crypto, but imho in HMAC_SHA256 procedure  is a small inaccuracy, that causes the problems for key longer than 64 chars.

I think, that it should be:

procedure HMAC_SHA256(key,msg: pointer; keylen,msglen: integer; out result: TSHA256Digest);
var i: integer;
    sha: TSHA256;
    k0,k0xorIpad,step7data: array[0..15] of cardinal;
begin
  FillcharFast(k0,sizeof(k0),0);
  if keylen>64 then
    sha.Full(key,keylen,PSHA256Digest(@k0)^) else        // < --- originally   sha.Full(key,64,PSHA256Digest(@k0)^) else
    MoveFast(key^,k0,keylen);
  for i := 0 to 15 do
    k0xorIpad[i] := k0[i] xor $36363636;
   ...

#34 Re: mORMot Framework » CallBackGet function and GET parameters » 2015-12-21 20:11:53

only small question - I cannot find  GetMimeContentTypeFromBuffer function
I suppose that it looks something like that:

function GetMimeContentTypeFromBuffer(Content: Pointer; Len: integer;
  const ContentType: RawUTF8 =''): RawUTF8;
begin
  Result := GetMimeContentType(Content, Len);
  if (Result = '') or (Result = 'application/octet-stream') then
    Result := ContentType;
end;

#35 Re: mORMot Framework » CallBackGet function and GET parameters » 2015-12-21 19:15:35

Using StrPosI() may be unsafe, since the text may appear as part of a header value, not as a header entry name...

You are right, I will use it your way, thx
ef

#36 Re: mORMot Framework » CallBackGet function and GET parameters » 2015-12-21 15:16:26

hi ab,

thanks for modification - the last wish (hope) is replacing IdemPChar function by some Pos function ( f.e. StrPosI function)
for the case:

lHead := 'Cookie: a=1111111111' +#13#10 +
            'Content-Type: application/x-www-form-urlencoded;charset=UTF-8';

can look something like this:

  if InternalCheckOpen then begin
    if Head<>'' then begin
      P := pointer(Head);
      P := StrPosI('CONTENT-TYPE:',P);
      if assigned(P) then begin
        PBegin := P;
        inc(P,14);
        lContentypeInHead := GetNextLine(P,PEnd);
        if not assigned(pEnd) then          // Content-type parameter is the last
        begin
          pEnd := Pointer(Head);
          Inc(pEnd, length(Head));
        end;
        system.delete(Head, PBegin - pointer(Head) + 1, pEnd-pBegin );
       ...

thanks again

ef

#37 Re: mORMot Framework » CallBackGet function and GET parameters » 2015-12-21 09:27:38

o, sorry, thanks for the info...
But I ran into another problem ( this time I have checked (to be the sure) in the latest unstable version too)
The problem is still related to the TSQLHttpClient. I  would like to set both the Content-Type  and also Cookies in the request.

something like

lHead := 'Content-Type: application/x-www-form-urlencoded;charset=UTF-8'+#13#10 +
              'Cookie: a=1111111111' ;

But InternalURI works like this: if Header contains any Content-type then all other settings in Header are neglected
( // header is processed -> no need to send Content-Type twice )

procedure TSQLHttpClientGeneric.InternalURI(var Call: TSQLRestURIParams);
var Head, Content, ContentType: RawUTF8;
    P: PUTF8Char;
begin
  ..
  Head := Call.InHead;
  Content := Call.InBody;
  if InternalCheckOpen then begin
    if Head<>'' then begin
      P := pointer(Head);
      if IdemPChar(P,'CONTENT-TYPE:') then begin
        inc(P,14);
        if Content<>'' then begin
          ContentType := GetMimeContentType(pointer(Content),Length(Content));
          if ContentType='application/octet-stream' then
            ContentType := '';
        end;
        if ContentType='' then
          ContentType := GetNextLine(P,PEnd);
        Head := ''; // header is processed -> no need to send Content-Type twice
      end;
    end;

IMHO it would cause trouble also in the case when TSQLHttpClient has set both Content-Type and fSessionHttpHeader

It is possible to preserve other settings in Header?
at least something like this: ( I maybe wrong )

procedure TSQLHttpClientGeneric.InternalURI(var Call: TSQLRestURIParams);
var Head, Content, ContentType, lContentypeInHead: RawUTF8;
    P,PBegin, pEnd: PUTF8Char;
begin
  ...
  Head := Call.InHead;
  Content := Call.InBody;
  if InternalCheckOpen then begin
    if Head<>'' then begin
      P := pointer(Head);
      if IdemPChar(P,'CONTENT-TYPE:') then begin
        PBegin := P;                                                  // <--- added
        inc(P,14);
        lContentypeInHead := GetNextLine(P,PEnd);                     // <--- added
        if Content<>'' then begin
          ContentType := GetMimeContentType(pointer(Content),Length(Content));
          if ContentType='application/octet-stream' then
            ContentType := '';
        end;
        if ContentType='' then
          ContentType := lContentypeInHead;                            // <--- changed
        system.delete(Head, PBegin - pointer(Head) + 1, pEnd-pBegin ); // <--- added
      end;
    end;
    ...
end;

P.S. I have just checked the IdemPChar function  - "Content-Type" should be the first parameter in the request-header because of using this IdemPChar  function

#38 mORMot Framework » CallBackGet function and GET parameters » 2015-12-18 09:49:52

EvaF
Replies: 9

Hi,
thanks for a great framework....

I am working on a REST communication with Wordpress ( via Wordpress plugin WP REST API with Oauth 1.0a authenification)
I would like to use the TSQLHttpClient class and CallBackGet function  but I ran into troubles with limited GET parameters names - only ['a'..'z','A'..'Z'] charset is allowed  in parameter names in mormot. However Oauth 1.0 requires parameters with underscores (f.e. oauth_signature,..).
Is it possible to add underscore into the allowed characters for parameter names?


here is the modification that could accomplish it... As you can see 1 line is changed.

function TSQLRestClientURI.CallBackGet(const aMethodName: RawUTF8;
  const aNameValueParameters: array of const; out aResponse: RawUTF8;
  aTable: TSQLRecordClass; aID: TID; aResponseHead: PRawUTF8): integer;
var url, header: RawUTF8;
begin
  if self=nil then
    result := HTML_UNAVAILABLE else begin
{$ifdef WITHLOG}
    fLogClass.Enter(Self,pointer(aMethodName),true);
{$endif}
    url := Model.getURICallBack(aMethodName,aTable,aID)+
      UrlEncode(aNameValueParameters);
     ....
  end;
end;

function UrlEncode(const NameValuePairs: array of const): RawUTF8;
// (['select','*','where','ID=12','offset',23,'object',aObject]);
var A, n: PtrInt;
    name, value: RawUTF8;
  function Invalid(P: PAnsiChar): boolean;
  begin
    result := true;
    if P<>nil then begin
      repeat
        if not (P^ in ['a'..'z','_','A'..'Z']) then       //  <--- originally if not (P^ in ['a'..'z','A'..'Z']) 
          exit else
          inc(P);
      until P^=#0;
      result := false;
    end;
  end;
begin
  result := '';
  n := high(NameValuePairs);
  if n>0 then begin
    for A := 0 to n shr 1 do begin
      VarRecToUTF8(NameValuePairs[A*2],name);
      if Invalid(pointer(name)) then
        continue;
      with NameValuePairs[A*2+1] do
        if VType=vtObject then
          value := ObjectToJSON(VObject,[]) else
          VarRecToUTF8(NameValuePairs[A*2+1],value);
      result := result+'&'+name+'='+UrlEncode(value);
    end;
    result[1] := '?';
  end;
end;

Eva

#39 Re: mORMot Framework » OnHttpThreadTerminate event » 2015-01-20 19:34:57

ok, you are right - I could not forsee all ramifications - therefore I used the more cumbersome variant..
I had another two little silly requests:
1) to expand the set  (SysCommon.pas)

 
 IsWord: set of byte =
    [ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),ord('{'),ord('}'),ord('-'),ord('_')];

  // instead of current set  

 IsWord: set of byte =
    [ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];

I often use TSynSQLTableDataSet and I need to fast locate the key - mostly of type Guid

2) while searching for a solution to the Onterminate problem, I stumbled on a small potential problem with EnterCriticalSection  ( the leaveCriticalSection is not executed if CurrentThreadConnection exists )

function TSQLDBConnectionPropertiesThreadSafe.ThreadSafeConnection: TSQLDBConnection;
var i: integer;
begin
  case fThreadingMode of
  tmThreadPool: begin
    EnterCriticalSection(fConnectionCS);
    try
      i := CurrentThreadConnectionIndex;
      if i>=0 then begin
        result := fConnectionPool.List[i];
        if result.IsOutdated then
          fConnectionPool.Delete(i) else // release outdated connection
          exit;                                  // <---------- here
      end;
      result := NewConnection;
      (result as TSQLDBConnectionThreadSafe).fThreadID := GetCurrentThreadId;
      fLatestConnectionRetrievedInPool := fConnectionPool.Add(result)
    finally
      LeaveCriticalSection(fConnectionCS);
     end;
  end;
  tmMainConnection:
    result := inherited GetMainConnection;
  else
    result := nil;
  end;
end;

Eva

#40 mORMot Framework » OnHttpThreadTerminate event » 2015-01-19 09:41:40

EvaF
Replies: 4

Hi,
first of all thank you  for a great framework.

While troubleshooting memory leaks in my webservices I  ran into a problem with releasing memory allocated for OleDBConnections.

I use  TInterfacedObject class, in sicPerSession mode.

here is the scenario:
I implement  my own OnHttpThreadTerminate  and the original OnHttpThreadTerminate is stored in fOnHttpThreadTerminate variable

here is the relevant excerpt:

  procedure TJSONServer.MyHttpThreadTerminate(Sender:TThread);
  begin
    fPropsMSSql.EndCurrentThread;
    fOnHttpThreadTerminate(Sender);
  end;
...
...
     fHTTPServer := TSQLHttpServer.Create(
                            aPORTNAME,                   
                            [fServerDB],                
                            aHostName,   
                            useHttpApiRegisteringURI,   
                            32,                         
                            secSSL);                 
      fOnHttpThreadTerminate :=fHTTPServer.HTTPSErver.OnHttpThreadTerminate;
      fHTTPServer.HTTPSErver.OnHttpThreadTerminate := MyHttpThreadTerminate;

I wondered why my MyHttpThreadTerminate wasn't called at all.. I have found out that it is caused by clones of THttpApiServer, that still point to the original onTerminated event procedure.
I have modified your code in SynCrtSock.pas like this:

  THttpServerGeneric = class(TNotifiedThread)
  protected
      ...
       procedure setOnTerminate(pValue: TNotifyThreadEvent);
  public
      ...
    property OnHttpThreadTerminate: TNotifyThreadEvent read fOnTerminate write setOnTerminate;
  end;
 ....
 ...
procedure THttpServerGeneric.setOnTerminate(pValue: TNotifyThreadEvent);
var i : integer;
begin
  fOnTerminate := pValue;
  if (self is THttpApiServer) and assigned ((self as THttpApiServer).Clones) and
    not assigned((self as THttpApiServer).fowner ) then
  begin
    for i := 0 to (self as THttpApiServer).Clones.count - 1 do
    begin
      THttpServerGeneric( (self as THttpApiServer).Clones[i]).OnHttpThreadTerminate := pValue;
    end;
  end;
end;

after this modification the  "MyHttpThreadTerminate" is now allways invoked

Eva

Board footer

Powered by FluxBB