paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 13:49:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved to utils

Browse Source
This commit is contained in:
peter 2000-06-01 10:58:47 +00:00
parent d854774374
commit 30b8959557
1 changed files with 84 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
compiler/utils/postw32.pp → utils/postw32.pp
View File

@ -21,27 +21,48 @@
**************************************************************************** ****************************************************************************
} }
program postw32;
program post_process_win32_executable;
uses uses
globtype,globals,strings; {$ifdef fpc}
strings
{$else}
sysutils
{$endif}
;
const const
execinfo_f_cant_open_executable='Cannot open file '; execinfo_f_cant_open_executable='Cannot open file ';
execinfo_x_codesize='Code size: '; execinfo_x_codesize='Code size: ';
execinfo_x_initdatasize='Size of Initialized Data: '; execinfo_x_initdatasize='Size of Initialized Data: ';
execinfo_x_uninitdatasize='Size of Uninitialized Data: '; execinfo_x_uninitdatasize='Size of Uninitialized Data: ';
execinfo_f_cant_process_executable='Cannot process file '; execinfo_f_cant_process_executable='Cannot process file ';
execinfo_x_stackreserve='Size of Stack Reserve: '; execinfo_x_stackreserve='Size of Stack Reserve: ';
execinfo_x_stackcommit='Size of Stack Commit: '; execinfo_x_stackcommit='Size of Stack Commit: ';
type
tapptype = (at_none,
at_gui,at_cui
);
var var
verbose:longbool; verbose:longbool;
ii,jj:longint; stacksize,
code:integer; ii,jj:longint;
DllVersion : sTring; code:integer;
Dllmajor,Dllminor : word; DllVersion : sTring;
Dllmajor,Dllminor : word;
apptype : tapptype;
function tostr(i : longint) : string;
{
return string of value i
}
var
hs : string;
begin
str(i,hs);
tostr:=hs;
end;
procedure Message1(const info,fn:string); procedure Message1(const info,fn:string);
var var
@ -241,20 +262,22 @@ begin
postprocessexecutable:=true; postprocessexecutable:=true;
end; end;
var var
fn,s:string; fn,s:string;
function GetSwitchValue(const key,shortkey,default:string;const PossibleValues:array of pchar):string; function GetSwitchValue(const key,shortkey,default:string;const PossibleValues:array of pchar):string;
var var
i,j,k:longint; i,j,k:longint;
x:double; x:double;
s1,s2:string; s1,s2:string;
code:integer; code:integer;
procedure Error;
procedure Error;
begin begin
writeln('Error: unrecognized option ',paramstr(i),' ',s1); writeln('Error: unrecognized option ',paramstr(i),' ',s1);
halt(1); halt(1);
end; end;
begin begin
for i:=1 to paramcount do for i:=1 to paramcount do
if(paramstr(i)=key)or(paramstr(i)=shortkey)then if(paramstr(i)=key)or(paramstr(i)=shortkey)then
@ -297,6 +320,7 @@ begin
end; end;
GetSwitchValue:=default; GetSwitchValue:=default;
end; end;
procedure help_info; procedure help_info;
begin begin
fn:=paramstr(0); fn:=paramstr(0);
@ -316,53 +340,51 @@ begin
writeln('-h | --help | -? - show this screen'); writeln('-h | --help | -? - show this screen');
halt; halt;
end; end;
begin begin
aktglobalswitches:=[]; verbose:=false;
verbose:=false; if paramcount=0 then
if paramcount=0 then help_info;
help_info; for ii:=1 to paramcount do
for ii:=1 to paramcount do if(paramstr(ii)='-h')or(paramstr(ii)='--help')or(paramstr(ii)='-?')then
if(paramstr(ii)='-h')or(paramstr(ii)='--help')or(paramstr(ii)='-?')then help_info
help_info else if(paramstr(ii)='-v')or(paramstr(ii)='--verbose')then
else if(paramstr(ii)='-v')or(paramstr(ii)='--verbose')then begin
begin verbose:=true;
verbose:=true; break;
break; end;
end; fn:=GetSwitchValue('--input','-i','',['*s']);
fn:=GetSwitchValue('--input','-i','',['*s']); val(GetSwitchValue('--stack','-s','33554432',['*i']),stacksize,code);
val(GetSwitchValue('--stack','-s','33554432',['*i']),stacksize,code); s:=GetSwitchValue('--subsystem','-m','console',['gui','console']);
{value from if s='gui' then
systems.pas apptype:=at_GUI
for Win32 target} else
apptype:=at_cui;
s:=GetSwitchValue('--subsystem','-m','console',['gui','console']); dllversion:=GetSwitchValue('--version','-V','1.0',['*r']);
if s='gui' then ii:=pos('.',dllversion);
apptype:=at_GUI if ii=0 then
else begin
apptype:=at_cui; ii:=succ(length(dllversion));
dllversion:=dllversion+'.0';
dllversion:=GetSwitchValue('--version','-V','1.0',['*r']); end
ii:=pos('.',dllversion); else if ii=1 then
if ii=0 then begin
begin ii:=2;
ii:=succ(length(dllversion)); dllversion:='0.'+dllversion;
dllversion:=dllversion+'.0'; end;
end val(copy(dllversion,1,pred(ii)),dllmajor,code);
else if ii=1 then val(copy(dllversion,succ(ii),length(dllversion)),dllminor,code);
begin if verbose then
ii:=2; writeln('Image Version: ',dllmajor,'.',dllminor);
dllversion:='0.'+dllversion; PostProcessExecutable(fn,false);
end;
val(copy(dllversion,1,pred(ii)),dllmajor,code);
val(copy(dllversion,succ(ii),length(dllversion)),dllminor,code);
if verbose then
writeln('Image Version: ',dllmajor,'.',dllminor);
PostProcessExecutable(fn,false);
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-04-14 11:10:46 pierre Revision 1.1 2000-06-01 10:58:47 peter
* moved to utils
Revision 1.1 2000/04/14 11:10:46 pierre
renamed to fit in 8.3 limitation renamed to fit in 8.3 limitation
} }