mORMot Open Source

  TSQLMyUser = class;

  TSQLMyRole = class(TSQLRecord)
  end;

  TSQLMyUserRole = class(TSQLRecordMany)
  private
    fSource: TSQLMyUser;
    fDest: TSQLMyRole;
  published
    property Source: TSQLMyUser read fSource; // map Source column
    property Dest: TSQLMyRole read fDest; // map Dest column
  end;

  TSQLMyUser = class(TSQLRecord)
  private
    FRoles: TSQLMyUserRole;
  published
    property Roles: TSQLMyUserRole read FRoles;
  end;

  ITest = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
    function GetUser(out aUser: TSQLMyUser): boolean;
  end;

  TSQLSKU = class(TSQLRecord)
  private
    FTitleLocal: RawUTF8;
  published
    property TitleLocal: RawUTF8 index 100 read FTitleLocal write FTitleLocal;
  end;

      aSKU := TSQLSKU.CreateAndFillPrepare(Server, 'TitleLocal is null OR TitleLocal = ''''');

      aSKU := TSQLSKU.CreateAndFillPrepare(Server, '(TitleLocal is null) OR (TitleLocal = '''')');

procedure TRecordEditForm.SetRecord
....
      if ((P.SQLFieldType in [ // must match "case SQLFieldType of" below
        // -- sftTID 
          sftRecord, {sftTID, }sftBlob, sftBlobDynArray, sftBlobCustom, sftUTF8Custom,
        //
....
          // ++ sftTID
          sftTID:
          if aClient<>nil then begin
            // ID field (TSQLRecord descendant) is handled by a TComboBox component
            // with all possible values of the corresponding TSQLRecord descendant
            IDClass := TSQLRecordClass((P as TSQLPropInfoRTTITID).RecordClass);
            CB := TComboBox.Create(Scroll);
            CB.Parent := Scroll; // need parent now for CB.Items access
            CB.Style := csDropDownList;
            aID := GetInt64(pointer(aValue));
            with IDClass.RecordProps do
            if MainField[true]>=0 then begin
              aClient.OneFieldValues(IDClass,Fields.List[MainField[true]].Name,
                '',CB.Items,@aID);
              CB.ItemIndex := aID; // @aID now contains the found index of aID
            end;
          end;
          //


procedure TRecordEditForm.BtnSaveClick(Sender: TObject);
....
    if C.InheritsFrom(TComboBox) then begin
      SetIndex := CB.ItemIndex;
      case P.SQLFieldType of
        sftEnumerate:
          if SetIndex>=0 then begin
            P.SetValue(Rec,pointer(Int32ToUTF8(SetIndex)),false);
            Include(ModifiedFields,FieldIndex);
          end;
        // + sftTID
        sftID, sftTID: begin
        //
          if SetIndex<0 then
            aID := 0 else
            aID := PtrInt(CB.Items.Objects[SetIndex]);
          P.SetValue(Rec,pointer(Int64ToUTF8(aID)),false);
          Include(ModifiedFields,FieldIndex);
        end;
      end;
    end else

function TWinHttpAPI.InternalRetrieveAnswer(var Header, Encoding, AcceptEncoding,
  Data: SockString): integer;
var Bytes, ContentLength, Read: DWORD;
begin // HTTP_QUERY* and WINHTTP_QUERY* do match -> common to TWinINet + TWinHTTP
    result := InternalGetInfo32(HTTP_QUERY_STATUS_CODE);
    Header := InternalGetInfo(HTTP_QUERY_RAW_HEADERS_CRLF);
    Encoding := InternalGetInfo(HTTP_QUERY_CONTENT_ENCODING);
    AcceptEncoding := InternalGetInfo(HTTP_QUERY_ACCEPT_ENCODING);
    // retrieve received content (if any)
    Read := 0;
    ContentLength := InternalGetInfo32(HTTP_QUERY_CONTENT_LENGTH);
    if ContentLength<>0 then begin
      SetLength(Data,ContentLength);
      repeat
        Bytes := InternalReadData(Data,Read);
// ////
// ---> we can notify 
       if Assigned(OnProgress) then
         OnProgress(Read+Bytes, ContentLength);
// ////
        if Bytes=0 then begin
          SetLength(Data,Read); // truncated content
          break;
        end else
          inc(Read,Bytes);
      until Read=ContentLength;
    end else begin
      // Content-Length not set: read response in blocks of HTTP_RESP_BLOCK_SIZE
      repeat
        SetLength(Data,Read+HTTP_RESP_BLOCK_SIZE);
        Bytes := InternalReadData(Data,Read);
        if Bytes=0 then
          break;
        inc(Read,Bytes);
      until false;
      SetLength(Data,Read);
    end;
end;

function TWinHTTP.InternalReadData(var Data: SockString; Read: integer): cardinal;
begin
  if not WinHttpReadData(fRequest, @PByteArray(Data)[Read], length(Data)-Read, result) then
    RaiseLastModuleError(winhttpdll,EWinHTTP);
end;

function TWinHTTP.InternalReadData(var Data: SockString; Read: integer; Count: Integer): cardinal;
begin
  if not WinHttpReadData(fRequest, @PByteArray(Data)[Read], Min(length(Data)-Read, Count), result) then
    RaiseLastModuleError(winhttpdll,EWinHTTP);
end;

    if ContentLength<>0 then begin
      SetLength(Data,ContentLength);
      repeat

// ////
       // read chunk HTTP_RESP_BLOCK_SIZE
       Bytes := InternalReadData(Data,Read,HTTP_RESP_BLOCK_SIZE);
       if Assigned(OnProgress) then
         OnProgress(Read+Bytes, ContentLength);
// ////

        if Bytes=0 then begin
          SetLength(Data,Read); // truncated content
          break;
        end else
          inc(Read,Bytes);
      until Read=ContentLength;
    end else begin

        if (LastPropName='Caption') or (LastPropName='EditLabel.Caption') or
           (LastPropName='Hint') or (LastPropName='EditLabel.Hint') or
           (LastPropName='Title') or (LastPropName='Items') then begin
          Writeln(F^,PropName,'=_',Hash32(CB_EnumStrings[AddOnceDynArray(Value)]),
            '   ',Value); // add original caption for custom form translation

  TSQLRegisterCUTE = class(TSQLRecord)
  private
    FDoc: TRecordReferenceToBeDeleted;
  published
    property Doc: TRecordReferenceToBeDeleted read FDoc write FDoc;
  end;

  aRec.Doc := aModel.RecordReference(TSQLDocPasterShiftReport, ID);
  aClient.Add(aRec, True);

function LanguageAbrToIndex(const value: RawUTF8): TLanguages;
// LanguageAbrToIndex('GR')=1
begin
  if length(value)=2 then
    result := LanguageAbrToIndex(pointer(Value)) else
    result := LANGUAGE_NONE;
end;