12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832 |
- {
- $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[12];
- 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 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 diskspace(const zipfile : string) : string;
- var
- uncompressed : longint;
- s : string;
- begin
- uncompressed:=DiskSpaceN (zipfile);
- if Uncompressed = -1 then DiskSpace := ' [INVALID]' else
- begin
- str(uncompressed,s);
- diskspace:=' ('+s+' KB)';
- end;
- 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;
- S : String;
- Re : Word;
- params : array[0..0] of pointer;
- dir : searchrec;
- r : trect;
- begin
- S:='HTML Index';
- 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 BIT32} FAR;{$ENDIF BIT32}
- 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;
- Cnt: integer;
- 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,path : string) : boolean;
- var
- buf : array[0..255] of char;
- begin
- strpcopy(buf,path+DirSep+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;
- 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
- if file_exists(package[i].zip,startpath) then
- begin
- {$ifdef MAYBE_LFN}
- if not(locallfnsupport) then
- begin
- if not(haslfn(package[i].zip,startpath)) then
- begin
- items[j]:=newsitem(package[i].name+diskspace(startpath+DirSep+package[i].zip),items[j]);
- packmask[j]:=packmask[j] or packagemask(i);
- firstitem[j]:=i;
- if createlog then
- writeln(log,'Checking lfn usage for ',startpath+DirSep+package[i].zip,' ... 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 ',startpath+DirSep+package[i].zip,' ... uses lfn');
- end;
- end
- else
- {$endif MAYBE_LFN}
- begin
- items[j]:=newsitem(package[i].name+diskspace(startpath+DirSep+package[i].zip),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 := DiskSpaceN (package[i].zip);
- 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) 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
- hashtmlhelp:=true;
- 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,
- line : longint;
- item,
- s : 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);
- package[packages].zip:=copy(s,1,j-1);
- package[packages].name:=copy(s,j+1,255);
- end;
- 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
- locallfnsupport:=false
- {$endif MAYBE_LFN}
- else if paramstr(i)='-h' then
- begin
- writeln('FPC Installer Copyright (c) 1993-2001 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.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
- }
|