Jump to content

Recommended Posts

Posted

Please  include event in TUniMainModule  for  custom htnml request handling

 

 

on with done like

 

TUniguiSession = class(TIdExtSession)

 

function BeforeHandleRequest : boolean; override;

 

end;

 

function TUniguiSession.BeforeHandleRequest : boolean; override;

begin

   if Assigned (MainDataModule.FOnBeforeHanle) then

     Result := MainDataModule.FOnBeforeHanle(CurrentRequest ,CurrentResponse)

   else

     Result := inherited;

)

 

 

This threaded method will be very useful for custom file  download in dragdrop and another

 

 

  • 2 weeks later...
Posted

Because unigui developers dont wont insert custom http request hhandling i publich how  i done it around the unigui sources:

 

In file unit ExtHTTPServer; i insert uses after implementation

 

implementation

uses
{$IFDEF GUR}
   UniGUIApplication,dtHtmlMain, Dialogs, ServerModule{, uMain, ServerModule, DB},
{$ENDIF}
  {$IFDEF MSWINDOWS}Windows, Messages,{$ENDIF} StrUtils,
(* deleted
  IdGlobalProtocols,
*)
(* added *)
  uIdGlobalProtocols,
(* added *)
  ExtPascal;
 

 

and in function insert a call to datamodule function

 

 

 

procedure TIdExtSession.HandleRequest(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo);
(* added *)
{$WARNINGS OFF}
(* added *)
  function CheckIfFileIsModified(FileName: string): Boolean;
  const
    FCompareDateFmt = 'yyyymmddhhnnss';
  var
    FFileDateTime: TDateTime;
  begin
    Result := True;
    if (ARequest.RawHeaders.Values['if-Modified-Since'] <> '') then begin
      FFileDateTime := FileDateToDateTime(FileAge(FileName));
      Result := not SameText(FormatDateTime(FCompareDateFmt, FFileDateTime),
        FormatDateTime(FCompareDateFmt, StrInternetToDateTime(ARequest.RawHeaders.Values['if-Modified-Since'])));
    end;
  end;

  function TryToServeFile: boolean;
  var
    FileName: string;
    FileDateTime: TDateTime;
  begin
    FileName := ExtractFilePath(ParamStr(0));
    FileName := StringReplace(FileName, ExtractFileDrive(FileName), '', []);
    if (Length(ARequest.Document) > 1) and (ARequest.Document[1]in ['/', '\']) then
      FileName := FileName + Copy(ARequest.Document, 2, MaxInt)
    else
      FileName := FileName + ARequest.Document;
    FileName := ExpandFilename(FileName);
    if FileExists(FileName) then
    begin
      Result := True;
      if CheckIfFileIsModified(FileName) then
      begin
        AResponse.ContentStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
        AResponse.FreeContentStream := True;
        AResponse.ContentLength := AResponse.ContentStream.Size;
        FileDateTime := FileDateToDateTime(FileAge(FileName));
        AResponse.LastModified := FileDateTime;
        AResponse.ContentType  := FileType2MimeType(FileName);
      end
      else
        AResponse.ResponseNo := 304; //Not Modified, use cache version
    end
    else
    begin
(* added *)
      AResponse.ResponseNo := 404; //Not found
(* added *)
      Result := false;
    end;
  end;

  function TryToServeDiskFile(FileName: String): boolean;
  var
    FileDateTime: TDateTime;
  begin
    if FileExists(FileName) then
    begin
      Result := True;
      if CheckIfFileIsModified(FileName) then
      begin
        AResponse.ContentStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
        AResponse.FreeContentStream := True;
        AResponse.ContentLength := AResponse.ContentStream.Size;
        FileDateTime := FileDateToDateTime(FileAge(FileName));
        AResponse.LastModified := FileDateTime;
        AResponse.ContentType  := FileType2MimeType(FileName);
      end
      else
        AResponse.ResponseNo := 304; //Not Modified, use cache version
    end
    else
    begin
(* added *)
      AResponse.ResponseNo := 404; //Not found
(* added *)
      Result := false;
    end;
  end;

(* added *)
{$WARNINGS ON}
(* added *)

type
  MethodCall = procedure of object;
var
  PageMethod : TMethod;
  MethodCode : pointer;
{$IFDEF GUR}
var
  AID: variant;
  ACmd: Integer;
  AFileName: String;
  AUID: variant;
(*
  md: TMainData;
  S : TStream;
  F: TSTringStream;
  FName, DOcName, AExt, ANam, ASendName: string;
*)
{$ENDIF}
begin
(* deleted *)
//CurrentFCGIThread := Self;
(* deleted *)

(* added *)
  SetCurrentFCGIThread(Self);
(* added *)
  FCurrentRequest   := ARequest;
  FCurrentResponse  := AResponse;
//  FCurrentResponse.CacheControl:='no-cache';

(* deleted *)
{
  if ARequest.Cookies.GetCookieIndex(0, 'FCGIThread') = -1 then
    with AResponse.Cookies.Add do begin
      CookieName := 'FCGIThread';
      Value      := SessionID;
      ARequest.Cookies.AddSrcCookie(CookieText);
    end;

  AResponse.ContentType := 'text/html'; // this changes charset in D2011 see #0000531
}
(* deleted *)
  if Length(ARequest.Params.Values['cmd'])>0 then
    begin
    Response := '';
    end;

  Response := '';
  FParams.DelimitedText := FCurrentRequest.UnParsedParams;
  if BeforeHandleRequest then
    if PathInfo = '' then
      begin
{$IFDEF GUR}
      if Length(ARequest.Params.Values['$$$'])>0 then
        begin
        ACmd := StrToInt(ARequest.Params.Values['$$$']);
        case ACmd of
          0: // file
            begin
            AID := StrToFloat(ARequest.Params.Values['id']);
            AUID := StrToFloat(ARequest.Params.Values['uid']);
            if TMainData(TUNIGUISession(Self).UniMainModule).PutToTmpFileByUser(AID, AFileName, AUID) then //; if FileExists(FILE_ROOT + ARequestInfo.Document) then
              begin
              TryToServeDiskFile(AFileName); //AResponse.ServeFile(AContext, AFileName);
              end;
            end;
        end;
        end //;
      else
{$ENDIF}
        begin
        Home;
        end;
      end
    else
    begin
      if Length(ARequest.Params.Values['$$$'])>0 then ShowMessage('PathInfo <> ''');
      MethodCode := MethodAddress(PathInfo);
      if MethodCode <> nil then
      begin
        PageMethod.Code := MethodCode;
        PageMethod.Data := Self;
        try
(*
{$IFDEF GUR}
          if Length(ARequest.Params.Values['cmd'])>0 then
            begin
            ACmd := StrToInt(ARequest.Params.Values['cmd']);
            case ACmd of
              0: // file
                begin
                AID := StrToFloat(ARequest.Params.Values['id']);
                if TMainData(TUNIGUISession(Self).UniMainModule).PutToTmpFile(AID, AFileName) then //; if FileExists(FILE_ROOT + ARequestInfo.Document) then
                  begin
                  TryToServeDiskFile(AFileName); //AResponse.ServeFile(AContext, AFileName);
                  end;
                end;
            end;
            end //;
          else
{$ENDIF}
*)
          MethodCall(PageMethod); // Call published method
        except
          on E : Exception do
            OnError(E, E.Message, PathInfo, FCurrentRequest.UnParsedParams);
        end;
      end
      else
      begin
        if not TryToServeFile then
          OnNotFoundError;
      end;
    end;
  AfterHandleRequest;
  if not Assigned(AResponse.ContentStream) and (Response <> '') and (AResponse.ResponseNo <> 304) then
    FCurrentResponse.ContentText := Response;
end;
 

 

in DataModule

 

add function to handle

 

 

function TMainData.PutToTmpFileByUser(AID: variant; var AFileName: String; AUID: variant): Boolean;
var
  S : TStream;
  F: TSTringStream;
  FName, DOcName, AExt, ANam, ASendName: string;
  baseAct: Boolean;
begin
  Result := False;

  baseAct := AltaData.Connected;

  if not baseAct then
    begin
    AltaData.SpecificOptions.Clear; //if Length(_Local)>0 then Database.Properties.Add('codepage='+_Local);
    AltaData.SpecificOptions.Values['SQL Server.OLEDBProvider'] := ProvToStrEx(StrToInt(UniServerModule.AdminProtocol));
    AltaData.Server := UniServerModule.AdminHostName; //;
    AltaData.Database := UniServerModule.AdminBaseName;
    AltaData.UserName := UniServerModule.AdminUserName;
    AltaData.PASSWORD := UniServerModule.AdminPassword;
    AltaData.LoginPrompt := False;
    AltaData.Connected := True;
    end;

  with qrGetUsrDoc do
    begin
    Params[0].Value := AID;
    Params[1].Value := AUID;
    Active := True;
    try
    if Active and (not EOF) then
      begin
      DocName := FieldByName('DocName').AsString;
      AFileName := FieldByName('FileName').AsString;
      AExt := ExtractFileExt(AFileName);
      ANam := ExtractFileName(AFileName);

      if Length(DocName)>0 then
        begin
        if DocName<>ANam then
          ASendName := DocName+AExt
        else
          ASendName := DocName;
        end
      else
        begin
        ASendName := ANam;
        end;

      (*
      S := CreateBlobStream(TBlobField(FieldByName('Body')), bmRead);
      if S<>nil then try
        S.Position := 0;
        UniSession.SendStream(S, ASendName);
      finally
        S.Free;
      end;
      *)

      AFileName := GetTmpFileInDir(UniServerModule.TempFolderPath, AExt, DocName); //FName := UniServerModule.TempFolderPath + DocName + AExt; // + FormatDateTime('hhnnss', Time)
      TBlobField(FieldByName('Body')).SaveToFile(AFileName);
      Result := True;
      end;

    finally
      Active := False;
    end;
    end;

  if not baseAct then
    begin
    AltaData.Connected := False;
    end;
end;
 

 

 

But remember http server create new sessin with new datamodule where wil be new database compontent and need set bin server module  global login and password

 

I havnt unigui  sources and because i can not prcreate code to call function in current DataModule  in javascrip  you can now create requests with parameters and handle it for eamle in drag from grid to desctop in google chrome

<script>

function dragStart(evt)
{
  var curgrid = GetGrid(evt.target); if (curgrid==null) return true;
    
  evt.dataTransfer.setData("gridid", curgrid.getAttribute('id'));
 
  var egrid=Ext.getCmp(curgrid.id);
  var sm = egrid.getSelectionModel().getSelection()[0]; //
  var fName = sm.get("2").toString();
  var fID = sm.get("4").toString();
 
  files = "application/octet-stream:"+fName+":"+
  document.location+"?$$$=0&id="+fID+"&uid="+MainForm.uid.text;
  event.dataTransfer.setData("DownloadURL",files);
  return true;
}

 

 

ldropbox.addEventListener("dragstart", dragStart, false);

</script>

 

 

Exaple how drag from grid to descto i can send if needed

 

BR Nick Gurov

×
×
  • Create New...