mORMot Open Source

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

UseOutlines := false;

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;

/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

 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;

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;

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;

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;

  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;

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;

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

 BI.pwszDataSourceType := 'DBTYPE_WVARCHAR';  

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

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;

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;