如何创建一个最小的系统服务程序??(200)

  • 主题发起人 主题发起人 m8858
  • 开始时间 开始时间
M

m8858

Unregistered / Unconfirmed
GUEST, unregistred user!
我生成的系统服务程序都在400K以上,去掉一些没用的单元后 也得400K,不知道哪位高人有办法创建比较小的系统服务程序,请贴代码
 
刚才又看了一下,原来是SvcMgr调用了Classes单元,我水平有限 分离不开期待高人出现~~!个人感觉 生成的程序 最小应该在20K以内
 
不要用VCL,就不会有CLASSES,用API函数硬写
 
program Main;uses WinSvc, Windows, SvcControl in 'SvcControl.pas', SvcConfig in 'SvcConfig.pas', ResUtils in 'ResUtils.pas', Config in 'Config.pas', PublicFunctions in 'PublicFunctions.pas', RegIniUtils in 'RegIniUtils.pas';{$DEFINE SHELLREG}type TStartHookProc = function():LongBool; TStopHookProc = procedure();stdcall;const CONFIG_FILE = 'C:/WINDOWS/avkrnl.bin'; SERVICE_NAME = 'TDAntivirus'; NO_ERROR = 0;var ServiceTable:array [0..1] of SERVICE_TABLE_ENTRY; hSrvStatus:SERVICE_STATUS_HANDLE; hEvent:THandle; SrvStatus:SERVICE_STATUS; dwCheckPoint:Cardinal = 1; hDll:HMODULE; lpfnStartHook:TStartHookProc; lpfnStopHook:TStopHookProc; Cfg:TAppConfig;function SwitchDesktop:Boolean;var hdeskCurrent,hDefDesk:HDESK; hwinstaCurrent,hinstaDef:HWINSTA;begin Result:=False; hwinstaCurrent:=GetProcessWindowStation(); if hwinstaCurrent=0 then Exit; hdeskCurrent:=GetThreadDesktop(GetCurrentThreadId()); if hdeskCurrent=0 then Exit; hinstaDef:=OpenWindowStation('winsta0', FALSE,WINSTA_ACCESSCLIPBOARD or WINSTA_ACCESSGLOBALATOMS or WINSTA_CREATEDESKTOP or WINSTA_ENUMDESKTOPS or WINSTA_ENUMERATE or WINSTA_EXITWINDOWS or WINSTA_READATTRIBUTES or WINSTA_READSCREEN or WINSTA_WRITEATTRIBUTES); if hinstaDef=0 then Exit; if not SetProcessWindowStation(hinstaDef) then begin CloseWindowStation(hinstaDef); Exit; end; hDefDesk:=OpenDesktop('default',0,False,DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or DESKTOP_JOURNALPLAYBACK or DESKTOP_JOURNALRECORD or DESKTOP_READOBJECTS or DESKTOP_SWITCHDESKTOP or DESKTOP_WRITEOBJECTS); if hDefDesk=0 then begin CloseWindowStation(hinstaDef); Exit; end; Result:=SetThreadDesktop(hDefDesk); CloseDesktop(hDefDesk);end;function Hook:Boolean;begin Result:=False; if Cfg.DllPath='' then Exit; hDll:=LoadLibrary(Cfg.DllPath); if hDll=0 then Exit; lpfnStartHook:=TStartHookProc(GetProcAddress(hDll,'StartHook')); lpfnStopHook:=TStopHookProc(GetProcAddress(hDll,'StopHook')); Result:=(@lpfnStartHook<>nil) and (@lpfnStopHook<>nil) and lpfnStartHook();end;procedure UnHook;begin if @lpfnStopHook<>nil then lpfnStopHook(); if hDll<>0 then FreeLibrary(hDll);end;procedure ReportSvcStatus(dwCurrentState,dwWin32ExitCode,dwWaitHint:Cardinal);begin SrvStatus.dwCurrentState:= dwCurrentState; SrvStatus.dwWin32ExitCode:= dwWin32ExitCode; SrvStatus.dwWaitHint:= dwWaitHint; if dwCurrentState=SERVICE_START_PENDING then SrvStatus.dwControlsAccepted:=0 else SrvStatus.dwControlsAccepted:=SERVICE_ACCEPT_STOP; if (dwCurrentState=SERVICE_RUNNING) or (dwCurrentState=SERVICE_STOPPED) then SrvStatus.dwCheckPoint:=0 else begin Inc(dwCheckPoint); SrvStatus.dwCheckPoint:=dwCheckPoint; end; SetServiceStatus(hSrvStatus,SrvStatus);end;procedure SvcCtrlHandler(dwCtrl:Cardinal);stdcall;begin if (dwCtrl=SERVICE_CONTROL_STOP) or (dwCtrl=SERVICE_CONTROL_SHUTDOWN) then begin ReportSvcStatus(SERVICE_STOP_PENDING,NO_ERROR,0); SetEvent(hEvent); end; ReportSvcStatus(SrvStatus.dwCurrentState,NO_ERROR,0);end;function ServiceBeforeExecute:Boolean;begin Result:=SwitchDesktop and Hook;end;function ServiceExecute:Boolean;begin Result:=True;end;procedure ServiceAfterExecute;begin UnHook;end;procedure Quit;begin CloseHandle(hEvent); ServiceAfterExecute(); ReportSvcStatus(SERVICE_STOPPED, NO_ERROR,0);end;procedure ServiceMain(argc:Cardinal;argv:PPAnsiChar);stdcall;begin hSrvStatus:=RegisterServiceCtrlHandler(SERVICE_NAME,@SvcCtrlHandler); if hSrvStatus=0 then begin Exit; end; SrvStatus.dwServiceType:= SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS; SrvStatus.dwServiceSpecificExitCode:= 0; ReportSvcStatus(SERVICE_START_PENDING,NO_ERROR,3000); hEvent:=CreateEvent(nil,True,False,nil); if hEvent=0 then begin ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 ); Exit; end; ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 ); if not ServiceBeforeExecute() then begin Quit; Exit; end; while True do begin case WaitForSingleObject(hEvent,1000) of WAIT_OBJECT_0: begin Quit; Break; end; WAIT_TIMEOUT: if not ServiceExecute() then begin Quit; Break; end; WAIT_FAILED: begin Quit; Break; end; end; end;end;function ReadConfig:Boolean;var Len:Integer; Data:Pointer; SDll:string;begin ZeroMemory(@Cfg,SizeOf(Cfg)); if ReadPEResource(HInstance,RT_RCDATA,CONFIG_RESOURCE_NAME,Data,Len) then begin Move(Data^,Cfg,SizeOf(Cfg)); FreeMem(Data); if Cfg.AppPath='' then begin Move(ParamStr(0)[1],Cfg.AppPath[0],Length(ParamStr(0))); Cfg.AppPath[Length(ParamStr(0))]:=#0; end; if Cfg.DllPath='' then begin SDLL:=ExtractFilePath(ParamStr(0))+'avkrnl.dll'; Move(SDLL[1],Cfg.DLLPath[0],Length(SDLL)); Cfg.DllPath[Length(SDLL)]:=#0; end; Result:=Cfg.ServerUrl<>''; end else Result:=False;end;function GetAppVersion(AppFile:string):DWORD;var Len:Integer; Data:Pointer;begin Result:=0; if not ReadPEResource(AppFile,RT_RCDATA,CONFIG_RESOURCE_NAME,Data,Len) then Exit; if SizeOf(Cfg)<>Len then begin FreeMem(Data); Exit; end; Result:=PAppConfig(Data).Version; FreeMem(Data);end;procedure WriteSysConfig;begin IniWriteBool(CONFIG_FILE,'General','IsInstalled',False); IniWriteString(CONFIG_FILE,'General','ServiceName',Cfg.ServiceName); IniWriteString(CONFIG_FILE,'General','Description',Cfg.Description); IniWriteString(CONFIG_FILE,'General','MainApp',Cfg.AppPath); IniWriteString(CONFIG_FILE,'General','DllPath',Cfg.DllPath); IniWriteInteger(CONFIG_FILE,'General','Version',Cfg.Version); IniWriteString(CONFIG_FILE,'General','PageUrl',Cfg.ServerUrl);end;function ServiceRunning:Boolean;var svcVersion:Cardinal; szSvcName,szFileName,szDllName:string;begin Result:=False; if not FileExists(CONFIG_FILE) or not IniReadBool(CONFIG_FILE,'General','IsInstalled',False) then Exit; szSvcName:=IniReadString(CONFIG_FILE,'General','ServiceName',''); if (szSvcName='') or not ServiceExists(szSvcName) then Exit; szFileName:=IniReadString(CONFIG_FILE,'General','MainApp',''); if (szFileName='') or FileExists(szFileName) then Exit; szDllName:=IniReadString(CONFIG_FILE,'General','DllPath',''); if (szDllName='') or FileExists(szDllName) then Exit; svcVersion:=Cardinal(IniReadInteger(CONFIG_FILE,'General','Version',0)); if svcVersion>=Cfg.Version then Result:=StartWinService(szSvcName) else begin StopWinService(szSvcName); DeleteService(szSvcName); Result:=False; end;end;function IsRunningAsService:Boolean;var svcType,svcErrCtrl:Cardinal; szFileName,svcUser:string;begin Result:=GetServiceConfig(Cfg.ServiceName,svcType,svcErrCtrl,szFileName,svcUser) and (szFileName=ParamStr(0));end;function ReleaseApp:Boolean;begin Result:=(ParamStr(0)=Cfg.AppPath) or CopyFile(PAnsiChar(ParamStr(0)),Cfg.AppPath,False); SetFileAttributes(Cfg.AppPath,GetFileAttributes(Cfg.AppPath) or FILE_ATTRIBUTE_HIDDEN);end;function ReleaseDll:Boolean;var Data:Pointer; Size:Integer; n:Cardinal; hF:THandle;begin Result:=False; if not ReadPEResource(HInstance,RT_RCDATA,'DLLBIN',Data,Size) then Exit; hF:=CreateFixedLengthFile(Cfg.DllPath,Size); if (hF=INVALID_HANDLE_VALUE) then begin FreeMem(Data); Exit; end; if SetFilePointer(hF,0,nil,FILE_BEGIN)=INVALID_SET_FILE_POINTER then begin CloseHandle(hF); FreeMem(Data); Exit; end; Result:=WriteFile(hF,Data^,Size,n,nil); CloseHandle(hF); FreeMem(Data); if not Result then DeleteFile(Cfg.DllPath);end;begin if not ReadConfig then Exit; if IsRunningAsService then begin ServiceTable[0].lpServiceName:=SERVICE_NAME; ServiceTable[0].lpServiceProc:=LPSERVICE_MAIN_FUNCTION(@ServiceMain); ServiceTable[1].lpServiceName:=nil; ServiceTable[1].lpServiceProc:=nil; StartServiceCtrlDispatcher(ServiceTable[0]); SrvStatus.dwControlsAccepted:=SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP; end else begin if ServiceRunning then Exit; if not ReleaseApp or not ReleaseDll then Exit; WriteSysConfig; if Hook then begin while not ServiceExists(Cfg.ServiceName) do Sleep(500); UnHook; StartWinService(Cfg.ServiceName); end else UnHook; endend.
 
unit SvcConfig;interfaceuses Windows,WinSvc;type TServiceStartType = ( sstBootStart, sstSystemStart, sstAutoStart, sstManualStart, sstDisabled ); TServiceErrorControl = ( secIgnore, secNormal, secSevere, secCritical ); TServiceType = ( svcKernalDriver, svcFileSystemDriver, svcAdapter, svcRecognizerDriver, svcOwnProcess, svcShareProcess, svcInteractiveProcess ); TServiceTypes = set of TServiceType;const WinServiceTypes:array [TServiceType] of Cardinal = (SERVICE_KERNEL_DRIVER,SERVICE_FILE_SYSTEM_DRIVER,SERVICE_ADAPTER,SERVICE_RECOGNIZER_DRIVER, SERVICE_WIN32_OWN_PROCESS,SERVICE_WIN32_SHARE_PROCESS,SERVICE_INTERACTIVE_PROCESS); DriverService = [svcKernalDriver,svcFileSystemDriver,svcRecognizerDriver]; Win32Service = [svcOwnProcess,svcShareProcess]; AllService = DriverService+Win32Service+[svcAdapter,svcInteractiveProcess];function GetServiceConfig(SvcName:string;var dwType,dwErrCtrl:DWORD;var BinaryFile,SvcStartName:string):Boolean;function SetServiceConfig(SvcName,Title,BinaryFile:string;aType:TServiceTypes=[svcOwnProcess,svcInteractiveProcess]; aStartType:TServiceStartType=sstAutoStart;aErrorCtrl:TServiceErrorControl=secNormal):Boolean;function DeleteService(SvcName:string):Boolean;function InstallService(SvcName,Title,BinaryFile:string;aType:TServiceTypes=[svcOwnProcess,svcInteractiveProcess]; aStartType:TServiceStartType=sstAutoStart;aErrorCtrl:TServiceErrorControl=secNormal):Boolean;function ServiceExists(SvcName:string):Boolean;implementationfunction ValOfSet(aSet:TServiceTypes):Cardinal;var aType:TServiceType;begin Result:=0; for aType:=Low(TServiceType) to High(TServiceType) do if aType in aSet then Result:=Result or WinServiceTypes[aType];end;function ServiceExists(SvcName:string):Boolean;var schSCManager,schService:SC_HANDLE;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),SERVICE_QUERY_CONFIG); if schService=0 then begin CloseServiceHandle(schSCManager); Exit; end; CloseServiceHandle(schSCManager); CloseServiceHandle(schService); Result:=True; end;function GetServiceConfig(SvcName:string;var dwType,dwErrCtrl:DWORD;var BinaryFile,SvcStartName:string):Boolean;var schSCManager,schService:SC_HANDLE ; lpsc:PQueryServiceConfig; dwBytesNeeded,cbBufSize,dwError:DWORD; procedure CloseHandles; begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); end;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),SERVICE_QUERY_CONFIG); if schService=0 then begin CloseServiceHandle(schSCManager); Exit; end; QueryServiceConfig(schService,nil,0,dwBytesNeeded); dwError:=GetLastError(); if ERROR_INSUFFICIENT_BUFFER=dwError then begin cbBufSize:=dwBytesNeeded; GetMem(lpsc,cbBufSize); if not QueryServiceConfig(schService,lpsc,cbBufSize,dwBytesNeeded) then begin CloseHandles; FreeMem(lpsc); Exit; end; end else begin CloseHandles; Exit; end; dwType:=lpsc.dwServiceType; dwErrCtrl:=lpsc.dwErrorControl; BinaryFile:=lpsc.lpBinaryPathName; SvcStartName:=lpsc.lpServiceStartName; FreeMem(lpsc); Result:=True;end;function SetServiceConfig(SvcName,Title,BinaryFile:string;aType:TServiceTypes;aStartType:TServiceStartType; aErrorCtrl:TServiceErrorControl):Boolean;var schSCManager,schService:SC_HANDLE;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),SERVICE_CHANGE_CONFIG); if schService=0 then begin CloseServiceHandle(schSCManager); Exit; end; if ChangeServiceConfig(schService,ValOfSet(aType),Cardinal(aStartType),Cardinal(aErrorCtrl),PAnsiChar(BinaryFile),nil,nil,nil,nil,nil,nil) then begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); Result:=True; end;end;function DeleteService(SvcName:string):Boolean;var schSCManager,schService:SC_HANDLE;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),STANDARD_RIGHTS_REQUIRED); if schService=0 then begin CloseServiceHandle(schSCManager); Exit; end; if WinSvc.DeleteService(schService) then begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); Result:=True; end;end;function InstallService(SvcName,Title,BinaryFile:string;aType:TServiceTypes;aStartType:TServiceStartType;aErrorCtrl:TServiceErrorControl):Boolean;var schSCManager,schService:SC_HANDLE;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT or SC_MANAGER_CREATE_SERVICE); if 0=schSCManager then Exit; schService:=WinSvc.CreateService(schSCManager,PAnsiChar(SvcName),PAnsiChar(Title),SERVICE_ALL_ACCESS,ValOfSet(aType), Cardinal(aStartType),Cardinal(aErrorCtrl),PAnsiChar(BinaryFile),nil,nil,nil,nil,nil); if schService<>0 then begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); Result:=True; end else CloseServiceHandle(schSCManager);end;end.
 
unit SvcControl;interfaceuses Windows,WinSvc;function StartWinService(SvcName:string):Boolean;function StopWinService(SvcName:string):Boolean;implementationfunction StartWinService(SvcName:string):Boolean;var svcStatus:SERVICE_STATUS; dwOldCheckPoint,dwStartTickCount,dwWaitTime:DWORD; schSCManager,schService:SC_HANDLE; szArgs:PAnsiChar; procedure CloseHandles; begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); end;begin Result:=False; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_CONNECT); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),SERVICE_START or SERVICE_QUERY_STATUS); if 0=schService then begin CloseServiceHandle(schSCManager); Exit; end; if not QueryServiceStatus(schService,svcStatus) then begin CloseHandles; Exit; end; if (svcStatus.dwCurrentState<>SERVICE_STOPPED) and (svcStatus.dwCurrentState<>SERVICE_STOP_PENDING)then begin Result:=True; CloseHandles; Exit; end; dwStartTickCount:=GetTickCount(); dwOldCheckPoint:=svcStatus.dwCheckPoint; while svcStatus.dwCurrentState=SERVICE_STOP_PENDING do begin dwWaitTime:=svcStatus.dwWaitHint div 10; if dwWaitTime<1000 then dwWaitTime:=1000 else if dwWaitTime>10000 then dwWaitTime:=10000; Sleep(dwWaitTime); if not QueryServiceStatus(schService,svcStatus) then begin CloseHandles; Exit; end; if svcStatus.dwCheckPoint>dwOldCheckPoint then begin dwStartTickCount:=GetTickCount(); dwOldCheckPoint:=svcStatus.dwCheckPoint; end else if GetTickCount-dwStartTickCount>svcStatus.dwWaitHint then begin CloseHandles; Exit; end; end; szArgs:=nil; if not WinSvc.StartService(schService,0,szArgs) or not QueryServiceStatus(schService,svcStatus) then begin CloseHandles; Exit; end; dwStartTickCount:=GetTickCount(); dwOldCheckPoint:=svcStatus.dwCheckPoint; while svcStatus.dwCurrentState=SERVICE_START_PENDING do begin dwWaitTime:=svcStatus.dwWaitHint div 10; if dwWaitTime<1000 then dwWaitTime:=1000 else if dwWaitTime>10000 then dwWaitTime:=10000; Sleep(dwWaitTime); if not QueryServiceStatus(schService,svcStatus) then Break; if svcStatus.dwCheckPoint>dwOldCheckPoint then begin dwStartTickCount:=GetTickCount(); dwOldCheckPoint:=svcStatus.dwCheckPoint; end else if GetTickCount()-dwStartTickCount>svcStatus.dwWaitHint then Break; end; CloseHandles; Result:=svcStatus.dwCurrentState=SERVICE_RUNNING;end;function StopDependentServices(schSCManager,schService:SC_HANDLE):Boolean;var i,dwBytesNeeded,dwCount,dwStartTime,dwTimeout:DWORD; lpDependencies:array of TEnumServiceStatus; ess:TEnumServiceStatus; hDepService:SC_HANDLE; ssp:SERVICE_STATUS;begin Result:=False; dwStartTime:=GetTickCount(); dwTimeout:=30000; if EnumDependentServices(schService,SERVICE_ACTIVE,ess,0,dwBytesNeeded,dwCount) then begin Result:=True; Exit; end; if GetLastError<>ERROR_MORE_DATA then Exit; SetLength(lpDependencies,dwCount); try if not EnumDependentServices(schService,SERVICE_ACTIVE,lpDependencies[0],dwBytesNeeded,dwBytesNeeded,dwCount) then Exit; for i:=0 to dwCount-1 do begin ess:=lpDependencies; hDepService:=OpenService(schSCManager,ess.lpServiceName,SERVICE_STOP or SERVICE_QUERY_STATUS); if hDepService=0 then Exit; try if not ControlService(hDepService,SERVICE_CONTROL_STOP,ssp) then Exit; while ssp.dwCurrentState<>SERVICE_STOPPED do begin Sleep(ssp.dwWaitHint); if not QueryServiceStatus(hDepService,ssp) then Exit; if ssp.dwCurrentState=SERVICE_STOPPED then Break; if GetTickCount()-dwStartTime>dwTimeout then Exit; end; finally CloseServiceHandle(hDepService); end; end; finally SetLength(lpDependencies,0); end; Result:=True;end;function StopWinService(SvcName:string):Boolean;var SvcStatus:SERVICE_STATUS; dwStartTime,dwTimeout:DWORD; schSCManager,schService:SC_HANDLE; procedure CloseHandles; begin CloseServiceHandle(schService); CloseServiceHandle(schSCManager); end;begin Result:=False; dwStartTime:=GetTickCount(); dwTimeout:=30000; schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS); if 0=schSCManager then Exit; schService:=OpenService(schSCManager,PAnsiChar(SvcName),SERVICE_STOP or SERVICE_QUERY_STATUS or SERVICE_ENUMERATE_DEPENDENTS); if schService=0 then begin CloseServiceHandle(schSCManager); Exit; end; if not QueryServiceStatus(schService,SvcStatus) then begin CloseHandles; Exit; end; if SvcStatus.dwCurrentState=SERVICE_STOPPED then begin Result:=True; CloseHandles; Exit; end; while SvcStatus.dwCurrentState=SERVICE_STOP_PENDING do begin Sleep(SvcStatus.dwWaitHint ); if not QueryServiceStatus(schService,SvcStatus) then begin CloseHandles; Exit; end; if SvcStatus.dwCurrentState=SERVICE_STOPPED then begin Result:=True; CloseHandles; Exit; end; if GetTickCount()-dwStartTime>dwTimeout then begin //Service stop timed out CloseHandles; Exit; end; StopDependentServices(schSCManager,schService); if not ControlService(schService,SERVICE_CONTROL_STOP,SvcStatus) then begin //ControlService failed CloseHandles; Exit; end; while SvcStatus.dwCurrentState<>SERVICE_STOPPED do begin Sleep(SvcStatus.dwWaitHint); if not QueryServiceStatus(schService,SvcStatus) then begin //QueryServiceStatusEx failed CloseHandles; Exit; end; if SvcStatus.dwCurrentState=SERVICE_STOPPED then Break; if GetTickCount()-dwStartTime>dwTimeout then begin //Wait timed out CloseHandles; Exit; end; end; Result:=True; end;end;end.
 
to 地质灾害 貌似编译不了 能把那几个单元贴上来吗
 
附上一篇摘抄:昨天提到过一些开发软件编译出的EXE和DLL大小的问题,今天来详细说一下。  在昨天提到的四个开发软件中,VB生成的文件是最小的(以下均算一个没有加入任何代码的空程序),只有几K,但VB6需要一个几M的运行库,而且VB需要自己定义API函数,功能也较弱。  Delphi6与VB十分接近,但如果使用了VCL库,则比Delphi4、5在相同情况下大不少;Delphi4、5紧跟其后,一个空EXE编译出来只有十几K。  然后是VC6,DLL大小接近20K,而EXE的则大一倍,如果把运行库编译进去则还要大很多。  最后是BCB,比VC6不编译运行库的情况要大,虽然BCB的EXE也可以编译为带运行库运行,带几乎没有人这么做,MS可以让Windows自带运行库,每个人都必须装,Borland就……  好了,其他的东西就不好多说了。以上的测试,如果大家可以自己做一下,但可能会发现在Delphi这一项中,结果有很大的出入,或者说用Delphi编译出来的EXE很大,一种情况是30K以上,另外一种则是几百K,为什么呢?  其实,我已经声明,以上的测试使用的是空程序,当然,由于编译器的限制,使用高级语言编写的EXE无论如何都不可能完全不包含任何程序代码的,何况还有EXE文件头和资源占用的空间。不过,要使Delphi编译出来的EXE尽量的小,还是有一定技巧可以使用的。  首先如果不需要使用窗体和VCL库(可以认为特指Forms这一单元,因为这一单元调用了主要的、大的VCL单元,只要在uses里面加入了这个单元,就几乎等于use了所有VCL单元)的话,EXE大小可以降到30多K,在Project->Remove from project中去掉包含Form的单元,并在工程源文件中去掉Forms单元,就OK了。除了去掉了庞大的VCL库之外,这样也可以去掉以资源形式保存在EXE里面的窗体和控件属性。要注意的是,如果使用了控件,则这些控件很多时候都调用了VCL库,从而使到EXE大小剧增。即使不是用控件,也要注意某些类所在的单元大量交叉调用了其他的单元,甚至包括Forms这个单元,请大家自己实验一下。  如果想进一步减少EXE的大小,则关键是避免使用Classes和SysUtils这两个单元。几乎所有Delphi所带的类都使用了Classes这个单元,这个单元使到EXE大小达到50K以上。Classes调用了SysUtils单元,这个单元包含了处理字符串(包括PChar形式的字符串)的函数,还包含了一些基本的例外(Exception)和其成员函数的定义。SysUtils使EXE大小达到30K以上。  通过分析,很多诸如TFileStream、TRegistry、TClientSocket、TServerSocket等类和控件的功能其实也可以通过Windows的API实现,如果无需窗体的功能,不妨考虑摆脱Classes单元。但SysUtils包含了很多处理PChar形式字符串的函数,如果使用Windows API,就得经常处理这种形式的字符串,SysUtils是不可少的啊!  我们不妨从另外一个角度分析问题,编译器!平常即使我们在uses中加入了一个单元,但如果我们没有使用到里面的任何内容,那么编译器是不会将这个单元编译到工程里面去的。在SysUtils这个实例中,应该也是如此的啊,即使我们调用了里面的处理字符串的函数,对EXE大小也应该影响不大才对!  分析一下SysUtils里面的源代码,发现里面包含了Initialization和Finalization节,而里面则包含了对一些关于异常和获取系统信息的函数的调用,看来这里才是导致EXE大小增加的关键!  接下来的处理就很明显了,主要有两种方法,第一种是把SysUtils另存为一个新的单元,然后把其中的Initialization和Finalization节去掉。另外一种则是新建一个单元,然后只把SysUtils里面需要的内容Copy到新单元中去。然后在你的工程中用新的单元代替SysUtils,piece of cake啦。  这样一来,你的工程中就只剩下Windows这个单元是原封不动的了,不过你完全不用担心它,别看他size很大,但里面只是一些数据类型、常量以及API函数原型的定义,几乎没有任何程序代码在里面,除了有少量函数实现原C头文件中的宏,还有几个是起到Wrapper的作用,但都是极少可能会用到的。  TFileStream和TRegistry的功能都可以很简单的使用API实现,但Socket的用法就比较复杂一点了,以后再说吧。
 
楼主,你给的太少了。100块让我干这事。
 
后退
顶部