mORMot Open Source

  SetLength(len, tbl_patients.FieldCount - 1);
  for i := 0 to tbl_patients.FieldCount - 1 do len[i] := tbl_patients.FieldLengthMean(i);
  len[colAproove] := 0;
  len[colDecline] := 0;
  tbl_patients.SetFieldLengthMean(len);
  with TSQLTableToGrid.Create(dgList, tbl_Patients, ClientRest) do begin
    ShowHint := False;
    OnValueText := OnValueTextTablePatients;
    OnDrawCellBackground := OnDrawCellBackgroundPatients;
    Resize(nil);
...
   end;

procedure TSQLTable.SetFieldLengthMean(const Lengths: array of cardinal);
...
procedure TSQLTableToGrid.SetFieldLengthMean(const Lengths: RawUTF8; aMarkAllowed: boolean);
...

  with TSQLTableToGrid.Create(dgList, tbl_Patients, ClientRest) do begin
    ShowHint := False;
    OnValueText := OnValueTextTablePatients;
    OnDrawCellBackground := OnDrawCellBackgroundPatients;
    Resize(nil);
    ...
  end;

   ...'where ' + FormatUTF8('r.mo = ? AND r.Created BETWEEN ? AND ?', [], [mo_id, TimeLogFromDateTime(db), TimeLogFromDateTime(de)]);

' AND (r.Created BETWEEN ? AND ?)');
  t := ClientRest.ExecuteFmt(s,[],[TimeLogFromDateTime(db),TimeLogFromDateTime(de)]);

procedure TSQLTableToGrid.DrawGridMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
...
  if ARow=0 then
  if (ssCtrl in Shift) or (Button<>mbLeft) then begin
    // Ctrl or right button pressed -> display first row as hint
    ShowHintString(U2S(Table.Get(ARow,ACol)),ACol,ARow,4000);

  SQLTableToGrid.OnHintText := OnListText;


procedure TSQLTableToGrid.DrawGridMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
...
  if ARow=0 then
  if (ssCtrl in Shift) or (Button<>mbLeft) then begin
    // Ctrl or right button pressed -> display first row as hint
    if Assigned(OnHintText) and OnHintText(Table,ACol,ARow,Hint) then
      ShowHintString(Hint,ACol,ARow,4000)
    else
      ShowHintString(U2S(Table.Get(ARow,ACol)),ACol,ARow,4000);

/// minimal REST client for a list of Persons from RESTserver.exe
program RESTclient;

{$APPTYPE CONSOLE}

uses
  SynCommons,          // framework core
  mORMot,              // RESTful server & ORM
  mORMotHttpClient,    // HTTP client to a mORMot RESTful server
  SynGdiPlus,
  RESTData;           // data model unit, shared between server and client

var aModel: TSQLModel;
    aClient: TSQLHttpClient;
    aRootURI, response: RawUTF8;
    jpg: TJPEGImage;
    jpgRaw: RawByteString;
begin
  Gdip := TGDIPlusFull.Create;

  aModel := DataModel(aRootURI);
  try
    aClient := TSQLHttpClientWinHTTP.Create('localhost','888',aModel);
    jpg := TJPEGImage.Create;
    jpg.LoadFromFile('d:\scans\1.jpg');
    SaveAsRawByteString(jpg, jpgRaw, gptJPG);
    aClient.CallBackGet('root/notefile/blob', [], response, TSQLNoteFile);
    write(response);
    aClient.CallBackPut('root/notefile/blob', jpgRaw, response, TSQLNoteFile);
    write(response);
    write(#10'Press [Enter] to quit');
    readln;
  finally
    aModel.Free;
  end;

  Gdip.Free;
end.

procedure Fill_combobox_data(r: TSQLRecord; s: TStrings; field: string);
begin
  s.Clear;
  r.CreateAndFillPrepare(Database, '');
  try
    while r.FillOne do s.Add(r.RecordProps.Fields.ByRawUTF8Name(field).GetValue(r, False));
  finally
    r.Free;
  end;
end;

procedure Fill_distinct_combobox_data(r: TSQLRecord; s: TStrings; field: string);
var
 t: TSQLTable;
begin
  s.Clear;
  t := Database.List([r.RecordClass], 'distinct trim(' + field + ') as ' + field, '');
  if t = nil then Exit;
  t.OwnerMustFree := False;
  r.FillPrepare(t);
  try
    while r.FillOne do s.Add(r.RecordProps.Fields.ByRawUTF8Name(field).GetValue(r, False));
  finally
    r.Free;
    t.Free;
  end;
end;

ShowMessage(HttpGet('koscrb.dzo-kostroma.ru', '80', 'index.php?page_id=1'));
ShowMessage(TWinHTTP.Get('koscrb.dzo-kostroma.ru/index.php?page_id=1'));
ShowMessage(TWinINet.Get('koscrb.dzo-kostroma.ru/index.php?page_id=1'));

  With HttpCli1 do begin
    URL            := 'http://koscrb.dzo-kostroma.ru/index.php?page_id=1';
    Proxy          := '10.44.1.163';
    ProxyPort      := '3128';
    RequestVer     := '1.1';
    RcvdStream := TMemoryStream.Create;
    try
        Get;
    except
      RcvdStream.Free;
      Exit;
    end;
    RcvdStream.Seek(0,0);
    Memo1.Lines.LoadFromStream(RcvdStream);
    RcvdStream.Free;
  end;

function HttpGet(const server, port: AnsiString; const url: RawByteString): RawByteString;
var Http: THttpClientSocket;
begin
  result := '';
  Http := OpenHttp(server,port); <--- next see OpenHttp declaration
  if Http<>nil then
  try
    if Http.Get(url)=200 then
      result := Http.Content;
  finally
    Http.Free;
  end;
end;

function OpenHttp(const aServer, aPort: AnsiString): THttpClientSocket;
begin
  try
    result := THttpClientSocket.Open(aServer,aPort); <--- next see Open declaration
  except
    on ECrtSocket do
      result := nil;
  end;
end;
function Open(const aServer, aPort: AnsiString): TCrtSocket;
begin
  try
    result := TCrtSocket.Open(aServer,aPort);
  except
    on ECrtSocket do
      result := nil;
  end;
end;

constructor Open(const aServer, aPort: AnsiString; aLayer: TCrtSocketLayer=cslTCP; aTimeOut: cardinal=5000); <--- bingo find aTimeOut parameters and set 15000 and work fine.

  TSQLProduct = class(TSQLRecord)
  private
    fCategory: Integer;
    fPath, fName, fWeight: string;
    fPicture: TByteDynArray;
  published
    property category: Integer read fCategory write fCategory;
    property path:       string read fPath       write fPath;
    property name:    string read fArtikul    write fArtikul;
    property weight:     string read fWeight     write fWeight;
    property picture: TByteDynArray read fPicture write fPicture;
  end;

...

  if Database.TransactionBegin(TSQLProduct) then
  try
    Database.BatchStart(TSQLProduct);

    cat_id := 1;
    d := SetPathSep([TDirectory.GetCurrentDirectory, 'zl', 'valuables']);
    for directory in TDirectory.GetDirectories(d, TSearchOption.soTopDirectoryOnly, nil) do begin
      for f in TDirectory.GetFiles(Directory) do begin
        prd := TSQLProduct.Create;
        try
          with prd do begin
            category := cat_id;
            path := ExtractRelativePath(d, f);
            GetInfoFromFileName;
            name := sl[0];
            weight  := sl[1];
            ms := TMemoryStream.Create;
            try
              ms.LoadFromFile(f);
              SetLength(picBin, ms.Size);
              Move(ms.Memory^, picBin[0], ms.Size);
            finally
              ms.Free;
            end;
            picture := picBin;

            Database.BatchAdd(prd, True);
          end;
        finally
          FreeAndNil(prd);
        end;
      end;
      Inc(cat_id);
    end;
    Database.BatchSend(ids);
    Database.Commit;
  except
    Database.RollBack;
  end;

  if Database.TransactionBegin(TSQLProduct) then
  try
    Database.BatchStart(TSQLProduct);

    prd := TSQLProduct.Create;
    try
      prdtable := Database.ExecuteList([TSQLProduct], 'select * from product');
      prd.FillPrepare(prdtable);
      while prd.FillOne do
        with prd do begin
          pic := '';
          g := TPicture.Create;
          g.LoadFromFile(prd.pathtofile);
          SaveAsRawByteString(g, pic, gptJPG);
          picture := pic;
          Database.BatchUpdate(prd);
        end;
      finally
        FreeAndNil(prd);
      end;

    Database.BatchSend(ids);
    Database.Commit;
  except
    Database.RollBack;
  end;