2
0

install.pas 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993-98 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. This is the install program for the DOS and OS/2 versions of Free Pascal
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. program install;
  14. { $DEFINE DLL} (* TH - if defined, UNZIP32.DLL library is used to unpack. *)
  15. { $DEFINE DOSSTUB} (* TH - should _not_ be defined unless creating a bound DOS and OS/2 installer!!! *)
  16. (* Defining DOSSTUB causes adding a small piece of code *)
  17. (* for starting the OS/2 part from the DOS part of a bound *)
  18. (* application if running in OS/2 VDM (DOS) window. Used *)
  19. (* only if compiling with TP/BP (see conditionals below). *)
  20. {$IFDEF VER60}
  21. {$DEFINE TP}
  22. {$ENDIF}
  23. {$IFDEF VER70}
  24. {$DEFINE TP}
  25. {$ENDIF}
  26. {$IFNDEF TP}
  27. {$UNDEF DOSSTUB}
  28. {$ELSE}
  29. {$IFDEF OS2}
  30. {$UNDEF DOSSTUB}
  31. {$ENDIF}
  32. {$ENDIF}
  33. {$IFDEF DPMI}
  34. {$UNDEF DOSSTUB}
  35. {$ENDIF}
  36. {$ifdef go32v2}
  37. {$define MAYBE_LFN}
  38. {$endif}
  39. {$ifdef debug}
  40. {$ifdef win32}
  41. {$define MAYBE_LFN}
  42. {$endif win32}
  43. {$endif debug}
  44. {$ifdef TP}
  45. {$define MAYBE_LFN}
  46. {$endif}
  47. uses
  48. {$IFDEF OS2}
  49. {$IFDEF FPC}
  50. DosCalls,
  51. {$ELSE FPC}
  52. {$IFDEF VirtualPascal}
  53. OS2Base,
  54. {$ELSE VirtualPascal}
  55. BseDos,
  56. {$ENDIF VirtualPascal}
  57. {$ENDIF FPC}
  58. {$ENDIF OS2}
  59. {$IFDEF GO32V2}
  60. { emu387, not needed anymore PM }
  61. {$ENDIF}
  62. {$ifdef HEAPTRC}
  63. heaptrc,
  64. {$endif HEAPTRC}
  65. strings,dos,objects,drivers,
  66. {$IFNDEF FVISION}
  67. commands,
  68. HelpCtx,
  69. {$ENDIF}
  70. unzip,ziptypes,
  71. {$IFDEF DLL}
  72. unzipdll,
  73. {$ENDIF}
  74. app,dialogs,views,menus,msgbox,colortxt,tabs,scroll,
  75. WHTMLScn;
  76. const
  77. installerversion='1.0.4';
  78. maxpacks=10;
  79. maxpackages=20;
  80. maxdefcfgs=1024;
  81. HTMLIndexExt = '.htx';
  82. CfgExt = '.dat';
  83. MaxStatusPos = 4;
  84. StatusChars: string [MaxStatusPos] = '/-\|';
  85. StatusPos: byte = 1;
  86. { this variable is set to true if an ide is installed }
  87. haside : boolean = false;
  88. hashtmlhelp : boolean = false;
  89. {$ifdef linux}
  90. DirSep='/';
  91. {$else}
  92. DirSep='\';
  93. {$endif}
  94. type
  95. tpackage=record
  96. name : string[60];
  97. zip : string[40]; { default zipname }
  98. zipshort : string[12]; { 8.3 zipname }
  99. diskspace : longint; { diskspace required }
  100. end;
  101. tpack=record
  102. name : string[12];
  103. binsub : string[40];
  104. ppc386 : string[20];
  105. targetname : string[20];
  106. defidecfgfile,
  107. defideinifile,
  108. defcfgfile : string[12];
  109. include : boolean;
  110. filechk : string[40];
  111. packages : longint;
  112. package : array[1..maxpackages] of tpackage;
  113. end;
  114. tcfgarray = array[1..maxdefcfgs] of pstring;
  115. cfgrec=record
  116. title : string[80];
  117. version : string[20];
  118. helpidx,
  119. docsub,
  120. basepath : DirStr;
  121. packs : word;
  122. pack : array[1..maxpacks] of tpack;
  123. defideinis,
  124. defidecfgs,
  125. defcfgs : longint;
  126. defideini,
  127. defidecfg,
  128. defcfg : tcfgarray;
  129. end;
  130. datarec=packed record
  131. basepath : DirStr;
  132. cfgval : word;
  133. packmask : array[1..maxpacks] of word;
  134. end;
  135. punzipdialog=^tunzipdialog;
  136. tunzipdialog=object(tdialog)
  137. filetext : pstatictext;
  138. extractfiletext : pstatictext;
  139. constructor Init(var Bounds: TRect; ATitle: TTitleStr);
  140. procedure do_unzip(s,topath:string);
  141. end;
  142. penddialog = ^tenddialog;
  143. tenddialog = object(tdialog)
  144. constructor init;
  145. end;
  146. pinstalldialog = ^tinstalldialog;
  147. tinstalldialog = object(tdialog)
  148. constructor init;
  149. end;
  150. PFPHTMLFileLinkScanner = ^TFPHTMLFileLinkScanner;
  151. TFPHTMLFileLinkScanner = object(THTMLFileLinkScanner)
  152. function CheckURL(const URL: string): boolean; virtual;
  153. function CheckText(const Text: string): boolean; virtual;
  154. procedure ProcessDoc(Doc: PHTMLLinkScanFile); virtual;
  155. end;
  156. phtmlindexdialog = ^thtmlindexdialog;
  157. thtmlindexdialog = object(tdialog)
  158. text : pstatictext;
  159. constructor init(var Bounds: TRect; ATitle: TTitleStr);
  160. end;
  161. tapp = object(tapplication)
  162. procedure initmenubar;virtual;
  163. procedure handleevent(var event : tevent);virtual;
  164. procedure do_installdialog;
  165. procedure readcfg(const fn:string);
  166. procedure checkavailpack;
  167. end;
  168. {$IFDEF DOSSTUB}
  169. PByte = ^byte;
  170. PRunBlock = ^TRunBlock;
  171. TRunBlock = record
  172. Length: word;
  173. Dependent: word;
  174. Background: word;
  175. TraceLevel: word;
  176. PrgTitle: PChar;
  177. PrgName: PChar;
  178. Args: PChar;
  179. TermQ: longint;
  180. Environment: pointer;
  181. Inheritance: word;
  182. SesType: word;
  183. Icon: pointer;
  184. PgmHandle: longint;
  185. PgmControl: word;
  186. Column: word;
  187. Row: word;
  188. Width: word;
  189. Height: word;
  190. end;
  191. {$ENDIF}
  192. var
  193. installapp : tapp;
  194. startpath : string;
  195. successfull : boolean;
  196. cfg : cfgrec;
  197. data : datarec;
  198. CfgName: NameStr;
  199. DStr: DirStr;
  200. EStr: ExtStr;
  201. UnzDlg : punzipdialog;
  202. log : text;
  203. createlog : boolean;
  204. {$IFNDEF DLL}
  205. const
  206. UnzipErr: longint = 0;
  207. {$ENDIF}
  208. {$ifdef MAYBE_LFN}
  209. const
  210. locallfnsupport : boolean = false;
  211. {$endif MAYBE_LFN}
  212. {*****************************************************************************
  213. Helpers
  214. *****************************************************************************}
  215. procedure errorhalt;
  216. begin
  217. installapp.done;
  218. halt(1);
  219. end;
  220. function packagemask(i:longint):longint;
  221. begin
  222. packagemask:=1 shl (i-1);
  223. end;
  224. function upper(const s : string):string;
  225. var
  226. i : integer;
  227. begin
  228. for i:=1 to length(s) do
  229. if s[i] in ['a'..'z'] then
  230. upper[i]:=chr(ord(s[i])-32)
  231. else
  232. upper[i]:=s[i];
  233. upper[0]:=s[0];
  234. end;
  235. procedure Replace(var s:string;const s1,s2:string);
  236. var
  237. i : longint;
  238. begin
  239. repeat
  240. i:=pos(s1,s);
  241. if i>0 then
  242. begin
  243. Delete(s,i,length(s1));
  244. Insert(s2,s,i);
  245. end;
  246. until i=0;
  247. end;
  248. function DotStr(l:longint):string;
  249. var
  250. TmpStr : string[32];
  251. i : longint;
  252. begin
  253. Str(l,TmpStr);
  254. i:=Length(TmpStr);
  255. while (i>3) do
  256. begin
  257. i:=i-3;
  258. if TmpStr[i]<>'-' then
  259. Insert('.',TmpStr,i+1);
  260. end;
  261. DotStr:=TmpStr;
  262. end;
  263. function file_exists(const f : string;const path : string) : boolean;
  264. begin
  265. file_exists:=fsearch(f,path)<>'';
  266. end;
  267. function createdir(s:string):boolean;
  268. var
  269. s1,start : string;
  270. err : boolean;
  271. i : longint;
  272. begin
  273. err:=false;
  274. {$I-}
  275. getdir(0,start);
  276. {$ifndef linux}
  277. if (s[2]=':') and (s[3]=DirSep) then
  278. begin
  279. chdir(Copy(s,1,3));
  280. Delete(S,1,3);
  281. end;
  282. {$endif}
  283. repeat
  284. i:=Pos(DirSep,s);
  285. if i=0 then
  286. i:=255;
  287. s1:=Copy(s,1,i-1);
  288. Delete(s,1,i);
  289. ChDir(s1);
  290. if ioresult<>0 then
  291. begin
  292. mkdir(s1);
  293. chdir(s1);
  294. if ioresult<>0 then
  295. begin
  296. err:=true;
  297. break;
  298. end;
  299. end;
  300. until s='';
  301. chdir(start);
  302. {$I+}
  303. createdir:=err;
  304. end;
  305. function DiskSpaceN(const zipfile : string) : longint;
  306. var
  307. compressed,uncompressed : longint;
  308. s : string;
  309. begin
  310. s:=zipfile+#0;
  311. if not (IsZip (@S [1])) then
  312. DiskSpaceN := -1
  313. else
  314. begin
  315. Uncompressed:=UnzipSize(@s[1],compressed);
  316. DiskSpaceN:=uncompressed shr 10;
  317. end;
  318. end;
  319. function diskspacestr(uncompressed : longint) : string;
  320. begin
  321. if Uncompressed = -1 then
  322. DiskSpacestr := ' [INVALID]'
  323. else
  324. diskspacestr:=' ('+DotStr(uncompressed)+' KB)';
  325. end;
  326. function createinstalldir(s : string) : boolean;
  327. var
  328. err : boolean;
  329. dir : searchrec;
  330. params : array[0..0] of pointer;
  331. begin
  332. if s[length(s)]=DirSep then
  333. dec(s[0]);
  334. FindFirst(s,AnyFile,dir);
  335. if doserror=0 then
  336. begin
  337. if Dir.Attr and Directory = 0 then
  338. begin
  339. messagebox('A file with the name chosen as the installation '+
  340. 'directory exists already. Cannot create this directory!',nil,
  341. mferror+mfokbutton);
  342. createinstalldir:=false;
  343. end else
  344. createinstalldir:=messagebox('The installation directory exists already. '+
  345. 'Do you want to continue ?',nil,
  346. mferror+mfyesbutton+mfnobutton)=cmYes;
  347. exit;
  348. end;
  349. err:=Createdir(s);
  350. if err then
  351. begin
  352. params[0]:=@s;
  353. messagebox('The installation directory %s couldn''t be created',
  354. @params,mferror+mfokbutton);
  355. createinstalldir:=false;
  356. exit;
  357. end;
  358. {$ifndef TP}
  359. {$IFNDEF OS2}
  360. FindClose (dir);
  361. {$ENDIF}
  362. {$endif}
  363. createinstalldir:=true;
  364. end;
  365. function GetProgDir: DirStr;
  366. var
  367. D: DirStr;
  368. N: NameStr;
  369. E: ExtStr;
  370. begin
  371. FSplit (FExpand (ParamStr (0)), D, N, E);
  372. if (D [0] <> #0) and (D [byte (D [0])] = '\') then Dec (D [0]);
  373. GetProgDir := D;
  374. end;
  375. function RTrim(const S: string): string;
  376. var
  377. i : longint;
  378. begin
  379. i:=length(s);
  380. while (i>0) and (s[i]=' ') do
  381. dec(i);
  382. RTrim:=Copy(s,1,i);
  383. end;
  384. function LTrim(const S: string): string;
  385. var
  386. i : longint;
  387. begin
  388. i:=1;
  389. while (i<length(s)) and (s[i]=' ') do
  390. inc(i);
  391. LTrim:=Copy(s,i,255);
  392. end;
  393. function Trim(const S: string): string;
  394. begin
  395. Trim:=RTrim(LTrim(S));
  396. end;
  397. function CompareText(S1, S2: string): integer;
  398. var R: integer;
  399. begin
  400. S1:=Upcase(S1);
  401. S2:=Upcase(S2);
  402. if S1<S2 then R:=-1 else
  403. if S1>S2 then R:= 1 else
  404. R:=0;
  405. CompareText:=R;
  406. end;
  407. function ExtOf(const S: string): string;
  408. var D: DirStr; E: ExtStr; N: NameStr;
  409. begin
  410. FSplit(S,D,N,E);
  411. ExtOf:=E;
  412. end;
  413. function DirAndNameOf(const S: string): string;
  414. var D: DirStr; E: ExtStr; N: NameStr;
  415. begin
  416. FSplit(S,D,N,E);
  417. DirAndNameOf:=D+N;
  418. end;
  419. {*****************************************************************************
  420. HTML-Index Generation
  421. *****************************************************************************}
  422. var
  423. indexdlg : phtmlindexdialog;
  424. constructor thtmlindexdialog.Init(var Bounds: TRect; ATitle: TTitleStr);
  425. var
  426. r : trect;
  427. begin
  428. inherited init(bounds,atitle);
  429. R.Assign (4, 2,bounds.B.X-Bounds.A.X-2, 4);
  430. text:=new(pstatictext,init(r,'Please wait ...'));
  431. insert(text);
  432. end;
  433. procedure TFPHTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
  434. var
  435. oldtext : pstring;
  436. begin
  437. oldtext:=indexdlg^.text^.text;
  438. indexdlg^.text^.text:=newstr('Processing '+Doc^.GetDocumentURL);
  439. indexdlg^.text^.drawview;
  440. inherited ProcessDoc(Doc);
  441. disposestr(indexdlg^.text^.text);
  442. indexdlg^.text^.text:=oldtext;
  443. indexdlg^.text^.drawview;
  444. end;
  445. function TFPHTMLFileLinkScanner.CheckURL(const URL: string): boolean;
  446. var OK: boolean;
  447. const HTTPPrefix = 'http:';
  448. FTPPrefix = 'ftp:';
  449. begin
  450. OK:=inherited CheckURL(URL);
  451. if OK then OK:=DirAndNameOf(URL)<>'';
  452. if OK then OK:=CompareText(copy(ExtOf(URL),1,4),'.HTM')=0;
  453. if OK then OK:=CompareText(copy(URL,1,length(HTTPPrefix)),HTTPPrefix)<>0;
  454. if OK then OK:=CompareText(copy(URL,1,length(FTPPrefix)),FTPPrefix)<>0;
  455. CheckURL:=OK;
  456. end;
  457. function TFPHTMLFileLinkScanner.CheckText(const Text: string): boolean;
  458. var OK: boolean;
  459. S: string;
  460. begin
  461. S:=Trim(Text);
  462. OK:=(S<>'') and (copy(S,1,1)<>'[');
  463. CheckText:=OK;
  464. end;
  465. procedure writehlpindex(filename : string);
  466. var
  467. LS : PFPHTMLFileLinkScanner;
  468. BS : PBufStream;
  469. Re : Word;
  470. params : array[0..0] of pointer;
  471. dir : searchrec;
  472. r : trect;
  473. begin
  474. r.assign(10,10,70,15);
  475. indexdlg:=new(phtmlindexdialog,init(r,'Creating HTML index file, please wait ...'));
  476. desktop^.insert(indexdlg);
  477. {$warning FIXME !!!! }
  478. New(LS, Init(''));
  479. LS^.ProcessDocument(FileName,[soSubDocsOnly]);
  480. if LS^.GetDocumentCount=0 then
  481. begin
  482. params[0]:=@filename;
  483. MessageBox('Problem creating help index %1, aborting',@params,
  484. mferror+mfokbutton);
  485. end
  486. else
  487. begin
  488. FileName:=DirAndNameOf(FileName)+HTMLIndexExt;
  489. findfirst(filename,AnyFile,dir);
  490. if doserror=0 then
  491. begin
  492. params[0]:=@filename;
  493. Re:=MessageBox('Help index %s already exists, overwrite it?',@params,
  494. mfinformation+mfyesbutton+mfnobutton);
  495. end;
  496. if Re<>cmNo then
  497. begin
  498. New(BS, Init(FileName, stCreate, 4096));
  499. if Assigned(BS)=false then
  500. begin
  501. MessageBox('Error while writing help index! '+
  502. 'No help index is created',@params,
  503. mferror+mfokbutton);
  504. Re:=cmCancel;
  505. end
  506. else
  507. begin
  508. LS^.StoreDocuments(BS^);
  509. if BS^.Status<>stOK then
  510. begin
  511. MessageBox('Error while writing help index!'#13+
  512. 'No help index is created',@params,
  513. mferror+mfokbutton);
  514. Re:=cmCancel;
  515. end;
  516. Dispose(BS, Done);
  517. end;
  518. end;
  519. end;
  520. Dispose(LS, Done);
  521. desktop^.delete(indexdlg);
  522. dispose(indexdlg,done);
  523. end;
  524. {*****************************************************************************
  525. Writing of fpc.cfg
  526. *****************************************************************************}
  527. procedure writedefcfg(const fn:string;const cfgdata : tcfgarray;count : longint;const targetname : string);
  528. var
  529. t : text;
  530. i : longint;
  531. s : string;
  532. dir : searchrec;
  533. params : array[0..0] of pointer;
  534. d : dirstr;
  535. n : namestr;
  536. e : extstr;
  537. begin
  538. { already exists }
  539. findfirst(fn,AnyFile,dir);
  540. if doserror=0 then
  541. begin
  542. params[0]:=@fn;
  543. if MessageBox('Config %s already exists, continue writing default config?',@params,
  544. mfinformation+mfyesbutton+mfnobutton)=cmNo then
  545. exit;
  546. end;
  547. { create directory }
  548. fsplit(fn,d,n,e);
  549. createdir(d);
  550. { create the fpc.cfg }
  551. assign(t,fn);
  552. {$I-}
  553. rewrite(t);
  554. {$I+}
  555. if ioresult<>0 then
  556. begin
  557. params[0]:=@fn;
  558. MessageBox(#3'A config not written.'#13#3'%s'#13#3'couldn''t be created',@params,mfinformation+mfokbutton);
  559. exit;
  560. end;
  561. for i:=1 to count do
  562. if assigned(cfgdata[i]) then
  563. begin
  564. s:=cfgdata[i]^;
  565. Replace(s,'$1',data.basepath);
  566. Replace(s,'$target',targetname);
  567. writeln(t,s);
  568. end
  569. else
  570. writeln(t,'');
  571. close(t);
  572. end;
  573. {*****************************************************************************
  574. TUnZipDialog
  575. *****************************************************************************}
  576. constructor tunzipdialog.Init(var Bounds: TRect; ATitle: TTitleStr);
  577. var
  578. r : trect;
  579. begin
  580. inherited init(bounds,atitle);
  581. (* R.Assign (11, 4, 38, 6);*)
  582. R.Assign (1, 4,bounds.B.X-Bounds.A.X-2, 6);
  583. filetext:=new(pstatictext,init(r,#3'File: '));
  584. insert(filetext);
  585. R.Assign (1, 7,bounds.B.X-Bounds.A.X-2, 9);
  586. extractfiletext:=new(pstatictext,init(r,#3' '));
  587. insert(extractfiletext);
  588. end;
  589. {$IFNDEF DLL}
  590. procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
  591. {$ifndef fpc}{$IFNDEF BIT32} FAR;{$ENDIF BIT32}{$endif}
  592. var
  593. name : string;
  594. begin
  595. case Rec^.Status of
  596. unzip_starting:
  597. UnzipErr := 0;
  598. file_starting:
  599. begin
  600. with UnzDlg^.extractfiletext^ do
  601. begin
  602. Disposestr(text);
  603. name:=Strpas(Rec^.FileName);
  604. Text:=NewStr(#3+name);
  605. DrawView;
  606. end;
  607. end;
  608. file_failure:
  609. UnzipErr := RetCode;
  610. file_unzipping:
  611. begin
  612. with UnzDlg^.FileText^ do
  613. begin
  614. Inc (StatusPos);
  615. if StatusPos > MaxStatusPos then StatusPos := 1;
  616. Text^ [Length (Text^)] := StatusChars [StatusPos];
  617. DrawView;
  618. end;
  619. end;
  620. end;
  621. end;
  622. {$ENDIF}
  623. procedure tunzipdialog.do_unzip(s,topath : string);
  624. var
  625. again : boolean;
  626. fn,dir,wild : string;
  627. begin
  628. Disposestr(filetext^.text);
  629. filetext^.Text:=NewStr(#3'File: '+s + #13#3' ');
  630. filetext^.drawview;
  631. if not(file_exists(s,startpath)) then
  632. begin
  633. messagebox('File "'+s+'" missing for the selected installation. '+
  634. 'Installation hasn''t been completed.',nil,mferror+mfokbutton);
  635. errorhalt;
  636. end;
  637. {$IFNDEF DLL}
  638. {$IFDEF FPC}
  639. SetUnzipReportProc (@UnzipCheckFn);
  640. {$ELSE FPC}
  641. SetUnzipReportProc (UnzipCheckFn);
  642. {$ENDIF FPC}
  643. {$ENDIF DLL}
  644. repeat
  645. fn:=startpath+DirSep+s+#0;
  646. dir:=topath+#0;
  647. wild:=AllFiles + #0;
  648. again:=false;
  649. FileUnzipEx(@fn[1],@dir[1],@wild[1]);
  650. if (UnzipErr <> 0) then
  651. begin
  652. Str(UnzipErr,s);
  653. if messagebox('Error (' + S + ') while extracting. Disk full?'#13+
  654. #13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then
  655. errorhalt
  656. else
  657. again:=true;
  658. end;
  659. until not again;
  660. end;
  661. {*****************************************************************************
  662. TEndDialog
  663. *****************************************************************************}
  664. constructor tenddialog.init;
  665. var
  666. R : TRect;
  667. P : PStaticText;
  668. Control : PButton;
  669. YB: word;
  670. {$IFNDEF LINUX}
  671. i : longint;
  672. S: string;
  673. WPath: boolean;
  674. {$ENDIF}
  675. {$IFDEF OS2}
  676. ErrPath: array [0..259] of char;
  677. Handle: longint;
  678. WLibPath: boolean;
  679. const
  680. EMXName: array [1..4] of char = 'EMX'#0;
  681. {$ENDIF}
  682. begin
  683. if haside then
  684. YB := 15
  685. else
  686. YB := 14;
  687. {$IFNDEF LINUX}
  688. s:='';
  689. for i:=1 to cfg.packs do
  690. if cfg.pack[i].binsub<>'' then
  691. begin
  692. if s<>'' then
  693. s:=s+';';
  694. S := s+Data.BasePath + Cfg.pack[i].BinSub;
  695. end;
  696. if Pos (Upper (S), Upper (GetEnv ('PATH'))) = 0 then
  697. begin
  698. WPath := true;
  699. Inc (YB, 2);
  700. end
  701. else
  702. WPath := false;
  703. {$IFDEF OS2}
  704. if DosLoadModule (@ErrPath, SizeOf (ErrPath), @EMXName, Handle) = 0 then
  705. begin
  706. WLibPath := false;
  707. DosFreeModule (Handle);
  708. end
  709. else
  710. begin
  711. WLibPath := true;
  712. Inc (YB, 2);
  713. end;
  714. {$ENDIF}
  715. {$ENDIF}
  716. R.Assign(6, 6, 74, YB);
  717. inherited init(r,'Installation Successfull');
  718. {$IFNDEF LINUX}
  719. if WPath then
  720. begin
  721. R.Assign(2, 3, 64, 5);
  722. P:=new(pstatictext,init(r,'Extend your PATH variable with '''+S+''''));
  723. insert(P);
  724. end;
  725. {$IFDEF OS2}
  726. if WLibPath then
  727. begin
  728. if WPath then
  729. S := 'and your LIBPATH with ''' + S + '\dll'''
  730. else
  731. S := 'Extend your LIBPATH with ''' + S + '\dll''';
  732. R.Assign (2, YB - 14, 64, YB - 12);
  733. P := New (PStaticText, Init (R, S));
  734. Insert (P);
  735. end;
  736. {$ENDIF}
  737. {$ENDIF}
  738. R.Assign(2, YB - 13, 64, YB - 12);
  739. P:=new(pstatictext,init(r,'To compile files enter '''+cfg.pack[1].ppc386+' [file]'''));
  740. insert(P);
  741. if haside then
  742. begin
  743. R.Assign(2, YB - 12, 64, YB - 10);
  744. P:=new(pstatictext,init(r,'To start the IDE (Integrated Development Environment) type ''fp'' at a command line prompt'));
  745. insert(P);
  746. end;
  747. R.Assign (29, YB - 9, 39, YB - 7);
  748. Control := New (PButton, Init (R,'~O~k', cmOK, bfDefault));
  749. Insert (Control);
  750. end;
  751. {*****************************************************************************
  752. TInstallDialog
  753. *****************************************************************************}
  754. {$ifdef MAYBE_LFN}
  755. var
  756. islfn : boolean;
  757. procedure lfnreport( Retcode : longint;Rec : pReportRec );
  758. var
  759. p : pathstr;
  760. n : namestr;
  761. e : extstr;
  762. begin
  763. fsplit(strpas(rec^.Filename),p,n,e);
  764. if (length(n)>8) or (length(e)>4) then
  765. islfn:=true;
  766. end;
  767. function haslfn(const zipfile : string) : boolean;
  768. var
  769. buf : array[0..255] of char;
  770. begin
  771. strpcopy(buf,zipfile);
  772. islfn:=false;
  773. {$ifdef FPC}
  774. ViewZip(buf,AllFiles,@lfnreport);
  775. {$else FPC}
  776. ViewZip(buf,AllFiles,lfnreport);
  777. {$endif FPC}
  778. haslfn:=islfn;
  779. end;
  780. {$endif MAYBE_LFN}
  781. constructor tinstalldialog.init;
  782. const
  783. width = 76;
  784. height = 20;
  785. x1 = (79-width) div 2;
  786. y1 = (23-height) div 2;
  787. x2 = x1+width;
  788. y2 = y1+height;
  789. var
  790. tabr,tabir,r : trect;
  791. packmask : array[1..maxpacks] of longint;
  792. i,line,j : integer;
  793. items : array[1..maxpacks] of psitem;
  794. f : pview;
  795. found : boolean;
  796. okbut,cancelbut : pbutton;
  797. firstitem : array[1..maxpacks] of integer;
  798. packcbs : array[1..maxpacks] of pcheckboxes;
  799. packtd : ptabdef;
  800. labpath : plabel;
  801. ilpath : pinputline;
  802. tab : ptab;
  803. titletext : pcoloredtext;
  804. labcfg : plabel;
  805. cfgcb : pcheckboxes;
  806. scrollbox: pscrollbox;
  807. sbr,sbsbr: trect;
  808. sbsb: pscrollbar;
  809. zipfile : string;
  810. begin
  811. f:=nil;
  812. { walk packages reverse and insert a newsitem for each, and set the mask }
  813. for j:=1 to cfg.packs do
  814. with cfg.pack[j] do
  815. begin
  816. firstitem[j]:=0;
  817. items[j]:=nil;
  818. packmask[j]:=0;
  819. for i:=packages downto 1 do
  820. begin
  821. zipfile:='';
  822. if file_exists(package[i].zip,startpath) then
  823. zipfile:=startpath+DirSep+package[i].zip
  824. else if file_exists(package[i].zipshort,startpath) then
  825. begin
  826. zipfile:=startpath+DirSep+package[i].zipshort;
  827. { update package to replace the full zipname with the short name }
  828. package[i].zip:=package[i].zipshort;
  829. end;
  830. if zipfile<>'' then
  831. begin
  832. { get diskspace required }
  833. package[i].diskspace:=diskspaceN(zipfile);
  834. {$ifdef MAYBE_LFN}
  835. if not(locallfnsupport) then
  836. begin
  837. if not(haslfn(zipfile)) then
  838. begin
  839. items[j]:=newsitem(package[i].name+diskspacestr(package[i].diskspace),items[j]);
  840. packmask[j]:=packmask[j] or packagemask(i);
  841. firstitem[j]:=i;
  842. if createlog then
  843. writeln(log,'Checking lfn usage for ',zipfile,' ... no lfn');
  844. end
  845. else
  846. begin
  847. items[j]:=newsitem(package[i].name+' (requires LFN support)',items[j]);
  848. packmask[j]:=packmask[j] or packagemask(i);
  849. firstitem[j]:=i;
  850. if createlog then
  851. writeln(log,'Checking lfn usage for ',zipfile,' ... uses lfn');
  852. end;
  853. end
  854. else
  855. {$endif MAYBE_LFN}
  856. begin
  857. items[j]:=newsitem(package[i].name+diskspacestr(package[i].diskspace),items[j]);
  858. packmask[j]:=packmask[j] or packagemask(i);
  859. firstitem[j]:=i;
  860. end;
  861. end
  862. else
  863. items[j]:=newsitem(package[i].name,items[j]);
  864. end;
  865. end;
  866. { If no component found abort }
  867. found:=false;
  868. for j:=1 to cfg.packs do
  869. if packmask[j]<>0 then
  870. found:=true;
  871. if not found then
  872. begin
  873. messagebox('No components found to install, aborting.',nil,mferror+mfokbutton);
  874. errorhalt;
  875. end;
  876. r.assign(x1,y1,x2,y2);
  877. inherited init(r,'');
  878. GetExtent(R);
  879. R.Grow(-2,-1);
  880. Dec(R.B.Y,2);
  881. TabR.Copy(R);
  882. TabIR.Copy(R);
  883. TabIR.Grow(-2,-2);
  884. TabIR.Move(-2,0);
  885. {-------- General Sheets ----------}
  886. R.Copy(TabIR);
  887. r.move(0,1);
  888. r.b.x:=r.a.x+40;
  889. r.b.y:=r.a.y+1;
  890. new(titletext,init(r,cfg.title,$71));
  891. r.move(0,2);
  892. r.b.x:=r.a.x+40;
  893. new(labpath,init(r,'~B~ase path',f));
  894. r.move(0,1);
  895. r.b.x:=r.a.x+40;
  896. r.b.y:=r.a.y+1;
  897. new(ilpath,init(r,high(DirStr)));
  898. r.move(0,2);
  899. r.b.x:=r.a.x+40;
  900. new(labcfg,init(r,'Con~f~ig',f));
  901. r.move(0,1);
  902. r.b.x:=r.a.x+40;
  903. r.b.y:=r.a.y+1;
  904. new(cfgcb,init(r,newsitem('create fpc.cfg',nil)));
  905. data.cfgval:=1;
  906. {-------- Pack Sheets ----------}
  907. for j:=1 to cfg.packs do
  908. begin
  909. R.Copy(TabIR);
  910. if R.A.Y+cfg.pack[j].packages>R.B.Y then
  911. R.B.Y:=R.A.Y+cfg.pack[j].packages;
  912. new(packcbs[j],init(r,items[j]));
  913. if data.packmask[j]=$ffff then
  914. data.packmask[j]:=packmask[j];
  915. packcbs[j]^.enablemask:={$ifdef DEV}$7fffffff{$else}packmask[j]{$endif};
  916. packcbs[j]^.movedto(firstitem[j]);
  917. end;
  918. {--------- Main ---------}
  919. packtd:=nil;
  920. sbr.assign(1,3,tabr.b.x-tabr.a.x-3,tabr.b.y-tabr.a.y-1);
  921. for j:=cfg.packs downto 1 do
  922. begin
  923. if (sbr.b.y-sbr.a.y)<cfg.pack[j].packages then
  924. begin
  925. sbsbr.assign(sbr.b.x,sbr.a.y,sbr.b.x+1,sbr.b.y);
  926. New(sbsb, init(sbsbr));
  927. end
  928. else
  929. sbsb:=nil;
  930. New(ScrollBox, Init(sbr, nil, sbsb));
  931. PackCbs[j]^.MoveTo(0,0);
  932. ScrollBox^.Insert(PackCbs[j]);
  933. packtd:=NewTabDef(
  934. cfg.pack[j].name,ScrollBox,
  935. NewTabItem(sbsb,
  936. NewTabItem(ScrollBox,
  937. nil)),
  938. packtd);
  939. end;
  940. New(Tab, Init(TabR,
  941. NewTabDef('~G~eneral',IlPath,
  942. NewTabItem(TitleText,
  943. NewTabItem(LabPath,
  944. NewTabItem(ILPath,
  945. NewTabItem(LabCfg,
  946. NewTabItem(CfgCB,
  947. nil))))),
  948. packtd)
  949. ));
  950. Tab^.GrowMode:=0;
  951. Insert(Tab);
  952. line:=tabr.b.y;
  953. r.assign((width div 2)-18,line,(width div 2)-4,line+2);
  954. new(okbut,init(r,'~C~ontinue',cmok,bfdefault));
  955. Insert(OkBut);
  956. r.assign((width div 2)+4,line,(width div 2)+14,line+2);
  957. new(cancelbut,init(r,'~Q~uit',cmcancel,bfnormal));
  958. Insert(CancelBut);
  959. Tab^.Select;
  960. end;
  961. {*****************************************************************************
  962. TApp
  963. *****************************************************************************}
  964. const
  965. cmstart = 1000;
  966. procedure tapp.do_installdialog;
  967. var
  968. p : pinstalldialog;
  969. p3 : penddialog;
  970. r : trect;
  971. result,
  972. c : word;
  973. i,j : longint;
  974. found : boolean;
  975. {$ifndef linux}
  976. DSize,Space,ASpace : longint;
  977. S: DirStr;
  978. {$endif}
  979. procedure doconfigwrite;
  980. var
  981. i : longint;
  982. begin
  983. for i:=1 to cfg.packs do
  984. if cfg.pack[i].defcfgfile<>'' then
  985. writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile,cfg.defcfg,cfg.defcfgs,cfg.pack[i].targetname);
  986. if haside then
  987. begin
  988. for i:=1 to cfg.packs do
  989. if cfg.pack[i].defidecfgfile<>'' then
  990. writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defidecfgfile,cfg.defidecfg,cfg.defidecfgs,cfg.pack[i].targetname);
  991. for i:=1 to cfg.packs do
  992. if cfg.pack[i].defideinifile<>'' then
  993. writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defideinifile,cfg.defideini,cfg.defideinis,cfg.pack[i].targetname);
  994. if hashtmlhelp then
  995. writehlpindex(data.basepath+DirSep+cfg.DocSub+DirSep+cfg.helpidx);
  996. end;
  997. end;
  998. begin
  999. data.basepath:=cfg.basepath;
  1000. data.cfgval:=0;
  1001. for j:=1 to cfg.packs do
  1002. data.packmask[j]:=$ffff;
  1003. repeat
  1004. { select components }
  1005. p:=new(pinstalldialog,init);
  1006. c:=executedialog(p,@data);
  1007. if (c=cmok) then
  1008. begin
  1009. if Data.BasePath = '' then
  1010. messagebox('Please, choose the directory for installation first.',nil,mferror+mfokbutton)
  1011. else
  1012. begin
  1013. found:=false;
  1014. for j:=1 to cfg.packs do
  1015. if data.packmask[j]>0 then
  1016. found:=true;
  1017. if found then
  1018. begin
  1019. {$IFNDEF LINUX}
  1020. { TH - check the available disk space here }
  1021. DSize := 0;
  1022. for j:=1 to cfg.packs do
  1023. with cfg.pack[j] do
  1024. begin
  1025. for i:=1 to packages do
  1026. begin
  1027. if data.packmask[j] and packagemask(i)<>0 then
  1028. begin
  1029. ASpace := package[i].diskspace;
  1030. if ASpace = -1 then
  1031. MessageBox ('File ' + package[i].zip +
  1032. ' is probably corrupted!', nil,
  1033. mferror + mfokbutton)
  1034. else Inc (DSize, ASpace);
  1035. end;
  1036. end;
  1037. end;
  1038. S := FExpand (Data.BasePath);
  1039. if S [Length (S)] = DirSep then
  1040. Dec (S [0]);
  1041. Space := DiskFree (byte (Upcase(S [1])) - 64);
  1042. { -1 means that the drive is invalid }
  1043. if Space=-1 then
  1044. begin
  1045. if messagebox('The drive '+S[1]+': is not valid. Do you ' +
  1046. 'want to change the installation path?',nil,
  1047. mferror+mfyesbutton+mfnobutton) = cmYes then
  1048. Continue;
  1049. Space:=0;
  1050. end;
  1051. Space := Space shr 10;
  1052. if Space < DSize then
  1053. S := 'is not'
  1054. else
  1055. S := '';
  1056. if (Space < DSize + 500) then
  1057. begin
  1058. if S = '' then
  1059. S := 'might not be ';
  1060. if messagebox('There ' + S + 'enough space on the target ' +
  1061. 'drive for all the selected components. Do you ' +
  1062. 'want to change the installation path?',nil,
  1063. mferror+mfyesbutton+mfnobutton) = cmYes then
  1064. Continue;
  1065. end;
  1066. {$ENDIF}
  1067. if createinstalldir(data.basepath) then
  1068. break;
  1069. end
  1070. else
  1071. begin
  1072. { maybe only config }
  1073. if (data.cfgval and 1)<>0 then
  1074. begin
  1075. result:=messagebox('No components selected.'#13#13'Create a configfile ?',nil,
  1076. mfinformation+mfyesbutton+mfnobutton);
  1077. if (result=cmYes) and createinstalldir(data.basepath) then
  1078. doconfigwrite;
  1079. exit;
  1080. end
  1081. else
  1082. begin
  1083. result:=messagebox('No components selected.'#13#13'Abort installation?',nil,
  1084. mferror+mfyesbutton+mfnobutton);
  1085. if result=cmYes then
  1086. exit;
  1087. end;
  1088. end;
  1089. end;
  1090. end
  1091. else
  1092. exit;
  1093. until false;
  1094. { extract packages }
  1095. for j:=1 to cfg.packs do
  1096. with cfg.pack[j] do
  1097. begin
  1098. r.assign(10,7,70,18);
  1099. UnzDlg:=new(punzipdialog,init(r,'Extracting Packages'));
  1100. desktop^.insert(UnzDlg);
  1101. for i:=1 to packages do
  1102. begin
  1103. if data.packmask[j] and packagemask(i)<>0 then
  1104. begin
  1105. UnzDlg^.do_unzip(package[i].zip,data.basepath);
  1106. { gather some information about the installed files }
  1107. if copy(package[i].zip,1,3)='ide' then
  1108. haside:=true;
  1109. if copy(package[i].zip,1,7)='doc-htm' then
  1110. begin
  1111. hashtmlhelp:=true;
  1112. { correct the fpctoc file name if .html files are used }
  1113. if package[i].zip='doc-html.zip' then
  1114. if copy(cfg.helpidx,length(cfg.helpidx)-3,4)='.htm' then
  1115. cfg.helpidx:=cfg.helpidx+'l';
  1116. end;
  1117. end;
  1118. end;
  1119. desktop^.delete(UnzDlg);
  1120. dispose(UnzDlg,done);
  1121. end;
  1122. { write config }
  1123. if (data.cfgval and 1)<>0 then
  1124. doconfigwrite;
  1125. { show end message }
  1126. p3:=new(penddialog,init);
  1127. executedialog(p3,nil);
  1128. end;
  1129. procedure tapp.readcfg(const fn:string);
  1130. var
  1131. t : text;
  1132. i,j,k,
  1133. line : longint;
  1134. item,
  1135. s,hs : string;
  1136. params : array[0..0] of pointer;
  1137. {$ifndef FPC}
  1138. procedure readln(var t:text;var s:string);
  1139. var
  1140. c : char;
  1141. i : longint;
  1142. begin
  1143. c:=#0;
  1144. i:=0;
  1145. while (not eof(t)) and (c<>#10) do
  1146. begin
  1147. read(t,c);
  1148. if c<>#10 then
  1149. begin
  1150. inc(i);
  1151. s[i]:=c;
  1152. end;
  1153. end;
  1154. if (i>0) and (s[i]=#13) then
  1155. dec(i);
  1156. s[0]:=chr(i);
  1157. end;
  1158. {$endif}
  1159. begin
  1160. assign(t,StartPath + DirSep + fn);
  1161. {$I-}
  1162. reset(t);
  1163. {$I+}
  1164. if ioresult<>0 then
  1165. begin
  1166. StartPath := GetProgDir;
  1167. assign(t,StartPath + DirSep + fn);
  1168. {$I-}
  1169. reset(t);
  1170. {$I+}
  1171. if ioresult<>0 then
  1172. begin
  1173. params[0]:=@fn;
  1174. messagebox('File %s not found!',@params,mferror+mfokbutton);
  1175. errorhalt;
  1176. end;
  1177. end;
  1178. line:=0;
  1179. while not eof(t) do
  1180. begin
  1181. readln(t,s);
  1182. inc(line);
  1183. if (s<>'') and not(s[1] in ['#',';']) then
  1184. begin
  1185. i:=pos('=',s);
  1186. if i>0 then
  1187. begin
  1188. item:=upper(Copy(s,1,i-1));
  1189. system.delete(s,1,i);
  1190. if item='VERSION' then
  1191. cfg.version:=s
  1192. else
  1193. if item='TITLE' then
  1194. cfg.title:=s
  1195. else
  1196. if item='BASEPATH' then
  1197. cfg.basepath:=s
  1198. else
  1199. if item='HELPIDX' then
  1200. cfg.helpidx:=s
  1201. else
  1202. if item='DOCSUB' then
  1203. cfg.docsub:=s
  1204. else
  1205. if item='DEFAULTCFG' then
  1206. begin
  1207. repeat
  1208. readln(t,s);
  1209. if upper(s)='ENDCFG' then
  1210. break;
  1211. if cfg.defcfgs<maxdefcfgs then
  1212. begin
  1213. inc(cfg.defcfgs);
  1214. cfg.defcfg[cfg.defcfgs]:=newstr(s);
  1215. end;
  1216. until false;
  1217. end
  1218. else if item='DEFAULTIDECFG' then
  1219. begin
  1220. repeat
  1221. readln(t,s);
  1222. if upper(s)='ENDCFG' then
  1223. break;
  1224. if cfg.defidecfgs<maxdefcfgs then
  1225. begin
  1226. inc(cfg.defidecfgs);
  1227. cfg.defidecfg[cfg.defidecfgs]:=newstr(s);
  1228. end;
  1229. until false;
  1230. end
  1231. else if item='DEFAULTIDEINI' then
  1232. begin
  1233. repeat
  1234. readln(t,s);
  1235. if upper(s)='ENDCFG' then
  1236. break;
  1237. if cfg.defideinis<maxdefcfgs then
  1238. begin
  1239. inc(cfg.defideinis);
  1240. cfg.defideini[cfg.defideinis]:=newstr(s);
  1241. end;
  1242. until false;
  1243. end
  1244. else
  1245. if item='PACK' then
  1246. begin
  1247. inc(cfg.packs);
  1248. if cfg.packs>maxpacks then
  1249. begin
  1250. writeln('Too many packs');
  1251. halt(1);
  1252. end;
  1253. cfg.pack[cfg.packs].name:=s;
  1254. end
  1255. else
  1256. if item='CFGFILE' then
  1257. begin
  1258. if cfg.packs=0 then
  1259. begin
  1260. writeln('No pack set');
  1261. halt(1);
  1262. end;
  1263. cfg.pack[cfg.packs].defcfgfile:=s
  1264. end
  1265. else
  1266. if item='IDECFGFILE' then
  1267. begin
  1268. if cfg.packs=0 then
  1269. begin
  1270. writeln('No pack set');
  1271. halt(1);
  1272. end;
  1273. cfg.pack[cfg.packs].defidecfgfile:=s
  1274. end
  1275. else
  1276. if item='IDEINIFILE' then
  1277. begin
  1278. if cfg.packs=0 then
  1279. begin
  1280. writeln('No pack set');
  1281. halt(1);
  1282. end;
  1283. cfg.pack[cfg.packs].defideinifile:=s
  1284. end
  1285. else
  1286. if item='PPC386' then
  1287. begin
  1288. if cfg.packs=0 then
  1289. begin
  1290. writeln('No pack set');
  1291. halt(1);
  1292. end;
  1293. cfg.pack[cfg.packs].ppc386:=s;
  1294. end
  1295. else
  1296. if item='BINSUB' then
  1297. begin
  1298. if cfg.packs=0 then
  1299. begin
  1300. writeln('No pack set');
  1301. halt(1);
  1302. end;
  1303. cfg.pack[cfg.packs].binsub:=s;
  1304. end
  1305. else
  1306. if item='FILECHECK' then
  1307. begin
  1308. if cfg.packs=0 then
  1309. begin
  1310. writeln('No pack set');
  1311. halt(1);
  1312. end;
  1313. cfg.pack[cfg.packs].filechk:=s;
  1314. end
  1315. else
  1316. if item='TARGETNAME' then
  1317. begin
  1318. if cfg.packs=0 then
  1319. begin
  1320. writeln('No pack set');
  1321. halt(1);
  1322. end;
  1323. cfg.pack[cfg.packs].targetname:=s;
  1324. end
  1325. else
  1326. if item='PACKAGE' then
  1327. begin
  1328. if cfg.packs=0 then
  1329. begin
  1330. writeln('No pack set');
  1331. halt(1);
  1332. end;
  1333. with cfg.pack[cfg.packs] do
  1334. begin
  1335. j:=pos(',',s);
  1336. if (j>0) and (packages<maxpackages) then
  1337. begin
  1338. inc(packages);
  1339. hs:=copy(s,1,j-1);
  1340. k:=pos('[',hs);
  1341. if (k>0) then
  1342. begin
  1343. package[packages].zip:=Copy(hs,1,k-1);
  1344. package[packages].zipshort:=Copy(hs,k+1,length(hs)-k-1);
  1345. end
  1346. else
  1347. package[packages].zip:=hs;
  1348. package[packages].name:=copy(s,j+1,255);
  1349. end;
  1350. package[packages].diskspace:=-1;
  1351. end;
  1352. end
  1353. end;
  1354. end;
  1355. end;
  1356. close(t);
  1357. end;
  1358. procedure tapp.checkavailpack;
  1359. var
  1360. j : longint;
  1361. dir : searchrec;
  1362. begin
  1363. { check the packages }
  1364. j:=0;
  1365. while (j<cfg.packs) do
  1366. begin
  1367. inc(j);
  1368. if cfg.pack[j].filechk<>'' then
  1369. begin
  1370. findfirst(cfg.pack[j].filechk,$20,dir);
  1371. if doserror<>0 then
  1372. begin
  1373. { remove the package }
  1374. move(cfg.pack[j+1],cfg.pack[j],sizeof(tpack)*(cfg.packs-j));
  1375. dec(cfg.packs);
  1376. dec(j);
  1377. end;
  1378. {$IFNDEF TP}
  1379. findclose(dir);
  1380. {$ENDIF}
  1381. end;
  1382. end;
  1383. end;
  1384. procedure tapp.initmenubar;
  1385. var
  1386. r : trect;
  1387. begin
  1388. getextent(r);
  1389. r.b.y:=r.a.y+1;
  1390. menubar:=new(pmenubar,init(r,newmenu(
  1391. newsubmenu('Free Pascal Installer',hcnocontext,newmenu(nil
  1392. ),
  1393. nil))));
  1394. end;
  1395. procedure tapp.handleevent(var event : tevent);
  1396. begin
  1397. inherited handleevent(event);
  1398. if event.what=evcommand then
  1399. if event.command=cmstart then
  1400. begin
  1401. clearevent(event);
  1402. do_installdialog;
  1403. if successfull then
  1404. begin
  1405. event.what:=evcommand;
  1406. event.command:=cmquit;
  1407. handleevent(event);
  1408. end;
  1409. end;
  1410. end;
  1411. {$IFDEF DOSSTUB}
  1412. function CheckOS2: boolean;
  1413. var
  1414. OwnName: PathStr;
  1415. OwnDir: DirStr;
  1416. Name: NameStr;
  1417. Ext: ExtStr;
  1418. DosV, W: word;
  1419. P: PChar;
  1420. const
  1421. Title: string [15] = 'FPC Installer'#0;
  1422. RunBlock: TRunBlock = (Length: $32;
  1423. Dependent: 0;
  1424. Background: 0;
  1425. TraceLevel: 0;
  1426. PrgTitle: @Title [1];
  1427. PrgName: nil;
  1428. Args: nil;
  1429. TermQ: 0;
  1430. Environment: nil;
  1431. Inheritance: 0;
  1432. SesType: 2;
  1433. Icon: nil;
  1434. PgmHandle: 0;
  1435. PgmControl: 2;
  1436. Column: 0;
  1437. Row: 0;
  1438. Width: 80;
  1439. Height: 25);
  1440. begin
  1441. CheckOS2 := false;
  1442. asm
  1443. mov ah, 30h
  1444. int 21h
  1445. xchg ah, al
  1446. mov DosV, ax
  1447. mov ax, 4010h
  1448. int 2Fh
  1449. cmp ax, 4010h
  1450. jnz @0
  1451. xor bx, bx
  1452. @0:
  1453. mov W, bx
  1454. end;
  1455. if DosV > 3 shl 8 then
  1456. begin
  1457. OwnName := FExpand (ParamStr (0));
  1458. FSplit (OwnName, OwnDir, Name, Ext);
  1459. if (DosV >= 20 shl 8 + 10) and (W >= 20 shl 8 + 10) then
  1460. (* OS/2 version 2.1 or later running (double-checked) *)
  1461. begin
  1462. OwnName [Succ (byte (OwnName [0]))] := #0;
  1463. RunBlock.PrgName := @OwnName [1];
  1464. P := Ptr (PrefixSeg, $80);
  1465. if PByte (P)^ <> 0 then
  1466. begin
  1467. Inc (P);
  1468. RunBlock.Args := Ptr (PrefixSeg, $81);
  1469. end;
  1470. asm
  1471. mov ax, 6400h
  1472. mov bx, 0025h
  1473. mov cx, 636Ch
  1474. mov si, offset RunBlock
  1475. int 21h
  1476. jc @0
  1477. mov DosV, 0
  1478. @0:
  1479. end;
  1480. CheckOS2 := DosV = 0;
  1481. end;
  1482. end;
  1483. end;
  1484. {$ENDIF}
  1485. var
  1486. i : longint;
  1487. begin
  1488. { register objects for help streaming }
  1489. RegisterWHTMLScan;
  1490. {$ifdef FPC}
  1491. {$ifdef win32}
  1492. Dos.Exec(GetEnv('COMSPEC'),'/C echo This dummy call gets the mouse to become visible');
  1493. {$endif win32}
  1494. {$endif FPC}
  1495. (* TH - no error boxes if checking an inaccessible disk etc. *)
  1496. {$IFDEF OS2}
  1497. {$IFDEF FPC}
  1498. DosCalls.DosError (0);
  1499. {$ELSE FPC}
  1500. {$IFDEF VirtualPascal}
  1501. OS2Base.DosError (ferr_DisableHardErr);
  1502. {$ELSE VirtualPascal}
  1503. BseDos.DosError (0);
  1504. {$ENDIF VirtualPascal}
  1505. {$ENDIF FPC}
  1506. {$ENDIF}
  1507. {$IFDEF DOSSTUB}
  1508. if CheckOS2 then Halt;
  1509. {$ENDIF}
  1510. createlog:=false;
  1511. {$ifdef MAYBE_LFN}
  1512. locallfnsupport:=system.lfnsupport;
  1513. {$endif MAYBE_LFN}
  1514. for i:=1 to paramcount do
  1515. begin
  1516. if paramstr(i)='-l' then
  1517. createlog:=true
  1518. {$ifdef MAYBE_LFN}
  1519. else if paramstr(i)='--nolfn' then
  1520. begin
  1521. locallfnsupport:=false;
  1522. {$ifdef GO32V2}
  1523. { lfnsupport is a const in win32 RTL }
  1524. system.lfnsupport:=locallfnsupport;
  1525. {$endif GO32V2}
  1526. end
  1527. {$endif MAYBE_LFN}
  1528. else if paramstr(i)='-h' then
  1529. begin
  1530. writeln('FPC Installer Copyright (c) 1993-2002 Florian Klaempfl');
  1531. writeln('Command line options:');
  1532. writeln(' -l create log file');
  1533. {$ifdef MAYBE_LFN}
  1534. writeln(' --nolfn force installation with short file names');
  1535. {$endif MAYBE_LFN}
  1536. writeln;
  1537. writeln(' -h displays this help');
  1538. halt(0);
  1539. end
  1540. else
  1541. begin
  1542. writeln('Illegal command line parameter: ',paramstr(i));
  1543. halt(1);
  1544. end;
  1545. end;
  1546. if createlog then
  1547. begin
  1548. assign(log,'install.log');
  1549. rewrite(log);
  1550. {$ifdef MAYBE_LFN}
  1551. if not(locallfnsupport) then
  1552. writeln(log,'OS doesn''t have LFN support');
  1553. {$endif}
  1554. end;
  1555. getdir(0,startpath);
  1556. successfull:=false;
  1557. fillchar(cfg, SizeOf(cfg), 0);
  1558. fillchar(data, SizeOf(data), 0);
  1559. installapp.init;
  1560. FSplit (FExpand (ParamStr (0)), DStr, CfgName, EStr);
  1561. installapp.readcfg(CfgName + CfgExt);
  1562. installapp.checkavailpack;
  1563. { installapp.readcfg(startpath+dirsep+cfgfile);}
  1564. {$ifdef GO32V2}
  1565. if not(lfnsupport) then
  1566. MessageBox('The operating system doesn''t support LFN (long file names),'+
  1567. ' so some packages will get shorten filenames when installed',nil,mfinformation or mfokbutton);
  1568. {$endif}
  1569. installapp.do_installdialog;
  1570. installapp.done;
  1571. if createlog then
  1572. close(log);
  1573. end.
  1574. {
  1575. $Log$
  1576. Revision 1.6 2002-03-19 09:14:56 pierre
  1577. * fix fpctoc.html problem
  1578. Revision 1.5 2002/03/13 22:27:36 pierre
  1579. * fix problem if invalid drive is given
  1580. Revision 1.4 2002/02/28 21:30:34 peter
  1581. * regenated
  1582. Revision 1.3 2002/02/28 17:02:08 pierre
  1583. * fix win32 compilation if DEBUG cond is set
  1584. Revision 1.2 2002/01/29 22:01:17 peter
  1585. * support fvision
  1586. Revision 1.1 2002/01/29 17:59:15 peter
  1587. * moved installer
  1588. Revision 1.2.2.16 2001/11/24 14:29:54 carl
  1589. * ppc386.cfg -> fpc.cfg
  1590. Revision 1.2.2.15 2001/05/02 16:22:43 pierre
  1591. + Shorten file names to comply with Dos 8+3 limitation
  1592. Revision 1.2.2.14 2001/04/19 15:50:24 pierre
  1593. * remove use of reals so emu387 is not needed anymore
  1594. Revision 1.2.2.13 2001/01/02 09:43:12 florian
  1595. * vresion fixed
  1596. Revision 1.2.2.12 2001/01/02 09:35:50 florian
  1597. * targetname is now read from the .dat file too
  1598. Revision 1.2.2.11 2000/11/26 19:02:58 hajny
  1599. * English correction
  1600. Revision 1.2.2.10 2000/11/26 16:49:57 hajny
  1601. * removed unneeded OS/2 conditionals
  1602. Revision 1.2.2.9 2000/11/09 22:02:33 florian
  1603. * fixed bug 1226: wrong target for the win32 IDE
  1604. Revision 1.2.2.8 2000/10/11 18:08:45 peter
  1605. * lfnsupport is only for go32v2
  1606. Revision 1.2.2.7 2000/10/11 16:49:02 florian
  1607. + fixed a typo and the setting of haside and hashtmlhelp
  1608. Revision 1.2.2.6 2000/10/11 13:10:20 florian
  1609. + added preconfiguratioh of help files
  1610. Revision 1.2.2.5 2000/10/10 22:12:10 florian
  1611. + added a message how to start the IDE
  1612. Revision 1.2.2.4 2000/10/10 16:36:12 florian
  1613. + creation of IDE configuration files added
  1614. Revision 1.2.2.3 2000/09/24 10:52:14 peter
  1615. * window can now also be smaller again
  1616. Revision 1.2.2.2 2000/09/22 08:41:36 pierre
  1617. * add emulation for go32v2 and display currently extraced file
  1618. Revision 1.2.2.1 2000/09/21 10:57:11 pierre
  1619. changes by Gabor for scrolling support
  1620. Revision 1.2 2000/07/21 10:43:01 florian
  1621. + added for lfn support
  1622. Revision 1.1 2000/07/13 06:30:21 michael
  1623. + Initial import
  1624. Revision 1.20 2000/07/09 12:55:45 hajny
  1625. * updated for version 1.0
  1626. Revision 1.19 2000/06/18 18:27:32 hajny
  1627. + archive validity checking, progress indicator, better error checking
  1628. Revision 1.18 2000/02/24 17:47:47 peter
  1629. * last fixes for 0.99.14a release
  1630. Revision 1.17 2000/02/23 17:17:56 peter
  1631. * write ppc386.cfg for all found targets
  1632. Revision 1.16 2000/02/06 12:59:39 peter
  1633. * change upper -> upcase
  1634. * fixed stupid debugging leftover with diskspace check
  1635. Revision 1.15 2000/02/02 17:19:10 pierre
  1636. * avoid diskfree problem and get mouse visible
  1637. Revision 1.14 2000/02/02 15:21:31 peter
  1638. * show errorcode in message when error in unzipping
  1639. Revision 1.13 2000/01/26 21:49:33 peter
  1640. * install.pas compilable by FPC again
  1641. * removed some notes from unzip.pas
  1642. * support installer creation under linux (install has name conflict)
  1643. Revision 1.12 2000/01/26 21:15:59 hajny
  1644. * compilable with TP again (lines < 127install.pas, ifdef around findclose)
  1645. Revision 1.11 2000/01/24 22:21:48 peter
  1646. * new install version (keys not wrong correct yet)
  1647. Revision 1.10 2000/01/18 00:22:48 peter
  1648. * fixed uninited local var
  1649. Revision 1.9 1999/08/03 20:21:53 peter
  1650. * fixed sources mask which was not set correctly
  1651. Revision 1.7 1999/07/01 07:56:58 hajny
  1652. * installation to root fixed
  1653. Revision 1.6 1999/06/29 22:20:19 peter
  1654. * updated to use tab pages
  1655. Revision 1.5 1999/06/25 07:06:30 hajny
  1656. + searching for installation script updated
  1657. Revision 1.4 1999/06/10 20:01:23 peter
  1658. + fcl,fv,gtk support
  1659. Revision 1.3 1999/06/10 15:00:14 peter
  1660. * fixed to compile for not os2
  1661. * update install.dat
  1662. Revision 1.2 1999/06/10 07:28:27 hajny
  1663. * compilable with TP again
  1664. Revision 1.1 1999/02/19 16:45:26 peter
  1665. * moved to fpinst/ directory
  1666. + makefile
  1667. Revision 1.15 1999/02/17 22:34:08 peter
  1668. * updates from TH for OS2
  1669. Revision 1.14 1998/12/22 22:47:34 peter
  1670. * updates for OS2
  1671. * small fixes
  1672. Revision 1.13 1998/12/21 13:11:39 peter
  1673. * updates for 0.99.10
  1674. Revision 1.12 1998/12/16 00:25:34 peter
  1675. * updated for 0.99.10
  1676. * new end dialogbox
  1677. Revision 1.11 1998/11/01 20:32:25 peter
  1678. * packed record
  1679. Revision 1.10 1998/10/25 23:38:35 peter
  1680. * removed warnings
  1681. Revision 1.9 1998/10/23 16:57:40 pierre
  1682. * compiles without -So option
  1683. * the main dialog init was buggy !!
  1684. Revision 1.8 1998/09/22 21:10:31 jonas
  1685. * initialize cfg and data with 0 at startup
  1686. Revision 1.7 1998/09/16 16:46:37 peter
  1687. + updates
  1688. Revision 1.6 1998/09/15 13:11:14 pierre
  1689. small fix to cleanup if no package
  1690. Revision 1.5 1998/09/15 12:06:06 peter
  1691. * install updated to support w32 and dos and config file
  1692. Revision 1.4 1998/09/10 10:50:49 florian
  1693. * DOS install program updated
  1694. Revision 1.3 1998/09/09 13:39:58 peter
  1695. + internal unzip
  1696. * dialog is showed automaticly
  1697. Revision 1.2 1998/04/07 22:47:57 florian
  1698. + version/release/patch numbers as string added
  1699. }