1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1993-98 by Florian Klaempfl
- member of the Free Pascal development team
- This is the install program for the DOS and OS/2 versions of Free Pascal
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- program install;
- { $DEFINE DLL} (* TH - if defined, UNZIP32.DLL library is used to unpack. *)
- { $DEFINE DOSSTUB} (* TH - should _not_ be defined unless creating a bound DOS and OS/2 installer!!! *)
- (* Defining DOSSTUB causes adding a small piece of code *)
- (* for starting the OS/2 part from the DOS part of a bound *)
- (* application if running in OS/2 VDM (DOS) window. Used *)
- (* only if compiling with TP/BP (see conditionals below). *)
- {$IFDEF VER60}
- {$DEFINE TP}
- {$ENDIF}
- {$IFDEF VER70}
- {$DEFINE TP}
- {$ENDIF}
- {$IFNDEF TP}
- {$UNDEF DOSSTUB}
- {$ELSE}
- {$IFDEF OS2}
- {$UNDEF DOSSTUB}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DPMI}
- {$UNDEF DOSSTUB}
- {$ENDIF}
- {$ifdef go32v2}
- {$define MAYBE_LFN}
- {$endif}
- {$ifdef debug}
- {$ifdef win32}
- {$define MAYBE_LFN}
- {$endif win32}
- {$endif debug}
- {$ifdef TP}
- {$define MAYBE_LFN}
- {$endif}
- uses
- {$IFDEF OS2}
- {$IFDEF FPC}
- DosCalls,
- {$ELSE FPC}
- {$IFDEF VirtualPascal}
- OS2Base,
- {$ELSE VirtualPascal}
- BseDos,
- {$ENDIF VirtualPascal}
- {$ENDIF FPC}
- {$ENDIF OS2}
- {$IFDEF GO32V2}
- { emu387, not needed anymore PM }
- {$ENDIF}
- {$ifdef HEAPTRC}
- heaptrc,
- {$endif HEAPTRC}
- strings,dos,objects,drivers,
- {$IFNDEF FVISION}
- commands,
- HelpCtx,
- {$ENDIF}
- unzip,ziptypes,
- {$IFDEF DLL}
- unzipdll,
- {$ENDIF}
- app,dialogs,views,menus,msgbox,colortxt,tabs,scroll,
- WHTMLScn;
- const
- installerversion='1.0.4';
- maxpacks=10;
- maxpackages=20;
- maxdefcfgs=1024;
- HTMLIndexExt = '.htx';
- CfgExt = '.dat';
- MaxStatusPos = 4;
- StatusChars: string [MaxStatusPos] = '/-\|';
- StatusPos: byte = 1;
- { this variable is set to true if an ide is installed }
- haside : boolean = false;
- hashtmlhelp : boolean = false;
- {$ifdef linux}
- DirSep='/';
- {$else}
- DirSep='\';
- {$endif}
- type
- tpackage=record
- name : string[60];
- zip : string[40]; { default zipname }
- zipshort : string[12]; { 8.3 zipname }
- diskspace : longint; { diskspace required }
- end;
- tpack=record
- name : string[12];
- binsub : string[40];
- ppc386 : string[20];
- targetname : string[20];
- defidecfgfile,
- defideinifile,
- defcfgfile : string[12];
- include : boolean;
- filechk : string[40];
- packages : longint;
- package : array[1..maxpackages] of tpackage;
- end;
- tcfgarray = array[1..maxdefcfgs] of pstring;
- cfgrec=record
- title : string[80];
- version : string[20];
- helpidx,
- docsub,
- basepath : DirStr;
- packs : word;
- pack : array[1..maxpacks] of tpack;
- defideinis,
- defidecfgs,
- defcfgs : longint;
- defideini,
- defidecfg,
- defcfg : tcfgarray;
- end;
- datarec=packed record
- basepath : DirStr;
- cfgval : word;
- packmask : array[1..maxpacks] of word;
- end;
- punzipdialog=^tunzipdialog;
- tunzipdialog=object(tdialog)
- filetext : pstatictext;
- extractfiletext : pstatictext;
- constructor Init(var Bounds: TRect; ATitle: TTitleStr);
- procedure do_unzip(s,topath:string);
- end;
- penddialog = ^tenddialog;
- tenddialog = object(tdialog)
- constructor init;
- end;
- pinstalldialog = ^tinstalldialog;
- tinstalldialog = object(tdialog)
- constructor init;
- end;
- PFPHTMLFileLinkScanner = ^TFPHTMLFileLinkScanner;
- TFPHTMLFileLinkScanner = object(THTMLFileLinkScanner)
- function CheckURL(const URL: string): boolean; virtual;
- function CheckText(const Text: string): boolean; virtual;
- procedure ProcessDoc(Doc: PHTMLLinkScanFile); virtual;
- end;
- phtmlindexdialog = ^thtmlindexdialog;
- thtmlindexdialog = object(tdialog)
- text : pstatictext;
- constructor init(var Bounds: TRect; ATitle: TTitleStr);
- end;
- tapp = object(tapplication)
- procedure initmenubar;virtual;
- procedure handleevent(var event : tevent);virtual;
- procedure do_installdialog;
- procedure readcfg(const fn:string);
- procedure checkavailpack;
- end;
- {$IFDEF DOSSTUB}
- PByte = ^byte;
- PRunBlock = ^TRunBlock;
- TRunBlock = record
- Length: word;
- Dependent: word;
- Background: word;
- TraceLevel: word;
- PrgTitle: PChar;
- PrgName: PChar;
- Args: PChar;
- TermQ: longint;
- Environment: pointer;
- Inheritance: word;
- SesType: word;
- Icon: pointer;
- PgmHandle: longint;
- PgmControl: word;
- Column: word;
- Row: word;
- Width: word;
- Height: word;
- end;
- {$ENDIF}
- var
- installapp : tapp;
- startpath : string;
- successfull : boolean;
- cfg : cfgrec;
- data : datarec;
- CfgName: NameStr;
- DStr: DirStr;
- EStr: ExtStr;
- UnzDlg : punzipdialog;
- log : text;
- createlog : boolean;
- {$IFNDEF DLL}
- const
- UnzipErr: longint = 0;
- {$ENDIF}
- {$ifdef MAYBE_LFN}
- const
- locallfnsupport : boolean = false;
- {$endif MAYBE_LFN}
- {*****************************************************************************
- Helpers
- *****************************************************************************}
- procedure errorhalt;
- begin
- installapp.done;
- halt(1);
- end;
- function packagemask(i:longint):longint;
- begin
- packagemask:=1 shl (i-1);
- end;
- function upper(const s : string):string;
- var
- i : integer;
- begin
- for i:=1 to length(s) do
- if s[i] in ['a'..'z'] then
- upper[i]:=chr(ord(s[i])-32)
- else
- upper[i]:=s[i];
- upper[0]:=s[0];
- end;
- procedure Replace(var s:string;const s1,s2:string);
- var
- i : longint;
- begin
- repeat
- i:=pos(s1,s);
- if i>0 then
- begin
- Delete(s,i,length(s1));
- Insert(s2,s,i);
- end;
- until i=0;
- end;
- function DotStr(l:longint):string;
- var
- TmpStr : string[32];
- i : longint;
- begin
- Str(l,TmpStr);
- i:=Length(TmpStr);
- while (i>3) do
- begin
- i:=i-3;
- if TmpStr[i]<>'-' then
- Insert('.',TmpStr,i+1);
- end;
- DotStr:=TmpStr;
- end;
- function file_exists(const f : string;const path : string) : boolean;
- begin
- file_exists:=fsearch(f,path)<>'';
- end;
- function createdir(s:string):boolean;
- var
- s1,start : string;
- err : boolean;
- i : longint;
- begin
- err:=false;
- {$I-}
- getdir(0,start);
- {$ifndef linux}
- if (s[2]=':') and (s[3]=DirSep) then
- begin
- chdir(Copy(s,1,3));
- Delete(S,1,3);
- end;
- {$endif}
- repeat
- i:=Pos(DirSep,s);
- if i=0 then
- i:=255;
- s1:=Copy(s,1,i-1);
- Delete(s,1,i);
- ChDir(s1);
- if ioresult<>0 then
- begin
- mkdir(s1);
- chdir(s1);
- if ioresult<>0 then
- begin
- err:=true;
- break;
- end;
- end;
- until s='';
- chdir(start);
- {$I+}
- createdir:=err;
- end;
- function DiskSpaceN(const zipfile : string) : longint;
- var
- compressed,uncompressed : longint;
- s : string;
- begin
- s:=zipfile+#0;
- if not (IsZip (@S [1])) then
- DiskSpaceN := -1
- else
- begin
- Uncompressed:=UnzipSize(@s[1],compressed);
- DiskSpaceN:=uncompressed shr 10;
- end;
- end;
- function diskspacestr(uncompressed : longint) : string;
- begin
- if Uncompressed = -1 then
- DiskSpacestr := ' [INVALID]'
- else
- diskspacestr:=' ('+DotStr(uncompressed)+' KB)';
- end;
- function createinstalldir(s : string) : boolean;
- var
- err : boolean;
- dir : searchrec;
- params : array[0..0] of pointer;
- begin
- if s[length(s)]=DirSep then
- dec(s[0]);
- FindFirst(s,AnyFile,dir);
- if doserror=0 then
- begin
- if Dir.Attr and Directory = 0 then
- begin
- messagebox('A file with the name chosen as the installation '+
- 'directory exists already. Cannot create this directory!',nil,
- mferror+mfokbutton);
- createinstalldir:=false;
- end else
- createinstalldir:=messagebox('The installation directory exists already. '+
- 'Do you want to continue ?',nil,
- mferror+mfyesbutton+mfnobutton)=cmYes;
- exit;
- end;
- err:=Createdir(s);
- if err then
- begin
- params[0]:=@s;
- messagebox('The installation directory %s couldn''t be created',
- @params,mferror+mfokbutton);
- createinstalldir:=false;
- exit;
- end;
- {$ifndef TP}
- {$IFNDEF OS2}
- FindClose (dir);
- {$ENDIF}
- {$endif}
- createinstalldir:=true;
- end;
- function GetProgDir: DirStr;
- var
- D: DirStr;
- N: NameStr;
- E: ExtStr;
- begin
- FSplit (FExpand (ParamStr (0)), D, N, E);
- if (D [0] <> #0) and (D [byte (D [0])] = '\') then Dec (D [0]);
- GetProgDir := D;
- end;
- function RTrim(const S: string): string;
- var
- i : longint;
- begin
- i:=length(s);
- while (i>0) and (s[i]=' ') do
- dec(i);
- RTrim:=Copy(s,1,i);
- end;
- function LTrim(const S: string): string;
- var
- i : longint;
- begin
- i:=1;
- while (i<length(s)) and (s[i]=' ') do
- inc(i);
- LTrim:=Copy(s,i,255);
- end;
- function Trim(const S: string): string;
- begin
- Trim:=RTrim(LTrim(S));
- end;
- function CompareText(S1, S2: string): integer;
- var R: integer;
- begin
- S1:=Upcase(S1);
- S2:=Upcase(S2);
- if S1<S2 then R:=-1 else
- if S1>S2 then R:= 1 else
- R:=0;
- CompareText:=R;
- end;
- function ExtOf(const S: string): string;
- var D: DirStr; E: ExtStr; N: NameStr;
- begin
- FSplit(S,D,N,E);
- ExtOf:=E;
- end;
- function DirAndNameOf(const S: string): string;
- var D: DirStr; E: ExtStr; N: NameStr;
- begin
- FSplit(S,D,N,E);
- DirAndNameOf:=D+N;
- end;
- {*****************************************************************************
- HTML-Index Generation
- *****************************************************************************}
- var
- indexdlg : phtmlindexdialog;
- constructor thtmlindexdialog.Init(var Bounds: TRect; ATitle: TTitleStr);
- var
- r : trect;
- begin
- inherited init(bounds,atitle);
- R.Assign (4, 2,bounds.B.X-Bounds.A.X-2, 4);
- text:=new(pstatictext,init(r,'Please wait ...'));
- insert(text);
- end;
- procedure TFPHTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
- var
- oldtext : pstring;
- begin
- oldtext:=indexdlg^.text^.text;
- indexdlg^.text^.text:=newstr('Processing '+Doc^.GetDocumentURL);
- indexdlg^.text^.drawview;
- inherited ProcessDoc(Doc);
- disposestr(indexdlg^.text^.text);
- indexdlg^.text^.text:=oldtext;
- indexdlg^.text^.drawview;
- end;
- function TFPHTMLFileLinkScanner.CheckURL(const URL: string): boolean;
- var OK: boolean;
- const HTTPPrefix = 'http:';
- FTPPrefix = 'ftp:';
- begin
- OK:=inherited CheckURL(URL);
- if OK then OK:=DirAndNameOf(URL)<>'';
- if OK then OK:=CompareText(copy(ExtOf(URL),1,4),'.HTM')=0;
- if OK then OK:=CompareText(copy(URL,1,length(HTTPPrefix)),HTTPPrefix)<>0;
- if OK then OK:=CompareText(copy(URL,1,length(FTPPrefix)),FTPPrefix)<>0;
- CheckURL:=OK;
- end;
- function TFPHTMLFileLinkScanner.CheckText(const Text: string): boolean;
- var OK: boolean;
- S: string;
- begin
- S:=Trim(Text);
- OK:=(S<>'') and (copy(S,1,1)<>'[');
- CheckText:=OK;
- end;
- procedure writehlpindex(filename : string);
- var
- LS : PFPHTMLFileLinkScanner;
- BS : PBufStream;
- Re : Word;
- params : array[0..0] of pointer;
- dir : searchrec;
- r : trect;
- begin
- r.assign(10,10,70,15);
- indexdlg:=new(phtmlindexdialog,init(r,'Creating HTML index file, please wait ...'));
- desktop^.insert(indexdlg);
- {$warning FIXME !!!! }
- New(LS, Init(''));
- LS^.ProcessDocument(FileName,[soSubDocsOnly]);
- if LS^.GetDocumentCount=0 then
- begin
- params[0]:=@filename;
- MessageBox('Problem creating help index %1, aborting',@params,
- mferror+mfokbutton);
- end
- else
- begin
- FileName:=DirAndNameOf(FileName)+HTMLIndexExt;
- findfirst(filename,AnyFile,dir);
- if doserror=0 then
- begin
- params[0]:=@filename;
- Re:=MessageBox('Help index %s already exists, overwrite it?',@params,
- mfinformation+mfyesbutton+mfnobutton);
- end;
- if Re<>cmNo then
- begin
- New(BS, Init(FileName, stCreate, 4096));
- if Assigned(BS)=false then
- begin
- MessageBox('Error while writing help index! '+
- 'No help index is created',@params,
- mferror+mfokbutton);
- Re:=cmCancel;
- end
- else
- begin
- LS^.StoreDocuments(BS^);
- if BS^.Status<>stOK then
- begin
- MessageBox('Error while writing help index!'#13+
- 'No help index is created',@params,
- mferror+mfokbutton);
- Re:=cmCancel;
- end;
- Dispose(BS, Done);
- end;
- end;
- end;
- Dispose(LS, Done);
- desktop^.delete(indexdlg);
- dispose(indexdlg,done);
- end;
- {*****************************************************************************
- Writing of fpc.cfg
- *****************************************************************************}
- procedure writedefcfg(const fn:string;const cfgdata : tcfgarray;count : longint;const targetname : string);
- var
- t : text;
- i : longint;
- s : string;
- dir : searchrec;
- params : array[0..0] of pointer;
- d : dirstr;
- n : namestr;
- e : extstr;
- begin
- { already exists }
- findfirst(fn,AnyFile,dir);
- if doserror=0 then
- begin
- params[0]:=@fn;
- if MessageBox('Config %s already exists, continue writing default config?',@params,
- mfinformation+mfyesbutton+mfnobutton)=cmNo then
- exit;
- end;
- { create directory }
- fsplit(fn,d,n,e);
- createdir(d);
- { create the fpc.cfg }
- assign(t,fn);
- {$I-}
- rewrite(t);
- {$I+}
- if ioresult<>0 then
- begin
- params[0]:=@fn;
- MessageBox(#3'A config not written.'#13#3'%s'#13#3'couldn''t be created',@params,mfinformation+mfokbutton);
- exit;
- end;
- for i:=1 to count do
- if assigned(cfgdata[i]) then
- begin
- s:=cfgdata[i]^;
- Replace(s,'$1',data.basepath);
- Replace(s,'$target',targetname);
- writeln(t,s);
- end
- else
- writeln(t,'');
- close(t);
- end;
- {*****************************************************************************
- TUnZipDialog
- *****************************************************************************}
- constructor tunzipdialog.Init(var Bounds: TRect; ATitle: TTitleStr);
- var
- r : trect;
- begin
- inherited init(bounds,atitle);
- (* R.Assign (11, 4, 38, 6);*)
- R.Assign (1, 4,bounds.B.X-Bounds.A.X-2, 6);
- filetext:=new(pstatictext,init(r,#3'File: '));
- insert(filetext);
- R.Assign (1, 7,bounds.B.X-Bounds.A.X-2, 9);
- extractfiletext:=new(pstatictext,init(r,#3' '));
- insert(extractfiletext);
- end;
- {$IFNDEF DLL}
- procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
- {$ifndef fpc}{$IFNDEF BIT32} FAR;{$ENDIF BIT32}{$endif}
- var
- name : string;
- begin
- case Rec^.Status of
- unzip_starting:
- UnzipErr := 0;
- file_starting:
- begin
- with UnzDlg^.extractfiletext^ do
- begin
- Disposestr(text);
- name:=Strpas(Rec^.FileName);
- Text:=NewStr(#3+name);
- DrawView;
- end;
- end;
- file_failure:
- UnzipErr := RetCode;
- file_unzipping:
- begin
- with UnzDlg^.FileText^ do
- begin
- Inc (StatusPos);
- if StatusPos > MaxStatusPos then StatusPos := 1;
- Text^ [Length (Text^)] := StatusChars [StatusPos];
- DrawView;
- end;
- end;
- end;
- end;
- {$ENDIF}
- procedure tunzipdialog.do_unzip(s,topath : string);
- var
- again : boolean;
- fn,dir,wild : string;
- begin
- Disposestr(filetext^.text);
- filetext^.Text:=NewStr(#3'File: '+s + #13#3' ');
- filetext^.drawview;
- if not(file_exists(s,startpath)) then
- begin
- messagebox('File "'+s+'" missing for the selected installation. '+
- 'Installation hasn''t been completed.',nil,mferror+mfokbutton);
- errorhalt;
- end;
- {$IFNDEF DLL}
- {$IFDEF FPC}
- SetUnzipReportProc (@UnzipCheckFn);
- {$ELSE FPC}
- SetUnzipReportProc (UnzipCheckFn);
- {$ENDIF FPC}
- {$ENDIF DLL}
- repeat
- fn:=startpath+DirSep+s+#0;
- dir:=topath+#0;
- wild:=AllFiles + #0;
- again:=false;
- FileUnzipEx(@fn[1],@dir[1],@wild[1]);
- if (UnzipErr <> 0) then
- begin
- Str(UnzipErr,s);
- if messagebox('Error (' + S + ') while extracting. Disk full?'#13+
- #13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then
- errorhalt
- else
- again:=true;
- end;
- until not again;
- end;
- {*****************************************************************************
- TEndDialog
- *****************************************************************************}
- constructor tenddialog.init;
- var
- R : TRect;
- P : PStaticText;
- Control : PButton;
- YB: word;
- {$IFNDEF LINUX}
- i : longint;
- S: string;
- WPath: boolean;
- {$ENDIF}
- {$IFDEF OS2}
- ErrPath: array [0..259] of char;
- Handle: longint;
- WLibPath: boolean;
- const
- EMXName: array [1..4] of char = 'EMX'#0;
- {$ENDIF}
- begin
- if haside then
- YB := 15
- else
- YB := 14;
- {$IFNDEF LINUX}
- s:='';
- for i:=1 to cfg.packs do
- if cfg.pack[i].binsub<>'' then
- begin
- if s<>'' then
- s:=s+';';
- S := s+Data.BasePath + Cfg.pack[i].BinSub;
- end;
- if Pos (Upper (S), Upper (GetEnv ('PATH'))) = 0 then
- begin
- WPath := true;
- Inc (YB, 2);
- end
- else
- WPath := false;
- {$IFDEF OS2}
- if DosLoadModule (@ErrPath, SizeOf (ErrPath), @EMXName, Handle) = 0 then
- begin
- WLibPath := false;
- DosFreeModule (Handle);
- end
- else
- begin
- WLibPath := true;
- Inc (YB, 2);
- end;
- {$ENDIF}
- {$ENDIF}
- R.Assign(6, 6, 74, YB);
- inherited init(r,'Installation Successfull');
- {$IFNDEF LINUX}
- if WPath then
- begin
- R.Assign(2, 3, 64, 5);
- P:=new(pstatictext,init(r,'Extend your PATH variable with '''+S+''''));
- insert(P);
- end;
- {$IFDEF OS2}
- if WLibPath then
- begin
- if WPath then
- S := 'and your LIBPATH with ''' + S + '\dll'''
- else
- S := 'Extend your LIBPATH with ''' + S + '\dll''';
- R.Assign (2, YB - 14, 64, YB - 12);
- P := New (PStaticText, Init (R, S));
- Insert (P);
- end;
- {$ENDIF}
- {$ENDIF}
- R.Assign(2, YB - 13, 64, YB - 12);
- P:=new(pstatictext,init(r,'To compile files enter '''+cfg.pack[1].ppc386+' [file]'''));
- insert(P);
- if haside then
- begin
- R.Assign(2, YB - 12, 64, YB - 10);
- P:=new(pstatictext,init(r,'To start the IDE (Integrated Development Environment) type ''fp'' at a command line prompt'));
- insert(P);
- end;
- R.Assign (29, YB - 9, 39, YB - 7);
- Control := New (PButton, Init (R,'~O~k', cmOK, bfDefault));
- Insert (Control);
- end;
- {*****************************************************************************
- TInstallDialog
- *****************************************************************************}
- {$ifdef MAYBE_LFN}
- var
- islfn : boolean;
- procedure lfnreport( Retcode : longint;Rec : pReportRec );
- var
- p : pathstr;
- n : namestr;
- e : extstr;
- begin
- fsplit(strpas(rec^.Filename),p,n,e);
- if (length(n)>8) or (length(e)>4) then
- islfn:=true;
- end;
- function haslfn(const zipfile : string) : boolean;
- var
- buf : array[0..255] of char;
- begin
- strpcopy(buf,zipfile);
- islfn:=false;
- {$ifdef FPC}
- ViewZip(buf,AllFiles,@lfnreport);
- {$else FPC}
- ViewZip(buf,AllFiles,lfnreport);
- {$endif FPC}
- haslfn:=islfn;
- end;
- {$endif MAYBE_LFN}
- constructor tinstalldialog.init;
- const
- width = 76;
- height = 20;
- x1 = (79-width) div 2;
- y1 = (23-height) div 2;
- x2 = x1+width;
- y2 = y1+height;
- var
- tabr,tabir,r : trect;
- packmask : array[1..maxpacks] of longint;
- i,line,j : integer;
- items : array[1..maxpacks] of psitem;
- f : pview;
- found : boolean;
- okbut,cancelbut : pbutton;
- firstitem : array[1..maxpacks] of integer;
- packcbs : array[1..maxpacks] of pcheckboxes;
- packtd : ptabdef;
- labpath : plabel;
- ilpath : pinputline;
- tab : ptab;
- titletext : pcoloredtext;
- labcfg : plabel;
- cfgcb : pcheckboxes;
- scrollbox: pscrollbox;
- sbr,sbsbr: trect;
- sbsb: pscrollbar;
- zipfile : string;
- begin
- f:=nil;
- { walk packages reverse and insert a newsitem for each, and set the mask }
- for j:=1 to cfg.packs do
- with cfg.pack[j] do
- begin
- firstitem[j]:=0;
- items[j]:=nil;
- packmask[j]:=0;
- for i:=packages downto 1 do
- begin
- zipfile:='';
- if file_exists(package[i].zip,startpath) then
- zipfile:=startpath+DirSep+package[i].zip
- else if file_exists(package[i].zipshort,startpath) then
- begin
- zipfile:=startpath+DirSep+package[i].zipshort;
- { update package to replace the full zipname with the short name }
- package[i].zip:=package[i].zipshort;
- end;
- if zipfile<>'' then
- begin
- { get diskspace required }
- package[i].diskspace:=diskspaceN(zipfile);
- {$ifdef MAYBE_LFN}
- if not(locallfnsupport) then
- begin
- if not(haslfn(zipfile)) then
- begin
- items[j]:=newsitem(package[i].name+diskspacestr(package[i].diskspace),items[j]);
- packmask[j]:=packmask[j] or packagemask(i);
- firstitem[j]:=i;
- if createlog then
- writeln(log,'Checking lfn usage for ',zipfile,' ... no lfn');
- end
- else
- begin
- items[j]:=newsitem(package[i].name+' (requires LFN support)',items[j]);
- packmask[j]:=packmask[j] or packagemask(i);
- firstitem[j]:=i;
- if createlog then
- writeln(log,'Checking lfn usage for ',zipfile,' ... uses lfn');
- end;
- end
- else
- {$endif MAYBE_LFN}
- begin
- items[j]:=newsitem(package[i].name+diskspacestr(package[i].diskspace),items[j]);
- packmask[j]:=packmask[j] or packagemask(i);
- firstitem[j]:=i;
- end;
- end
- else
- items[j]:=newsitem(package[i].name,items[j]);
- end;
- end;
- { If no component found abort }
- found:=false;
- for j:=1 to cfg.packs do
- if packmask[j]<>0 then
- found:=true;
- if not found then
- begin
- messagebox('No components found to install, aborting.',nil,mferror+mfokbutton);
- errorhalt;
- end;
- r.assign(x1,y1,x2,y2);
- inherited init(r,'');
- GetExtent(R);
- R.Grow(-2,-1);
- Dec(R.B.Y,2);
- TabR.Copy(R);
- TabIR.Copy(R);
- TabIR.Grow(-2,-2);
- TabIR.Move(-2,0);
- {-------- General Sheets ----------}
- R.Copy(TabIR);
- r.move(0,1);
- r.b.x:=r.a.x+40;
- r.b.y:=r.a.y+1;
- new(titletext,init(r,cfg.title,$71));
- r.move(0,2);
- r.b.x:=r.a.x+40;
- new(labpath,init(r,'~B~ase path',f));
- r.move(0,1);
- r.b.x:=r.a.x+40;
- r.b.y:=r.a.y+1;
- new(ilpath,init(r,high(DirStr)));
- r.move(0,2);
- r.b.x:=r.a.x+40;
- new(labcfg,init(r,'Con~f~ig',f));
- r.move(0,1);
- r.b.x:=r.a.x+40;
- r.b.y:=r.a.y+1;
- new(cfgcb,init(r,newsitem('create fpc.cfg',nil)));
- data.cfgval:=1;
- {-------- Pack Sheets ----------}
- for j:=1 to cfg.packs do
- begin
- R.Copy(TabIR);
- if R.A.Y+cfg.pack[j].packages>R.B.Y then
- R.B.Y:=R.A.Y+cfg.pack[j].packages;
- new(packcbs[j],init(r,items[j]));
- if data.packmask[j]=$ffff then
- data.packmask[j]:=packmask[j];
- packcbs[j]^.enablemask:={$ifdef DEV}$7fffffff{$else}packmask[j]{$endif};
- packcbs[j]^.movedto(firstitem[j]);
- end;
- {--------- Main ---------}
- packtd:=nil;
- sbr.assign(1,3,tabr.b.x-tabr.a.x-3,tabr.b.y-tabr.a.y-1);
- for j:=cfg.packs downto 1 do
- begin
- if (sbr.b.y-sbr.a.y)<cfg.pack[j].packages then
- begin
- sbsbr.assign(sbr.b.x,sbr.a.y,sbr.b.x+1,sbr.b.y);
- New(sbsb, init(sbsbr));
- end
- else
- sbsb:=nil;
- New(ScrollBox, Init(sbr, nil, sbsb));
- PackCbs[j]^.MoveTo(0,0);
- ScrollBox^.Insert(PackCbs[j]);
- packtd:=NewTabDef(
- cfg.pack[j].name,ScrollBox,
- NewTabItem(sbsb,
- NewTabItem(ScrollBox,
- nil)),
- packtd);
- end;
- New(Tab, Init(TabR,
- NewTabDef('~G~eneral',IlPath,
- NewTabItem(TitleText,
- NewTabItem(LabPath,
- NewTabItem(ILPath,
- NewTabItem(LabCfg,
- NewTabItem(CfgCB,
- nil))))),
- packtd)
- ));
- Tab^.GrowMode:=0;
- Insert(Tab);
- line:=tabr.b.y;
- r.assign((width div 2)-18,line,(width div 2)-4,line+2);
- new(okbut,init(r,'~C~ontinue',cmok,bfdefault));
- Insert(OkBut);
- r.assign((width div 2)+4,line,(width div 2)+14,line+2);
- new(cancelbut,init(r,'~Q~uit',cmcancel,bfnormal));
- Insert(CancelBut);
- Tab^.Select;
- end;
- {*****************************************************************************
- TApp
- *****************************************************************************}
- const
- cmstart = 1000;
- procedure tapp.do_installdialog;
- var
- p : pinstalldialog;
- p3 : penddialog;
- r : trect;
- result,
- c : word;
- i,j : longint;
- found : boolean;
- {$ifndef linux}
- DSize,Space,ASpace : longint;
- S: DirStr;
- {$endif}
- procedure doconfigwrite;
- var
- i : longint;
- begin
- for i:=1 to cfg.packs do
- if cfg.pack[i].defcfgfile<>'' then
- writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile,cfg.defcfg,cfg.defcfgs,cfg.pack[i].targetname);
- if haside then
- begin
- for i:=1 to cfg.packs do
- if cfg.pack[i].defidecfgfile<>'' then
- writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defidecfgfile,cfg.defidecfg,cfg.defidecfgs,cfg.pack[i].targetname);
- for i:=1 to cfg.packs do
- if cfg.pack[i].defideinifile<>'' then
- writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defideinifile,cfg.defideini,cfg.defideinis,cfg.pack[i].targetname);
- if hashtmlhelp then
- writehlpindex(data.basepath+DirSep+cfg.DocSub+DirSep+cfg.helpidx);
- end;
- end;
- begin
- data.basepath:=cfg.basepath;
- data.cfgval:=0;
- for j:=1 to cfg.packs do
- data.packmask[j]:=$ffff;
- repeat
- { select components }
- p:=new(pinstalldialog,init);
- c:=executedialog(p,@data);
- if (c=cmok) then
- begin
- if Data.BasePath = '' then
- messagebox('Please, choose the directory for installation first.',nil,mferror+mfokbutton)
- else
- begin
- found:=false;
- for j:=1 to cfg.packs do
- if data.packmask[j]>0 then
- found:=true;
- if found then
- begin
- {$IFNDEF LINUX}
- { TH - check the available disk space here }
- DSize := 0;
- for j:=1 to cfg.packs do
- with cfg.pack[j] do
- begin
- for i:=1 to packages do
- begin
- if data.packmask[j] and packagemask(i)<>0 then
- begin
- ASpace := package[i].diskspace;
- if ASpace = -1 then
- MessageBox ('File ' + package[i].zip +
- ' is probably corrupted!', nil,
- mferror + mfokbutton)
- else Inc (DSize, ASpace);
- end;
- end;
- end;
- S := FExpand (Data.BasePath);
- if S [Length (S)] = DirSep then
- Dec (S [0]);
- Space := DiskFree (byte (Upcase(S [1])) - 64);
- { -1 means that the drive is invalid }
- if Space=-1 then
- begin
- if messagebox('The drive '+S[1]+': is not valid. Do you ' +
- 'want to change the installation path?',nil,
- mferror+mfyesbutton+mfnobutton) = cmYes then
- Continue;
- Space:=0;
- end;
- Space := Space shr 10;
- if Space < DSize then
- S := 'is not'
- else
- S := '';
- if (Space < DSize + 500) then
- begin
- if S = '' then
- S := 'might not be ';
- if messagebox('There ' + S + 'enough space on the target ' +
- 'drive for all the selected components. Do you ' +
- 'want to change the installation path?',nil,
- mferror+mfyesbutton+mfnobutton) = cmYes then
- Continue;
- end;
- {$ENDIF}
- if createinstalldir(data.basepath) then
- break;
- end
- else
- begin
- { maybe only config }
- if (data.cfgval and 1)<>0 then
- begin
- result:=messagebox('No components selected.'#13#13'Create a configfile ?',nil,
- mfinformation+mfyesbutton+mfnobutton);
- if (result=cmYes) and createinstalldir(data.basepath) then
- doconfigwrite;
- exit;
- end
- else
- begin
- result:=messagebox('No components selected.'#13#13'Abort installation?',nil,
- mferror+mfyesbutton+mfnobutton);
- if result=cmYes then
- exit;
- end;
- end;
- end;
- end
- else
- exit;
- until false;
- { extract packages }
- for j:=1 to cfg.packs do
- with cfg.pack[j] do
- begin
- r.assign(10,7,70,18);
- UnzDlg:=new(punzipdialog,init(r,'Extracting Packages'));
- desktop^.insert(UnzDlg);
- for i:=1 to packages do
- begin
- if data.packmask[j] and packagemask(i)<>0 then
- begin
- UnzDlg^.do_unzip(package[i].zip,data.basepath);
- { gather some information about the installed files }
- if copy(package[i].zip,1,3)='ide' then
- haside:=true;
- if copy(package[i].zip,1,7)='doc-htm' then
- begin
- hashtmlhelp:=true;
- { correct the fpctoc file name if .html files are used }
- if package[i].zip='doc-html.zip' then
- if copy(cfg.helpidx,length(cfg.helpidx)-3,4)='.htm' then
- cfg.helpidx:=cfg.helpidx+'l';
- end;
- end;
- end;
- desktop^.delete(UnzDlg);
- dispose(UnzDlg,done);
- end;
- { write config }
- if (data.cfgval and 1)<>0 then
- doconfigwrite;
- { show end message }
- p3:=new(penddialog,init);
- executedialog(p3,nil);
- end;
- procedure tapp.readcfg(const fn:string);
- var
- t : text;
- i,j,k,
- line : longint;
- item,
- s,hs : string;
- params : array[0..0] of pointer;
- {$ifndef FPC}
- procedure readln(var t:text;var s:string);
- var
- c : char;
- i : longint;
- begin
- c:=#0;
- i:=0;
- while (not eof(t)) and (c<>#10) do
- begin
- read(t,c);
- if c<>#10 then
- begin
- inc(i);
- s[i]:=c;
- end;
- end;
- if (i>0) and (s[i]=#13) then
- dec(i);
- s[0]:=chr(i);
- end;
- {$endif}
- begin
- assign(t,StartPath + DirSep + fn);
- {$I-}
- reset(t);
- {$I+}
- if ioresult<>0 then
- begin
- StartPath := GetProgDir;
- assign(t,StartPath + DirSep + fn);
- {$I-}
- reset(t);
- {$I+}
- if ioresult<>0 then
- begin
- params[0]:=@fn;
- messagebox('File %s not found!',@params,mferror+mfokbutton);
- errorhalt;
- end;
- end;
- line:=0;
- while not eof(t) do
- begin
- readln(t,s);
- inc(line);
- if (s<>'') and not(s[1] in ['#',';']) then
- begin
- i:=pos('=',s);
- if i>0 then
- begin
- item:=upper(Copy(s,1,i-1));
- system.delete(s,1,i);
- if item='VERSION' then
- cfg.version:=s
- else
- if item='TITLE' then
- cfg.title:=s
- else
- if item='BASEPATH' then
- cfg.basepath:=s
- else
- if item='HELPIDX' then
- cfg.helpidx:=s
- else
- if item='DOCSUB' then
- cfg.docsub:=s
- else
- if item='DEFAULTCFG' then
- begin
- repeat
- readln(t,s);
- if upper(s)='ENDCFG' then
- break;
- if cfg.defcfgs<maxdefcfgs then
- begin
- inc(cfg.defcfgs);
- cfg.defcfg[cfg.defcfgs]:=newstr(s);
- end;
- until false;
- end
- else if item='DEFAULTIDECFG' then
- begin
- repeat
- readln(t,s);
- if upper(s)='ENDCFG' then
- break;
- if cfg.defidecfgs<maxdefcfgs then
- begin
- inc(cfg.defidecfgs);
- cfg.defidecfg[cfg.defidecfgs]:=newstr(s);
- end;
- until false;
- end
- else if item='DEFAULTIDEINI' then
- begin
- repeat
- readln(t,s);
- if upper(s)='ENDCFG' then
- break;
- if cfg.defideinis<maxdefcfgs then
- begin
- inc(cfg.defideinis);
- cfg.defideini[cfg.defideinis]:=newstr(s);
- end;
- until false;
- end
- else
- if item='PACK' then
- begin
- inc(cfg.packs);
- if cfg.packs>maxpacks then
- begin
- writeln('Too many packs');
- halt(1);
- end;
- cfg.pack[cfg.packs].name:=s;
- end
- else
- if item='CFGFILE' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].defcfgfile:=s
- end
- else
- if item='IDECFGFILE' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].defidecfgfile:=s
- end
- else
- if item='IDEINIFILE' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].defideinifile:=s
- end
- else
- if item='PPC386' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].ppc386:=s;
- end
- else
- if item='BINSUB' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].binsub:=s;
- end
- else
- if item='FILECHECK' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].filechk:=s;
- end
- else
- if item='TARGETNAME' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- cfg.pack[cfg.packs].targetname:=s;
- end
- else
- if item='PACKAGE' then
- begin
- if cfg.packs=0 then
- begin
- writeln('No pack set');
- halt(1);
- end;
- with cfg.pack[cfg.packs] do
- begin
- j:=pos(',',s);
- if (j>0) and (packages<maxpackages) then
- begin
- inc(packages);
- hs:=copy(s,1,j-1);
- k:=pos('[',hs);
- if (k>0) then
- begin
- package[packages].zip:=Copy(hs,1,k-1);
- package[packages].zipshort:=Copy(hs,k+1,length(hs)-k-1);
- end
- else
- package[packages].zip:=hs;
- package[packages].name:=copy(s,j+1,255);
- end;
- package[packages].diskspace:=-1;
- end;
- end
- end;
- end;
- end;
- close(t);
- end;
- procedure tapp.checkavailpack;
- var
- j : longint;
- dir : searchrec;
- begin
- { check the packages }
- j:=0;
- while (j<cfg.packs) do
- begin
- inc(j);
- if cfg.pack[j].filechk<>'' then
- begin
- findfirst(cfg.pack[j].filechk,$20,dir);
- if doserror<>0 then
- begin
- { remove the package }
- move(cfg.pack[j+1],cfg.pack[j],sizeof(tpack)*(cfg.packs-j));
- dec(cfg.packs);
- dec(j);
- end;
- {$IFNDEF TP}
- findclose(dir);
- {$ENDIF}
- end;
- end;
- end;
- procedure tapp.initmenubar;
- var
- r : trect;
- begin
- getextent(r);
- r.b.y:=r.a.y+1;
- menubar:=new(pmenubar,init(r,newmenu(
- newsubmenu('Free Pascal Installer',hcnocontext,newmenu(nil
- ),
- nil))));
- end;
- procedure tapp.handleevent(var event : tevent);
- begin
- inherited handleevent(event);
- if event.what=evcommand then
- if event.command=cmstart then
- begin
- clearevent(event);
- do_installdialog;
- if successfull then
- begin
- event.what:=evcommand;
- event.command:=cmquit;
- handleevent(event);
- end;
- end;
- end;
- {$IFDEF DOSSTUB}
- function CheckOS2: boolean;
- var
- OwnName: PathStr;
- OwnDir: DirStr;
- Name: NameStr;
- Ext: ExtStr;
- DosV, W: word;
- P: PChar;
- const
- Title: string [15] = 'FPC Installer'#0;
- RunBlock: TRunBlock = (Length: $32;
- Dependent: 0;
- Background: 0;
- TraceLevel: 0;
- PrgTitle: @Title [1];
- PrgName: nil;
- Args: nil;
- TermQ: 0;
- Environment: nil;
- Inheritance: 0;
- SesType: 2;
- Icon: nil;
- PgmHandle: 0;
- PgmControl: 2;
- Column: 0;
- Row: 0;
- Width: 80;
- Height: 25);
- begin
- CheckOS2 := false;
- asm
- mov ah, 30h
- int 21h
- xchg ah, al
- mov DosV, ax
- mov ax, 4010h
- int 2Fh
- cmp ax, 4010h
- jnz @0
- xor bx, bx
- @0:
- mov W, bx
- end;
- if DosV > 3 shl 8 then
- begin
- OwnName := FExpand (ParamStr (0));
- FSplit (OwnName, OwnDir, Name, Ext);
- if (DosV >= 20 shl 8 + 10) and (W >= 20 shl 8 + 10) then
- (* OS/2 version 2.1 or later running (double-checked) *)
- begin
- OwnName [Succ (byte (OwnName [0]))] := #0;
- RunBlock.PrgName := @OwnName [1];
- P := Ptr (PrefixSeg, $80);
- if PByte (P)^ <> 0 then
- begin
- Inc (P);
- RunBlock.Args := Ptr (PrefixSeg, $81);
- end;
- asm
- mov ax, 6400h
- mov bx, 0025h
- mov cx, 636Ch
- mov si, offset RunBlock
- int 21h
- jc @0
- mov DosV, 0
- @0:
- end;
- CheckOS2 := DosV = 0;
- end;
- end;
- end;
- {$ENDIF}
- var
- i : longint;
- begin
- { register objects for help streaming }
- RegisterWHTMLScan;
- {$ifdef FPC}
- {$ifdef win32}
- Dos.Exec(GetEnv('COMSPEC'),'/C echo This dummy call gets the mouse to become visible');
- {$endif win32}
- {$endif FPC}
- (* TH - no error boxes if checking an inaccessible disk etc. *)
- {$IFDEF OS2}
- {$IFDEF FPC}
- DosCalls.DosError (0);
- {$ELSE FPC}
- {$IFDEF VirtualPascal}
- OS2Base.DosError (ferr_DisableHardErr);
- {$ELSE VirtualPascal}
- BseDos.DosError (0);
- {$ENDIF VirtualPascal}
- {$ENDIF FPC}
- {$ENDIF}
- {$IFDEF DOSSTUB}
- if CheckOS2 then Halt;
- {$ENDIF}
- createlog:=false;
- {$ifdef MAYBE_LFN}
- locallfnsupport:=system.lfnsupport;
- {$endif MAYBE_LFN}
- for i:=1 to paramcount do
- begin
- if paramstr(i)='-l' then
- createlog:=true
- {$ifdef MAYBE_LFN}
- else if paramstr(i)='--nolfn' then
- begin
- locallfnsupport:=false;
- {$ifdef GO32V2}
- { lfnsupport is a const in win32 RTL }
- system.lfnsupport:=locallfnsupport;
- {$endif GO32V2}
- end
- {$endif MAYBE_LFN}
- else if paramstr(i)='-h' then
- begin
- writeln('FPC Installer Copyright (c) 1993-2002 Florian Klaempfl');
- writeln('Command line options:');
- writeln(' -l create log file');
- {$ifdef MAYBE_LFN}
- writeln(' --nolfn force installation with short file names');
- {$endif MAYBE_LFN}
- writeln;
- writeln(' -h displays this help');
- halt(0);
- end
- else
- begin
- writeln('Illegal command line parameter: ',paramstr(i));
- halt(1);
- end;
- end;
- if createlog then
- begin
- assign(log,'install.log');
- rewrite(log);
- {$ifdef MAYBE_LFN}
- if not(locallfnsupport) then
- writeln(log,'OS doesn''t have LFN support');
- {$endif}
- end;
- getdir(0,startpath);
- successfull:=false;
- fillchar(cfg, SizeOf(cfg), 0);
- fillchar(data, SizeOf(data), 0);
- installapp.init;
- FSplit (FExpand (ParamStr (0)), DStr, CfgName, EStr);
- installapp.readcfg(CfgName + CfgExt);
- installapp.checkavailpack;
- { installapp.readcfg(startpath+dirsep+cfgfile);}
- {$ifdef GO32V2}
- if not(lfnsupport) then
- MessageBox('The operating system doesn''t support LFN (long file names),'+
- ' so some packages will get shorten filenames when installed',nil,mfinformation or mfokbutton);
- {$endif}
- installapp.do_installdialog;
- installapp.done;
- if createlog then
- close(log);
- end.
- {
- $Log$
- Revision 1.6 2002-03-19 09:14:56 pierre
- * fix fpctoc.html problem
- Revision 1.5 2002/03/13 22:27:36 pierre
- * fix problem if invalid drive is given
- Revision 1.4 2002/02/28 21:30:34 peter
- * regenated
- Revision 1.3 2002/02/28 17:02:08 pierre
- * fix win32 compilation if DEBUG cond is set
- Revision 1.2 2002/01/29 22:01:17 peter
- * support fvision
- Revision 1.1 2002/01/29 17:59:15 peter
- * moved installer
- Revision 1.2.2.16 2001/11/24 14:29:54 carl
- * ppc386.cfg -> fpc.cfg
- Revision 1.2.2.15 2001/05/02 16:22:43 pierre
- + Shorten file names to comply with Dos 8+3 limitation
- Revision 1.2.2.14 2001/04/19 15:50:24 pierre
- * remove use of reals so emu387 is not needed anymore
- Revision 1.2.2.13 2001/01/02 09:43:12 florian
- * vresion fixed
- Revision 1.2.2.12 2001/01/02 09:35:50 florian
- * targetname is now read from the .dat file too
- Revision 1.2.2.11 2000/11/26 19:02:58 hajny
- * English correction
- Revision 1.2.2.10 2000/11/26 16:49:57 hajny
- * removed unneeded OS/2 conditionals
- Revision 1.2.2.9 2000/11/09 22:02:33 florian
- * fixed bug 1226: wrong target for the win32 IDE
- Revision 1.2.2.8 2000/10/11 18:08:45 peter
- * lfnsupport is only for go32v2
- Revision 1.2.2.7 2000/10/11 16:49:02 florian
- + fixed a typo and the setting of haside and hashtmlhelp
- Revision 1.2.2.6 2000/10/11 13:10:20 florian
- + added preconfiguratioh of help files
- Revision 1.2.2.5 2000/10/10 22:12:10 florian
- + added a message how to start the IDE
- Revision 1.2.2.4 2000/10/10 16:36:12 florian
- + creation of IDE configuration files added
- Revision 1.2.2.3 2000/09/24 10:52:14 peter
- * window can now also be smaller again
- Revision 1.2.2.2 2000/09/22 08:41:36 pierre
- * add emulation for go32v2 and display currently extraced file
- Revision 1.2.2.1 2000/09/21 10:57:11 pierre
- changes by Gabor for scrolling support
- Revision 1.2 2000/07/21 10:43:01 florian
- + added for lfn support
- Revision 1.1 2000/07/13 06:30:21 michael
- + Initial import
- Revision 1.20 2000/07/09 12:55:45 hajny
- * updated for version 1.0
- Revision 1.19 2000/06/18 18:27:32 hajny
- + archive validity checking, progress indicator, better error checking
- Revision 1.18 2000/02/24 17:47:47 peter
- * last fixes for 0.99.14a release
- Revision 1.17 2000/02/23 17:17:56 peter
- * write ppc386.cfg for all found targets
- Revision 1.16 2000/02/06 12:59:39 peter
- * change upper -> upcase
- * fixed stupid debugging leftover with diskspace check
- Revision 1.15 2000/02/02 17:19:10 pierre
- * avoid diskfree problem and get mouse visible
- Revision 1.14 2000/02/02 15:21:31 peter
- * show errorcode in message when error in unzipping
- Revision 1.13 2000/01/26 21:49:33 peter
- * install.pas compilable by FPC again
- * removed some notes from unzip.pas
- * support installer creation under linux (install has name conflict)
- Revision 1.12 2000/01/26 21:15:59 hajny
- * compilable with TP again (lines < 127install.pas, ifdef around findclose)
- Revision 1.11 2000/01/24 22:21:48 peter
- * new install version (keys not wrong correct yet)
- Revision 1.10 2000/01/18 00:22:48 peter
- * fixed uninited local var
- Revision 1.9 1999/08/03 20:21:53 peter
- * fixed sources mask which was not set correctly
- Revision 1.7 1999/07/01 07:56:58 hajny
- * installation to root fixed
- Revision 1.6 1999/06/29 22:20:19 peter
- * updated to use tab pages
- Revision 1.5 1999/06/25 07:06:30 hajny
- + searching for installation script updated
- Revision 1.4 1999/06/10 20:01:23 peter
- + fcl,fv,gtk support
- Revision 1.3 1999/06/10 15:00:14 peter
- * fixed to compile for not os2
- * update install.dat
- Revision 1.2 1999/06/10 07:28:27 hajny
- * compilable with TP again
- Revision 1.1 1999/02/19 16:45:26 peter
- * moved to fpinst/ directory
- + makefile
- Revision 1.15 1999/02/17 22:34:08 peter
- * updates from TH for OS2
- Revision 1.14 1998/12/22 22:47:34 peter
- * updates for OS2
- * small fixes
- Revision 1.13 1998/12/21 13:11:39 peter
- * updates for 0.99.10
- Revision 1.12 1998/12/16 00:25:34 peter
- * updated for 0.99.10
- * new end dialogbox
- Revision 1.11 1998/11/01 20:32:25 peter
- * packed record
- Revision 1.10 1998/10/25 23:38:35 peter
- * removed warnings
- Revision 1.9 1998/10/23 16:57:40 pierre
- * compiles without -So option
- * the main dialog init was buggy !!
- Revision 1.8 1998/09/22 21:10:31 jonas
- * initialize cfg and data with 0 at startup
- Revision 1.7 1998/09/16 16:46:37 peter
- + updates
- Revision 1.6 1998/09/15 13:11:14 pierre
- small fix to cleanup if no package
- Revision 1.5 1998/09/15 12:06:06 peter
- * install updated to support w32 and dos and config file
- Revision 1.4 1998/09/10 10:50:49 florian
- * DOS install program updated
- Revision 1.3 1998/09/09 13:39:58 peter
- + internal unzip
- * dialog is showed automaticly
- Revision 1.2 1998/04/07 22:47:57 florian
- + version/release/patch numbers as string added
- }
|