unit uHTTPCommandGet_TPS_HTTPFileServerAddon;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,
  IdHTTPServer, Vcl.StdCtrls,System.json,System.NetEncoding,System.IOUtils, System.Types,

  HTTPApp,IdMultipartFormData, IdContext,

  //myUnits
  uDivideAndGatherFile_TPS_HTTPFileServerAddon,
  uCreateUniqueName_TPS_HTTPFileServerAddon,
  uDecodePostRequest_TPS_HTTPFileServerAddon,

  IdServerIOHandler, IdSSL, IdSSLOpenSSL,
  IdSSLOpenSSLHeaders, IdTCPConnection, IdTCPClient, IdHTTP

;

type
  THTTPCommandGet_TPS_HTTPFileServerAddon = class(TDataModule)
  private
    procedure DecodeParam(var Aparam: string);
    function IsAuthorizationOk(PostParams: TStringList): boolean;




    { Private declarations }
  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;


    procedure CreateDirOnServer(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
    AResponseInfo: TIdHTTPResponseInfo);

    procedure DeleteDirOnServer(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
    AResponseInfo: TIdHTTPResponseInfo);

    procedure ReceiveOneWholeFile(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
    AResponseInfo: TIdHTTPResponseInfo);

    procedure CheckChunksIntegrity(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
    AResponseInfo: TIdHTTPResponseInfo);

    procedure JustGatherFileFromChunks(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);

    procedure ReceiveChunksInfoFile(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo; var ChunksInfoString: string);

  end;


implementation

{%CLASSGROUP 'System.Classes.TPersistent'}

{$R *.dfm}

{ THTTPCommandGet_TPS_HTTPFileServerAddon }

uses uMain_TPS_HTTPFileServerAddon;
var PS_HTTPFileServerAddon_UnitVar:TPS_HTTPFileServerAddon;


constructor THTTPCommandGet_TPS_HTTPFileServerAddon.Create(AOwner: TComponent);
begin
  inherited;

//
  if (AOwner is TPS_HTTPFileServerAddon) then
  PS_HTTPFileServerAddon_UnitVar:=(AOwner as TPS_HTTPFileServerAddon);


end;

procedure THTTPCommandGet_TPS_HTTPFileServerAddon.CreateDirOnServer(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

  var PostParams:TStringList;
      DecodePostRequest: TDecodePostRequest;
      AbsoluteDir:string;

      ErrorMessage: string;
      RelativeDir: string;
      CuttedRelativeDir:string;
      SplittedString: TArray<String>;
      SDAResult:TStringDynArray;
      AbsRootDir:string;
      ParentPath: string;

begin

//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);


   try

   //Main work
   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);

   if IsAuthorizationOk(PostParams) then begin


    // Preparing dir to Create

     RelativeDir:=PostParams.Values['DirectoryToCreate'];
     DecodeParam(RelativeDir);
     AbsoluteDir:=ExtractFileDir(Application.ExeName)+'\'+RelativeDir;



     SplittedString:=RelativeDir.Split(['\']);
     CuttedRelativeDir:=SplittedString[0];

     AbsRootDir:=ExtractFileDir(Application.ExeName)+'\'+CuttedRelativeDir;

      if Length(AbsoluteDir)>MAX_PATH then // 255 or 260

      begin


         ErrorMessage:='dir '+AbsoluteDir+' too long - try shorten it';

         AResponseInfo.ContentText:=ErrorMessage;

         AResponseInfo.WriteContent;

         raise Exception.Create(ErrorMessage);



      end;








          try

             ParentPath:=
             TDirectory.GetParent(ExcludeTrailingPathDelimiter(AbsoluteDir));

               //Creating dir
             if not TDirectory.Exists(AbsoluteDir) then

               begin // checking if Direcory Writable

//                if IsDirectoryWriteable(ParentPath) then
                TDirectory.CreateDirectory(AbsoluteDir)

//                else

//                 raise Exception.Create('Directory not writable');

               end;


             //Writing to DataBase Relative dir

             // Example of dir that we give to following funciton
//C:\DELPHI\MyStudyProjects\373_PS_HTTPClient_Dev\HTTPServer\Win32\Debug\public
           //  FDataBaseUnitServer.WriteDirToDataBase(RelativeDir);
{
           FDataBaseUnitServer.SynchronizeDirWithDataBase(
           AbsRootDir,
           SDAResult,
           -1
           );
}
        except

            on E:Exception do begin

            AResponseInfo.ContentText:='Server Error '+'Class='+E.ClassName+
            ' / Message='+E.Message;//   'testing ok';
            AResponseInfo.WriteContent;

            raise Exception.Create('Server Error '+'Class='+E.ClassName+
            ' / Message='+E.Message);

            end;


        //AResponseInfo.ContentText:='testing ok2';
        //AResponseInfo.WriteContent; // this will not show testing ok2!

        end;



        AResponseInfo.ContentText:='ok';
        AResponseInfo.WriteContent;


   end;


   finally


   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);

   end;





end;


procedure THTTPCommandGet_TPS_HTTPFileServerAddon.DecodeParam(var Aparam: string);
begin
Aparam:=TNetEncoding.URL.Decode(Aparam);
end;

function THTTPCommandGet_TPS_HTTPFileServerAddon.IsAuthorizationOk(PostParams:TStringList):boolean;
begin

Result:=false;

   if (PostParams.Values['Login']='SomeLogin')
   and (PostParams.Values['Password']='SomePassword') then

Result:=true else

 raise Exception.Create('Authorization not Ok');

end;


procedure THTTPCommandGet_TPS_HTTPFileServerAddon.DeleteDirOnServer(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
{DeleteDirOnServer}

  var PostParams:TStringList;
      DecodePostRequest:TDecodePostRequest;
      AbsoluteDir:string;
      RelativeDir:string;

begin

//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);

   try

   //Main work
   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);

   if IsAuthorizationOk(PostParams) then begin


    // Preparing dir to Create
     RelativeDir:=PostParams.Values['DirectoryToDelete'];
     DecodeParam(RelativeDir);
     AbsoluteDir:=ExtractFileDir(Application.ExeName)+'\'+RelativeDir;

//     try


         try
         if TDirectory.Exists(AbsoluteDir) then TDirectory.Delete(AbsoluteDir,true);
         except

         on E:Exception do
            begin

              raise Exception.Create(' Exception Raised = '+'Class='+E.ClassName
                    +#13#1+#13#10+'  Message='+E.Message);


                       AResponseInfo.ContentText := E.Message;
                       AResponseInfo.WriteContent;
            end;


         end;


         AResponseInfo.ContentText:='ok';
         AResponseInfo.WriteContent;


   end;


   finally


   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);

   end;





end;


procedure THTTPCommandGet_TPS_HTTPFileServerAddon.ReceiveOneWholeFile(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);

  var PostParams:TStringList;
      DecodePostRequest: TDecodePostRequest;
      RelativeDir:string;


      AppPath:string;
      logFilePath: string;
      FileNameOnServer:string;
      UniqueFileNameOnServer:string;

  NamesInDirSDA: TStringDynArray;
  NamesInDirSL: TStringList;
  i: Integer;
  Outputfilepath:string;
  difference:Integer;
  StringWithoutExtension:String;
  Extension:String;
  ReldirOnServer: String;
  idUserString: string;
  AbsDirs: TStringList;
  RelDirs: TStringList;
  idParentForFile:integer;
  RelFilePath: String;
  FileNameToInsert: String;
  AbsPath: String;

  fileSize:Int64;

begin



//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);
AppPath:=ExtractFilePath(Application.ExeName);

      AbsDirs:=TStringList.Create;
      RelDirs:=TStringList.Create;



   try

   //Main work

   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);

   RelativeDir:=PostParams.Values['dirOnServer']; // dir appears from params
   DecodeParam(RelativeDir);

   FileNameOnServer:=(PostParams.Values['fileNameOnServer']);
   DecodeParam(FileNameOnServer);

   idUserString:=TNetEncoding.URL.Decode(PostParams.Values['idUsersString']);


   //CreateUniqueFileName if needed
    NamesInDirSDA:=TDirectory.GetFiles(AppPath+RelativeDir);
    NamesInDirSL:=TStringList.Create;

    for i := 0 to High(NamesInDirSDA) do
    NamesInDirSL.Add(
    ExtractFileName(NamesInDirSDA[i])
    );

    UniqueFileNameOnServer:=
    TCreateUniqueNameServer.CreateUniqueNameAddingNumber(NamesInDirSL,FileNameOnServer);

    Outputfilepath:=AppPath+RelativeDir+'/'+UniqueFileNameOnServer;


          // check length of the string
          if Outputfilepath.Length>255 then
          begin

          //try to shorten
          difference:=Outputfilepath.Length-255+5; // for example 20 symbols


              if (difference>0) and (UniqueFileNameOnServer.Length>Difference) then begin

              StringWithoutExtension:=TCreateUniqueNameServer.GetStringWithoutExtension(UniqueFileNameOnServer,Extension);

              StringWithoutExtension:=StringWithoutExtension.Substring(0,StringWithoutExtension.Length-difference);

              UniqueFileNameOnServer:=
                  TCreateUniqueNameServer.CreateUniqueNameAddingNumber(NamesInDirSL,StringWithoutExtension+'.'+Extension);

              //Outputfilepath:=AppServerPath+AOutputDir+'\'+UniqueFileNameOnServer;

              end;

          end;



       try


           if IsAuthorizationOk(PostParams) then
           begin

               if FileNameOnServer<>'' then

                 // setting some unique name created here, on Server
                 DecodePostRequest.
                 ReceiveFile(AContext,ARequestInfo,AResponseInfo,RelativeDir,UniqueFileNameOnServer)

               else
                 // using name from client
                 DecodePostRequest.ReceiveFile(AContext,ARequestInfo,AResponseInfo,RelativeDir);


             AResponseInfo.ContentText := 'ok';
             AResponseInfo.WriteContent;

           end;



       except

       on E:Exception do

       begin
       AResponseInfo.ContentText := 'Error during receiving file without log '+E.Message;
       AResponseInfo.WriteContent;
       raise Exception.Create('Error during receiving file without log');
       end;




   end;



   finally


   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);
   FreeAndNil(NamesInDirSL);

   FreeAndNil(AbsDirs);
   FreeAndNil(RelDirs);

   end;


end;




procedure THTTPCommandGet_TPS_HTTPFileServerAddon.CheckChunksIntegrity(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);

  var PostParams:TStringList;
      DecodePostRequest: TDecodePostRequest;


      RelativeDirOnServer: string;
      OutPutDir: string;
      OutPutFileName: string;
  AppPath: string;
  ChunksInfoFileName: string;
  JSONObject:TJSONObject;
  JsonString: string;
  i: Integer;

  ChunksToBeUploaded:TStringList;

begin

//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);
ChunksToBeUploaded:=TStringList.Create;


   try

   //Main work
   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);


   if IsAuthorizationOk(PostParams) then
    begin

     RelativeDirOnServer:=PostParams.Values['dirOnServer'];
     DecodeParam(RelativeDirOnServer);

     ChunksInfoFileName:=PostParams.Values['ChunksInfoFileName'];
     DecodeParam(RelativeDirOnServer);

     //-----------1 working with ChunksInfo.txt

     AppPath:=ExtractFilePath(Application.ExeName);

     if TFile.Exists(AppPath+RelativeDirOnServer+ChunksInfoFileName) then
      begin

        JsonString:=TFile.ReadAllText(AppPath+RelativeDirOnServer+ChunksInfoFileName);

        // Reading json file here

      //  JSONObject:=TJSONObject.Create;
        JSONObject:=TJSONObject.ParseJSONValue(JsonString) as TJSONObject;

        for i := 0 to JSONObject.Count-1  do begin

          if JSONObject.Pairs[i].JsonString.Value.Contains('{chunk=') then
          ChunksToBeUploaded.Add(JSONObject.Pairs[i].JsonString.Value);


        end;

        FreeAndNil(JSONObject);

        //Checking if all files uploaded in that dir



        for i := 0 to ChunksToBeUploaded.Count-1 do
          begin

          if not TFile.Exists(AppPath+RelativeDirOnServer+ChunksToBeUploaded[i]) then

           begin

           AResponseInfo.ContentText:='not ok. File '+AppPath+RelativeDirOnServer+ChunksToBeUploaded[i]+' not on Server';
           AResponseInfo.WriteContent;

           raise Exception.Create('Error Message');


           end;

          end;


        AResponseInfo.ContentText:='ok'; // on every check we think that all ok
        AResponseInfo.WriteContent;


      end else

      AResponseInfo.ContentText:='not ok. File '+AppPath+RelativeDirOnServer+ChunksInfoFileName+' not on Server';
      AResponseInfo.WriteContent;

     end;


   finally


   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);
   FreeAndNil(ChunksToBeUploaded);
   end;


end;



procedure THTTPCommandGet_TPS_HTTPFileServerAddon.JustGatherFileFromChunks(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);

  var PostParams:TStringList;
      DecodePostRequest: TDecodePostRequest;
      dir:string;
      DivideAndGatherFileServer:TDivideAndGatherFileServer;


      ChunksDir: string;
      OutPutDir: string;
      OutPutFileName: string;
      ResponseInfo:string;
      idUserString:string;
      FS:TFileStream;

      AppPath:string;
      RelFilePath: string;


begin

//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);
DivideAndGatherFileServer:=TDivideAndGatherFileServer.Create(Self);


AppPath:=ExtractFilePath(Application.ExeName);



   try

   //Main work
   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);


   if IsAuthorizationOk(PostParams) then
    begin


       ChunksDir:=PostParams.Values['AChunksDir'];
       DecodeParam(ChunksDir);

       OutPutDir:=PostParams.Values['AOutPutDir'];
       DecodeParam(OutPutDir);

       OutPutFileName:=PostParams.Values['AOutPutFileName'];
       DecodeParam(OutPutFileName);

       idUserString:=PostParams.Values['AidUserString'];

       DivideAndGatherFileServer.GatherFileFromChunks(ChunksDir,OutPutDir,OutPutFileName);


       AResponseInfo.ContentText:='ok';
       AResponseInfo.WriteContent;

     end;


   finally


   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);
   FreeAndNil(DivideAndGatherFileServer);

   end;


end;



procedure THTTPCommandGet_TPS_HTTPFileServerAddon.ReceiveChunksInfoFile(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo; var ChunksInfoString:string);

  var PostParams:TStringList;
      DecodePostRequest: TDecodePostRequest;
      dirOnServer: string;
      AppPath:string;

begin

//Create
PostParams:=TStringList.Create;
DecodePostRequest:=TDecodePostRequest.Create(PS_HTTPFileServerAddon_UnitVar);


AppPath:=ExtractFilePath(Application.ExeName);


   try

   //Main work
   PostParams.Clear;
   DecodePostRequest.DecodePostParamsAnsi(AContext,ARequestInfo,AResponseInfo,PostParams);


   if IsAuthorizationOk(PostParams) then

     begin

     dirOnServer:=PostParams.Values['AchunksDirOnServer'];

     //Creating dir
     if not TDirectory.Exists(AppPath+dirOnServer) then
     TDirectory.CreateDirectory(AppPath+dirOnServer);
     // Receiving file
     DecodePostRequest.ReceiveFile(AContext,ARequestInfo,AResponseInfo,dirOnServer); // Error Handling Ok
     // Confirming
     AResponseInfo.ContentText := 'ok';
     AResponseInfo.WriteContent;

     end;

   finally

   //Free
   FreeAndNil(DecodePostRequest);
   FreeAndNil(PostParams);

   end;

end;



end.
